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.
While implementing my own observer framework I got a problem: I can't execute procedures of object when they are returned in getter. I have here an example program for Lazarus. What should I do to see "TRUE" in console? (Now program returns false). It's a complete program, you can just copy-paste it.
program project1;
{$mode objfpc}
uses
SysUtils,
Classes;
type
TEvent = procedure of object;
{ IInterface }
IInterface = interface
function GetEvent: TEvent;
procedure SetEvent(AValue: TEvent);
property Event: TEvent read GetEvent write SetEvent;
end;
{ TMYClass }
TMYClass = class(TInterfacedObject, IInterface)
private
FEvent: TEvent;
public
function GetEvent: TEvent;
procedure SetEvent(AValue: TEvent);
property Event: TEvent read GetEvent write SetEvent;
end;
{ TAnotherClass }
TAnotherClass = class
FVariable: boolean;
constructor Create;
procedure Handler;
end;
{ TAnotherClass }
constructor TAnotherClass.Create;
begin
FVariable := False;
end;
procedure TAnotherClass.Handler;
begin
FVariable := True;
end;
function TMYClass.GetEvent: TEvent;
begin
Result := FEvent;
end;
procedure TMYClass.SetEvent(AValue: TEvent);
begin
FEvent := AValue;
end;
var
LInterface: IInterface;
LAnother: TAnotherClass;
begin
LInterface := TMYClass.Create;
LAnother := TAnotherClass.Create;
LInterface.Event:=#LAnother.Handler;
LInterface.Event;
WriteLn(LAnother.FVariable);
ReadLn();
end.
When I debug this, it looks as if Result isn't assigned in TMYClass.GetEvent. Do you know, what is my problem?
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 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.
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;