type
PSysMenuItem= ^TSysMenuItem;
TSysMenuItem= Packed Record
SysMenuItemID: DWORD;
SysMenuItemText: PChar;
End;
//得到窗口的Style
function THCForm.TestWinStyle(dwStyleBit: longInt): boolean;
begin
Result:= ((GetWindowLong(Handle, GWL_STYLE) AND dwStyleBit) <> 0);
end;
//判断窗口是否包含标题
function THCForm.HasCaption: boolean;
begin
Result:= TestWinStyle(WS_CAPTION) {BorderStyle <> bsNone};
end;
//得到窗口标题区域
function THCForm.GetCaptionRect(var Rect: TRect): boolean;
begin
If HasCaption Then Begin
GetWindowRect(Handle, Rect);
{Adjust for borders}
If TestWinStyle(WS_THICKFRAME) Then Begin
InflateRect(Rect, -GetSystemMetrics(SM_CXFRAME),-GetSystemMetrics(SM_CYFRAME));
End Else Begin
If TestWinStyle(DS_MODALFRAME) Then Begin
InflateRect(Rect,
-(GetSystemMetrics(SM_CXDLGFRAME)+ GetSystemMetrics(SM_CXBORDER)),
-(GetSystemMetrics(SM_CYDLGFRAME)+ GetSystemMetrics(SM_CYBORDER))
);
End Else Begin
If TestWinStyle(WS_BORDER) Then Begin
InflateRect(Rect, -GetSystemMetrics(SM_CXBORDER),-GetSystemMetrics(SM_CYBORDER));
End;
End;
End;
Rect.Bottom:= Rect.Top + fCaptionHeight;
Result:= True;
End Else Begin
SetRectEmpty(Rect);
Result:= False;
End;
end;
//得到窗口按钮区域
function THCForm.GetCaptionButtonRect(Which:word; var Rect: TRect): boolean;
Procedure SetButtonRect;
Var
pButton: byte;
Begin
pButton:=0;
Case Which Of
HTMINBUTTON: Begin
If TestWinStyle(WS_MAXIMIZEBOX) Then Begin
Inc(pButton);
End;
If TestWinStyle(WS_SYSMENU) Then Begin
Inc(pButton);
End;
End;
HTMAXBUTTON: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
Inc(pButton);
End;
End;
End;
{ Draw them into the right side on caption /width=height/ }
Dec(Rect.Right, fCaptionHeight * pButton + 1);
Rect.Left:= Rect.Right-fCaptionHeight + 2;
End;
begin
Result:= False;
If GetCaptionRect(Rect) Then Begin
Inc(Rect.Top);
Dec(Rect.Bottom);
Case Which Of
HTSYSMENU: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
{ Draw it into the left side on caption /width=height/ }
Rect.Right:=Rect.Left + fCaptionHeight - 1;
Result:= True;
End;
End;
HTMINBUTTON: Begin
If TestWinStyle(WS_MINIMIZEBOX) Then Begin
SetButtonRect;
Result:= True;
End;
End;
HTMAXBUTTON: Begin
If TestWinStyle(WS_MAXIMIZEBOX) Then Begin
SetButtonRect;
Result:= True;
End;
End;
HTCLOSE: Begin
If TestWinStyle(WS_SYSMENU) Then Begin
SetButtonRect;
Result:= True;
End;
End;
End;
End;
If NOT Result Then SetRectEmpty(Rect);
end;
//绘制标题按钮
procedure THCForm.DrawCaptionButton(DC: HDC; Which: word; Pressed: boolean);
var
Rect,RectBox: TRect;
DC_Created: boolean;
begin
{Get size & position of button, and convert to window coordinates}
If GetCaptionButtonRect( Which, RectBox ) Then Begin
If DC = 0 Then Begin
DC_Created:= True;
DC:= GetWindowDC(Handle);
End Else DC_Created:= False;
If DC <> 0 Then Begin
GetWindowRect(Handle, Rect);
OffsetRect(RectBox, -Rect.Left, -Rect.Top);
InflateRect(RectBox,-1,0);
{ 绘制按钮 }
If fCaptionHeight > CaptionMinHeightPattern Then Begin
Rect:= RectBox;
Case Which Of
HTSYSMENU: Begin
With TBitmap.Create do
try
if Pressed then
LoadFromResourceName(0,'STYLE5_TITLEBTN_HELP_MOUSEON')
else
LoadFromResourceName(0,'STYLE5_TITLEBTN_HELP_NORMAL');
BitBlt(DC,RectBox.Left,RectBox.Top,
Width,Height,
Canvas.Handle,0,0,srccopy);
finally
Free;
end;
End;
HTMINBUTTON: Begin
With TBitmap.Create do
try
if Pressed then
LoadFromResourceName(0,'STYLE5_TITLEBTN_MIN_MOUSEON')
else
LoadFromResourceName(0,'STYLE5_TITLEBTN_MIN_NORMAL');
BitBlt(DC,RectBox.Left,RectBox.Top,
Width,Height,
Canvas.Handle,0,0,srccopy);
finally
Free;
end;
End;
HTMAXBUTTON: Begin
With TBitmap.Create do
try
if Pressed then
LoadFromResourceName(0,'STYLE5_TITLEBTN_MAX_MOUSEON')
else
LoadFromResourceName(0,'STYLE5_TITLEBTN_MAX_NORMAL');
BitBlt(DC,RectBox.Left,RectBox.Top,
Width,Height,
Canvas.Handle,0,0,srccopy);
finally
Free;
end;
End;
HTCLOSE: Begin
With TBitmap.Create do
try
if Pressed then
LoadFromResourceName(0,'STYLE5_TITLEBTN_CLOSE_MOUSEON')
else
LoadFromResourceName(0,'STYLE5_TITLEBTN_CLOSE_NORMAL');
BitBlt(DC,RectBox.Left,RectBox.Top,
Width,Height,
Canvas.Handle,0,0,srccopy);
finally
Free;
end;
End;
End;
End;
End;
If DC_Created Then Begin
ReleaseDC(Handle, DC);
End;
End;
end;
//绘制标题
function THCForm.DrawCaption: boolean;
var
DC: hDC;
Rect: TRect;
rcCap: TRect;
rgbText: TColor;
lpStr: PChar;
TextLen: word;
cX: integer;
imgLeft,imgRight,ImgClient:TBitmap;
begin
Result:=False;
DC:= GetWindowDC(Handle);
If DC <> 0 Then Begin
If fActiveCaption Then Begin
rgbText:= ColorToRGB(clBlack);
End Else Begin
rgbText:= ColorToRGB(clHCDarkGreen);
End;
If fSysMenu Then Inc(rcCap.Left, fCaptionHeight);
If fMax Then Dec(rcCap.Right, fCaptionHeight);
If fMin Then Dec(rcCap.Right, fCaptionHeight);
If fClose Then Dec(rcCap.Right, fCaptionHeight);
Inc(rcCap.Right,1);
Dec(rcCap.Bottom,1);
imgLeft:=TBitmap.Create;
imgRight:=TBitmap.Create;
ImgClient:=TBitmap.Create;
try
imgLeft.LoadFromResourceName(0,'STYLE5_TITLE_LEFT');
imgRight.LoadFromResourceName(0,'STYLE5_TITLE_RIGHT');
imgClient.LoadFromResourceName(0,'STYLE5_TITLE_CLIENT');
CX:=0;
While Cx<Self.Width do begin
Bitblt(DC,CX,0,imgClient.Width,imgClient.Height,
imgClient.Canvas.Handle,0,0,srcCopy);
Inc(CX,imgClient.Width);
end;
Bitblt(DC,0,0,imgLeft.Width,imgLeft.Height,imgLeft.Canvas.Handle,0,0,srcCopy);
Bitblt(DC,Self.Width-imgRight.Width,0,imgRight.Width,imgLeft.Height,imgLeft.Canvas.Handle,0,0,srcCopy);
finally
imgLeft.Free;
imgRight.Free;
imgClient.Free;
end;
// 绘制系统、最小、最大按钮
If fSysMenu Then DrawCaptionButton(DC, HTSYSMENU, False);
If fMin Then DrawCaptionButton(DC, HTMINBUTTON, False);
If fMax Then DrawCaptionButton(DC, HTMAXBUTTON, False);
If fClose Then DrawCaptionButton(DC, HTCLOSE, False);
ReleaseDC(Handle, DC);
Result:= True;
end;
end;
//鼠标在标题栏消息的处理
function THCForm.DepressCaptionButton(Which: word): boolean;
var
Rect: TRect;
Msg: TMsg;
Pressed : boolean;
begin
Result:=False;
Pressed:=True;
If GetCaptionButtonRect(Which, Rect) Then Begin
DrawCaptionButton(0, Which, Pressed);
{Collect all mouse events until WM_LBUTTONUP}
SetCapture(Handle);
{Loop until the button is released}
While TRUE Do Begin
If PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) Then Begin
Case Msg.Message Of
WM_LBUTTONUP: Begin
If Pressed Then Begin
Pressed:= False;
DrawCaptionButton(0, Which, Pressed);
End;
ReleaseCapture;
Result:= PtInRect(Rect, Msg.pt);
BREAK;
End;
WM_MOUSEMOVE: Begin
If PtInRect(Rect, Msg.pt) Then Begin
If NOT Pressed Then Begin
Pressed:= True;
DrawCaptionButton(0, Which, Pressed);
End;
End Else Begin
If Pressed Then Begin
Pressed:= False;
DrawCaptionButton(0, Which, Pressed);
End;
End;
End;
End;
End;
End;
End;
end;
//处理系统菜单(左上角)
function THCForm.DoSysMenu : boolean;
var
DC: HDC;
Rect: TRect;
mPoint: TPoint;
SysMenu : HMenu;
wMove,wSize,wMinBox,wMaxBox,wRestore: word;
begin
Result := False; {Initially assume no menu}
if TestWinStyle(WS_SYSMENU) then begin
DC:= GetWindowDC(Handle);
If DC <> 0 Then Begin
{Invert the control box}
DrawCaptionButton(DC, HTSYSMENU, True);
{Pop up the mock-system menu}
mPoint:= Point(0, -1);
GetWindowRect(Handle, Rect);
{Convert coordinates to screen coords. using functions in WinProcs unit}
{("WinProcs" must be given to avoid calling TForm1's ClientToScreen() )}
WinProcs.ClientToScreen(Handle, mPoint);
WinProcs.ClientToScreen(Handle, Rect.BottomRight);
SysMenu:= GetSystemMenu(Handle, False);
{Initially assume all menu items should be grayed}
wMove:= MF_GRAYED;
wSize:= MF_GRAYED;
wMinBox:= MF_GRAYED;
wMaxBox:= MF_GRAYED;
wRestore:= MF_GRAYED;
{Now check the window styles, etc.}
If NOT (IsIconic(Handle) OR IsZoomed(Handle)) Then Begin
If TestWinStyle(WS_CAPTION) Then wMove:= MF_ENABLED;
If TestWinStyle(WS_THICKFRAME) Then wSize:= MF_ENABLED;
End;
If TestWinStyle(WS_MINIMIZEBOX) Then wMinBox:= MF_ENABLED;
If TestWinStyle(WS_MAXIMIZEBOX) OR IsIconic(Handle) Then wMaxBox:= MF_ENABLED;
If IsZoomed(Handle) Then wRestore:= MF_ENABLED;
EnableMenuItem(SysMenu, SC_MOVE, wMove);
EnableMenuItem(SysMenu, SC_SIZE, wSize);
EnableMenuItem(SysMenu, SC_MINIMIZE, wMinBox);
EnableMenuItem(SysMenu, SC_MAXIMIZE, wMaxBox);
EnableMenuItem(SysMenu, SC_RESTORE, wRestore);
//处理进程回调
procedure THCForm.WndProc(var Message : TMessage);
begin
With Message Do Begin
Case Msg Of
WM_NCPAINT,
WM_NCACTIVATE: Begin
If HasCaption AND NOT IsIconic(Handle) Then Begin
If Msg = WM_NCPAINT Then Begin
fActiveCaption:= (Handle = GetActiveWindow);
End Else
fActiveCaption := (wParam <> 0);
DrawCaption;
End;
inherited WndProc(Message);
End
Else Begin
inherited WndProc(Message);
End;
End;
End;
end;
//------------------------------------------------------------------------------
// 绘制客户区
procedure THCForm.DrawWallpapper( DC: hDC );
var
cx,cy:integer;
imgClient:Tbitmap;
begin
cx:=0;
cy:=0;
imgClient:=TBitmap.Create;
try
imgClient.LoadFromResourceName(0,'STYLE5_FORM_BACKGROUND');
While cy<height do begin
While cx<width do begin
BitBlt(Dc,cx,cy,imgClient.Width,imgClient.Height,imgClient.Canvas.Handle,0,0,srccopy);
Inc(cx,imgClient.Width);
end;
cx:=0;
Inc(cy,imgClient.Height);
end;
finally
imgClient.Free;
end;
end;
//------------------------------------------------------------------------------
// 创建外边框
procedure THCForm.WMNCCreate(var Message : TWMNCCreate);
var
dwStyle : longInt;
begin
fCaptionHeight:= (GetSystemMetrics(SM_CYCAPTION))+CaptionMinHeightPattern;
dwStyle:= GetWindowLong(Handle, GWL_STYLE);
If (dwStyle and WS_DLGFRAME) = WS_DLGFRAME Then Begin
dwStyle:= dwStyle AND NOT longInt(WS_DLGFRAME);
SetWindowLong(Handle, GWL_STYLE, dwStyle);
End;
fMenuUp:= False; {Indicate the system menu is not showing}
fSysMenu:= TestWinStyle(WS_SYSMENU);
fMin:= TestWinStyle(WS_MINIMIZEBOX);
fMax:= TestWinStyle(WS_MAXIMIZEBOX);
fClose:= TestWinStyle(WS_SYSMENU);
inherited; {Call default processing.}
end;
//------------------------------------------------------------------------------
// 计算尺寸
procedure THCForm.WMNCCalcSize(var Message : TWMNCCalcSize);
begin
inherited; {Call default processing.}
If HasCaption and not IsIconic(Handle) Then Begin
Inc(Message.CalcSize_Params^.RgRc[0].Top, fCaptionHeight);
{If NOT Message.CalcValidRects Then Begin
End;}
End;
end;
//------------------------------------------------------------------------------
// 处理非工作区消息
procedure THCForm.WMNCHitTest(var Message : TWMNCHitTest);
var
rcCap,rcMenu,rcMin,rcMax,rcClose: TRect;
Point : TPoint;
begin
Inherited; {Call default processing.}
If (Message.Result = HTNOWHERE) AND HasCaption AND NOT IsIconic(Handle) Then Begin
GetCaptionRect(rcCap);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcCap, Point) Then Begin
Message.Result:= HTCAPTION;
GetCaptionButtonRect(HTSYSMENU,rcMenu);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMenu, Point) Then Begin
Message.Result:= HTSYSMENU
End Else Begin
GetCaptionButtonRect(HTMINBUTTON,rcMin);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMin, Point) then Begin
Message.Result:= HTMINBUTTON
End Else Begin
GetCaptionButtonRect(HTMAXBUTTON,rcMax);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcMax, Point) Then Begin
Message.Result:= HTMAXBUTTON;
End Else Begin
GetCaptionButtonRect(HTCLOSE,rcClose);
Point.X:=Message.Pos.X;
Point.Y:=Message.Pos.Y;
If PtInRect(rcClose, Point) Then Begin
Message.Result:= HTCLOSE;
End;
End;
End;
End;
End;
End;
If Message.Result <> HTSYSMENU Then Begin
fMenuUp := False; {Indicate the system menu is not showing}
End;
end;
procedure THCForm.WMNCLButtonDblClk(var Message : TWMNCLButtonDblClk);
begin
If (Message.HitTest = HTSYSMENU) AND HasCaption AND NOT IsIconic(Handle) Then
SendMessage(Handle, WM_CLOSE, 0, 0)
Else inherited; {Call default processing.}
end;
//------------------------------------------------------------------------------
// 处理左键消息
procedure THCForm.WMNCLButtonDown(var Message : TWMNCLButtonDown);
var
mPoint: TPoint;
begin
If HasCaption AND NOT IsIconic(Handle) Then Begin
mPoint:= Point(Message.XCursor, Message.YCursor);
Case Message.HitTest Of
HTSYSMENU: Begin
If NOT fMenuUp AND DoSysMenu Then
fMenuUp := True
Else fMenuUp := False;
End;
HTMINBUTTON: Begin
If DepressCaptionButton(HTMINBUTTON) Then
SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, longInt(@mPoint));
End;
HTMAXBUTTON: Begin
If DepressCaptionButton(HTMAXBUTTON) Then Begin
If IsZoomed(Handle) Then
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, longInt(@mPoint))
Else SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, longInt(@mPoint));
End;
End;
HTCLOSE: Begin
If DepressCaptionButton(HTCLOSE) Then Begin
SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, longInt(@mPoint));
End;
End;
Else Begin
inherited; {Call default processing.}
End;
End;
End Else Begin
inherited; {Call default processing.}
End;
end;
{ }
{ WMxxxx messages }
{ }
//------------------------------------------------------------------------------
procedure THCForm.WMPaint(var Message: TWMPaint);
var
DC: HDC;
PS: TPaintStruct;
begin
If NOT IsIconic(Handle) Then Begin
ControlState:= ControlState + [csCustomPaint];
DC:= BeginPaint(Handle, PS);
DrawWallpapper(DC);
EndPaint(Handle, PS);
ControlState:= ControlState - [csCustomPaint];
Message.Result:=0;
End Else
inherited;
end;
procedure THCForm.WMSize(var Message: TWMSize);
begin
Invalidate;
inherited;
end;
procedure THCForm.WMSysChar(var Message : TWMSysChar);
begin
If HasCaption AND (Message.CharCode = VK_SPACE) Then
DoSysMenu
Else inherited; {Call default processing.}
end;
procedure THCForm.WMCommand(var Message : TMessage);
begin
If Message.wParam >= $F000 Then
PostMessage(Handle, WM_SYSCOMMAND, Message.wParam, Message.lParam);
inherited; {Call default processing.}
end;
procedure THCForm.WMKeyDown(var Message : TWMKeyDown);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;
procedure THCForm.WMKeyUp(var Message : TWMKeyUp);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;
procedure THCForm.WMSysKeyDown(var Message : TWMSysKeyDown);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;
procedure THCForm.WMSysKeyUp(var Message : TWMSysKeyUp);
var
dwStyle : longInt;
begin
dwStyle := GetWindowLong(Handle, GWL_STYLE);
SetWindowLong(Handle, GWL_STYLE, dwStyle AND NOT longInt(WS_SYSMENU));
inherited; {Call default processing.}
SetWindowLong(Handle, GWL_STYLE, dwStyle);
end;
procedure THCForm.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
var
cX,cY: integer;
rcMenu,rcMin,rcMax,rcClose: TRect;
begin
If HasCaption and TestWinStyle(WS_THICKFRAME) Then Begin
{The following functions return empty rects. if box/button doesn't exist}
GetCaptionButtonRect(HTSYSMENU,rcMenu);
GetCaptionButtonRect(HTMINBUTTON,rcMin);
GetCaptionButtonRect(HTMAXBUTTON,rcMax);
GetCaptionButtonRect(HTCLOSE,rcClose);