Mike Lischke's TThemeServices subclasses Application.Handle, so that it can receive broadcast notifications from Windows (i.e. WM_THEMECHANGED) when theming changes.
It subclasses the Application object's window:
FWindowHandle := Application.Handle;
if FWindowHandle <> 0 then
begin
// If a window handle is given then subclass the window to get notified about theme changes.
{$ifdef COMPILER_6_UP}
FObjectInstance := Classes.MakeObjectInstance(WindowProc);
{$else}
FObjectInstance := MakeObjectInstance(WindowProc);
{$endif COMPILER_6_UP}
FDefWindowProc := Pointer(GetWindowLong(FWindowHandle, GWL_WNDPROC));
SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FObjectInstance));
end;
The subclassed window procdure then does, as it's supposed to, WM_DESTROY message, remove it's subclass, and then pass the WM_DESTROY message on:
procedure TThemeServices.WindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_THEMECHANGED:
begin
[...snip...]
end;
WM_DESTROY:
begin
// If we are connected to a window then we have to listen to its destruction.
SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FDefWindowProc));
{$ifdef COMPILER_6_UP}
Classes.FreeObjectInstance(FObjectInstance);
{$else}
FreeObjectInstance(FObjectInstance);
{$endif COMPILER_6_UP}
FObjectInstance := nil;
end;
end;
with Message do
Result := CallWindowProc(FDefWindowProc, FWindowHandle, Msg, WParam, LParam);
end;
The TThemeServices object is a singleton, destroyed during unit finalization:
initialization
finalization
InternalThemeServices.Free;
end.
And that all works well - as long as TThemeServices is the only guy who ever subclasses the Application's handle.
i have a similar singleton library, that also wants to hook Application.Handle so i can receive broadcasts:
procedure TDesktopWindowManager.WindowProc(var Message: TMessage);
begin
case Message.Msg of
WM_DWMCOLORIZATIONCOLORCHANGED: ...
WM_DWMCOMPOSITIONCHANGED: ...
WM_DWMNCRENDERINGCHANGED: ...
WM_DESTROY:
begin
// If we are connected to a window then we have to listen to its destruction.
SetWindowLong(FWindowHandle, GWL_WNDPROC, Integer(FDefWindowProc));
{$ifdef COMPILER_6_UP}
Classes.FreeObjectInstance(FObjectInstance);
{$else}
FreeObjectInstance(FObjectInstance);
{$endif COMPILER_6_UP}
FObjectInstance := nil;
end;
end;
with Message do
Result := CallWindowProc(FDefWindowProc, FWindowHandle, Msg, WParam, LParam);
And my singleton is similarly removed when the unit finalizes:
initialization
...
finalization
InternalDwmServices.Free;
end.
Now we come to the problem. i can't guarantee the order in which someone might choose to access ThemeServices or DWM, each of which apply their subclass. Nor can i know the order in which Delphi will finalize units.
The subclasses are being removed in the wrong order, and there is a crash on application close.
How to fix? How can i ensure that i keep my subclassing method around long enough until the other guy is done after me is done? (i don't want to leak memory, after all)
See also
Raymond Chen: Safer Subclassing
MSDN: Using Window Procedures
Raymond Chen: When the normal window destruction messages are thrown for a loop
Update: i see Delphi 7 solves the bug by rewriting TApplication. ><
procedure TApplication.WndProc(var Message: TMessage);
...
begin
...
with Message do
case Msg of
...
WM_THEMECHANGED:
if ThemeServices.ThemesEnabled then
ThemeServices.ApplyThemeChange;
...
end;
...
end;
Grrrr
In other words: trying to subclass TApplication was a bug, that Borland fixed when they adopted Mike's TThemeManager.
That very well may mean that there is no way to remove subclasses on TApplication in reverse order. Someone put that in the form of an answer, and i'll accept it.
Change your code to call SetWindowSubclass, as the article you linked to advises. But that only works if everyone uses the same API, so patch Theme Manager to use the same technique. The API was introduced in Windows XP, so there's no danger that it's not available on the systems where it would be needed.
There should be no problem with patching Theme Manager. It's designed to support Windows XP, which Microsoft doesn't support anymore, and to support Delphi 4 through 6, which Borland doesn't support anymore. Since development has ceased on all relevant products, it is safe for you to fork the Theme Manager project without risk of falling behind due to future updates.
You're not really introducing a dependency. Rather, you're fixing a bug that's only present when both window-appearance libraries are in use at the same time. Users of your library don't need to have Theme Manager for yours to work, but if they wish to use both, they need to use Theme Manager with your patches applied. There should be little objection to that since they already have the base version, so it's not like they'd be installing an entirely new library. They'd just be applying a patch and recompiling.
Rather than subclassing the TApplication window, perhaps you can use AllocateHWnd() instead to receive the same broadcasts separately, since it is a top-level window of its own.
I think I would do the following:
Put a reference to ThemeServices in the initialization section of ThemeSrv.pas.
Put a reference to DwmServices in the initialization section of DwmSrv.pas (I'm guess the name of your unit).
Since units are finalised in reverse order from the order of initialisation, your problem will be solved.
Why don't you just use the ApplicationEvents and be done with it. No need to messing around with subclassing.
The other way is to create only one subclass and create multi-notify events and subscribe as many as you wish.
Cheers
Related
I want to show a label on a form when FastMM4 is being used ('Uses' in the project file), so that I don't make the mistake of giving the executable to someone who doesn't have FastMM_FullDebugMode.dll installed.
I tried these, but they have are no effect:
{$ifdef FullDebugMode}
LblFastMM4.Visible := true;
{$endif}
{$ifdef EnableMemoryLeakReporting}
LblFastMM4.Visible := true;
{$endif}
How can I detect FastMM4 at runtime?
Note: I don't 'officially' distribute the app with FastMM4. This is just a reminder to myself when I want to give the alpha version to a non-technical user for a quick look. It's annoying if they then bump into the error.
Your {$ifdef}'s don't work because your own code is not including FastMM4Options.inc directly, so FastMM's conditionals are not defined in scope of your code. They are only defined in scope of FastMM's code. You can't test for conditionals that are {$define}'d in someone else's unit.
However, you can use {$If Declared(...)} to check for public symbols that are in scope from using another unit. In this case, the interface section of FastMM4.pas declares various symbols under certain conditions, for instance TRegisteredMemoryLeak when EnableMemoryLeakReporting is defined, DebugGetMem when FullDebugMode is defined, etc.
{$if declared(DebugGetMem)}
LblFastMM4.Visible := true;
{$endif}
{$if declared(TRegisteredMemoryLeak)}
LblFastMM4.Visible := true;
{$endif}
A lot of options can be configured for FastMM. In your case the option DoNotInstallIfDLLMissing can be of value. A nice application is available for setting options: https://jedqc.blogspot.com/2007/07/new-fastmm4-options-interface.html
try this:
LblFastMM4.Visible := InitializationCodeHasRun;
I developed an application in VCL which is using VCL Themes. This application requires TPageControl and inner(child) forms in it.
Each child form has same way in OnClose: Parent.Destroy;
MsgResp := MessageDlg('Closing info....', mtWarning, [mbYes, mbNo, mbCancel], 0);
case MsgResp of
mrYes:
begin
DoSomething; {Save something}
Parent.Destroy;
end;
mrNo:
begin
Parent.Destroy;
end;
mrCancel:
begin
Exit;
end;
end;
If I set a theme to application like Sapphire Kamri (or something else), I get access violation error in destroying parent component. But if I use default style (Windows), this code works fine.
This is entirely to be expected. Your code is just as broken without VCL styles, but you get away with it.
The problem is the calls to Parent.Destroy. When these occur, the parent is destroyed, and so are all of its children, including the control that owns the code seen in the question. When the call to Parent.Destroy returns, execution continues in methods of objects that have been destroyed. That is the source of the runtime error.
You need to schedule the destruction to happen after the OnClose event handler has completed. The VCL Release method exists for this very purpose.
How can I be sure that in some point of my VCL application lifetime the Application.MainForm is valid so I could post a message to it (from a MadExcept ExceptionHandler).
This could be at any point (in the context of any thread) in my application (also initialization, finalization etc...)
I was thinking:
if Assigned(Application)
and (not Application.Terminated)
and Assigned(Application.MainForm)
and Application.MainForm.HandleAllocated then
begin
PostMessage(Application.MainForm.Handle, MyMessage, 0, 0);
end;
Is this correct?
How can I be sure that in some point of my VCL application lifetime the Application.MainForm is valid so I could post a message to it.
OK.
This could be at any point (in the context of any thread) in my application (also initialization, finalization etc...)
Uh oh.
....
Is this correct?
No it certainly is not. Your code can never be made threadsafe because it is not permitted to access VCL objects from outside the main thread.
In your particular case consider the following sequence of events:
You perform your tests in the if culminating in your evaluating Application.MainForm.HandleAllocated as True. Ignore for a moment the fact that you are doing this outside the main thread.
You then set about preparing the call to PostMessage. But at this very instance, the main form is destroyed.
By the time your thread gets round to accessing Application.MainForm, it has gone.
You are going to need to work a little harder here. You'll need to do something like this:
// interface section of some unit
procedure RegisterMainFormHandle(Wnd: HWND);
procedure UnregisterMainFormHandle;
procedure PostMessageToMainForm(...);
// implementation section
var
MainFormHandleLock: TCriticalSection;
MainFormHandle: HWND;
procedure RegisterMainFormHandle(Wnd: HWND);
begin
MainFormHandleLock.Acquire;
try
MainFormHandle := Wnd;
finally
MainFormHandleLock.Release;
end;
end;
procedure UnregisterMainFormHandle;
begin
MainFormHandleLock.Acquire;
try
MainFormHandle := 0;
finally
MainFormHandleLock.Release;
end;
end;
procedure PostMessageToMainForm(...);
begin
MainFormHandleLock.Acquire;
try
if MainFormHandle <> 0 then
PostMessage(MainFormHandle, ...)
finally
MainFormHandleLock.Release;
end;
end;
You also need to create and destroy the critical section, but I assume that you know how to do that.
In your main form you override CreateWnd and DestroyWnd and arrange that they call RegisterMainFormHandle and UnregisterMainFormHandle.
Then you can call PostMessageToMainForm from any thread at any time.
Of course, if the main form's window is recreated then you'll lose some messages. Which sounds like it could be a problem. Using AllocateHwnd to have a window whose lifetime you control is usually a better option than using the main form's window like this.
Make some global variable flag = false at the beginning.
Make your mainform turn it to true.
Check that flag to see if main form was already initialised or not yet.
You can make it from such places as mainform's OnActivate event or overridden TMainForm.Loaded method
Similarly when your application would be terminating and the mainform would get hidden (and later even destroyed) - you would reset the flag back to false
I inherited a GUI implemented in Delphi RadStudio2007 targeted for Windows XP embedded. I am seeing a lot of code that looks like this:
procedure TStatusForm.Status_refresh;
begin
if DataModel.CommStatus = COMM_OK then begin
if CommStatusOKImage.Visible<>True then CommStatusOKImage.Visible:=True;
if CommStatusErrorImage.Visible<>False then CommStatusErrorImage.Visible:=False;
end else begin
if CommStatusOKImage.Visible<>False then CommStatusOKImage.Visible:=False;
if CommStatusErrorImage.Visible<>True then CommStatusErrorImage.Visible:=True;
end;
end
I did find this code sample on the Embarcadero site:
procedure TForm1.ShowPaletteButtonClick(Sender: TObject);
begin
if Form2.Visible = False then Form2.Visible := True;
Form2.BringToFront;
end;
That shows a check of Visible before changing it, but there is no explanation of what is served by checking it first.
I am trying to understand why the original developer felt that it was necessary to only set the Visible flag if it was to be changed, and did not choose to code it this way instead:
procedure TStatusForm.Status_refresh;
begin
CommStatusOKImage.Visible := DataModel.CommStatus = COMM_OK;
CommStatusErrorImage.Visible := not CommStatusOKImage.Visible;
end
Are there performance issues or cosmetic issues (such as screen flicker) that I need to be aware of?
As Remy Lebeau said, Visible setter already checks if new value differs.
For example, in XE, for TImage, assignment to Visible actually invokes inherited code:
procedure TControl.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
VisibleChanging;
FVisible := Value;
Perform(CM_VISIBLECHANGED, Ord(Value), 0);
RequestAlign;
end;
end;
So, there is no benefits of checking it. However, might there in your code are used some third-party or rare components - for them all may be different, though, I doubt it.
You can investigate it yourself, using "Find Declaration" context menu item in editor (or simply Ctrl+click), and/or stepping into VCL code with "Use debug dcus" compiler option turned on.
Like many properties, the Visible property setter checks if the new value is different than the current value before doing anything. There is no need to check the current property value manually.
Well, I doubt it will, but maybe there could be issues specifically for forms in recent Delphi versions. The Visible property is redeclared in TCustomForm to assure the execution of the OnCreate event prior to setting the visibility. It is technically not overriden since TControl.SetVisible is not virtual, but it has the same effect:
procedure TCustomForm.SetVisible(Value: Boolean);
begin
if fsCreating in FFormState then
if Value then
Include(FFormState, fsVisible) else
Exclude(FFormState, fsVisible)
else
begin
if Value and (Visible <> Value) then SetWindowToMonitor;
inherited Visible := Value;
end;
end;
This implementation in Delphi 7 still does not require checking the visibility manually, but check this yourself for more recent versions.
Also, I agree with Larry Lustig's comment because the code you provided does not testify of accepted syntax. It could have better been written as:
procedure TForm1.ShowPaletteButtonClick(Sender: TObject);
begin
if not Form2.Visible then Form2.Visible := True;
Form2.BringToFront;
end;
Update: The changes to introduce VCL styles in XE2 have removed the memory leak. So I guess it was unintentional after all.
I came across a VCL memory leak today, in Themes.pas. It only occurs for DLLs. The unit finalization code is as so:
finalization
if not IsLibrary then
InternalServices.Free;
InternalServices is a singleton that is created on demand when you call the ThemeServices function. Many DLLs do not have UI and so do not ever create this singleton. However, I happen to have a COM add-in to Excel which does result in this leak manifesting.
The leak doesn't particularly bother me because this DLL is never repeatedly loaded and unloaded from the same process. And I know how I could fix the leak using the ThemeServicesClass global variable.
My question though, is to ask if anyone can explain why this code is the way it is. It seems quite deliberately coded this way. For the life of me I cannot come up with an explanation for this intentional leak.
One explanation is that the unit finalization section is executed while the OS loader lock is active. During that time, there are significant restrictions on what a DLL is allowed to do without risking deadlock.
We run into this same problem as well. Here is what we are currently doing to prevent the leak in our projects:
In the dll .dpr file add Themes to the uses section.
Add the following to clean up the leak on shutdown:
procedure DLLEntryProc(EntryCode: integer);
begin
case EntryCode of
DLL_PROCESS_DETACH:
begin
ThemeServices.Free;
end;
DLL_PROCESS_ATTACH:
begin
end;
DLL_THREAD_ATTACH:
begin
end;
DLL_THREAD_DETACH:
begin
end;
end;
end;
begin
{$IFDEF DEBUG}
ReportMemoryLeaksOnShutdown := True;
{$ENDIF}
DllProc := #DLLEntryProc;
end.
On the same idea that there must be a good reason to leave it leaking (indy leaks a couple of things on purpose as well, or at least it used to) I prefer to ignore it, like so:
{$I FastMM4Options.inc}
...
{$IFDEF EnableMemoryLeakReporting}
if IsLibrary then// ThemeServices is leaked when created in a DLL.
RegisterExpectedMemoryLeak(ThemeServices);
{$ENDIF}