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.
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;
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;
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 have a simple form that only contains a TTouchKeyboard. The forms BorderStyle is set to bsToolWindow. To avoid the form getting focus when clicking the touch keyboard I handle the WM_MOUSEACTIVATE message with this implementation:
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
The BorderStyle setting allows the form to be dragged with the title bar, but in that case the form still gets the focus. Is there a way to avoid this?
Update: I tried adding WS_EX_NOACTIVATE to ExStyle in CreateParams, but unfortunately that doesn't hinder the form to receive focus when dragged.
procedure TKeyboardForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_NOACTIVATE;
end;
Because I was not very pleased with the approach that requires me to manually update the focused form variable in the keyboard form, I searched for a more transparent solution and came up with this approach.
Update: The previous approach had some issues with VCL styles. In addition not all of the message handlers were really necessary, though others turned out to be helpful, too. This version works well with VCL styles avoiding any flicker as far as possible:
type
TKeyboardForm = class(TForm)
TouchKeyboard1: TTouchKeyboard;
private
FLastFocusedForm: TCustomForm;
procedure SetLastFocusedForm(const Value: TCustomForm);
protected
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property LastFocusedForm: TCustomForm read FLastFocusedForm write SetLastFocusedForm;
public
class constructor Create;
destructor Destroy; override;
function SetFocusedControl(Control: TWinControl): Boolean; override;
end;
type
TKeyboardFormStyleHook = class(TFormStyleHook)
protected
procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
end;
procedure TKeyboardFormStyleHook.WMNCActivate(var Message: TWMNCActivate);
begin
{ avoids the title bar being drawn active for blink }
Message.Active := False;
inherited;
end;
class constructor TKeyboardForm.Create;
begin
TCustomStyleEngine.RegisterStyleHook(TKeyboardForm, TKeyboardFormStyleHook);
end;
destructor TKeyboardForm.Destroy;
begin
LastFocusedForm := nil;
inherited;
end;
procedure TKeyboardForm.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FLastFocusedForm) then begin
FLastFocusedForm := nil;
end;
inherited;
end;
function TKeyboardForm.SetFocusedControl(Control: TWinControl): Boolean;
begin
LastFocusedForm := Screen.FocusedForm;
result := inherited;
end;
procedure TKeyboardForm.SetLastFocusedForm(const Value: TCustomForm);
begin
if FLastFocusedForm <> Value then
begin
if FLastFocusedForm <> nil then begin
FLastFocusedForm.RemoveFreeNotification(Self);
end;
FLastFocusedForm := Value;
if FLastFocusedForm <> nil then begin
FLastFocusedForm.FreeNotification(Self);
end;
end;
end;
procedure TKeyboardForm.WMActivate(var Message: TWMActivate);
begin
Message.Active := WA_INACTIVE;
inherited;
end;
procedure TKeyboardForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
inherited;
Message.Result := MA_NOACTIVATE;
end;
procedure TKeyboardForm.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
if (FLastFocusedForm <> nil) and (message.FocusedWnd <> FLastFocusedForm.Handle) then begin
SendMessage(FLastFocusedForm.Handle, WM_SETFOCUS, 0, 0);
Message.FocusedWnd := FLastFocusedForm.Handle;
end;
end;
The following combination of WMMouseActivate(), WMNCActivate() and reseting focus seems to fulfill your wishes:
The keyboard form (with BorderStyle = bsToolWindow) has message handlers for WM_MOUSEACTIVATE (as you already have) and WM_NCACTIVATE. The latter for having a point where to reset focus to the window with the edit control.
In addition the keyboardform will keep track of which form holds the edit (or other) control that has focus, and does that by introducing a new method for showing, which I called ShowUnfocused() and a field called FocusedForm: THandle.
procedure TKbdForm.ShowUnfocused(FocusedWindow: THandle);
begin
FocusedForm := FocusedWindow;
Show;
end;
procedure TKbdForm.FormShow(Sender: TObject);
begin
SetForegroundWindow(FocusedForm);
end;
procedure TKbdForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TKbdForm.WMNCActivate(var Message: TWMNCActivate);
begin
Message.Result := 1; // important
SetForegroundWindow(FocusedForm);
end;
The keyboardform is invoked by the following common code of the edit controls:
procedure TForm17.EditClick(Sender: TObject);
begin
KbdForm.ShowUnfocused(self.Handle);
(Sender as TWinControl).SetFocus;
end;
An alternative to what is said above, could be to set the BorderStyle = bsNone and arrange the dragging of the form with the Mouse Down, Move, Up events directly from the forms surface (or maybe a panel to mimic a top frame), and adding a close button. The challenge would be to get it visually acceptable.
I have a VCL form that is set for bsDialog with biHelp enabled ("?" icon in application bar). The application is also using a custom VCL Style (Aqua Light Slate).
However I cannot get the WMNCLBUTTONDOWN Windows Message to appear when I click the "?" button. It only works if the VCL Style of the application is changed back to Windows (Default).
procedure TMainFrm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
if Msg.HitTest = HTHELP then
begin
OutputDebugString('Help button down');
Msg.Result := 0;
end
else
inherited;
end;
procedure TMainFrm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
if Msg.HitTest = HTHELP then
begin
OutputDebugString('Help button up');
Msg.Result := 0;
end
else
inherited;
end;
Is there a way to get these events to fire with a custom VCL style?
The form style hook handles that message:
TFormStyleHook = class(TMouseTrackControlStyleHook)
....
procedure WMNCLButtonUp(var Message: TWMNCHitMessage); message WM_NCLBUTTONUP;
end;
The implementation includes this
else if (Message.HitTest = HTHELP) and (biHelp in Form.BorderIcons) then
Help;
This calls the virtual Help method of the form style hook. That is implemented like this:
procedure TFormStyleHook.Help;
begin
SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0)
end;
So you could simply listen for WM_SYSCOMMAND and test wParam for SC_CONTEXTHELP. Like this:
type
TMainFrm = class(TForm)
protected
procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
end;
....
procedure TMainFrm.WMSysCommand(var Message: TWMSysCommand);
begin
if Message.CmdType = SC_CONTEXTHELP then begin
OutputDebugString('Help requested');
Message.Result := 0;
end else begin
inherited;
end;
end;