7

to paint themed button I use this code:

var
  h: HTHEME;
begin
  if UseThemes then begin
    SetWindowTheme(Handle, 'explorer', nil);
    h := OpenThemeData(Handle, 'WINDOW');
    if h <> 0 then
    try
      DrawThemeBackground(h, Canvas.Handle, WP_CLOSEBUTTON, GetAeroState, ClientRect, nil);
    finally
      CloseThemeData(h);
    end;
  end
  else
    DrawFrameControl(Canvas.Handle, ClientRect, DFC_CAPTION, DFCS_CAPTIONCLOSE or GetClassicState)
end;

This code works fine but painted button looks like from Windows 7 theme, even on Windows 8 or 10. This is possible to paint the Close button using Windows 10 or 8 theme?

enter image description here

Alex Egorov
  • 907
  • 7
  • 26
  • 1
    What version of Delphi are you using? – Jerry Dodge Nov 30 '15 at 18:00
  • Added tag delphi-xe7, this is not important for this (I think), and also, I'm developed under Window 8, but this is painted like under Windows 7 – Alex Egorov Nov 30 '15 at 18:14
  • It's not very clear what your problem is. The way I understood it, you're trying to paint a theme matching the version of Windows. This should happen by default without any coding. It sounded like you were using a very old version of Delphi without run-time themes. Can you provide screenshots of both what you are expecting, and what you see instead? – Jerry Dodge Nov 30 '15 at 18:17
  • I don't think it is possible to do what you want. I think you need to draw it yourself. – David Heffernan Nov 30 '15 at 18:19
  • To David: Create screenshots of such buttons and paint it? But this is so ugly, but easy. With UxTheme we will alaway be with old theme from Windows Vista/7 for emulated system buttons? – Alex Egorov Nov 30 '15 at 18:26
  • To Jerry, this code paint not standard button, but button from windows header [X] button, which colored and styled like it from Windows Vista/7 – Alex Egorov Nov 30 '15 at 18:30
  • 2
    I don't think that there's an api for this. I also think the question is badly tagged. Despite what @Jerry says this is, as you know, not a Delphi issue. If I were you I'd remove the Delphi tag and retag with just `winapi`. – David Heffernan Nov 30 '15 at 18:31
  • The problem with Delphi tag is most of the winapi experts will ignore Delphi tagged questions – David Heffernan Nov 30 '15 at 18:42

2 Answers2

2

One of ways to resolve this question: manual parsing active *.msstyles file. Usual this is aero.msstyles. Bitmap for different window controls stored in STREAM section. For Windows 7 ResId = 971, Windows 8: Id = 1060, Windows 10: Id = 1194. But this is manual work and this bitmaps is different.

Update:

I found, that even for one version of the Windows (tested for 8) we can have different values of the resource id for this Bitmap (png image) and now I can provide the code to obtain resource id on any Windows (tested for 7,8,10):

function EnumStreamProc(hModule: HMODULE; AType, AName: PChar; Params: LPARAM): BOOL; stdcall;
var
  Id: NativeInt;
begin
  PNativeInt(Params)^ := Integer(AName);
  Result := False;
end;

function GetStyleResourceId(AModule: HMODULE): Integer;
begin
  Result := 0;
  EnumResourceNames(AMODULE, 'STREAM', @EnumStreamProc, LPARAM(@Result));
end;

var
  hLib: HMODULE;
  ResId: Integer;
  RS: TResourceStream;
  Png: TPngImage;

begin
  hLib := LoadLibraryEx(PChar(GetWindowsPath + 'Resources\Themes\Aero\aero.msstyles'), 
                        0, LOAD_LIBRARY_AS_DATAFILE);
  ResId := GetStyleResourceId(hLib);
  RS := TResourceStream.CreateFromID(hLib, ResId, 'STREAM');
  Png := TPngImage.Create;
  Png.LoadFromStream(RS);  
  ...
end;

Update 2:

Found not hacked method using official api:

var
  h: HTHEME;
  Rect: TRect;
  PBuf, PPBuf: Pointer;
  BufSize: Cardinal;
  Buf: array[0..1024*1024] of Byte;


h := OpenThemeData(Handle, 'DWMWINDOW');
if h <> 0 then
try
  GetThemeRect(h, WP_MINCAPTION, MNCS_ACTIVE, TMT_ATLASRECT, Rect);
  PBuf := @Buf[0];
  PPBuf := @PBuf;
  GetThemeStream(h, WP_MINCAPTION, MNCS_ACTIVE, TMT_ATLASRECT, PBuf, BufSize, hInstance);
finally
  CloseThemeData(h);
end;

I can get Rect for minimized button, but don't understand how to use GetThemeStream? There should be used PBuf or PPBuf?

Alex Egorov
  • 907
  • 7
  • 26
  • Hacking away at implementation details isn't really viable. This is a very bad idea. – David Heffernan Dec 03 '15 at 07:11
  • Why this is a bad idea? To solve the problem we have 3 possibilities: 1. Using official api (not provided); 2. Create screenshots of the buttons (this is easy but not supported other themes); 3. Provided code to reading of the theme png content (currently I'm prepare parsing of this png, and this will have support of different themes). I'm will be glad to hear another more convenient solution – Alex Egorov Dec 03 '15 at 07:52
  • Because it won't work reliably as even you have found out – David Heffernan Dec 03 '15 at 08:00
  • Additional investigations show, that guys from Wine and ReactOS have source code to read *.msstyles files. And this job can be done after reading this source: http://source.winehq.org/source/dlls/uxtheme/stylemap.c – Alex Egorov Dec 03 '15 at 10:36
  • Which works right up until the point where a new version of the OS is released – David Heffernan Dec 03 '15 at 10:48
1

Workable solution to get bitmaps from theme:

var
  h: HTHEME;
  Rect: TRect;
  BufSize: Cardinal;    

h := OpenThemeData(Handle, 'DWMWINDOW');
if h <> 0 then
try
  GetThemeRect(h, WP_MINCAPTION, MNCS_ACTIVE, TMT_ATLASRECT, Rect);
  ...
  GetThemeStream(...);
finally
  CloseThemeData(h);
end;

And how to use GetThemeStream described here: GetThemeStream usage, many thanks to Andreas Verhoeven, author of the program Vista Style Builder

Community
  • 1
  • 1
Alex Egorov
  • 907
  • 7
  • 26