Disable Theming on specific controls?

Question

I know you can use SetWindowTheme found in uxTheme.pas to disable/enable the theming on controls, like this for example:

SetWindowTheme(Button1.Handle, nil, nil);

This works on quite a few of the controls, however it will not work on some controls such as TBitBtn or TSpeedButton. I think this must be because TBitBtn and TSpeedButton are not Windows controls, but custom ones?

There may well be other controls that also won't work, so I was hoping someone could share a solution or alternative to achieve this?

I want some of the controls to have no theming at all, eg they will show as classic themed whilst the rest of the controls will not be affected.

Thanks.

Did you read the source yet for the painting of these VCL controls. — David Heffernan, Apr 01 '12 at 17:53
In StdCtrls.pas I see TButton is of TWinControl descendance, and in Buttons.pas I believe TBitBtn and TSpeedButton are custom classes. It all looks a bit complicated too me though! — , Apr 01 '12 at 18:23
`TSpeedButton` is a `TGraphicControl` which does not have a handle anyway. You could override `Paint` of `TspeedButton` and `CNDrawItem` of `TBitBtn`... Why didn't XE provided some kind of `UseThemes` for custom controls? dunno... — kobik, Apr 01 '12 at 18:33
@kobik it would be a really good idea if Delphi had this built in and you could access it like a regular property to toggle on/off. — , Apr 01 '12 at 19:31

David Heffernan · Accepted Answer · 2012-04-01T19:17:11.587

13

Your analysis is correct. SetWindowTheme works for window controls but TSpeedButton and TBitBtn are non-winowed controls.

In XE, from my quick scan, it seems that most controls call Themes.ThemeControl to determine whether or not to draw themed. So the simple solution is to replace that routine with logic that you control. Since it does not provide any extension points, you need to hook it. Like this:

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    Move(NewCode, Address^, Size);
    FlushInstructionCache(GetCurrentProcess, Address, Size);
    VirtualProtect(Address, Size, OldProtect, @OldProtect);
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

function MyThemeControl(AControl: TControl): Boolean;
begin
  Result := False;
  if AControl = nil then exit;
  if AControl is TSpeedButton then exit;
  if AControl is TBitBtn then exit;
  Result := (not (csDesigning in AControl.ComponentState) and ThemeServices.ThemesEnabled) or
            ((csDesigning in AControl.ComponentState) and (AControl.Parent <> nil) and
             (ThemeServices.ThemesEnabled and not UnthemedDesigner(AControl.Parent)));
end;

initialization
  RedirectProcedure(@Themes.ThemeControl, @MyThemeControl);

As it stands, this will not work with runtime packages, but it's easy enough to extend the code to work with packages.

edited Apr 01 '12 at 19:17

answered Apr 01 '12 at 18:59

David Heffernan

601,492
42
1,072
1,490

1

@blobby If you want to change this behaviour and not modify vcl code, or create subclasses and copy/paste VCL code, this is the answer. – David Heffernan Apr 01 '12 at 19:03
And a very technical well written answer it is David, even if I don't understand any of it! It boggles my mind how you and others can come up with code like this - Amazing :) – Apr 01 '12 at 19:21
This is stock code of mine but it's not original in idea. You'l find it in many other places. It simply rewrites the code at the beginning of ThemeControls with an unconditional JMP to the replacement code, MyThemeControls in this case. And then you can make your mods to behaviour. In the case of your question, ThemeControls is the least invasive way to change the behaviour. – David Heffernan Apr 01 '12 at 19:23
I accepted your answer as it works and does not interfere with the Delphi units. I just wish I could understand the code from answers, it annoys me accepting answers and not knowing how the code works or how it was written as I will never learn. Whats worse is you could explain it to me all day and I would still be no wiser! – Apr 01 '12 at 19:29
2

To understand it, try this. Make sure that the code above is in your app. Then enable Debug DCUs. Then set a breakpoint on TSpeedButton.Paint. Step through until the `if ThemeControls` line. Then step **in**. Notice that you go to `Themes.ThemeControls`. Then step once and notice that you jump into `MyThemeControls`. Now you should get how this is able to change behaviour. Next repeat the procedure and when you get to `Themes.ThemeControls` switch to CPU view. Notice the dissasembly reads `JMP ....`. That's the machine code that we wrote ourselves. – David Heffernan Apr 01 '12 at 19:32
Oh, and I must say that you are quite right to feel uneasy about using code that you don't understand. That is absolutely the right approach. I'm happy to spend time trying to help you understand!! ;-) – David Heffernan Apr 01 '12 at 19:33
And this is safer than patching the VMT? – kobik Apr 02 '12 at 08:38
@kobik In my view this is safe. What dangers do you see? – David Heffernan Apr 02 '12 at 08:58
@DavidHeffernan, My point is that this code is not less of a hack as [this](http://stackoverflow.com/a/9887684/937125). Do you agree? – kobik Apr 02 '12 at 09:03
@kobik No I don't agree. Detouring like this is very standard practice. Indeed the Win32 API is compiled in a way to facilitate detouring. – David Heffernan Apr 02 '12 at 09:06
@DavidHeffernan, Understood. and no special calling convention for `MyThemeControl` is needed here either? – kobik Apr 02 '12 at 09:13
1

@kobik Calling convention for original routine and the replacement routine need to match. Otherwise it doesn't actually matter what the calling convention is, so long as both routines have same convention. – David Heffernan Apr 02 '12 at 09:24

score 5 · Answer 2 · answered Apr 01 '12 at 18:34

If you look at the source code for TBitBtn (in particular, TBitBtn.DrawItem), you see that it is drawn manually in the Delphi source code. It uses the Windows visual themes API to draw the button (ThemeServices.Draw*) in the current theme, if themes are enabled. If not, it uses the old-style Windows API functions to draw controls, such as Rectangle and DrawFrameControl. I think you have to alter the source code of the control in order to circumvent this behaviour.

Thanks for the information Andreas. However I would rather not want to modify the Delphi source code. — , Apr 01 '12 at 19:01

Disable Theming on specific controls?

2 Answers2