📄 theme.pas
字号:
unit Theme;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ImgList, jpeg;
type
//初始化,关闭,最大化,最小化,还原
TState = (stIni,stClose,stMax,stMin,stRes,stNone);
TBaseForm = class(TForm)
ClientImage: TImage;
Title3: TImage;
Left1: TImage;
Bottom1: TImage;
MinButton: TImage;
title2: TImage;
title1: TImage;
RedButton: TImage;
MaxButton: TImage;
CloseButton: TImage;
Icon: TImage;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
private
IsMax: Boolean; //是否处于最大化状态
IsHint: Boolean;
IsDrawForm: Boolean;//是否需要绘制窗体
FTitle: String;
ButtonState: TState;
FTitleColor: TColor;
x,y,z: integer;
Brush1: TBrush;
GlobleDC: HDC;
OrigonLeft,OrigonTop,OrigonWidth,OrigonHeight: Integer;
{ Private declarations }
procedure RepaintWin(Var Msg: TWMNCACTIVATE); Message WM_NCACTIVATE;
procedure PosMove(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
procedure NoClientMouseMove(Var Msg: TWMNCMouseMove);message WM_NCMouseMove;
procedure ActiveForm(Var Msg: TWMACTIVATE); Message WM_ACTIVATE;
Procedure NoClientMouseDown(var Msg: TWMNCLBUTTONDOWN);message WM_NCLBUTTONDOWN;
Procedure NCPaint(var Msg: TWMNCPAINT);message WM_NCPAINT;
Procedure PARENTNOTIFY(Var Msg: TWMPARENTNOTIFY);message WM_PARENTNOTIFY;
//阻止用于双击标题栏
Procedure PreventDlbTitle(Var Msg: TWMNCLBUTTONDBLCLK);Message WM_NCLBUTTONDBLCLK;
procedure SetTitle(Text: String);
procedure DrawTitle;
Procedure SetTitleColor(Color: TColor);
published
Property Title: String Read FTitle Write SetTitle;
property TitleColor: TColor Read FTitleColor Write SetTitleColor default clBlue;
public
IniRect,MinRect,MaxRect,CloseRect: TRect;
Procedure DrawForm; virtual;
procedure DoExtra(State: TState);virtual;
{ Public declarations }
end;
var
BaseForm: TBaseForm;
implementation
uses Math, Types;
{$R *.dfm}
procedure TBaseForm.RepaintWin(var Msg: TWMNCACTIVATE);
begin
Inherited;
IsDrawForm := True;
DrawForm;
end;
procedure TBaseForm.PosMove(var Message: TWMWindowPosChanging);
begin
Inherited;
DrawForm;
IsDrawForm := True;
end;
procedure TBaseForm.FormCreate(Sender: TObject);
begin
x:= GetSystemMetrics(SM_CXBORDER);
y := GetSystemMetrics(SM_CYBORDER);
z := GetSystemMetrics(SM_CYCAPTION);
GlobleDC := GetWindowDC(Handle);
//Icon.Picture.Icon.LoadFromFile('C:\Documents and Settings\梁水\桌面\新建文件夹\MACOS.ICO');
FTitle:=Self.Caption;
FTitleColor := clBlack;
OrigonLeft := Left;
OrigonTop := Top;
OrigonWidth := Width;
OrigonHeight := Height;
IsMax := True;
IsDrawForm := True;
IsHint := False;
Brush.Bitmap := ClientImage.Picture.Bitmap;
Brush1 := TBrush.Create;
IniRect := Rect(8,(z+3*y -Self.Icon.Height)div 2,Self.Icon.Width,Self.Icon.Height);
MinRect := Rect(Width-45,(z+2*y-MinButton.Height)div 2,MinButton.Width,MinButton.Height);
MaxRect := Rect(Width-32,(z+2*y-MaxButton.Height)div 2,MaxButton.Width,MaxButton.Height);
CloseRect := Rect(Width-19,(z+2*y-CloseButton.Height)div 2,CloseButton.Width,CloseButton.Height);
ButtonState :=stNone;
end;
procedure TBaseForm.NoClientMouseMove(var Msg: TWMNCMouseMove);
var
dc1: HDC;
Point1: TPoint;
IniTemp,MinTemp,MaxTemp,CloseTemp: TRect;
begin
inherited;
Point1 := Point(Msg.XCursor,Msg.YCursor);
IniTemp:= Rect(IniRect.Left+ Left,Top+ IniRect.Top,IniRect.Right+IniRect.Left+ Left,IniRect.Bottom+IniRect.Top+Top);
MinTemp:= Rect(MinRect.Left+ Left,Top+ MinRect.Top,MinRect.Right+MinRect.Left+ Left,MinRect.Bottom+MinRect.Top+Top);
MaxTemp:= Rect(MaxRect.Left+ Left,Top+ MaxRect.Top,MaxRect.Right+MaxRect.Left+ Left,MaxRect.Bottom+MaxRect.Top+Top);
CloseTemp:= Rect(CloseRect.Left+ Left,Top+ CloseRect.Top,CloseRect.Right+CloseRect.Left+ Left,CloseRect.Bottom+CloseRect.Top+Top);
if PtInRect(IniTemp,Point1) then
begin
IsDrawForm := True;
ButtonState := stIni;
dc1 := GetWindowDC(Handle);
StretchBlt(dc1,IniRect.Left,IniRect.Top,IniRect.Right,IniRect.Bottom,RedButton.Canvas.Handle,0,0,RedButton.Width,RedButton.Height,SRCCOPY);
ReleaseDC(Handle,dc1);
DoExtra(stIni);
end
else if PtInRect(MinTemp,Point1) then
begin
IsHint := True;
IsDrawForm := True;
ButtonState := stMin;
dc1 := GetWindowDC(Handle);
//DrawForm;
StretchBlt(dc1,MinRect.Left,MinRect.Top,MinRect.Right,MinRect.Bottom,MinButton.Canvas.Handle,0,0,MinButton.Width,MinButton.Height,SRCCOPY);
ReleaseDC(Handle,dc1);
DoExtra(stMin);
end
else if PtInRect(MaxTemp,Point1) then
begin
IsDrawForm := True;
dc1 := GetWindowDC(Handle);
//DrawForm;
StretchBlt(dc1,MaxRect.Left,MaxRect.Top,MaxRect.Right,MaxRect.Bottom,MaxButton.Canvas.Handle,0,0,MaxButton.Width,MaxButton.Height,SRCCOPY);
ReleaseDC(Handle,dc1);
if IsMax then
begin
ButtonState := stMax;
DoExtra(stMax);
end
else
begin
ButtonState := stRes;
DoExtra(stRes);
end;
end
else if PtInRect(CloseTemp,Point1) then
begin
IsDrawForm := True;
ButtonState := stClose;
dc1 := GetWindowDC(Handle);
//DrawForm;
StretchBlt(dc1,CloseRect.Left,CloseRect.Top,CloseRect.Right,CloseRect.Bottom,CloseButton.Canvas.Handle,0,0,CloseButton.Width,CloseButton.Height,SRCCOPY);
ReleaseDC(Handle,dc1);
DoExtra(stClose);
end
else
begin
// t_hint.Hide;
IsHint := True;
ButtonState := stNone;
DoExtra(stNone);
DrawForm;
end;
end;
procedure TBaseForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//Brush1.Free;
//ReleaseDC(Handle,GlobleDC);
end;
procedure TBaseForm.DrawForm;
var
Rect1: TRect;
dc: HDC;
begin
inherited;
dc := GetWindowDC(Handle);
if IsDrawForm then
begin
Rect1 := GetClientRect;
Rect1 := Rect(Rect1.Left-2,Rect1.Top,Rect1.Right+x,Rect1.Bottom);
//左边线
StretchBlt(dc,1-x,-3,Left1.Width+1,Height+2*y+1,Left1.Canvas.Handle,0,0,Left1.Width,Left1.Height,SRCCOPY );
//右边线
StretchBlt(dc,Width-y*4-2,Title3.Height,Left1.Width+1,Height+2*y+1,Left1.Canvas.Handle,0,0,Left1.Width,Left1.Height,SRCCOPY);
//中间标题
StretchBlt(dc,Title1.Width-1,0,Width-Title1.Width-Title3.Width,z+4,Title2.Canvas.Handle,0,0,Title2.Width,Title2.Height,SRCCOPY );
//左标题
StretchBlt(dc,-x,0,Title1.Width,z+4,Title1.Canvas.Handle,0,0,Title1.Width,Title1.Height,SRCCOPY );
//右标题
StretchBlt(dc,Width-Title3.Width-1,0,Title3.Width+3,z+4,Title3.Canvas.Handle,0,0,Title3.Width,Title3.Height,SRCCOPY);
//底边线
StretchBlt(dc,-x+Left1.Width,Height-2*y-3,Width,Bottom1.Height,Bottom1.Canvas.Handle,0,0,Bottom1.Width,Bottom1.Height,SRCCOPY);
//绘制左按钮
StretchBlt(dc,IniRect.Left,IniRect.Top,IniRect.Right,IniRect.Bottom,Icon.Canvas.Handle,0,0,Icon.Width,Icon.Height,SRCCOPY);
//绘制关闭按钮
StretchBlt(dc,CloseRect.Left,CloseRect.Top,CloseRect.Right,CloseRect.Bottom,CloseButton.Canvas.Handle,0,0,CloseButton.Width,CloseButton.Height,SRCCOPY);
//绘制最大化按钮
StretchBlt(dc,MaxRect.Left,MaxRect.Top,MaxRect.Right,MaxRect.Bottom,MaxButton.Canvas.Handle,0,0,MaxButton.Width,MaxButton.Height,SRCCOPY);
//绘制最小化按钮
StretchBlt(dc,MinRect.Left,MinRect.Top,MinRect.Right,MinRect.Bottom,MinButton.Canvas.Handle,0,0,MinButton.Width,MinButton.Height,SRCCOPY);
IsDrawForm := False;
// Brush.Bitmap := ClientImage.Picture.Bitmap;
DrawTitle;
end;
ReleaseDC(Handle,dc);
end;
procedure TBaseForm.NoClientMouseDown(var Msg: TWMNCLBUTTONDOWN);
var
Point1: TPoint;
begin
inherited;
Point1 := Point(Msg.XCursor,Msg.YCursor);
Case ButtonState of
stIni : begin
//top := Top+500;
ShowWindow(Handle,SW_RESTORE);
SetWindowPos(Handle,HWND_NOTOPMOST,(Screen.Width-OrigonWidth)div 2,(Screen.Height- OrigonHeight)div 2,OrigonWidth,OrigonHeight,SWP_SHOWWINDOW);
DrawForm;
IsMax := True;
end;
stMax: begin
ButtonState := stMax;
ShowWindow(Handle,SW_MAXIMIZE);
//SetWindowPos(Handle,HWND_NOTOPMOST,0,0,Screen.Width,Screen.Height,SWP_SHOWWINDOW);
IsMax := False;
//DrawForm;
end;
stMin: begin
// ButtonState := stMin;
//ShowWindow(Handle,SW_MINIMIZE);
//SetWindowPos(Handle,HWND_NOTOPMOST ,(Screen.Width-OrigonWidth)div 2,2,OrigonWidth,0,SWP_SHOWWINDOW);
// DrawForm;
// Self.WindowState:=wsMinimized;
end;
stRes: begin
// ButtonState := stRes;
//if biMinimize in Self.BorderIcons then
ShowWindow(Handle,SW_RESTORE);
DrawForm;
IsMax := True;
end;
stClose:begin
//ButtonState := stClose;
//if biMaximize in Self.BorderIcons then
Close;
end;
end;
end;
procedure TBaseForm.SetTitle(Text: String);
begin
FTitle := Text;
DrawTitle;
end;
procedure TBaseForm.DrawTitle;
begin
if (FTitle <>'')then
begin
SetBkMode(GlobleDC,TRANSPARENT);
SetTextColor(GlobleDC,FTitleColor);
SelectObject(GlobleDC,Font.Handle);
SetTextAlign(GlobleDC,TA_CENTER);
//TextOut(GlobleDC,width div 2,z div 3 ,Pchar(FTitle),Length(FTitle));
TextOut(GlobleDC,60,z div 3 ,Pchar(FTitle),Length(FTitle));
end;
end;
procedure TBaseForm.DoExtra(State: TState);
begin
//add code...
end;
procedure TBaseForm.SetTitleColor(Color: TColor);
begin
FTitleColor := Color;
end;
procedure TBaseForm.ActiveForm(var Msg: TWMACTIVATE);
begin
DrawForm;
IsDrawForm := True;
inherited;
end;
procedure TBaseForm.NCPaint(var Msg: TWMNCPAINT);
begin
DrawForm;
IsDrawForm := True;
//IsDrawTitle := True;
inherited;
end;
procedure TBaseForm.FormPaint(Sender: TObject);
begin
DrawForm;
IsDrawForm := True;
end;
procedure TBaseForm.FormResize(Sender: TObject);
begin
IniRect := Rect(8,(z+3*y -Icon.Height)div 2,Icon.Width,Icon.Height);
MinRect := Rect(Width-45,(z+2*y-MinButton.Height)div 2,MinButton.Width,MinButton.Height);
MaxRect := Rect(Width-32,(z+2*y-MaxButton.Height)div 2,MaxButton.Width,MaxButton.Height);
CloseRect := Rect(Width-19,(z+2*y-CloseButton.Height)div 2,CloseButton.Width,CloseButton.Height);
Refresh;
end;
procedure TBaseForm.PARENTNOTIFY(var Msg: TWMPARENTNOTIFY);
begin
inherited;
DrawForm;
end;
procedure TBaseForm.PreventDlbTitle(var Msg: TWMNCLBUTTONDBLCLK);
begin
//
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -