I have to make project in Delphi. I made an array of buttons and an array of images. I want to show Image[i] when I click button[i].
Can somebody help please?
How about using the button's tag property to store a pointer to the correlating image. I'm unsure of your Array structure but here's a code snippet to demonstrate.
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Button2: TButton;
Image2: TImage;
procedure FormCreate(Sender: TObject);
private
FMyCurrentImage : TImage; //Keeps track of the current image
procedure MyButtonClick(Sender: TObject);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyCurrentImage := nil;
Button1.Tag := Integer(Image1);
Button1.OnClick := MyButtonClick;
Image1.Hide;
Button2.Tag := Integer(Image2);
Button2.OnClick := MyButtonClick;
Image2.Hide;
end;
procedure TForm1.MyButtonClick(Sender: TObject);
begin
if Sender is TButton then
with Sender as TButton do
if Assigned(TImage(Tag)) then
begin
//Hide the previously selected image
if Assigned(FMyCurrentImage) then
FMyCurrentImage.Hide;
//Assign and show the clicked button's image
FMyCurrentImage := TImage(Tag);
FMyCurrentImage.Show;
end;
end;
What kind of component are you using in your form to show the image?
I don't know what you really need, but here's something I guess you'd want:
I have created three components in the form to test it: two TButton's and one of TImage type.
TfrmTest = class(TForm)
btn1: TButton;
btn2: TButton;
img: TImage;
procedure showImage(sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
In the var section:
var
frmTest: TfrmTest;
imagesArray: array[1..2] of String = ('blue.jpg', 'red.jpg');
buttonsArray: array[1..2] of String = ('btn1', 'btn2');
The implementation of your event:
procedure TfrmTest.showImage(sender: TObject);
var
i: integer;
begin
for i := low(buttonsArray) to high(buttonsArray) do
begin
if (buttonsArray[i] = TButton(sender).name) then
begin
img.picture.loadFromFile('your images directory path here' + imagesArray[i]);
break;
end;
end;
end;
In the Object Inspector, you need to set the OnClick event of your buttons with the showImage procedure.
Related
I have a RFID reader that comes with a RFTT service. I start the service and try to access it with TidTCPClient, but I get an access violation as soon I try to connect. Read of Address 00000000
As soon it click connect I get the message.
unit UClient;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdThreadComponent;
type
TFClient = class(TForm)
Label1 : TLabel;
Label2 : TLabel;
messageToSend : TMemo;
messagesLog : TMemo;
btn_connect : TButton;
btn_disconnect: TButton;
btn_send : TButton;
procedure FormShow(Sender: TObject);
procedure btn_connectClick(Sender: TObject);
procedure btn_disconnectClick(Sender: TObject);
procedure btn_sendClick(Sender: TObject);
procedure IdTCPClientConnected(Sender: TObject);
procedure IdTCPClientDisconnected(Sender: TObject);
procedure IdThreadComponentRun(Sender: TIdThreadComponent);
procedure Display(p_sender: String; p_message: string);
function GetNow():String;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
// ... listening port : GUEST CLIENT
const GUEST_PORT = 5733;
var
FClient : TFClient;
// ... TIdTCPClient
idTCPClient : TIdTCPClient;
// ... TIdThreadComponent
idThreadComponent : TIdThreadComponent;
implementation
{$R *.dfm}
procedure TFClient.FormCreate(Sender: TObject);
begin
// ... create TIdTCPClient
idTCPClient := TIdTCPClient.Create();
// ... set properties
idTCPClient.Host := 'localhost';
idTCPClient.Port := GUEST_PORT;
idTCPClient.ConnectTimeout := 5000;
// ... etc..
// ... callback functions
idTCPClient.OnConnected := IdTCPClientConnected;
idTCPClient.OnDisconnected := IdTCPClientDisconnected;
// ... etc..
// ... create TIdThreadComponent
idThreadComponent := TIdThreadComponent.Create();
// ... callback functions
idThreadComponent.OnRun := IdThreadComponentRun;
// ... etc..
end;
procedure TFClient.FormShow(Sender: TObject);
begin
// ... INITAILIZE
// ... message to send
messageToSend.Clear;
messageToSend.Enabled := False;
// ... clear log
messagesLog.Clear;
// ... buttons
btn_connect.Enabled := True;
btn_disconnect.Enabled := False;
btn_send.Enabled := False;
end;
procedure TFClient.btn_connectClick(Sender: TObject);
begin
// ... disable connect button
btn_connect.Enabled := False;
// ... try to connect to Server
try
IdTCPClient.Connect;
except
on E: Exception do begin
Display('CLIENT', 'CONNECTION ERROR! ' + E.Message);
btn_connect.Enabled := True;
end;
end;
end;
procedure TFClient.btn_disconnectClick(Sender: TObject);
begin
// ... is connected?
if IdTCPClient.Connected then begin
// ... disconnect from Server
IdTCPClient.Disconnect;
// ... set buttons
btn_connect.Enabled := True;
btn_disconnect.Enabled := False;
btn_send.Enabled := False;
messageToSend.Enabled := False;
end;
end;
procedure TFClient.IdTCPClientConnected(Sender: TObject);
begin
// ... messages log
Display('CLIENT', 'CONNECTED!');
// ... after connection is ok, run the Thread ... waiting messages from server
IdThreadComponent.Active := True;
// ... set buttons
btn_connect.Enabled := False;
btn_disconnect.Enabled := True;
btn_send.Enabled := True;
// ... enable message to send
messageToSend.Enabled := True;
end;
procedure TFClient.IdTCPClientDisconnected(Sender: TObject);
begin
// ... message log
Display('CLIENT', 'DISCONNECTED!');
end;
procedure TFClient.IdThreadComponentRun(Sender: TIdThreadComponent);
var
msgFromServer : string;
begin
// ... read message from server
msgFromServer := IdTCPClient.IOHandler.ReadLn();
// ... messages log
Display('SERVER', msgFromServer);
end;
procedure TFClient.Display(p_sender : String; p_message : string);
begin
TThread.Queue(nil, procedure
begin
MessagesLog.Lines.Add('[' + p_sender + '] - '
+ GetNow() + ': ' + p_message);
end
);
end;
function TFClient.getNow() : String;
begin
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ': ';
end;
end.
This is the whole program unfortunately I have to put all this text because it will not let me post with out more detailed text.
Thanks for any help,
KimHJ
As Remy suggested after dropping the component on the form and us those instead, everything worked fine.
The program freezes as usual. how to do in the flow ?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls, Unit2;
type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager1: TIdCookieManager;
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
private
my:myth;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
my:=myth.Create(true);
my.Priority:=tpNormal;
my.FreeOnTerminate:=True;
my.Resume;
end;
end.
FLOW
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls;
type
myth = class(TThread)
IdHTTP1: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager1: TIdCookieManager;
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
private
{ Private declarations }
protected
procedure Execute; override;
procedure meme;
public
end;
implementation
uses Unit1;
procedure myth.Execute;
begin
Synchronize(meme);
end;
procedure myth.meme;
var
s: string;
list, lista: TStringList;
resul: string;
begin
list := TStringList.Create;
Form1.Memo1.Clear;
list.Add('...');
list.Add('...');
list.Add('...');
list.Add('...');
s := IdHTTP1.Post('https://,list);
list.Free;
(LOGIN)
resul := idHTTP1.Get('...');
while Pos('tdn',resul) > 0 do begin //PRESS ON BUTTON
lista := TStringList.Create;
lista.Add('...');
IdHTTP1.Post('https:...,lista);
lista.Free;
end;
end;
end.
You are creating a worker thread just to Synchronize() all of its work back to the main UI thread. Don't do that! Only synchronize the pieces that actually need it. Have the thread call meme() directly without Synchronize(), and then have meme() use Synchronize() to access Form1.Memo1 and anything else that touches the UI. Your TStringList and TIdHTTP operations themselves don't need to be synchronized since they are local to meme() (if you create your IdHTTP1, IdSSLIOHandlerSocketOpenSSL1, and IdCookieManager1 objects dynamically in the thread, instead of on the Form at design-time).
Try something more like this instead:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
private
my: myth;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
my := myth.Create;
end;
end.
FLOW
unit Unit2;
interface
uses
Classes, IdCookieManager, IdSSLOpenSSL, IdHTTP;
type
myth = class(TThread)
IdHTTP: TIdHTTP;
IdSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
IdCookieManager: TIdCookieManager;
private
{ Private declarations }
procedure meme;
protected
procedure Execute; override;
public
constructor Create; reintroduce;
destructor Destroy; override;
end;
implementation
uses Unit1;
constructor myth.Create;
begin
inherited Create(False);
Priority := tpNormal;
FreeOnTerminate := True;
IdHTTP := TIdHTTP.Create(nil);
IdSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
// configure as needed...
IdHTTP.IOHandler := IdSSLIOHandlerSocketOpenSSL;
IdCookieManager := TIdCookieManager.Create(IdHTTP);
// configure as needed...
IdHTTP.CookieManager := IdCookieManager;
end;
destructor myth.Destroy;
begin
IdHTTP.Free;
inherited;
end;
procedure myth.Execute;
begin
meme;
end;
procedure myth.meme;
var
list: TStringList;
resul: string;
begin
list := TStringList.Create;
try
Synchronize(ClearMemo);
list.Add('...');
list.Add('...');
list.Add('...');
list.Add('...');
s := IdHTTP1.Post('https://...', list);
list.Clear;
...
resul := IdHTTP1.Get('...');
while Pos('tdn', resul) > 0 do begin
list.Clear;
list.Add('...');
IdHTTP1.Post('https://...', list);
list.Clear;
end;
finally
list.Free;
end;
end;
procedure myth.ClearMemo;
begin
Form1.Memo1.Clear;
end;
end.
I'm running Lazarus on Windows. I would really like to make the program "Beep". It appears that you can do so in Pascal using:
windows.beep(300,500);
But not in Lazarus! Is there another command that I can use?
Update:
sysutils.beep()
This works, but I'd really like to set the frequency and duration of sound
Afaik this is functionality that worked for ages. (Dev Pascal is over ten years old).
What is different is that Lazarus does not automatically add Windows to the uses clause, like Delphi does.
If this function is not declared in Lazarus, you can declare it like:
function Beep(dwFreq, dwDuration: DWORD): BOOL; stdcall; external 'kernel32.dll';
In Lazarus create a new project and add a button. Add windows unit into uses list.
In the button default event put your codes:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
windows; // added by manually
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
n,
freq,dur : integer;
begin
Randomize;
for n:=1 to 100 do
begin
windows.Beep(random(1000)+n,random(100)+100);
end;
end;
end.
I apologize for having another similar question but I was hoping to find a simpler solution to a problem I am having.
I have a listview in form1 that I want form2 to be able to add to. Form2 is created by form1 by a button press. Form2 has a listview and when I click on a button in form2 I want it to add all items to the listview in form1 and close form2. What is the simplest way to accomplish this?
*I tried using windows messaging but for some reason Lazarus doesn't work with TWM_CopyData.
Since I would prefer the unit referencing, here is what might help you. In the Form2 is declared public property TargetListView into which is assigned the list view from the Form1 before the Form2 is shown. Now you have the access to the Form1 list view from the Form2 scope and you can copy the items there before you close it.
Here is the simplified code for the first unit:
unit Unit1;
uses
Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
Form2.TargetListView := ListView1;
Form2.Show;
end;
And here is the simplified code for the second unit:
unit Unit2;
type
TForm2 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
TargetListView: TListView;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
I: Integer;
begin
TargetListView.Items.BeginUpdate;
try
for I := 0 to ListView1.Items.Count - 1 do
TargetListView.Items.Add.Assign(ListView1.Items[I]);
finally
TargetListView.Items.EndUpdate;
end;
Close;
end;
How to send & receive commands from other Delphi created applications? I want to send command to another application that I've written.
Sender:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
WM_MY_MESSAGE = WM_USER + 1;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
h: HWND;
begin
h := FindWindow(nil, 'My Second Window');
if IsWindow(h) then
SendMessage(h, WM_MY_MESSAGE, 123, 520);
end;
end.
Receiver:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
WM_MY_MESSAGE = WM_USER + 1;
type
TForm1 = class(TForm)
private
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
case Message.Msg of
WM_MY_MESSAGE:
ShowMessageFmt('The other application sent the data %d and %d.', [Message.WParam, Message.LParam]);
end;
end;
end.
Make sure that the caption of the receiving form is 'My Second Window'.
Windows Messages might be a solution - an interesting article can be found here: http://delphi.about.com/od/windowsshellapi/a/aa020800a.htm
Look up interprocess communication. Some lightweight appropriate options for you could be:
Define your own custom windows
message
Use WM_COPYDATA
If you are writing both these applications, TCP/IP can be a cleaner solution than windows messages. The two applications can even be on different computers in a network.