Is it possible to start procedure delayed after the calling procedure will end?
procedure StartLoop;
begin
DoSomething;
end;
procedure FormCreate(...);
begin
if ParamStr(1)='start' then StartLoop;
end;
StartLoop will be called inside FormCreate, and FormCreate will be waiting, and block further execution not only the of FormCreate itself, but also further procedures executing after it (FormShow, etc.), and form will not show until StartLoop will end.
I need to wait until FormCreate will end, and run StartLoop after that (without using threads).
If you are using 10.2 Tokyo or later, you can use TThread.ForceQueue():
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TThread.ForceQueue(nil, StartLoop);
end;
Otherwise, you can use PostMessage() instead:
const
WM_STARTLOOP = WM_USER + 1;
procedure TMyForm.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
PostMessage(Handle, WM_STARTLOOP, 0, 0);
end;
procedure TMyForm.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_STARTLOOP then
StartLoop
else
inherited;
end;
The simplest way is using timer.
Let you create DelayTimer with needed period set and Enabled = False on the form in design time (you can also create it dynamically). Assign event handler for it:
procedure TFormXX.DelayTimerTimer(Sender: TObject);
begin
DelayTimer.Enabled := False; // works only once
StartLoop;
end;
in the form intialization routine start this timer:
procedure FormCreate(...);
begin
if ParamStr(1)='start' then
DelayTimer.Enabled := True;
end;
Perhaps you want to start the timer later, for example - in the OnShow, if your application performs some continuous actions during creation.
AN other solution could be wrapping your DoSomething method into a Task:
uses
System.Threading;
procedure TForm2.DoSomething;
begin
Sleep(2000);
Caption := 'Done';
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
if ParamStr(1) = 'start' then
TTask.Run(
procedure
begin
DoSomething
end);
end;
Related
I have a problem that I don't know how to fix.
I try to start a thread in the OnCreate event, or after creating a TFrame when its Parent is still nil. When creating the thread, I pass it a window handle, but the address of the window changes after e.g. the OnShow event.
procedure Form1.OnCreate(Sender: TObject);
begin
TCustomThread.Create(Self);
Label1.Caption := IntToStr(Self.Handle); //for example 10203040
end;
procedure Form1.ButtonOnClick;
begin
Label1.Caption := IntToStr(Self.Handle); //i give 342545454 not 10203040
end;
procedure Form1.FromThread(var Msg: TMessage); message WM_TheardComplete;
begin
{do something}
end;
constructor TCustomThread.Create(AWinControl: TWinControl);
begin
inherited Create(False);
FWinControl := AWinControl;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWinControl.Handle, WM_TheardComplete, 0, 0); //Handle 10203040
end;
What parameter can I use to start the thread so that it can later send messages to this object?
The TWinControl.Handle property is NOT thread-safe. The VCL can, and does, recreate a control's window dynamically during the control's lifetime, even multiple times. But more importantly, windows have thread affinity, where message retrieval and processing for a given window only works in the thread that creates the window. A worker thread using a control's Handle property causes a race condition that, if you are not careful, can actually cause the worker thread to capture ownership of the control's window, rendering the control completely useless in the main UI thread.
If you need to give a worker thread a window to post/send messages to, give the thread a persistent window that the VCL won't destroy (without you telling it to), for instance by using the main TApplication window, using its OnMessage event to handle posted messages, or its HookMainWindow() method to handle sent messages, eg:
procedure Form1.OnCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
TCustomThread.Create(Application.Handle);
end;
procedure Form1.OnDestroy(Sender: TObject);
begin
Application.OnMessage := nil;
end;
procedure Form1.AppMessage(var Msg: tagMSG; var Handled: Boolean);
begin
if Msg.message = WM_TheardComplete then
begin
Handled := True;
{do something}
end;
end;
constructor TCustomThread.Create(AWnd: HWND);
begin
inherited Create(False);
FWnd := AWnd;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWnd, WM_TheardComplete, 0, 0);
end;
Or better, use a new dedicated window created with the VCL's AllocateHWnd() function, eg:
procedure Form1.OnCreate(Sender: TObject);
begin
ThreadWnd := AllocateHWnd(ThreadWndProc);
TCustomThread.Create(ThreadWnd);
end;
procedure Form1.OnDestroy(Sender: TObject);
begin
DeallocateHWnd(ThreadWnd);
end;
procedure Form1.ThreadWndProc(var Message: TMessage);
begin
if Message.Msg = WM_TheardComplete then
begin
{do something}
end else
Message.Result := DefWindowProc(ThreadWnd, Message.Msg, Message.WParam, Message.LParam);
end;
constructor TCustomThread.Create(AWnd: HWND);
begin
inherited Create(False);
FWnd := AWnd;
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
PostMessage(FWnd, WM_TheardComplete, 0, 0);
end;
However, in the example you have presented, rather than sending a message at the end of the thread's execution, I would suggest a completely different approach - use the TThread.OnTerminate event instead, which is already synced with the main thread, eg:
procedure Form1.OnCreate(Sender: TObject);
var
Thread: TCustomThread;
begin
Thread := TCustomThread.Create;
Thread.OnTerminate := ThreadFinished;
Thread.Start; // or Resume() in older versions
end;
procedure Form1.ThreadFinished(Sender: TObject);
begin
{do something}
end;
constructor TCustomThread.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
end;
procedure TCustomThread.Execute;
begin
{do something}
end;
Alternatively, in modern versions of Delphi, consider using TThread.CreateAnonymousThread() instead, eg:
procedure Form1.OnCreate(Sender: TObject);
var
Thread: TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
{do something}
end
);
Thread.OnTerminate := ThreadFinished;
Thread.Start;
end;
procedure Form1.ThreadFinished(Sender: TObject);
begin
{do something}
end;
Or even:
procedure Form1.OnCreate(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
try
{do something}
finally
TThread.Queue(nil,
procedure
begin
{do something}
end
);
end;
end
).Start;
end;
I've created an class that should propagate to the entire application a customized message when its going to be freed.
I did it with PostMessage and it worked with few bugs
PostMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
then I realized it should be synchronous - via SendMessage.
SendMessage(Application.Handle, UM_MYMESSAGE, 0, 0);
On my Form I was handling the messages with a TApplicationEvents component, but just switching SendMessage to PostMessage didn't make it handle the message
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Handled := True;
end;
end;
It works if I pass the Form Handle but not working with Application.Handle...
What am I doing wrong?
The TApplication(Events).OnMessage event is triggered only for messages that are posted to the main UI thread message queue. Sent messages go directly to the target window's message procedure, bypassing the message queue. That is why your OnMessage event handler works with using PostMessage() but not SendMessage().
To catch messages that are sent to the TApplication window, you need to use TApplication.HookMainWindow() instead of TApplication(Events).OnMessage, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MyAppHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MyAppHook);
end;
function TForm1.MyAppHook(var Message: TMessage): Boolean;
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Result := True;
end else
Result := False;
end;
That being said, a better solution is to use AllocateHWnd() to create your own private window that you can post/send your custom messages to, eg:
procedure TForm1.FormCreate(Sender: TObject);
begin
FMyWnd := AllocateHWnd(MyWndMsgProc);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeallocateHWnd(FMyWnd);
end;
procedure TForm1.MyWndMsgProc(var Message: TMessage);
begin
if Message.Msg = UM_MYMESSAGE then
begin
ShowMessage('Ok');
Message.Result := 0;
end else
Message.Result := DefWindowProc(FMyWnd, Message.Msg, Message.WParam, Message.LParam);
end;
Then you can post/send messages to FMyWnd.
I have an application that restores windows on startup but this results in a potential flicker as each window is created and positioned.
To get around this I have the splash screen (stretched to the full size of the screen) set to "StayOnTop" and close it after the OnShow event using a TTask. The problem is that occasionally the splash screen gets stuck. If you click where buttons should be they redraw and show correctly.
I have tried to "invalidate" all WinControls but this problem still shows up.
I have never seen the problem in the debugger.
Are there any other tricks anyone can suggest to forcing a full repaint of the screen?
Here is my code to close the splash - This is in the OnShow of the main form.
aTask := TTask.Create(procedure()
begin
Sleep(800);
TThread.Synchronize(nil, procedure()
begin
fSplash.Close;
FreeAndNil(fSplash);
DoInvalidate(self);
end);
end);
aTask.Start;
Here is my attempt to invalidate everything...
Procedure DoInvalidate( aWinControl: TWInControl );
var
i: Integer;
ctrl: TControl;
begin
for i:= 0 to aWinControl.Controlcount-1 do
begin
ctrl:= aWinControl.Controls[i];
if ctrl Is TWinControl then
DoInvalidate( TWincontrol( ctrl ));
end;
aWinControl.Invalidate;
end;
Martin
You don't need to recursively invalidate everything, just invalidating the Form itself is sufficient.
If you upgrade to 10.2 Tokyo, you can now use TThread.ForceQueue() instead of TThread.Synchronize() in a TTask:
procedure TMainForm.FormShow(Sender: TObject);
begin
TThread.ForceQueue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end
);
end;
If you stick with TTask, you should at least use TThread.Queue() instead:
procedure TMainForm.FormShow(Sender: TObject);
begin
TTask.Create(procedure
begin
TThread.Queue(nil, procedure
begin
FreeAndNil(fSplash);
Application.MainForm.Invalidate;
end;
end
).Start;
end;
Or, you could just use a short TTimer, like zdzichs suggested:
procedure TMainForm.FormShow(Sender: TObject);
begin
Timer1.Enabled := True;
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
FreeAndNil(fSplash);
Invalidate;
end;
Or, you could assign an OnClose event handler to the splash form to invalidate the MainForm, and then PostMessage() a WM_CLOSE message to the splash form:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnClose := SplashClosed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
PostMessage(fSplash.Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.SplashClosed(Sender: TObject; var Action: TCloseAction);
begin
fSplash := nil;
Action := caFree;
Invalidate;
end;
Or, use the OnDestroy event instead:
procedure TMainForm.FormCreate(Sender: TObject);
begin
fSplash := TSplashForm.Create(nil);
fSplash.OnDestroy := SplashDestroyed;
fSplash.Show;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
if fSplash <> nil then
fSplash.Release; // <-- delayed free
end;
procedure TMainForm.SplashDestroyed(Sender: TObject);
begin
fSplash := nil;
Invalidate;
end;
i am using delphi7. I want put a song in my program, but i don't want it to end never. I tried using a timer, but it didn't play the music:
procedure TForm1.FormCreate(Sender: TObject);
begin
timer1.enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var playsound,destination:string;
begin
destination:=paramstr(0);
playsound:=extractfilepath(destination)+'Soundtrack\play.wma';
mediaplayer1.FileName:=playsound;
mediaplayer1.Open;
mediaplayer1.Play; //USING TMEDIAPLAYER
end;
There are no syntax errors in this code, however the song is not running, perhaps the timer is not for that job. How should i do it? Thanks
The TMediaPlayer is a control, so you should naturally not use it unless you want precisely its GUI.
If you only want to play a audio file repeatedly, use the PlaySound function in MMSystem.pas:
PlaySound('test.wav', 0, SND_FILENAME or SND_NODEFAULT or SND_ASYNC or SND_LOOP)
Don't use a timer for this. Use the TMediaPlayer.OnNotify event instead:
procedure TForm1.FormCreate(Sender: TObject);
begin
mediaplayer1.FileName := extractfilepath(paramstr(0))+'Soundtrack\play.wma';
mediaplayer1.Notify := true;
mediaplayer1.Wait := false;
mediaplayer1.Open;
end;
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
case mediaplayer1.Mode of
mpOpen, mpStopped: begin
if mediaplayer1.Error = 0 then begin
mediaplayer1.Notify := true;
mediaplayer1.Wait := false;
mediaplayer1.Play;
end;
end;
end;
end;
If I create a (suspended) thread from the main thread as such:
with TMyThread.Create(True) do
begin
OnTerminate := ThreadTerminated;
FreeOnTerminate := False;
Start;
end;
How do I go about freeing that instance once it's completed? (ie the Execute procedure has finished executing - assume I've captured exceptions).
This Proper way of destroying a tthread object link shows a way (via the PostMessage procedure) which works fine and makes sense. However, what if I create the thread and I don't have a handle to a form or something where I can invoke the PostMessage procedure. eg I create the thread within a class descended directly from TObject?
TMyClass = class
public
procedure DoSomething;
end;
TMyClass.DoSomething;
begin
with TMyThread.Create(True) do
begin
OnTerminate := ThreadTerminated;
FreeOnTerminate := False;
Start;
end;
end;
So, I guess, how do I free a thread without access to a form handle?
Thanks
Obviously, somewhere there has to be a reference to the instantiated thread. But I can relate to your wish: you want a always-done-never-care solution.
I suggest you manage the thread's existence by a separate ThreadController class:
unit Unit2;
interface
uses
Classes, SysUtils, Forms, Windows, Messages;
type
TMyThreadProgressEvent = procedure(Value: Integer;
Proceed: Boolean) of object;
procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
implementation
type
TMyThread = class(TThread)
private
FException: Exception;
FOnProgress: TMyThreadProgressEvent;
FProceed: Boolean;
FValue: Integer;
procedure DoProgress;
procedure HandleException;
procedure ShowException;
protected
procedure Execute; override;
end;
TMyThreadController = class(TObject)
private
FThreads: TList;
procedure StartThread(StartValue: Integer;
OnProgress: TMyThreadProgressEvent);
procedure ThreadTerminate(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
end;
var
FMyThreadController: TMyThreadController;
function MyThreadController: TMyThreadController;
begin
if not Assigned(FMyThreadController) then
FMyThreadController := TMyThreadController.Create;
Result := FMyThreadController
end;
procedure RunMyThread(StartValue: Integer; OnProgress: TMyThreadProgressEvent);
begin
MyThreadController.StartThread(StartValue, OnProgress);
end;
{ TMyThreadController }
constructor TMyThreadController.Create;
begin
inherited;
FThreads := TList.Create;
end;
destructor TMyThreadController.Destroy;
var
Thread: TThread;
begin
while FThreads.Count > 0 do
begin
Thread := FThreads[0]; //Save reference because Terminate indirectly
//extracts the list entry in OnTerminate!
Thread.Terminate; //Indirectly decreases FThreads.Count
Thread.Free;
end;
FThreads.Free;
inherited Destroy;
end;
procedure TMyThreadController.StartThread(StartValue: Integer;
OnProgress: TMyThreadProgressEvent);
var
Thread: TMyThread;
begin
Thread := TMyThread.Create(True);
FThreads.Add(Thread); //Add to list before a call to Resume because once
//resumed, the thread might be gone already!
Thread.FValue := StartValue;
Thread.FOnProgress := OnProgress;
Thread.OnTerminate := ThreadTerminate;
Thread.Resume;
end;
procedure TMyThreadController.ThreadTerminate(Sender: TObject);
begin
FThreads.Extract(Sender);
end;
{ TMyThread }
procedure TMyThread.DoProgress;
begin
if (not Application.Terminated) and Assigned(FOnProgress) then
FOnProgress(FValue, FProceed);
end;
procedure TMyThread.Execute;
begin
try
FProceed := True;
while (not Terminated) and (not Application.Terminated) and FProceed and
(FValue < 20) do
begin
Synchronize(DoProgress);
if not FProceed then
Break;
Inc(FValue);
Sleep(2000);
end;
//In case of normal execution ending, the thread may free itself. Otherwise,
//the thread controller object frees the thread.
if not Terminated then
FreeOnTerminate := True;
except
HandleException;
end;
end;
procedure TMyThread.HandleException;
begin
FException := Exception(ExceptObject);
try
if not (FException is EAbort) then
Synchronize(ShowException);
finally
FException := nil;
end;
end;
procedure TMyThread.ShowException;
begin
if GetCapture <> 0 then
SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
if (FException is Exception) and (not Application.Terminated) then
Application.ShowException(FException)
else
SysUtils.ShowException(FException, nil);
end;
initialization
finalization
FreeAndNil(FMyThreadController);
end.
To run this sample thread which counts from 5 to 19 in 2 second intervals and provides feedback and an opportunity to a premature termination, call from the main thread:
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure MyThreadProgress(Value: Integer; Proceed: Boolean);
end;
...
procedure TForm1.Button1Click(Sender: TObject);
begin
RunMyThread(5, MyThreadProgress);
end;
procedure TForm1.MyThreadProgress(Value: Integer; Proceed: Boolean);
begin
Caption := IntToStr(Value);
end;
This thread automatically kills itself on either thread's or application's termination.
Maybe this unit is a little overkill for your situation because it is capable of handling multiple threads (of the same type), but I think it answers your question. Adjust to your liking.
Partial origin of this answer: NLDelphi.com.