unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UxTheme, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormResize(Sender: TObject);
    procedure PaintB;
    procedure LoadTheme;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMNCPAINT(var Msg: TMessage); message WM_NCPAINT;
    procedure WMNCACTIVATE(var Msg: TWMNCActivate); message WM_NCACTIVATE;
    procedure WMTema(var Msg: TMessage); message WM_THEMECHANGED;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  NonBut, Press, Focus, XpT: Boolean;
  Rec: TRect;
  Theme: HTHEME;
  FMouseHook:THandle;

implementation

{$R *.dfm}

procedure TForm1.LoadTheme;
var
RightB: integer;
begin
//здесь выполняется "загрузка" темы
if InitThemeLibrary and UseThemes then //если XP поддерживается, то используем её
  begin
Theme:=OpenThemeData(Form1.Handle, 'Window');
XpT:=True;

//чтоб не мучиться - автоматически определяем положение кнопки
if (biSystemMenu in Form1.BorderIcons) and ((biMinimize in Form1.BorderIcons) or (biMaximize in Form1.BorderIcons)) then
RightB:=3*(GetSystemMetrics(SM_CXSIZE)-2)+6
else
if (biSystemMenu in Form1.BorderIcons) and (biHelp in Form1.BorderIcons) then
RightB:=2*(GetSystemMetrics(SM_CXSIZE)-2)+6
else
if biSystemMenu in Form1.BorderIcons then
RightB:=GetSystemMetrics(SM_CXSIZE)+4
else
RightB:=6;
//определяем её размер
Rec.Left:=Form1.Width-(RightB+GetSystemMetrics(SM_CXSIZE)-4);
Rec.Top:=6;
Rec.Right:=Form1.Width-RightB;
Rec.Bottom:=GetSystemMetrics(SM_CYSIZE)+2;
  end
else //если не XP - значит 98 (Висту позже добавлю)
  begin
XpT:=False;

if (biSystemMenu in Form1.BorderIcons) and ((biMinimize in Form1.BorderIcons) or (biMaximize in Form1.BorderIcons)) then
RightB:=3*(GetSystemMetrics(SM_CXSIZE)-2)+8
else
if (biSystemMenu in Form1.BorderIcons) and (biHelp in Form1.BorderIcons) then
RightB:=2*(GetSystemMetrics(SM_CXSIZE)-2)+8
else
if biSystemMenu in Form1.BorderIcons then
RightB:=GetSystemMetrics(SM_CXSIZE)+8
else
RightB:=6;

Rec.Left:=Form1.Width-(RightB+GetSystemMetrics(SM_CXSIZE)-2);
Rec.Top:=6;
Rec.Right:=Form1.Width-RightB;
Rec.Bottom:=GetSystemMetrics(SM_CYSIZE)+2;
  end;
end;

procedure TForm1.WMTema(var Msg: TMessage); //на случай если поменяли тему
begin
CloseThemeData(Theme);
LoadTheme;
end;

procedure TForm1.WMNCPAINT(var Msg: TMessage);
begin
//чтоб при ресайзе небыло мерцания, сюда бы вставить альтернативу ValidateRect
inherited;
PaintB;
end;

procedure TForm1.FormResize(Sender: TObject);
var
RightB: integer;
begin
//координаты можно каждый раз не считать, уберу это позже
if XpT then
  begin

if (biSystemMenu in Form1.BorderIcons) and ((biMinimize in Form1.BorderIcons) or (biMaximize in Form1.BorderIcons)) then
RightB:=3*(GetSystemMetrics(SM_CXSIZE)-2)+6
else
if (biSystemMenu in Form1.BorderIcons) and (biHelp in Form1.BorderIcons) then
RightB:=2*(GetSystemMetrics(SM_CXSIZE)-2)+6
else
if biSystemMenu in Form1.BorderIcons then
RightB:=GetSystemMetrics(SM_CXSIZE)+4
else
RightB:=6;

Rec.Left:=Form1.Width-(RightB+GetSystemMetrics(SM_CXSIZE)-4);
Rec.Top:=6;
Rec.Right:=Form1.Width-RightB;
Rec.Bottom:=GetSystemMetrics(SM_CYSIZE)+2;

  end
else
  begin

if (biSystemMenu in Form1.BorderIcons) and ((biMinimize in Form1.BorderIcons) or (biMaximize in Form1.BorderIcons)) then
RightB:=3*(GetSystemMetrics(SM_CXSIZE)-2)+8
else
if (biSystemMenu in Form1.BorderIcons) and (biHelp in Form1.BorderIcons) then
RightB:=2*(GetSystemMetrics(SM_CXSIZE)-2)+8
else
if biSystemMenu in Form1.BorderIcons then
RightB:=GetSystemMetrics(SM_CXSIZE)+8
else
RightB:=6;

Rec.Left:=Form1.Width-(RightB+GetSystemMetrics(SM_CXSIZE)-2);
Rec.Top:=6;
Rec.Right:=Form1.Width-RightB;
Rec.Bottom:=GetSystemMetrics(SM_CYSIZE)+2;

  end;
end;

