I created a small application that allows minimizing to the system tray by clicking on a pop-up menu item associated with the form.
The application adds an icon by calling the Shell_NotifyIcon function and hides itself. To restore, simply click on the icon in the tray, the form is displayed and the icon disappears.
This all works as expected when I run the application from the project folder, but when it is run from another location (any location), the icon creation fails, with the error code I get using GetLastError being 0x80004005.
Here is the execution code:
procedure TMyForm.BMHideClick(Sender: TObject);
begin
Hide;
PowerNotifyIcon.uFlags := NIF_MESSAGE or NIF_ICON or NIF_GUID or NIF_TIP; {PowerNotifyIcon is a TNotifyIconData structure}
StrPLCopy(PowerNotifyIcon.szTip, ICON_TIP, Length(ICON_TIP)); {ICON_TIP is a predefined string constant}
if not Shell_NotifyIcon(NIM_ADD, #PowerNotifyIcon) then
begin
MessageBox(Handle, PChar(Format('Failed to create system tray icon. error code: 0x%x', [GetLastError])),
PChar('Error'), MB_OK or MB_ICONERROR);
Show;
Exit;
end;
Shell_NotifyIcon(NIM_SETVERSION, #PowerNotifyIcon);
end;
To restore the form, I handle the WM_SYSTEM_TRAY_MESSAGE messages received from the icon:
procedure TMyForm.TrayIconProc(var Msg: TMessage);
begin
case LOWORD(Msg.LParam) of
{...}
NIN_SELECT, NIN_KEYSELECT, WM_CONTEXTMENU, WM_LBUTTONUP, WM_RBUTTONUP: begin
Show;
Shell_NotifyIcon(NIM_DELETE, #PowerNotifyIcon);
end;
end;
end;
Related
Normal behaviour for the caret in Windows 10 seems to be that as soon as a caret-capable control gets focus the caret will blink for about 5 seconds and then go solid (non-blinking). Whenever the left or right arrow keys are pressed it will move the caret and then it will start to blink again for the 5 second period, etc.
I cannot get the same behaviour on my custom control. Creation, displaying, moving and destruction of the caret seems to work fine but it will only blink for the 5 second duration after getting focus and perhaps one more time upon moving it with the arrow keys but never after that again. It stays solid (non-blinking) every time I move the caret with the arrow keys.
It will blink again if the control looses focus and regains it.
I noticed on another 3rd party control's source code that the authors used the SetCaretBlinkTime api call and I wonder if that was to get the desired effect but SetCaretBlinkTime's documenation encourages developers to only use it when actually wanting to set the blink rate similar to what the Keyboard Control Panel Applet does.
My custom control:
const
CCharWidth = 8;
CWidth = 200;
CInsideMargin = 2;
CCharsPerLine = (CWidth - (CInsideMargin * 2)) div CCharWidth;
type
TEditPane = class(TCustomControl)
private
FCaretPosX : Integer;
procedure SetCaretPosition(AXPos : Integer);
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
protected
procedure Paint; override;
public
end;
implementation
procedure TEditPane.Paint;
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clWindow;
Canvas.FillRect(Rect(0,0,Width,Height));
end;
procedure TEditPane.SetCaretPosition(AXPos : Integer);
begin
If AXPos < CInsideMargin then
AXPos := CInsideMargin;
If AXPos > CInsideMargin + (CCharsPerLine * CCharWidth) then
AXPos := CInsideMargin + (CCharsPerLine * CCharWidth);
FCaretPosX := AXPos;
SetCaretPos(FCaretPosX,CInsideMargin);
end;
procedure TEditPane.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
inherited;
Message.Result := Message.Result or DLGC_WANTARROWS;
end;
procedure TEditPane.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
Case Message.CharCode of
VK_LEFT :
SetCaretPosition(FCaretPosX - CCharWidth);
VK_RIGHT :
SetCaretPosition(FCaretPosX + CCharWidth);
end;
end;
procedure TEditPane.WMKillFocus(var Message: TWMKillFocus);
begin
inherited;
HideCaret(Handle);
DestroyCaret;
end;
procedure TEditPane.WMLButtonDown(var Message: TWMLButtonDown);
begin
inherited;
SetFocus;
end;
procedure TEditPane.WMSetFocus(var Message: TWMSetFocus);
begin
inherited;
CreateCaret(Handle,0,1,13);
SetCaretPosition(CInsideMargin);
ShowCaret(Handle);
end;
Blinking is resumed after you show the caret. So you can
HideCaret(Handle); { assuming that show counter is 1 }
ShowCaret(Handle);
or repeat your code form WMSetFocus
CreateCaret(Handle,0,1,13);
SetCaretPosition(CInsideMargin);
ShowCaret(Handle);
Blinking also resumes after BeginPaint and EndPaint because it implicitly hides and shows caret if visible but it is side-effect and shouldn't be relied on.
I am trying following code for a GUI to show 2 identical windows. I am using show rather than showmodal:
program RnTFormclass;
{$mode delphi}
uses
//cthreads, // for linux only.
Interfaces, Forms, StdCtrls;
type
RnTForm = class(TForm)
private
wnd: TForm;
btn: TButton;
public
constructor create;
procedure showit;
end;
constructor RnTForm.create;
begin
//Application.Initialize; //removed.
wnd := TForm.Create(Application);
with wnd do begin
Height := 300;
Width := 400;
Position:= poDesktopCenter;
Caption := 'LAZARUS WND';
end;
btn := TButton.Create(wnd);
with btn do begin
SetBounds(0, 0, 100, 50);
Caption := 'Click Me';
Parent := wnd;
end;
end;
procedure RnTForm.showit;
begin
wnd.Show;
end;
var
myform1, myform2: RnTForm;
begin
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
end.
I want two identical windows to show/open up. Though the program runs without any error or warning, not even one window is shown.
The program just terminates.
Where is the problem and how can it be solved? Thanks for your help.
Edit: As pointed out in the comments, Application.initialize is being called twice and not run. I have commented out Application.initialize and the code still does not open up any of the window. (It does open windows one by one if show is replaced by showModal).
Main question is how to keep window open after show?
Taking suggestions from comments, I got it working by following main method:
begin
Application.Initialize;
// create windows:
myform1 := RnTForm.Create;
myform2 := RnTForm.Create;
// show windows:
myform1.showit;
myform2.showit;
Application.run;
end.
Now both the windows appear and I can click and work on any of them.
However, on closing both the windows, the program still keeps running in background. An exit button with its click function needs to be added.
I Delphi, I need a function which determinates if the system menu (resp. window menu, the menu that appears when the icon is clicked) is opened. The reason is that I am writing a anti-keylogger functionality which sends garbage to the current active editcontrol (this also prevents keylogger which read WinAPI messages to read the content). But if system-menu is opened, the editcontrol STILL has the focus, so the garbage will invoke shortcuts.
If I use message WM_INITMENUPOPUP in my TForm1, I can determinate when the system menu opens, but I wish that I do not have to change the TForm, since I want to write a non visual component, which does not need any modifications at the TForm-derivate-class itself.
//I do not want that solution since I have to modify TForm1 for that!
procedure TForm1.WMInitMenuPopup(var Message: TWMInitMenuPopup);
begin
if message.MenuPopup=getsystemmenu(Handle, False) then
begin
SystemMenuIsOpened := true;
end;
end;
TApplicaton.HookMainWindow() does not send the WM_INITMENUPOPUP to my hook function.
function TForm1.MessageHook(var Msg: TMessage): Boolean;
begin
Result := False;
if (Msg.Msg = WM_INITMENUPOPUP) then
begin
// Msg.Msg IS NEVER WM_INITMENUPOPUP!
if LongBool(msg.LParamHi) then
begin
SystemMenuIsOpened := true;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.HookMainWindow(MessageHook);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.UnhookMainWindow(MessageHook);
end;
Even after very long research I did not found any information about how to query if the system-menu is opened or not. I do not find any way to determinate the opening+closing of that menu.
Has someone a solution for me please?
Regards
Daniel Marschall
Application.HookMainWindow doesn't do what you seem to think. It hooks the hidden application window, not the main form. To intercept WM_INITMENUPOPUP on a specific form, all you need to do is write a handler for it, as you have seen.
To do this generically for any owner form of a component, you could assign WindowProc property of the form to place the hook:
unit FormHook;
interface
uses
Windows, Classes, SysUtils, Messages, Controls, Forms;
type
TFormMessageEvent = procedure(var Message: TMessage; var Handled: Boolean) of object;
TFormHook = class(TComponent)
private
FForm: TCustomForm;
FFormWindowProc: TWndMethod;
FOnFormMessage: TFormMessageEvent;
protected
procedure FormWindowProc(var Message: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnFormMessage: TFormMessageEvent read FOnFormMessage write FOnFormMessage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TFormHook]);
end;
procedure TFormHook.FormWindowProc(var Message: TMessage);
var
Handled: Boolean;
begin
if Assigned(FFormWindowProc) then
begin
Handled := False;
if Assigned(FOnFormMessage) then
FOnFormMessage(Message, Handled);
if not Handled then
FFormWindowProc(Message);
end;
end;
constructor TFormHook.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFormWindowProc := nil;
FForm := nil;
while Assigned(AOwner) do
begin
if AOwner is TCustomForm then
begin
FForm := TCustomForm(AOwner);
FFormWindowProc := FForm.WindowProc;
FForm.WindowProc := FormWindowProc;
Break;
end;
AOwner := AOwner.Owner;
end;
end;
destructor TFormHook.Destroy;
begin
if Assigned(FForm) and Assigned(FFormWindowProc) then
begin
FForm.WindowProc := FFormWindowProc;
FFormWindowProc := nil;
FForm := nil;
end;
inherited Destroy;
end;
end.
You could then use this component on a form:
procedure TForm1.FormHook1FormMessage(var Message: TMessage; var Handled: Boolean);
begin
case Message.Msg of
WM_INITMENUPOPUP:
...
end;
end;
The problem might be that if the form has any other components which do the same thing then you need to make sure that unhooking happens in reverse order (last hooked, first unhooked). The above example hooks in the constructor and unhooks in the destructor; this seems to work even with multiple instances on the same form.
If you don't want any modifications to TForm-derivate-class, why don't try pure Windows API way to implement your current solution, that is, use SetWindowLongPtr() to intercept the WM_INITMENUPOPUP message. Delphi VCL style to intercept messages is just a wrapper of this Windows API function actually.
For that purpose, use SetWindowLongPtr() to set a new address for the window procedure and to get the original address of the window procedure, both at one blow. Remember to store the original address in a LONG_PTR variable. In 32-bit Delphi, LONG_PTR was Longint; supposing 64-bit Delphi will have been released in the future, LONG_PTR should be Int64; you can use $IFDEF directive to distinguish them as follows:
Type
{$IFDEF WIN32}
PtrInt = Longint;
{$ELSE}
PtrInt = Int64;
{$ENDIF}
LONG_PTR = PtrInt;
The value for nIndex parameter to be used for this purpose is GWLP_WNDPROC. Also, pass the new address for the window procedure to dwNewLong parameter, e.g. LONG_PTR(NewWndProc). The NewWndProc is a WindowProc Callback Function that processes messages, it is where your put your intercept criteria and override the default handling of the message you are going to intercept. The callback function can be any name, but the parameters must follow the WindowProc convention.
Note that you must call CallWindowProc() to pass any messages not processed by the new window procedure to the original window procedure.
Finally, you should call SetWindowLongPtr() again somewhere in your code to set the address of modified/new window procedure handler back to the original address. The original address has been saved before as mentioned above.
There was a Delphi code example here. It used SetWindowLong(), but now Microsoft recommends to use SetWindowLongPtr() instead to make it compatible with both 32-bit and 64-bit versions of Windows.
SetWindowLongPtr() didn't exist in Windows.pas of Delphi prior to Delphi 2009. If you use an older version of Delphi, you must declare it by yourself, or use JwaWinUser unit of JEDI API Library.
Not tried this myself, but give this a shot:
Use GetMenuItemRect to get the rect for item 0 of the menu returned by GetSystemMenu.
I (assume!) GetMenuItemRect should return 0 if the system menu is not open (because system could not know the rect of the menu item unless it is open?) If the result is non-zero, check if the coords returned are possible for the given screen resolution.
If you have the time, you could look into AutoHotKey's source code to see how to monitor when system menu is open/closed.
I want to minimize a Delphi application to the systray instead of the task bar.
The necessary steps seem to be the following:
Create icon which should then be displayed in the systray.
When the user clicks the [-] to minimize the application, do the following:
Hide the form.
Add the icon (step #1) to the systray.
Hide/delete the application's entry in the task bar.
When the user double-clicks the application's icon in the systray, do the following:
Show the form.
Un-minimize the application again and bring it to the front.
If "WindowState" is "WS_Minimized" set to "WS_Normal".
Hide/delete the application's icon in the systray.
When the user terminates the application, do the following:
Hide/delete the application's icon in the systray.
That's it. Right?
How could one implement this in Delphi?
I've found the following code but I don't know why it works. It doesn't follow my steps described above ...
unit uMinimizeToTray;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellApi;
const WM_NOTIFYICON = WM_USER+333;
type
TMinimizeToTray = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CMClickIcon(var msg: TMessage); message WM_NOTIFYICON;
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
MinimizeToTray: TMinimizeToTray;
implementation
{$R *.dfm}
procedure TMinimizeToTray.CMClickIcon(var msg: TMessage);
begin
if msg.lparam = WM_LBUTTONDBLCLK then Show;
end;
procedure TMinimizeToTray.FormCreate(Sender: TObject);
VAR tnid: TNotifyIconData;
HMainIcon: HICON;
begin
HMainIcon := LoadIcon(MainInstance, 'MAINICON');
Shell_NotifyIcon(NIM_DELETE, #tnid);
tnid.cbSize := sizeof(TNotifyIconData);
tnid.Wnd := handle;
tnid.uID := 123;
tnid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
tnid.uCallbackMessage := WM_NOTIFYICON;
tnid.hIcon := HMainIcon;
tnid.szTip := 'Tooltip';
Shell_NotifyIcon(NIM_ADD, #tnid);
end;
procedure TMinimizeToTray.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Hide;
end;
end.
If it still works, it's probably easiest to use JVCL's TJvTrayIcon to handle it automatically.
I would recommend using CoolTrayIcon. The author has already worked out all the issues involved with tray icons. Its free with source and examples and very debugged.
http://subsimple.com/delphi.asp
Instead of Application.BringToFront; use SetforegroundWindow(Application.Handle);
In the following text I'll be referring to the step numbers mentioned in the question:
The following solution is without any additional components. It's very easy to implement.
Step #1:
Just use the application's main icon (see following code).
Step #2:
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
Shell_NotifyIcon(NIM_ADD, #TrayIconData);
Form1.Hide;
end;
Step #3:
procedure TForm1.TrayMessage(var Msg: TMessage);
begin
if Msg.lParam = WM_LBUTTONDOWN then begin
Form1.Show;
Form1.WindowState := wsNormal;
Application.BringToFront;
Shell_NotifyIcon(NIM_DELETE, #TrayIconData);
end;
end;
Step #4:
procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, #TrayIconData);
end;
Necessary code in interface part:
uses
[...], ShellApi;
const
WM_ICONTRAY = WM_USER + 1;
type
TForm1 = class(TForm)
[...]
procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
end;
The only problem: The application can be minimized to the systray only once. The next time you want to minimize it, nothing will happen. Why?
Source: delphi.about.com
I have a Delphi application that has a document browser as the main form. When the user opens a document, we open an editor window. We want to have each editor with a button on the task bar, as well as the main form. I've applied the normal code to do this (below), but when I click on the main form after using the editor window the editor is being left on top, while the focus is on the main form. I'm unable to work out what is causing this behaviour.
Stage setting: I open the main form and a document form.
Click on another app, click on main form, main form stays focused.
(Behaving as expected.)
Click on the document form, click on main form, document form comes
back to front, but shown inactive. (Picture shows result)
alt text http://www.matthew-jones.com/temp_xfer/titlebarfailure.jpg
First step, this is Delphi 2007, and I have in the project:
Application.MainFormOnTaskBar := True;
For the main form, I have no additional code.
For the document form, I have
procedure TCommonEditForm.CreateParams(var params: TCreateParams);
begin
inherited;
params.WndParent := 0; // GetDeskTopWindow; no diff
end;
I've tried to work out if there is a message that is making this happen, but can't locate anything appropriate. I've searched the code for anything to do with "activate". Clues welcome!
My application works in the way you describe. Here is the approach I took. I would have liked to find a simpler approach but never did.
I started out by reading these articles. This first one is an great write up by Peter Below:
http://groups-beta.google.com/group/borland.public.delphi.winapi/msg/e9f75ff48ce960eb?hl=en
Other information was also found here, however this did not prove to be a valid solution: for my use:
http://blogs.teamb.com/DeepakShenoy/archive/2005/04/26/4050.aspx
Eventually here is what I ended up with.
My splash screen doubles as the Application Main form. The Main form has a special tie to the Application Object. Using all secondary forms gets me the behavior that I was looking for.
In each form that I want on the task bar I override CreateParams. I do this on my edit forms and what the users sees as the "main form"
procedure TUaarSalesMain.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
My "Main" form as far as Delphi is concerned loads the true main form in its Activitate function. I use a member variable to keep track of the first activate. Then at the end of the function I hide the splash form, but do not close it. This was important for me because if the user was editing a document and closed the main form I did not want the edit screens to be forced closed at the same time. This way all of the visible forms are treated the same.
if FFirstActivate = false then
exit;
FFristActivate := false;
/*
Main Load code here
Update Splash label, repaint
Application.CreateForm
etc.
*/
// I can't change visible here but I can change the size of the window
Self.Height := 0;
Self.Width := 0;
Self.Enabled := false;
// It is tempting to set Self.Visible := false here but that is not
// possible because you can't change the Visible status inside this
// function. So we need to send a message instead.
ShowWindow(Self.Handle, SW_HIDE);
end;
But there is still a problem. You need the main/splash window to close when all other forms are closed. I have an extra check in my close routines for Parent <> nil because I use forms as plugins (form my purposes they work better than frames).
I didn't really like using the Idle event, but I don't notice this being a drag on the CPU.
{
TApplicationManager.ApplicationEventsIdle
---------------------------------------------------------------------------
}
procedure TApplicationManager.ApplicationEventsIdle(Sender: TObject;
var Done: Boolean);
begin
if Screen.FormCount < 2 then
Close;
end;
{
TApplicationManager.FormCloseQuery
---------------------------------------------------------------------------
}
procedure TApplicationManager.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
i: integer;
begin
for i := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[i] <> self then
begin
// Forms that have a parent will be cleaned up by that parent so
// ignore them here and only attempt to close the parent forms
if Screen.Forms[i].Parent = nil then
begin
if Screen.Forms[i].CloseQuery = false then
begin
CanClose := false;
break;
end;
end;
end;
end;
end;
{
TApplicationManager.FormClose
---------------------------------------------------------------------------
}
procedure TApplicationManager.FormClose(Sender: TObject;
var Action: TCloseAction);
var
i: integer;
begin
for i := Screen.FormCount - 1 downto 0 do
begin
if Screen.Forms[i] <> self then
begin
// Forms that have a parent will be cleaned up by that parent so
// ignore them here and only attempt to close the parent forms
if Screen.Forms[i].Parent = nil then
begin
Screen.Forms[i].Close;
end;
end;
end;
end;
This has served me well so far. I did make a small change for Vista because the icon for my "Main/Splash" screen was still showing. I don't remember what that was though. I probably don't need to set width, height, enabled, and send the hide message on the splash screen. I just wanted to make sure it didn't show up :-).
Dealing with the close events was necessary. If I remember correctly that was needed for when windows sent a shutdown message. I think only the main form gets that message.
Sorry if this is really stupid, but you don't have the formstyle set to fsStayOnTop do you? This would explain this behaviour.
perhaps add this in the createparams
Params.ExStyle := Params.ExStyle OR WS_EX_APPWINDOW;
or try this anywhere in the code. I presonally use it on the forms .OnCreate event.
SetWindowLong(Wnd, GWL_EXSTYLE,
GetWindowLong(Wnd, GWL_EXSTYLE) or WS_EX_APPWINDOW) ;
the downside of this is that if the main form is minimized the other forms hide aswell, but restore when the main form does.