抄袭千堆雪的。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
procedure WMNCPAint(var Mes : TWMNCPaint); message WM_NCPAINT;
procedure WMNCACTIVE(var msg: TMessage); message WM_NCACTIVATE;
procedure Paint_Caption;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
State:Integer;
procedure TForm1.WMNCPAint(var Mes : TWMNCPaint);
begin
inherited;
Paint_Caption;
end;
procedure TForm1.Paint_Caption;
var
ACanvas : TCanvas;
begin
ACanvas := TCanvas.Create;
try
ACanvas.Handle := GetWindowDC(Form1.Handle);
with ACanvas do begin
if State=1 then
Brush.Color := clActiveCaption
else
Brush.Color := clInactiveCaption;
Font.Name := 'Times New Roman';
Font.Size := 12;
Font.Color := clYellow;
Font.Style := [fsBold];
TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) +1,
'千堆雪最近不常来了');
end;
finally
ReleaseDC(Form1.Handle, ACanvas.Handle);
ACanvas.Free;
end;
end;
procedure TForm1.WMNCACTIVE(var msg: TMessage);
begin
inherited;
State:=msg.WParam;
Paint_Caption;
end;
end.
