I'm changing the parent of a frame a runtime to move the frame from one form to another. That works fine but after that my components do not receive mouse events any longer. For example, CM_MOUSEENTER and CM_MOUSELEAVE is not fired.
Frame.Parent := SecondDisplayForm;
Frame.Align := alClient;
SecondDisplayForm.Show;
I don't understand this effect and I don't really know what information to provide, so if you have hints please help me out here.
It works in D7 as NGLN reported, but in BDS2006 it's reproducible. I found that it's important to change the parent after the cm_mouseenter, and before cm_mouseleave, otherways ther's no problem. The problem is in the controls.pas I think, maybe it's a bug. Playing around a little bit I found out that if you Perform a wm_mouseleave message before changing the parent everything is fine again.
In my sample code i change the parent in an onclick event.
TFrame3 = class(TFrame)
procedure FrameClick(Sender: TObject);
private
procedure CMMouseEnter( var msg: TMessage ); message CM_MOUSEENTER;
procedure CMMouseLeave( var msg: TMessage ); message CM_MOUSELEAVE;
public
end;
implementation
procedure TFrame3.CMMouseEnter(var msg: TMessage);
begin
inherited;
Color := clRed;
end;
procedure TFrame3.CMMouseLeave(var msg: TMessage);
begin
inherited;
Color := clBlue;
end;
procedure TFrame3.FrameClick(Sender: TObject);
begin
if parent = Form1 then
begin
Perform( WM_MOUSELEAVE, 0, 0 );
parent := Form2;
align := alClient;
Form1.Hide;
Form2.Show;
end else
begin
Perform( WM_MOUSELEAVE, 0, 0 );
parent := Form1;
align := alClient;
Form2.Hide;
Form1.Show;
end;
end;
I think the problem is related to the FMouseControl in Controls.pas, but haven't investigated it properly.
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've a strange problem. I started approx. 160 processes. Now, if the mouse pointer is on the Desktop, some actions which used to take 100ms, now take 10 seconds although the total load of the system is 13-16%. Even thrid party programs like processhacker slowing down and doesn't refresh their gui. If I move the mouse pointer over some window no matter which one (could be notepad) even the taskbar can help all goes back to normal. Processhacker is refreshing his lists and the responsivness is back to 100ms.
Since Microsoft-Support won't help use - since or processes are programmed in Borland-Delphi we have no idea how to find out what's going on here.
A colleague tries to reproduce the effect with this little test program:
unit Unit1;
interface
uses
Forms,
ExtCtrls,
Classes,
Controls,
StdCtrls;
const
DEFAULT_INTERVAL = 31;
MOD_VALUE = 5;
MOD_INTERVAL = DEFAULT_INTERVAL * MOD_VALUE;
DEVIATION_BLACK = 2;
DEVIATION_RED = 10;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
Timer: TTimer;
lastTime: TDateTime;
procedure OnTimer(Sender: TObject);
procedure SetLabel(lbl: TLabel);
end;
var
Form1: TForm1;
GCounterT: Integer;
implementation
uses
Windows,
Graphics,
SysUtils,
DateUtils;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Self.DoubleBuffered := True;
Timer := TTimer.Create(nil);
Timer.Interval := DEFAULT_INTERVAL;
Timer.OnTimer := OnTimer;
GCounterT := 0;
lastTime := Now();
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer.Free;
end;
procedure TForm1.OnTimer(Sender: TObject);
begin
Inc(GCounterT);
if (GCounterT mod MOD_VALUE) = 0 then begin
SetLabel(Label1);
GCounterT := 0;
end;
end;
procedure TForm1.SetLabel(lbl: TLabel);
var
newValue: string;
nowTime: TDateTime;
msDiff: Integer;
newColor: TColor;
begin
if IsIconic(Application.Handle) then Exit;
nowTime := Now();
msDiff := MilliSecondsBetween(nowTime, lastTime);
lastTime := nowTime;
newValue := Format('TTimer: %s dev: %d',[FormatDateTime('ss.zzz', nowTime), msDiff - MOD_INTERVAL]);
if (msDiff <= (MOD_INTERVAL + DEVIATION_BLACK))
and (msDiff >= (MOD_INTERVAL - DEVIATION_BLACK)) then
newColor := clGreen
else if (msDiff <= (MOD_INTERVAL + DEVIATION_RED))
and (msDiff >= (MOD_INTERVAL - DEVIATION_RED)) then
newColor := clBlack
else
newColor := clRed;
try
lbl.Font.Color := newColor;
lbl.Caption := newValue;
except
end;
end;
end.
The effect in not as strong as with the original processes, but it's reproduceable.
If one starts 180 of this you can see the same effect only the slowdown is not that severe.
Update Aug 04:
I've added a screenshot from a WPA-Analyze-Session. Here one can see the sequence. Starting with mouse on a Window, then Desktop, Window, Desktop and ending with mouse on Window.
You can see, that the Thread: CSwitch count is going nearly half if the mouse is on the Desktop. What you also could see is that the system load is between 10-17% the whole time.
After we managed to add debug-symbols to some of our processes, we found the issue in the Delphi-VCL/Forms.pas.
In a new trace, with debug-symbols, we saw that the Application.DoMouseIdle method spends a lot of time finding VCLWindows, get Parents of these and so on.
The source of the slowdown is the "FindDragTarget" method. Our processes need no drag'n'drop functionality and they need no hint showing somewhere. So we cut this function call out of the code, which was not easy.
Now everything is running fast undependend from the mouse position.
I am minimizing a form to system tray (display a tray icon) while keeping its taskbar button when it is not minimized. This implies removing the taskbar button when the form is minimized and restoring it otherwise.
The simplest way to achieve this is to hide/show the form, a minimized window does not show anyway.
type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
procedure TrayIcon1DblClick(Sender: TObject);
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMSize(var Message: TWMSize);
begin
inherited;
case Message.SizeType of
SIZE_MINIMIZED:
if not TrayIcon1.Visible then begin
TrayIcon1.Visible := True;
Hide;
end;
SIZE_RESTORED, SIZE_MAXIMIZED:
if TrayIcon1.Visible then begin
Show;
Application.BringToFront;
TrayIcon1.Visible := False;
end;
end;
end;
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
Show;
WindowState := wsNormal;
end;
The above application introduces a visual glitch when "Animate windows when minimizing and maximizing" setting of the OS is on (accessible through 'SystemPropertiesPerformance.exe'). The minimize window animation is skipped. It appears that the animation actually takes place after the window is minimized. In the code, the window is already hidden by then.
One solution could be to have a notification when the window manager is done with the animation and hiding the form after that. I can't find any. When, for instance, you use the taskbar button minimizing the window, the last message sent is the WM_SYSCOMMAND, which doesn't lead to any progress if I move the code (not to mention that a window can be minimized through a ShowWindow and others).
Another solution might involve to know how long the animation takes place. SystemParametersInfo doesn't have it. Similar question here tries to deal with the animation displayed when a window is first shown, although that animation seems to be related with DWM and minimize/maximize animation precedes DWM. No conclusive solution there either. Like in that question, a 250ms delay seems to work fine. But I'm not sure this is a universally sound delay. I'm not even sure a discrete delay would be definitive, perhaps a stutter would cause it to extent (not that it would matter much, but anyway...).
I also tried to actually remove the taskbar button, without hiding the form. But it's more clumsy and it doesn't change the output: the animation is skipped.
Comment about DrawAnimatedRects (which draws no animation when Aero is on) convinced me to go slightly undocumented until I have a better alternative. Methods using DrawAnimatedRects have to determine where to minimize, that's where they use undocumented system tray window class name.
The below code goes undocumented when removing the taskbar button of the form, in particular with the use of the GWLP_HWNDPARENT index of SetWindowLongPtr. In any case, removing the taskbar button is not clumsy as in transforming the window to a tool window and the animation goes smooth.
The code falls back to a timer which hides the form in case removing the taskbar button fails.
type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
Timer1: TTimer;
procedure TrayIcon1DblClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
protected
procedure WMSize(var Message: TWMSize); message WM_SIZE;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ShowTaskbarButton(Wnd: HWND; Show: Boolean = True;
OwnerWnd: HWND = 0): Boolean;
var
ExStyle, HWndParent: LONG_PTR;
IsToolWindow: Boolean;
begin
HwndParent := GetWindowLongPtr(Wnd, GWLP_HWNDPARENT);
ExStyle := GetWindowLongPtr(Wnd, GWL_EXSTYLE);
Result := Show = (HWndParent = 0) and (ExStyle and WS_EX_APPWINDOW <> 0);
if not Result then begin
IsToolWindow := ExStyle and WS_EX_TOOLWINDOW <> 0;
if IsToolWindow then begin
ShowWindow(Wnd, SW_HIDE);
ShowWindowAsync(Wnd, SW_SHOW);
end;
SetLastError(0);
if Show then
SetWindowLongPtr(Wnd, GWL_EXSTYLE, ExStyle or WS_EX_APPWINDOW)
else
SetWindowLongPtr(Wnd, GWL_EXSTYLE, ExStyle and not WS_EX_APPWINDOW);
if not IsToolWindow and (GetLastError = 0) then
SetWindowLongPtr(Wnd, GWLP_HWNDPARENT, OwnerWnd);
Result := GetLastError = 0;
end;
end;
procedure TForm1.WMSize(var Message: TWMSize);
begin
inherited;
case Message.SizeType of
SIZE_MINIMIZED:
if not TrayIcon1.Visible then begin
if not ShowTaskbarButton(Handle, False, Application.Handle) then
Timer1.Enabled := True; // fall back
TrayIcon1.Visible := True
end;
SIZE_RESTORED, SIZE_MAXIMIZED:
if TrayIcon1.Visible then begin
ShowTaskbarButton(Handle);
Application.BringToFront;
TrayIcon1.Visible := False;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 250;
Timer1.Enabled := False;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Hide;
Timer1.Enabled := False;
end;
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
ShowTaskbarButton(Handle);
if not Showing then // used timer to hide
Show;
WindowState := wsNormal;
end;
How I can save the content of Listbox to file When the computer shutting down or sleeping, or restarting ???
I use Delphi XE7 ,
I do save the file , and I have no problem with it !
but I want to save the file when computer shutting down .
update my code and Problem:
my problem which is , when my project run in the background the both events OnClose & OnDestroy dose not work!
If the project work normally "not in the background", the both event's is work fine!
I figure my problem , which is my project working in background process , i add this lines to do this Application.MainFormOnTaskbar := False; Application.ShowMainForm := False; If i make my project to run in back ground process the events onClose and onDestroy is definitely not work,
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
str :TStringList;
i : integer;
begin
str := TStringList.Create;
for i := 0 to ListBox1.Count-1 do
str.Add(ListBox1.Items.Strings[i]);
try
str.SaveToFile('D:\test1.txt', TEncoding.UTF8);
finally
str.Free;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
str :TStringList;
i : integer;
begin
str := TStringList.Create;
for i := 0 to ListBox1.Count-1 do
str.Add(ListBox1.Items.Strings[i]);
try
str.SaveToFile('D:\test15.txt', TEncoding.UTF8);
finally
str.Free;
end;
end;
Handle the WM_ENDSESSION message and save your file there.
Catch the windows message like this:
private
procedure OnShutDown(var Msg: TMessage); message WM_ENDSESSION;
And here is your implementation
procedure TForm1.OnShutDown(var Msg: TMessage);
begin
//Save your file here.
end;
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