用户界面问题:金山词霸那种界面是怎么做的,而且还可以换皮肤(100分)

  • 主题发起人 主题发起人 yubing8
  • 开始时间 开始时间
Y

yubing8

Unregistered / Unconfirmed
GUEST, unregistred user!
我看了好多帖子,都说用这个控件那个控件,但我打算自已做,请问我没有什么好点的思路,在网上我也看了很多关于界面设计的文章,可惜都是用vc做的
 
用图片画出来的。你可以看看它的目录下有用到的图片。

image.picture.loadfromfile();
 
VCLSkin的控件
 
可是标题栏,还有那些最大最小化菜单也换图标了,那是怎么做的,谁有类似代码啊
 
我想不用控件,即使用控件,也想自已编
 
我的想法:
1、在程序中画界面,这个我想不难,关键要有耐心和美术功底。
2、要会改变窗口为任意形状。有api函数的。
3、将1、画到界面上,然后,切窗口为图画的形状。
本人感觉如果不是专门做窗口的,还是用控件吧,因为如果自己画,不亚于开发一般的应用程序。
 
gydldfw,你说的方法,设计起来很麻烦,最好可以像金山词霸是通过载了图片的形式实现,谁有没有更好的方法,或者是代码
 
1、我试过因为载入图片,切窗口就不成功(可能是我功力不够)。
2、那不如去搞个皮肤控件喽。有专门画皮肤的设计工具如vclskin,
它有个设计界面的工具,支持自己画图(界面的)。可我不会用那个玩艺。
 
金山就是通过换不同图片实现的,您可以用VCL Skin这套组件试试!
 
有谁可以不用控件做吗???
我实在不喜欢用别人的控件
 
是他们自己开发的组件包实现的。
你可以到NICROSOFT的站去看看,他们的SUIPACK组件专门弄这个的。
 
好的,谢谢
哪位还有更好的建议吗????
 
{***********************静心***********************}
// 创建作者:司马华鹏
// 创建日期:00-4-1
{***********************静心***********************}

unit HCForms;

interface

uses
Windows, SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Graphics, UrlLabel;

const
CaptionMinHeightPattern= 0;
CaptionHeightThreshold= 20;

clHCDarkGreen= {clBlack} $00308912;
clHCMidGreen= {clTeal } $0089CEB2;
clHCLightGreen= {clYellow } $00CCF7E6;

type
THCForm = class(TForm)
UrlLabel1: TUrlLabel;
private
fCaptionHeight: integer; {height of the title bar in pixels}
fActiveCaption: boolean; {state of the title bar}
fSysMenu, fMin, fMax, fClose: boolean;
fMenuUp: boolean; {state of the system menu}
function TestWinStyle(dwStyleBit : longInt): boolean;
function HasCaption: boolean;
function GetCaptionRect(var Rect: TRect): boolean;
function GetCaptionButtonRect(Which: word; var Rect: TRect): boolean;
procedure DrawCaptionButton(DC: HDC; Which: word; Pressed: boolean);
function DrawCaption: boolean;
function DepressCaptionButton(Which: word) : boolean;
function DoSysMenu : boolean;
procedure DrawWallpapper(DC: hDC);
protected
procedure WndProc(var Message: TMessage); override;
procedure WMNCCreate(var Message: TWMNCCreate); message WM_NCCREATE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;

procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMSysChar(var Message: TWMSysChar); message WM_SYSCHAR;
procedure WMCommand(var Message: TMessage); message WM_COMMAND;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
procedure WMSysKeyUp(var Message: TWMSysKeyUp); message WM_SYSKEYUP;
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
end;
var
HCForm:THCForm;
implementation

{$R *.DFM}
{$R UIRes.res}

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 &amp; 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;

// 得到标题区域
GetCaptionRect(rcCap);
GetWindowRect(Handle, Rect);
OffsetRect(rcCap, -Rect.Left, -Rect.Top);
SetBkMode(DC, TRANSPARENT);

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;

// 绘制标题
TextLen := GetWindowTextLength(Handle); // 得到标题的长度
lpStr:= GlobalAllocPtr(GHND, TextLen + 2); // 分配字符缓冲区
If lpStr<>NIL Then Begin
GetWindowText(Handle, lpStr, TextLen + 1); // 得到标题
rgbText:= SetTextColor(DC, rgbText); // 设置标题输出颜色
ExtTextOut(DC, 40, 4, ETO_CLIPPED, @rcCap, lpStr, TextLen, NIL); //绘制
SetTextColor(DC, rgbText); // 恢复颜色
GlobalFreePtr(lpStr); // 释放缓冲区
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);

TrackPopupMenu(SysMenu, 0, mPoint.X, mPoint.Y, 0, Handle, @Rect);
DrawCaptionButton(DC, HTSYSMENU, False);
ReleaseDC(Handle, DC);
End;
Result := True;
End;
end;

//处理进程回调
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;

//------------------------------------------------------------------------------
// 绘制外边框
procedure THCForm.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 4, Rgb(123,123,123));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
Rectangle(dc,0,0, Width, Height);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
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);

cX := (rcMenu.Right - rcMenu.Left) +
(rcMin.Right - rcMin.Left) +
(rcMax.Right - rcMax.Left) +
(rcClose.Right - rcClose.Left);
cY := GetSystemMetrics(SM_CYFRAME);

With Message.MinMaxInfo^.ptMinTrackSize do begin
x := cX + 2 * fCaptionHeight;
y := fCaptionHeight + 2 * cY - 1;
End;
End;
end;

//------------------------------------------------------------------------------
//构造函数
constructor THCForm.Create(Owner: TComponent);
begin
inherited Create(Owner);
Color:= clHCMidGreen;
SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) AND (NOT WS_EX_STATICEDGE));
DoubleBuffered:=True; //使用双缓冲
end;

//------------------------------------------------------------------------------
//析构函数
destructor THCForm.Destroy;
begin
inherited Destroy;
end;

end.
 
楼上的老大贴这么长
还是将源码发给大家共享一下吧
 
控件下载地址:
1、VCLSKIN
http://fj.fixdown.com/soft/11689.htm

2、BusinessSkinForm VCL v1.62(Source+Demo)
http://www.delphifly.com/cn/compent/dispdoc.asp?id=282
 
真长啊,等我试过了,再发表意见
 
爱元元的哥哥:有没有源码,帖子太长太长了
 
而且刚才试了一下,没法运行
 
VCLSkin有没有源码的?
 
不知道没用过,我下载看看
 

Similar threads

D
回复
0
查看
1K
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部