Форма под цвет темы виндовс

[Gudzik11]

Подскажите пожалуйста как сделать чтоб цвет формы был цвета темы виндовс ?
Весь интернет облазил нашёл один пример но при первом появлении формы цвет определяется почему то не правильно а после смены цвета начинает работать правильно?

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs , Winapi.Dwmapi;

type
  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    OldWindowProc : TWndMethod;
    function GetAeroColor:Tcolor;
    procedure OnAeroColorChange;
  public
    { Public declarations }
    procedure NewWindowProc(var Message: TMessage);
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  // Aero Farbe ermitteln und anzeigen
 form1.Color := getAeroColor;

// Wenn clnone ausgegeben wird: Fehlermeldung machen
if form1.Color = clnone then
 showmessagE('Aero nicht unterstьtzt oder Fehler aufgetreten!');

// WndProc
 OldWindowProc := form1.WindowProc;
 form1.WindowProc := NewWindowProc;
end;

function TForm1.GetAeroColor: Tcolor;
{****************************************************}
// Dies Funktion gibt die Aero Farbe als Tcolor zurьck
// Unterstьzt das OS kein Windows Aero, so wird der
// Wert clnone ausgegeben
{****************************************************}
var
// Gibt an ob Fenster Undurchsichtig sind
OpaqueBlend: bool;
// Gibt die Farbe an
farbe : dword;
// A=AlphaValue; RGB=R,G und B Farbwerte
A,R,G,B: integeR;
// um festzustellen, ob Aero unterstьzt wird
osVInfo: TOSVersionInfo;
begin
  // Feststellen, ob Windows Aero unterstьzt wird
  ZeroMemory(@osVinfo, SizeOf(osVinfo));
  OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);


  if  ((( not GetVersionEx(osVInfo))
  and   (osVinfo.dwPlatformId <> VER_PLATFORM_WIN32_NT)
  and   (osVinfo.dwMajorVersion < 5)))
 { or (Winapi.Dwmapi.dwm_   (dwmapi.DWM_GetColorizationColor(farbe,OpaqueBlend) = S_False)} then
  begin
    // Falls nicht wird das Ergebnis clnone ausgegeben
    result := clnone;
    exit;
  end;

  // AlphaValue und RGB-Werte ermitteln
  A := (farbe and $FF000000) shr 24;
  R := (farbe and $FF0000) shr 16;
  G := (farbe and $FF00) shr 8;
  B := (farbe and $FF);

  // AlphaValue auf RGB-Werte anwenden
  // Die 40 ermцglicht eine krдftigere Darstellung der Farbe
  r := r + (255-a-40);
  g := g +  (255-a-40);
  b := b + (255-a-40);

  // Ьberprьfen ob die RGB-Werte zulдssig sind
  if r < 0 then r := 0;
  if g < 0 then g := 0;
  if b < 0 then b := 0;

  if r > 255 then r := 255;
  if g > 255 then g := 255;
  if b > 255 then b := 255;

  // Farbe errechnen und ausgeben
  result := rgb(r,g,b);
end;


procedure TForm1.NewWindowProc(var Message: TMessage);
begin
  case message.Msg of
  WM_DWMCOLORIZATIONCOLORCHANGED: OnAeroColorChange;
 end;

 OldWindowProc(Message);
end;

procedure TForm1.OnAeroColorChange;
begin
 // Farbe ermitteln und anzeigen
form1.Color := GetAeroColor;

// Wenn clnone ausgegeben wird: Fehlermeldung machen
if form1.Color = clnone then
showmessagE('Aero nicht unterstьtzt oder Fehler aufgetreten!');
end;

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
  inherited;                   { вызов унаследованного обработчика события   }
 if M.Result = htClient then  { кликнув в области окна?                     }
 M.Result := htCaption;     { если так, то мы заставили Windows думать,   }
    { что щелчок был на заголовке окна.           }
end;

end.

Помогите исправить код

[саша40]

А просто картинку темы нельзя получить?

[Gudzik11]

Сообщение от саша40

А просто картинку темы нельзя получить?

Наврядли дело в том что цвет выставлен в автоматический и на каждую картинку выбирается виндовсом .

Есть запись в реестре HKEY_CURRENT_USER\Software\Microsof t\Windows\DWM\ColorizationColor и значения 0x84cbc966. Но как это значение перевести в цвет понятный

[dmitriegorovih]

все верно только 0x84cbc966 является форматом ARGB, тебе нужна только эта часть “cbc966” вида
cb - красный
c9 - зеленый
66 - синий

[Gudzik11]

Сообщение от dmitriegorovih

все верно только 0x84cbc966 является форматом ARGB, тебе нужна только эта часть “cbc966” вида
cb - красный
c9 - зеленый
66 - синий

Спасибо а как перевести это значение в цвет понятный delphi

[Пепел Феникса]

TColor это тоже самое что Integer.(для VCL по крайней мере)

[Gudzik11]

почти! я вычитал что это html цвет BGR

[Пепел Феникса]

html хранится как rgb.
да и это обычная хекс-запись, что вокруг нее бегать три дня?

на крайний есть функция rgb.

[dmitriegorovih]

Сообщение от Gudzik11

Спасибо а как перевести это значение в цвет понятный delphi

function TForm1.GetAeroColor: TColor;
var
  Reg: TRegistry;
  m:Cardinal;
  r,g,b:Byte;
begin
  Reg := TRegistry.Create;
  m:=0;
  try
  with Reg do
  begin
    RootKey := HKEY_CURRENT_USER;
    OpenKey('Software\Microsoft\Windows\DWM', false);
    m:=reg.ReadInteger('ColorizationColor');
  end;
  R := (m and $FF0000) shr 16;
  G := (m and $FF00) shr 8;
  B := (m and $FF);
  finally
  result:=rgb(r,g,b);
  freeandnil(reg);
  end
end;

в uses добавь Registry;
P.S. Пользоваться так

procedure TForm1.Button1Click(Sender: TObject);
begin
FORM1.Color:=GetAeroColor;
end;

[FleXik]

достаточно компонента XPMan думаю... по крайней мере этот компонент всегда подстраивается под тему винды...