D菜单栏改颜色测试

xiaoxiao2021-02-28  14

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.

转载请注明原文地址: https://www.6miu.com/read-1650024.html

最新回复(0)