D菜单栏改颜色测试

unit main;


interface


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


type
  TForm1 = class(TForm)
    procedure FormActivate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
     procedure DrawCaptButton;
     procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
     procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
     procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
     procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
     procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;


implementation


{$R *.dfm}


procedure TForm1.DrawCaptButton;
var
   xFrame,yFrame,xSize,ySize : Integer;
   R : TRect;
   X : TBITMAP;
begin
    xFrame := GetSystemMetrics(SM_CXFRAME);
    yFrame := GetSystemMetrics(SM_CYFRAME);
    xSize := GetSystemMetrics(SM_CXSIZE);
    ySize := GetSystemMetrics(SM_CYSIZE);
    Canvas.Handle := GetWindowDC(Self.Handle);
    Canvas.Font.Name := '宋体';
    Canvas.Font.Size := 11;
    Canvas.Pen.Color := clYellow;
    Canvas.Brush.Color := clPurple;
    try
       R := Bounds(xFrame,yFrame,width-2*xFrame,ySize);
       Canvas.FillRect(r);
       Canvas.TextRect(R,2*xFrame,xFrame+2, 'CAPTION');
    finally
       ReleaseDC(Self.Handle, Canvas.Handle);
       Canvas.Handle := 0;
    end;
end;


procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaptButton;
end;


procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
    inherited;
    DrawCaptButton;
end;


procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
   inherited;
   DrawCaptButton;
end;


procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
   inherited;
   DrawCaptButton;
end;


procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
   inherited;
   DrawCaptButton;
end;


procedure TForm1.FormActivate(Sender: TObject);
begin
   Perform(WM_NCACTIVATE, Word(Active), 0);
end;


procedure TForm1.FormResize(Sender: TObject);
begin
   Perform(WM_NCACTIVATE, Word(Active), 0);
end;


end.