I'm trying to do a very simple task... Detect when my form has been minimized.
But it seems Firemonkey has absolutely no way of handling this.
I've tried to use AllocateHWnd to intercept WM_SYSCOMMAND messages, but all I get is WM_ACTIVATEAPP messages and nothing else.
CreateForm:
AllocateHWnd(WndProcHandler);
WndProcHandler:
procedure TfrmMain.WndProcHandler(var Message: TMessage);
begin
if Message.msg = WM_SYSCOMMAND then
OutputDebugStringA('got command');
end;
Got it working with the following code.
Looks for the WM_SIZE command and SIZE_MINIMIZED parameter to detect all minimising events.
uses
Winapi.Windows, Winapi.Messages;
var
WndProcHook: THandle;
function WndProc(Code: integer; WParam, LParam: LongInt): LRESULT; stdcall;
var
msg: TCWPRetStruct;
begin;
if (Code >= HC_ACTION) and (LParam > 0) then begin
msg := PCWPRetStruct(LParam)^;
if (msg.Message = WM_SIZE) and (msg.WParam = SIZE_MINIMIZED) then begin
// Application has been minimized
// Check msg.wnd = WindowHandleToPlatform(Form1.Handle).wnd if necessary
end;
end;
result := CallNextHookEx(WndProcHook, Code, WParam, LParam)
end;
initialization
WndProcHook := SetWindowsHookEx(WH_CALLWNDPROCRET, #WndProc, 0, GetCurrentThreadId);
finalization
UnhookWindowsHookEx(WndProcHook);
Related
On Windows, I'd like for my FMX app to run from the SendTo context menu. If the app is already running I'd like for the second instance to pass its command line to the first and then exit. Code is below. The problem is that if I have first instance running in the debugger, and then double-click an appropriate file, I see no evidence that the first instance receives a message from a newly started instance. If the app is not already running then the double click starts a new instance as expected.
Is there a way to debug the startup of the instance launched by the SendTo menu?
This code adds the app to the SendTo menu:
class procedure TInstallationController.CreateSendTo;
var
lExePath: string;
lObject: IUnknown;
lSLink: IShellLink;
lPFile: IPersistFile;
lFolderPath: array[0..MAX_PATH] of char;
lLinkName: WideString;
begin
SHGetFolderPath(0, CSIDL_SENDTO, 0, 0, lFolderPath);
lLinkName := Format('%s\%s.lnk', [lFolderPath, 'AppName']);
{$IFNDEF DEBUG}
if String(lLinkName).Contains('debug') then
Tfile.Delete(lLinkName);
{$ENDIF DEBUG}
if not TFile.Exists(lLinkName) then
if CoInitializeEx(nil, COINIT_MULTITHREADED) = S_OK then
begin
lExePath := ParamStr(0);
lObject := CreateComObject(CLSID_ShellLink);
lSLink := lObject as IShellLink;
lPFile := lObject as IPersistFile;
with lSlink do
begin
SetPath(pChar(lExePath));
SetWorkingDirectory(PChar(TPath.GetDirectoryName(lExePath)));
end;
lPFile.Save(PWChar(WideString(lLinkName)), false);
end;
end;
This code is placed before Application.Initialize in the .dpr file:
var
lWindow: HWND;
lMutex: THandle;
lCopyDataStruct: TCopyDataStruct;
i: integer;
lArg: string;
lResult: DWORD;
begin
lMutex := CreateMutex(nil, False, PChar('43671EDF1E5A4B419F213336F2387B0D'));
if lMutex = 0 then
RaiseLastOSError;
if GetLastError = Error_Already_Exists then
begin
FillChar(lCopyDataStruct, Sizeof(lCopyDataStruct), 0);
for I := 1 to ParamCount do
begin
lArg := ParamStr(i);
lCopyDataStruct.cbData := (Length(lArg) + 1)*SizeOf(Char);
lCopyDataStruct.lpData := PChar(lArg);
lWindow := FindWindow('FMT' + STRMainWindowClassName, nil);
SendMessageTimeout(lWindow, WM_COPYDATA, 0, NativeInt(#lCopyDataStruct),
SMTO_BLOCK, 3000, #lResult);
end;
exit;
end;
...
end.
Assignments in FormCreate of the main form to support Windows message forwarding:
...
FHwnd := FmxHandleToHwnd(Handle);
FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC);
SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(#WindowProc));
...
This forwards Windows messages to my main FMX form:
function WindowProc (HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
begin
Result := MasterDetailView.WndProc (HWND, Msg, wParam, lParam);
end;
This main form method receives forwarded messages:
function TViewMasterDetail.WndProc(aHwnd: HWND; aMsg: UINT; aWParam: WPARAM;
aLParam: LPARAM): LResult;
begin
Result := 0;
if aMsg = WM_COPYDATA then
begin
TUtils.Log('External file: ' + PChar(PCopyDataStruct(aLParam)^.lpData));
Viewmodel.HandleExternalFile(PChar(PCopyDataStruct(aLParam)^.lpData));
Exit;
end;
result := CallWindowProc(Ptr(fOldWndProc), aHwnd, aMsg, aWParam, aLParam);
end;
TViewMasterDetail.WndProc is called many time, but as far as I can tell aMsg is never WM_COPYDATA. The 'External file:' message never appears in the log. Thanks
Programmer error. To approximate debugging the startup code I ran a copy of the app outside the debugger and then launched a second copy of the app in the debugger, passing the path to the target file on the command line. This told me FindWindow was failing. I wrote this startup code a long time ago and since then have changed the names of UI classes in the app, including the main window. But I neglected to change the constant I used for the class name of the main window and pass to FindWindow. Fixing the constant cleared the error. Just another win for the evils of using text!
Has anyone found a way to detect the mouse back and forward buttons in a Delphi FMX form in Windows (and only Windows)?
I understand this works fine in a VCL application, using
procedure WMAppCommand(var Msg: Winapi.Messages.TMessage); message WM_APPCOMMAND;
but this has no effect in an FMX application.
If anyone already has worked out a solution to this, would very much appreciate a hint (or the code they used, of course).
FMX heavily filters window messages, only dispatching the few messages it actually uses for itself. WM_APPCOMMAND is not one of them, which is why a simple message handler does not work in FMX, like it does in VCL.
So, you are going to have to manually subclass the TForm's Win32 HWND directly, via SetWindowLongPtr(GWLP_WNDPROC) or SetWindowSubclass(), in order to intercept window messages before FMX sees them. See Subclassing controls.
An ideal place to do that subclassing is to override the TForm.CreateHandle() method. You can use FMX's FormToHWND() function to get the TForm's HWND after it has been created.
protected
procedure CreateHandle; override;
...
uses
FMX.Platform.Win, Winapi.Windows, Winapi.CommCtrl;
function MySubclassProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): LRESULT; stdcall;
begin
case uMsg of
WM_APPCOMMAND: begin
// use TMyForm(dwRefData) as needed...
end;
WM_NCDESTROY:
RemoveWindowSubclass(hWnd, #MySubclassProc, uIdSubclass);
end;
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
procedure TMyForm.CreateHandle;
begin
inherited;
SetWindowSubclass(FormToHWND(Self), #MySubclassProc, 1, DWORD_PTR(Self));
end;
procedure InitStandardClasses;
var
ICC: TInitCommonControlsEx;
begin
ICC.dwSize := SizeOf(TInitCommonControlsEx);
ICC.dwICC := ICC_STANDARD_CLASSES;
InitCommonControlsEx(ICC);
end;
initialization
InitStandardClasses;
I try to exchange data between two applications in windows. I use an example from Zarko Gajic. It uses windows messaging and the example works great. There are a sender and a receiving application and some shared data: all coded for VCL. The code is shown below.
unit SenderMain;
{ How to send information (String, Image, Record) between two Delphi applications
http://delphi.about.com/od/windowsshellapi/a/wm_copydata.htm
Learn how to send the WM_CopyData message between two Delphi
applications to exchange information and make two applications
communicate. The accompanying source code demonstrates how to
send a string, record (complex data type) and even graphics
to another application.
~Zarko Gajic
About Delphi Programming
http://delphi.about.com
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, TlHelp32,
shared_data;
type
TSenderMainForm = class(TForm)
Button_Send_Data: TButton;
Log: TListBox;
procedure Button_Send_DataClick (Sender: TObject);
protected
procedure Loaded; override;
procedure SendString (send_string: aString);
end; // Class: TSenderMainForm //
var
SenderMainForm: TSenderMainForm;
implementation
{$R *.dfm}
{**************** NextWindow ****************}
function NextWindow (wnd: Thandle; list: Tstringlist):boolean; stdcall;
{This is the callback function which is called by EnumWindows procedure
for each top-level window. Return "true" to keep retrieving, return
"false" to stop EnumWindows from calling}
var
title: array [0..255] of char;
receiverHandle: HWND;//THandle;
win_name: PChar;
s: AnsiString;
begin
getwindowtext (wnd, title, 256);
s := AnsiString (pchar(#title));
if (s <> '') and (list.indexof (string (s)) < 0) then
begin
win_name := PaString (s);
receiverHandle := FindWindow (win_name, nil); // Find receiving app
s := AnsiString (Format ('%s (%d)', [s, receiverHandle]));
list.add (string (s));
end; // if
result:=true;
end;
procedure TSenderMainForm.Loaded;
begin
inherited Loaded;
enumwindows (#nextwindow, lparam (Log.Items)); {pass the list as a parameter}
end;
procedure TSenderMainForm.SendString (send_string: aString);
var copyDataStruct: TCopyDataStruct; { Declared in Windows.pas: TCopyDataStruct}
receiverHandle: THandle;
res: integer;
begin
// Copy string to CopyDataStruct
copyDataStruct.dwData := 1; //use it to identify the message contents
copyDataStruct.cbData := (1 + Length (send_string)) * SizeOf (Char);
copyDataStruct.lpData := PaString (send_string);
receiverHandle := FindWindow (PaString (cClassName), nil); // Find receiving app
if receiverHandle = 0 then // not found
begin
Log.Items.Add ('CopyData Receiver NOT found!');
end else // found, send message
begin
res := SendMessage (receiverHandle, WM_COPYDATA, Integer(Handle), Integer(#copyDataStruct));
Log.Items.Add (Format ('String sent, len = %d, result = %d', [copyDataStruct.cbData, res]));
Log.Items.Add ('"' + PaString (copyDataStruct.lpData) + '"');
end; // if
end; // SendString
procedure TSenderMainForm.Button_Send_DataClick (Sender: TObject);
begin
SendString (ParamStr (0));
end;
====================== Unit copyDataReceiver ================
unit ReceiverMain;
{ How to send information (String, Image, Record) between two Delphi applications
http://delphi.about.com/od/windowsshellapi/a/wm_copydata.htm }
interface
uses
Windows, Messages,
SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, shared_data;
type
TReceiverMainForm = class (TForm)
Log: TListBox;
procedure FormCreate(Sender: TObject);
private
procedure WMCopyData (var Msg: TWMCopyData); message WM_COPYDATA;
procedure WMSignalClose (var Msg: TMessage); message WM_SIGNAL_CLOSE;
procedure HandleCopyDataString (copyDataStruct: PCopyDataStruct);
end;
var ReceiverMainForm: TReceiverMainForm;
implementation
{$R *.dfm}
procedure TReceiverMainForm.FormCreate (Sender: TObject);
begin
Log.Clear;
end;
procedure TReceiverMainForm.WMSignalClose (var Msg: TMessage);
var pfn: PaString;
fn: aString;
begin
Log.Items.Add (Format ('Signal received, WParam = %d, LParam = %d', [Msg.WParam, Msg.LParam]));
pfn := PaString (Msg.LParam);
fn := aString (pfn);
Log.Items.Add (fn);
end;
procedure TReceiverMainForm.WMCopyData (var Msg: TWMCopyData);
var copyDataType: Int32;
begin
copyDataType := Msg.CopyDataStruct.dwData;
//Handle of the Sender
Log.Items.Add (Format ('WM_CopyData (type: %d) from: %d', [copyDataType, msg.From]));
HandleCopyDataString (Msg.CopyDataStruct);
//Send something back
msg.Result := Log.Items.Count;
end;
procedure TReceiverMainForm.HandleCopyDataString (copyDataStruct: PCopyDataStruct);
var mess: aString;
begin
mess := aString (PaString (copyDataStruct.lpData));
Log.Items.Add (Format ('Received string of length %d at %s', [Length (mess), DateToStr (Now)]));
Log.Items.Add ('"' + mess + '"');
end;
end.
================ unit shared_data ==========================
unit shared_data;
interface
uses Messages;
const
WM_SIGNAL_CLOSE = WM_APP + 2012;
ARG_AMI_1 = 285;
ARG_AMI_2 = 1;
cClassName = 'TReceiverMainForm';
type
aString = string;
PaString = PChar;
implementation
end.
The crux of the sender application is that it sends a WM_COPYDATA to the receiver. In order to find the receiver, FindWindow is used with the name of the receiving application (hard-coded) which returns a handle to the window. If the handle is zero, an error is shown.
When I duplicate this in an FMX application there are troubles. The FMX receiving part does not work, while the VCL receiver can receive messages from either the VCL sender or the FMX sender. The code of the FMX receiver is shown below.
Because I wasn't sure about the name of the windows I enumerated all windows, added the numeric handle to each window name and showed it in a listbox in the sender. All handles are zero. I have two questions:
Why are all handles zero in the enumeration?
Why can't I send a message to the FMX receiving applation?
Any help would be greatly appreciated.
unit copyDataReceiver;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.ListBox,
Windows, Messages, shared_data;
type
TReceiverMainForm = class (TForm)
Log: TListBox;
procedure FormCreate(Sender: TFMXObject);
private
procedure WMCopyData (var Msg: TWMCopyData); message WM_COPYDATA;
procedure WMSignalClose (var Msg: TMessage); message WM_SIGNAL_CLOSE;
procedure HandleCopyDataString (copyDataStruct: PCopyDataStruct);
end;
var ReceiverMainForm: TReceiverMainForm;
implementation
{$R *.fmx}
procedure TReceiverMainForm.FormCreate (Sender: TFMXObject);
begin
Log.Clear;
end;
procedure TReceiverMainForm.WMSignalClose (var Msg: TMessage);
var pfn: PaString;
fn: aString;
begin
Log.Items.Add (Format ('Signal received, WParam = %d, LParam = %d', [Msg.WParam, Msg.LParam]));
pfn := PaString (Msg.LParam);
fn := aString (pfn);
Log.Items.Add (fn);
end;
procedure TReceiverMainForm.WMCopyData (var Msg: TWMCopyData);
var copyDataType: Int32;
begin
copyDataType := Msg.CopyDataStruct.dwData;
//Handle of the Sender
Log.Items.Add (Format ('WM_CopyData (type: %d) from: %d', [copyDataType, msg.From]));
HandleCopyDataString (Msg.CopyDataStruct);
//Send something back
msg.Result := Log.Items.Count;
end;
procedure TReceiverMainForm.HandleCopyDataString (copyDataStruct: PCopyDataStruct);
var mess: aString;
begin
mess := aString (PaString (copyDataStruct.lpData));
Log.Items.Add (Format ('Received string of length %d at %s', [Length (mess), DateToStr (Now)]));
Log.Items.Add ('"' + mess + '"');
end;
end.
Why can't I send a message to the FMX receiving applation?
For VCL-Forms the ClassName is derived from the name of the form by simply
adding a leading 'T' to then Name.
e.g. If you have a Form named MyForm the ClassName is TMyForm.
Self.ClassName returns this name and a call to
Winapi.Windows.FindWindow(PChar(Self.ClassName), nil) returns the correct
Handle.
With FMX-Forms you will receive a ClassName builded in similar way.
For FMX-Forms the ClassName is derived from the name of the form by
adding leading 'FMT' to the name of the Form.
The ClassName returned by Self.ClassName, however, is the same as for VCL-Forms.
e.g. If you have a Form named MyFMXForm the ClassName is FMTMyFMXForm but
Self.ClassName returns TMyFMXForm.
Therefore an attempt to get the window-handle with that ClassName fails.
The correct call is
Winapi.Windows.FindWindow(PChar('FMTMyFMXForm'), nil)); .
FindWindow works just the same under FMX. The problem is that sending messages to the window that you find will not result in them being routed to the form's message handlers.
Instead you should do what you should always have done, even with the VCL. That is use a known window whose lifetime you control. Remember that VCL windows are subject to recreation. In other words, you might have a window handle for a window in another process, but that window may be destroyed before you get a chance to send your message to it.
Resolve this by using AllocateHWnd or CreateWindow to create a window that will not be recreated. A window whose lifetime you control. You'll have to devise a way for the other process to discover your window. Personally I would use CreateWindow with a known class name, and then enumerate top level windows with EnumWindows looking for windows that that class name.
I' programming a Delphi application. My goal is to cover ALL screen with my application to force user to fill my form. Application will be run as scheduled task.
My problem is, that normally, Windows does not allow applications to block other users action.
In Windows 7 I can run my application as scr file (screen saver), with no title bar and set StayOnTop. In this case, other application even if visible on "Window key" (start), stays behind my application, so my goal is reached.
Unfortunately, in Windows 8 this solution does not work because "window key" shows start screen, when I can run anything and this "anything" stays on top.
I tried some trick with code below, but without success.
h := FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil);
ShowWindow(h,0);
Windows.SetParent(h,0);
How to block 'window key' (start button) action in the entire Windows 8 system?
I didn't test it on windows 8, but in principle one can use a keyboard hook to discard the key-press.
Something similar to the following:
const
WH_KEYBOARD_LL = 13;
LLKHF_ALTDOWN = $00000020;
LLKHF_INJECTED = $00000010;
type
tagKBDLLHOOKSTRUCT = record
vkCode: DWORD;
scanCode: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
KBDLLHOOKSTRUCT = tagKBDLLHOOKSTRUCT;
LPKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
PKBDLLHOOKSTRUCT = ^KBDLLHOOKSTRUCT;
var
hhkLowLevelKybd: HHOOK;
function LowLevelKeyBoardProc(nCode: Integer; awParam: WPARAM; alParam: LPARAM): LRESULT; stdcall;
var
fEatKeyStroke: Boolean;
p: PKBDLLHOOKSTRUCT;
begin
fEatKeystroke := False;
if active and( nCode = HC_ACTION) then
begin
case awParam of
WM_KEYDOWN,
WM_SYSKEYDOWN,
WM_KEYUP,
WM_SYSKEYUP:
begin
p := PKBDLLHOOKSTRUCT(alParam);
if DisableWinKeys then
begin
if p^.vkCode = VK_LWIN
then fEatKeystroke := True;
if p^.vkCode = VK_RWIN
then fEatKeystroke := True;
end;
end;
end;
end;
if fEatKeyStroke then
Result := 1
else
Result := CallNextHookEx(hhkLowLevelKybd, nCode, awParam, alParam);
end;
procedure InstallHook;
begin
if hhkLowLevelKybd <> 0 then exit;
hhkLowLevelKybd := SetWindowsHookEx(WH_KEYBOARD_LL, #LowLevelKeyboardProc, hInstance, 0);
end;
procedure UninstallHook;
begin
if hhkLowLevelKybd = 0 then exit;
UnhookWindowsHookEx(hhkLowLevelKybd);
hhkLowLevelKybd := 0;
end;
When I try to use the Windows SetTimer function, it generate a IDEvent for the timer even if I have specified one!
This:
SetTimer(0,999,10000,#timerproc);
In:
procedure timerproc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR;dwTime: DWORD); stdcall;
begin
KillTimer(0, idEvent);
showmessage(inttostr(idevent));
end;
Return:
Random Number!
Is it possible to manage my timers by myself instead of Windows choosing for me?
Thank you very much!
If you want to handle multiple timer events in a single routine, then handle it by specific window rather then by specific routine:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FTimerWindow: HWND;
procedure TimerProc(var Msg: TMessage);
end;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
FTimerWindow := Classes.AllocateHWnd(TimerProc);
SetTimer(FTimerWindow, 999, 10000, nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Classes.DeallocateHWnd(FTimerWindow);
end;
procedure TForm1.TimerProc(var Msg: TMessage);
begin
if Msg.Msg = WM_TIMER then
with TWMTimer(Msg) do
case TimerID of
999:
//
else:
//
end;
end;
SetTimer will work differently, depending upon whether you are passing a window handle to it or not.
Timer_Indentifier := SetTimer(0, MyIdentifier, Time, #myproc);
In the above instance, Timer_Identifier does NOT equal MyIdentifier.
Timer_Indentifier := SetTimer(handle, MyIdentifier, Time, #myproc);
In the second example, Timer_Identifier = MyIdentifier.
This is because in the second example, your windows loop will need to use "MyIdentifier" to find out which timer is sending a "WM_Timer" message to it.
Using a specific Timer function, with no Window Handle, is different. The short answer is that in your scenario, use the value that Windows gives you.
http://msdn.microsoft.com/en-us/library/windows/desktop/ms644906%28v=vs.85%29.aspx
Multimedia Timer solved my problem!
I can pass whatever I want to them with dwUser:)
MMRESULT timeSetEvent(
UINT uDelay,
UINT uResolution,
LPTIMECALLBACK lpTimeProc,
DWORD_PTR dwUser,
UINT fuEvent
);
From MSDN : dwUser -> User-supplied callback data.
They have a TIME_ONESHOT option which is exactly what I use timers for!