procedure TForm1.WMNCACTIVATE(var Msg: TWMNCActivate);
begin
//на случай, если форма не активно и мы ткнули на кнопку
Focus:=Msg.Active;
inherited;
PaintB;
end;

//ниже я повесил хук, чтоб правильно ловилось WM_NCMOUSELEAVE, но всёравно не ловиться - хук можно не ставить
procedure InitMouseLeaveHook;
function MouseHookProc(nCode:Integer;wParam:UINT;lParam:PMsg):LRESULT; stdcall;
begin
Result:=CallNextHookEx(FMouseHook,nCode,wParam,Integer(lParam));

if nCode=HC_ACTION then
case lParam.message of
WM_NCMOUSELEAVE: //если мышь уходит с заголовка 
  begin
Press:=False; //кнопка не нажата (т.е. мы не быдем её рисовать нажатой)
NonBut:=True; //кнопка не сфокусированна
Form1.PaintB; //рисуем кнопку
  end;

WM_NCMOUSEMOVE: //если мышь бродит по заголовку
  begin
Dec(lParam.Pt.X, Form1.Left);
Dec(lParam.Pt.Y, Form1.Top);

if PtInRect(Rec, lParam.Pt) then //если мышь находится на кнопке
  begin
if HiWord(GetAsyncKeyState(VK_LBUTTON))<>0 then //в данный момент кнопка мыши нажата
begin
  Press:=True;
  NonBut:=False;
end
  else //или не нажата
begin
  Press:=False;
  NonBut:=False;
end;
  end
  else // мышь не находится на кнопке
begin
  Press:=False;
  NonBut:=True;
end;
Form1.PaintB;
  end;

WM_NCRBUTTONDOWN:// нажали правой кнопкой на заголовок
  begin
Dec(lParam.Pt.X, Form1.Left);
Dec(lParam.Pt.Y, Form1.Top);
if PtInRect(Rec, lParam.pt) then //нажали конкретно на кнопку
begin
  NonBut:=False;
  Press:=False;
  Form1.PaintB;
  lParam.message:=0; //чтоб не вылазило системное меню (хотя в стандартой кнопки свернуть оно появляется :))
end;
  end;

WM_NCLBUTTONDOWN:// нажали левой
  begin
Dec(lParam.Pt.X, Form1.Left);
Dec(lParam.Pt.Y, Form1.Top);

if PtInRect(Rec, lParam.pt) then //нажали конкретно на кнопку
begin
  if not Form1.Focused then //если форма не активна и мы ткнули - делаем её активной
  SetForegroundWindow(Form1.Handle);

  Press:=True;
  NonBut:=False;
  Form1.PaintB;
  lParam.message:=0; //это чтобы окно не таскалось за кнопочку
end
  else
begin
  Press:=False;
  NonBut:=True;
end;
  end;
WM_NCLBUTTONUP: //отжали кнопку мыши
  begin
Dec(lParam.Pt.X, Form1.Left);
Dec(lParam.Pt.Y, Form1.Top);
Press:=False;

if PtInRect(Rec, lParam.Pt) then
begin
  NonBut:=False;
  Form1.PaintB
end
  else
NonBut:=True;
  end;
  end;
end;
begin
  if FMouseHook=0 then FMouseHook:=SetWindowsHookEx(WH_GETMESSAGE,@MouseHookProc,0,GetCurrentThreadId);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
InitMouseLeaveHook; //ставим хук
LoadTheme; //грузим тему
NonBut:=True;
end;

procedure TForm1.PaintB; //здесь рисуем кнопку
var
DC: HDC;
begin
DC:=GetWindowDC(Form1.Handle);

if NonBut and Focus then //нормальная кнопка
  begin
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, MINBS_NORMAL, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN);

ReleaseDC(Form1.Handle, DC);
exit;
  end;

if (not Press) and (not NonBut) and Focus then //водим курсором по кнопке
  begin
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, MINBS_HOT, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN);

ReleaseDC(Form1.Handle, DC);
exit;
  end;

if Press and (not NonBut) and Focus then //нажали кнопку
  begin
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, MINBS_PUSHED, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN or DFCS_PUSHED);

ReleaseDC(Form1.Handle, DC);
exit;
  end;

if NonBut and (not Focus) then //если форма не активна и мы водим курсором по ней
  begin
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, 5 {исходники UxTheme врут - всего состояний у кнопки восемь, а не 4}, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN);

ReleaseDC(Form1.Handle, DC);
exit;
  end;

if (not NonBut) and (not Focus) then //водим курсором по кнопке, если форма не активна (хотя это может и ненадо)
  begin
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, MINBS_HOT, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN);

ReleaseDC(Form1.Handle, DC);
exit;
  end;

//на случай форс мажора - рисуем нормальную кнопку
if XpT then
  DrawThemeBackground(Theme, DC, WP_MINBUTTON, MINBS_NORMAL, Rec, nil)
else
  DrawFrameControl(DC, rec, DFC_CAPTION, DFCS_CAPTIONMIN);

ReleaseDC(Form1.Handle, DC);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//снимаем хуки и закрываем темы
UnhookWindowsHookEx(FMouseHook);
if XpT then CloseThemeData(Theme);
end;

end.