CODEWITHSUNDEEP
delphidelphi-xe
user1175743
user1175743

Reputation:

Disable Theming on specific controls?

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.

Upvotes: 9

Views: 3530

Answers (2)

David Heffernan
David Heffernan

Reputation: 612794

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.

Upvotes: 14

Andreas Rejbrand
Andreas Rejbrand

Reputation: 108919

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.

Upvotes: 5

Related Questions