用户界面设计及答案_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
用户界面设计及答案
上传于||文档简介
&&北​京​理​工​试​题
阅读已结束，如果下载本文需要使用1下载券
想免费下载本文？
定制HR最喜欢的简历
下载文档到电脑，查找使用更方便
还剩9页未读，继续阅读
定制HR最喜欢的简历
你可能喜欢& 前面做的工作就是想在标题区域增加快速工具条。前续的基础工作完成，想要在标题区域增加特殊区域都非常方便。只要在绘制时控制自定义区域需要占用标题区域多少空间，然后直接在所占位置绘制。做这个事情前，稍微把代码规整了下。所以界面皮肤处理放到一个单元中。
主要处理步骤
& 1、划出一个新区域（整个工具条作为一个区域）
& 2、处理区域检测（HitTest）
& 3、如果是新区域，把相应消息传给这个区域处理。
& 4、响应鼠标点击，执行Action
通过上述步骤就能扩展出所想要的标题区快速工具条的。
标题按钮区域是作为一个整体处理，这样比较容易控制和扩展。只要当检测区域是标题工具区时，消息交由工具条实现。
HTCUSTOM = 100; //HTHELP + 1;
/// 自定义区域ID
HTCAPTIONTOOLBAR = HTCUSTOM + 1;
/// 标题工具区域ID
6 /// 检测区域时增加自定义区域的检测
7 function TskForm.HitTest(P: TPoint):
... ... (代码略)
标题工具区域
需要前面扣除窗体图标区域
if (Result = HTNOWHERE) and (FToolbar.Visible) then
r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
R.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
R.Right := R.Left + FToolbar.Border.W
R.Bottom := R.Top + FToolbar.Border.H
if FToolbar.FOffset.X = -1 then
FToolbar.FOffset := r.TopL
if PtInRect(r, p) then
Result := HTCAPTIONTOOLBAR;
这样做的好处就是，简化自定义皮肤TskForm内部的处理。模块化比较清晰，简化实现逻辑。
标题工具条实现过程
& &1、准备绘制的区域
& &2、确定绘制区域大小
& &3、实现绘制
& &4、响应消息
确定绘制区域大小
& 考虑到按钮是动态增加上去，需要根据实际标题区域的按钮数量来确定实际大小。所有的Action存放在记录中，这样每次只要循环Action数组就可以获得相应宽度。
区域的宽度包括：两条分割线 + 下拉配置菜单 + Button * Count
1 /// 用于保存Action的信息
2 TcpToolButton = record
Action: TBasicA
Visible: B
ImageIndex: I
// 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
// 实际占用宽度，考虑后续加不同的按钮样式使用
// 褪色量 0 - 255
SaveEvent: TNotifyE
// 原始的Action OnChange事件
13 /// 计算实际占用尺寸
14 function TcpToolbar.CalcSize: TR
SIZE_SPLITER = 10;
SIZE_POPMENU = 10;
SIZE_BUTTON
如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。
w := SIZE_SPLITER * 2 + SIZE_POPMENU;
for I := 0 to FCount - 1 do
w := w + FItems[i].W
h := SIZE_BUTTON;
Result := Rect(0, 0, w, h);
占用区域大小的问题解决，绘制问题主要考虑在什么位置绘制，怎么获得Action的图标和实际的状态。
以正常情况考虑绘制区域：从原点（0，0）开始绘制，这样比较符合一般的习惯。只要在绘制前对画布重新设置原点，就能实现。
2 /// 绘制工具条
3 if FToolbar.Visible and (rCaptionRect.Right & rCaptionRect.Left) then
/// 防止出现绘制出多余区域，当区域不够时需要进行剪切。
如： 窗体缩小时
CurrentIdx := 0;
bClipRegion := rCaptionRect.Width & FToolbar.Border.W
if bClipRegion then
ClipRegion := CreateRectRgnIndirect(rCaptionRect);
CurrentIdx := SelectClipRgn(DC, ClipRegion);
DeleteObject(ClipRegion);
/// 设置原点偏移量
iLeftOff := rCaptionRect.L
iTopOff := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
MoveWindowOrg(DC, iLeftOff, iTopOff);
FToolbar.Paint(DC);
MoveWindowOrg(DC, -iLeftOff, -iTopOff);
if bClipRegion then
SelectClipRgn(DC, CurrentIdx);
/// 扣除工具条区域
rCaptionRect.Left := rCaptionRect.Left + FToolbar.Border.Width + SPALCE_CAPTIONAREA;
获取Action的图标
& 直接从ImageList中获取。考虑标题区域是纯色，能让标题工具条显的更美观（个人审美），能让工具条支持2中不同的图标。画了一组纯白的图标用于标题区域的显示。
1 // 创建Bmp，支持透明
2 // cIcon := TBitmap.C
3 // cIcon.PixelFormat := pf32
// 支持透明
4 // cIcon.alphaFormat := afI
6 function TcpToolbar.LoadActionIcon(Idx: I AImg: TBitmap):B
bHasImg: B
/// 获取Action的图标
AImg.Canvas.Brush.Color := clB
AImg.Canvas.FillRect(Rect(0,0, AImg.Width, AImg.Height));
bHasImg := F
if (FImages && nil) and (FItems[Idx].ImageIndex &= 0) then
bHasImg := FImages.GetBitmap(FItems[Idx].ImageIndex, AImg);
if not bHasImg and (FItems[Idx].Action is TCustomAction) then
with TCustomAction(FItems[Idx].Action) do
if (Images && nil) and (ImageIndex &= 0) then
bHasImg := Images.GetBitmap(ImageIndex, AImg);
Result := bHasI
获取Action的图标
绘制工具条
& 有了尺寸和Action就可以直接进行绘制。鼠标滑过和按下状态的处理方法和系统按钮区域的方法一致。
1 procedure TcpToolbar.Paint(DC: HDC);
function GetActionState(Idx: Integer): TSkinI
Result := siI
if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
Result := siPressed
else if Idx = FHotIndex then
Result := siH
工具条绘制
/// 分割线
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, steSplitter, r);
OffsetRect(r, r.Right - r.Left, 0);
/// 绘制Button
cIcon := TBitmap.C
cIcon.PixelFormat := pf32
cIcon.alphaFormat := afI
for I := 0 to FCount - 1 do
r.Right := r.Left + FItems[i].W
if FItems[I].Enabled then
SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
if LoadActionIcon(i, cIcon) then
iOpacity := 255;
/// 处理不可用状态，图标颜色变暗。
简易处理，增加绘制透明度。
if not FItems[i].Enabled then
iOpacity := 100;
SkinData.DrawIcon(DC, r, cIcon, iOpacity);
OffsetRect(r, r.Right - r.Left, 0);
/// 分割条
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, steSplitter, r);
OffsetRect(r, r.Right - r.Left, 0);
/// 绘制下拉菜单按钮
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, stePopdown, r);
&相应鼠标事件
& & 对于一个工具条，需要相应的事件有三个鼠标滑过、按下和弹起。滑过是出现Hot效果，按下时处理Button被压下的效果，弹起时执行实际的Action事件。简单处理处理的这三种效果，如果考虑动画效果。那么需要创建一个时钟，设置个背景褪色量（其实是个Alpha透明通道值），然后根据褪色量在时钟消息中进行绘制。时钟最好设置在主皮肤类（TskForm）上，不必为每个区域创建一个句柄，这样可以减少系统资源（句柄）的占用。
& & 统一消息入口，如果处理了此消息就返回True。这样可以让外部知道是否此消息被处理，以便外部作进一步的响应处理。
1 function TFormCaptionPlugin.HandleMessage(var Message: TMessage): B
Result := T
case Message.Msg of
WM_NCMOUSEMOVE
: MouseMove(ScreenToClient(TWMNCMouseMove(Message).XCursor, TWMNCMouseMove(Message).YCursor));
WM_NCLBUTTONDOWN
: MouseDown(mbLeft, ScreenToClient(TWMNCLButtonDown(Message).XCursor, TWMNCLButtonDown(Message).YCursor));
WM_NCHITTEST
: HitWindowTest(ScreenToClient(TWMNCHitTest(Message).XPos, TWMNCHitTest(Message).YPos));
WM_NCLBUTTONUP
: MouseUp(mbLeft, ScreenToClient(TWMNCLButtonUp(Message).XCursor, TWMNCLButtonUp(Message).YCursor));
Result := F
&这里一个比较关键的是，鼠标在这个区域内的实际位置。一般窗体都会有Handle，所以能直接通过API转换鼠标位置。
区域需要依靠主窗口的位置才能获得。每次窗口在处理尺寸时，区域的偏移位置是可以获得的。像标题工具条这种左靠齐，其实这个偏移位置算好后就肯定是不会变的。
1 // 偏移量
= 有效标题区域 - 系统图标位置 - 区域间隙
3 r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
4 r.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
1 function TFormCaptionPlugin.ScreenToClient(x, y: Integer): TP
/// 调整位置
以 FOffset 为中心位置
P := FOwner.NormalizePoint(Point(x, Y));
p.X := p.X - FOffset.X;
p.Y := p.y - FOffset.Y;
&上面鼠标的消息最终通过HitTest获取，实际鼠标所在按钮位置。这个处理方法和外部的TskForm处理方法一致，检测位置设置状态参数然后再重绘。
如：鼠标滑过时的消息处理。
1 procedure TcpToolbar.MouseMove(p: TPoint);
/// 鼠标滑入时设置HotIndex值
iIdx := HitTest(p);
if iIdx && FHotIndex then
FHotIndex := iI
1 function TcpToolbar.HitTest(P: TPoint):
检测鼠标位置
鼠标位置的 FCount位 为工具条系统菜单位置。
iIdx := -1;
iOff := RES_CAPTIONTOOLBAR.w;
if p.x & iOff then
for I := 0 to FCount - 1 do
if p.X & iOff then
inc(iOff, FItems[i].Width);
if p.x & iOff then
iIdx := -1;
inc(iOff, RES_CAPTIONTOOLBAR.w);
if p.x & iOff then
iIdx := FC
// FCount 为系统菜单按钮
Result := iI
坐标所在按钮区域检测 HitTest
还有些细节方面的处理，如鼠标离开这个区域时的处理。这样整个工具区的基本处理完成，整个工具条区域的处理还是相对比较简单。
Action状态处理
& Action处理主要是考虑，当外部改变Action状态。如：无效，不可见的一些事件处理。标准的处理方法是在关联Action是创建一个ActionLink实现联动，由于TskForm没有从TControl继承，没法使用此方法进行处理。在TBasicAction改变状态时会触发一个OnChange的保护（protected）事件，可以直接把事件挂接上去，就能简单处理状态。
保护方法的访问：创建一个访问类，进行引用。
TacWinControl = class(TWinControl);
TacAction = class(TBasicAction);
ZeroMemory(@FItems[FCount], SizeOf(TcpToolButton));
FItems[FCount].Action := A
FItems[FCount].Enabled :=
// &--- 这里应该获取Actoin的当前状态，这里简略处理。
FItems[FCount].Visible := T
// &--- 同上，注：现有代码中并未处理此状态
FItems[FCount].ImageIndex := AImageI
FItems[FCount].Width := 20;
FItems[FCount].Fade
FItems[FCount].SaveEvent := TacAction(Action).OnC
// 保存原事件
TacAction(Action).OnChange := DoOnActionC
// 挂接事件
&注意：不要把原事件丢了，需要保存。防止外部有挂接的情况下出现外部无法。
根据状态的不同，直接修改记录的Enabled 和 Visible 这两个状态。绘制时可以直接使用。
1 procedure TcpToolbar.DoOnActionChange(Sender: TObject);
bResize: B
if Sender is TBasicAction then
idx := IndexOf(TBasicAction(Sender));
if (idx &= 0) and (idx & FCount) then
外部状态改变响应
if FItems[idx].Action.InheritsFrom(TContainedAction) then
FItems[idx].Enabled := TContainedAction(Sender).E
bResize := FItems[idx].Visible && TContainedAction(Sender).V
if bResize then
FItems[idx].Visible := not FItems[idx].V
/// 执行原有事件
if Assigned(FItems[idx].SaveEvent) then
FItems[idx].SaveEvent(Sender);
&在绘制时就可以通过记录中的状态和鼠标位置状态进行判断，来绘制出所需要的效果
// 如果按钮有效，那么进行按钮底色绘制。
if FItems[I].Enabled then
SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
if LoadActionIcon(i, cIcon) then
/// 处理不可用状态，图标颜色变暗。
简易处理，增加绘制透明度。
iOpacity := 255;
if not FItems[i].Enabled then
iOpacity := 100;
SkinData.DrawIcon(DC, r, cIcon, iOpacity);
// 获取Action底色的显示状态
按下状态、滑过状态、默认状态
function GetActionState(Idx: Integer): TSkinI
Result := siI
if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
Result := siPressed
else if Idx = FHotIndex then
Result := siH
在窗体上加入测试Action
1 procedure TForm11.FormCreate(Sender: TObject);
FTest.Toolbar.Images := ImageList2;
FTest.Toolbar.Add(Action1, 0);
FTest.Toolbar.Add(Action2, 1);
FTest.Toolbar.Add(Action3, 2);
& &最终效果，就是上面的GIF效果。想做的更好，那么就需要在细节上考虑。细节是最花时间的地方。
1 unit uFormS
3 interface
Classes, windows, Controls, Graphics, Forms, messages, pngimage, Types, ImgList, Actions, ActnL
WM_NCUAHDRAWCAPTION = $00AE;
= WM_USER + 1;
// 增加标题区域位置
HTCUSTOM = 100; //HTHELP + 1;
/// 自定义区域ID
HTCAPTIONTOOLBAR = HTCUSTOM + 1;
/// 标题工具区域
TskForm = class;
TFormButtonKind = (fbkMin, fbkMax, fbkRestore, fbkClose, fbkHelp);
TSkinIndicator = (siInactive, siHover, siPressed, siSelected, siHoverSelected);
TFormCaptionPlugin = class
FOffset: TP
// 实际标题区域所在的偏移位置
FBorder: TR
FOwner: TskF
FVisible: B
procedure Paint(DC: HDC); virtual; abstract;
CalcSize: TR virtual; abstract;
ScreenToClient(x, y: Integer): TP
HandleMessage(var Message: TMessage): B virtual;
procedure HitWindowTest(P: TPoint); virtual;
procedure MouseMove(p: TPoint); virtual;
procedure MouseDown(Button: TMouseB p: TPoint); virtual;
procedure MouseUp(Button: TMouseB p: TPoint); virtual;
procedure MouseL virtual;
procedure I
procedure U
constructor Create(AOwner: TskForm); virtual;
property Border: TRect read FB
property Visible: Boolean read FV
TcpToolButton = record
Action: TBasicA
Visible: B
ImageIndex: I
// 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
// 实际占用宽度，考虑后续加不同的按钮样式使用
// 褪色量 0 - 255
SaveEvent: TNotifyE
// 原始的Action OnChange事件
TcpToolbar = class(TFormCaptionPlugin)
FItems: array of TcpToolB
FHotIndex: I
// 考虑标题栏比较特殊，背景使用的是纯属情况。图标需要做的更符合纯属需求。
FImages: TCustomImageL
FPressedIndex: I
procedure ExecAction(Index: Integer);
procedure PopConfigM
HitTest(P: TPoint):
LoadActionIcon(Idx: I AImg: TBitmap):B
procedure SetImages(const Value: TCustomImageList);
procedure DoOnActionChange(Sender: TObject);
// 绘制按钮样式
procedure Paint(DC: HDC); override;
// 计算实际占用尺寸
CalcSize: TR override;
procedure HitWindowTest(P: TPoint); override;
procedure MouseMove(p: TPoint); override;
procedure MouseDown(Button: TMouseB p: TPoint); override;
procedure MouseUp(Button: TMouseB p: TPoint); override;
procedure MouseL override;
constructor Create(AOwner: TskForm); override;
procedure Add(Action: TBasicA AImageIndex: Integer = -1);
procedure Delete(Index: Integer);
IndexOf(Action: TBasicAction): I
property Images: TCustomImageList read FImages write SetI
TskForm = class
FCallDefaultProc: B
FChangeSizeCalled: B
FControl: TWinC
FHandled: B
FRegion: HRGN;
/// 窗体图标
FIconHandle: HICON;
// 鼠标位置状态，只处理监控的位置，其他有交由系统处理
FPressedHit: I
// 实际按下的位置
// 记录上次的测试位置
FToolbar: TcpT
function GetHandle: HWND; inline;
function GetForm: TCustomF inline;
function GetFrameSize: TR
function GetCaptionRect(AMaxed: Boolean): TR inline;
function GetCaption: string;
function GetIcon: TI
function GetIconFast: TI
procedure ChangeS
NormalizePoint(P: TPoint): TP
HitTest(P: TPoint):
procedure M
procedure M
// 第一组 实现绘制基础
procedure WMNCPaint(var message: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var message: TMessage); message WM_NCACTIVATE;
procedure WMNCLButtonDown(var message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
procedure WMNCUAHDrawCaption(var message: TMessage); message WM_NCUAHDRAWCAPTION;
// 第二组 控制窗体样式
procedure WMNCCalcSize(var message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMWindowPosChanging(var message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
// 第三组 绘制背景和内部控件
procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMPaint(var message: TWMPaint); message WM_PAINT;
// 第四组 控制按钮状态
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonUp(var Message: TWMNCLButtonUp); message WM_NCLBUTTONUP;
procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
procedure WMSetText(var Message: TMessage); message WM_SETTEXT;
procedure WndProc(var message: TMessage);
procedure CallDefaultProc(var message: TMessage);
Handle: HWND read GetH
procedure InvalidateNC;
procedure PaintNC(DC: HDC);
procedure PaintBackground(DC: HDC);
procedure Paint(DC: HDC);
constructor Create(AOwner: TWinControl);
destructor D override;
function DoHandleMessage(var message: TMessage): B
property Toolbar: TcpToolbar read FT
property Handled: Boolean read FHandled write FH
property Control: TWinControl read FC
property Form: TCustomForm read GetF
181 implementation
SPALCE_CAPTIONAREA = 3;
186 {$R MySkin.RES}
TacWinControl = class(TWinControl);
TacAction = class(TBasicAction);
Res = class
class procedure LoadGraphic(const AName: string; AGraphic: TGraphic);
class procedure LoadBitmap(const AName: string; AGraphic: TBitmap);
TResArea = record
TSkinToolbarElement = (steSplitter, stePopdown);
SkinData = class
class constructor C
class destructor D
class procedure DrawButtonBackground(DC: HDC; AState: TSkinI const R: TR const Opacity: Byte = 255);
class procedure DrawButton(DC: HDC; AKind: TFormButtonK AState: TSkinI const R: TRect);
class procedure DrawElement(DC: HDC; AItem: TSkinToolbarE const R: TRect);
class procedure DrawIcon(DC: HDC; R: TR ASrc: TB const Opacity: Byte = 255);
SKINCOLOR_BAKCGROUND
= $00BF7B18;
SKINCOLOR_BTNHOT
= $00F2D5C2;
// Hot 激活状态
SKINCOLOR_BTNPRESSED
= $00E3BDA3;
// 按下状态
SIZE_SYSBTN: TSize
= (cx: 29; cy: 18);
SIZE_FRAME: TRect
= (Left: 4; Top: 29; Right: 5; Bottom: 5); // 窗体边框的尺寸
SPACE_AREA
// 功能区域之间间隔
SIZE_RESICON
// 资源中图标默认尺寸
SIZE_HEIGHTTOOLBAR
RES_CAPTIONTOOLBAR: TResArea = (x: 0; y: 16; w: 9; h: 16);
234 function BuildRect(L, T, W, H: Integer): TR inline;
Result := Rect(L, T, L + W, T + H);
239 procedure DrawTransparentBitmap(Source: TB sx, sy: I Destination: HDC;
const dX, dY: I
w, h: I const Opacity: Byte = 255); overload;
BlendFunc: TBlendF
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := O
if Source.PixelFormat = pf32bit then
BlendFunc.AlphaFormat := AC_SRC_ALPHA
BlendFunc.AlphaFormat := 0;
AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
257 procedure TskForm.CallDefaultProc(var message: TMessage);
if FCallDefaultProc then
FControl.WindowProc(message)
FCallDefaultProc := T
FControl.WindowProc(message);
FCallDefaultProc := F
269 procedure TskForm.ChangeS
hTmp: HRGN;
/// 设置窗体外框样式
FChangeSizeCalled := T
hTmp := FR
/// 创建矩形外框，3的倒角
FRegion := CreateRoundRectRgn(0, 0, FWidth, FHeight, 3, 3);
SetWindowRgn(Handle, FRegion, True);
if hTmp && 0 then
DeleteObject(hTmp);
FChangeSizeCalled := F
290 function TskForm.NormalizePoint(P: TPoint): TP
rWindowPos, rClientPos: TP
rWindowPos := Point(FLeft, FTop);
rClientPos := Point(0, 0);
ClientToScreen(Handle, rClientPos);
Result := P;
ScreenToClient(Handle, Result);
Inc(Result.X, rClientPos.X - rWindowPos.X);
Inc(Result.Y, rClientPos.Y - rWindowPos.Y);
303 function TskForm.HitTest(P: TPoint):
rCaptionRect: TR
rFrame: TR
Result := HTNOWHERE;
/// 检测位置
rFrame := GetFrameS
if p.Y & rFrame.Top then
只关心窗体按钮区域
bMaxed := IsZoomed(Handle);
rCaptionRect := GetCaptionRect(bMaxed);
if PtInRect(rCaptionRect, p) then
r.Right := rCaptionRect.Right - 1;
r.Top := 0;
if bMaxed then
r.Top := rCaptionRect.T
r.Top := r.Top + (rFrame.Top - r.Top - SIZE_SYSBTN.cy) div 2;
r.Left := r.Right - SIZE_SYSBTN.
r.Bottom := r.Top + SIZE_SYSBTN.
/// 实际绘制的按钮就三个，其他没处理
if (P.Y &= r.Top) and (p.Y &= r.Bottom) and (p.X &= r.Right) then
if (P.X &= r.Left) then
Result := HTCLOSE
else if p.X &= (r.Left - SIZE_SYSBTN.cx) then
Result := HTMAXBUTTON
else if p.X &= (r.Left - SIZE_SYSBTN.cx * 2) then
Result := HTMINBUTTON;
标题工具区域
需要前面扣除窗体图标区域
if (Result = HTNOWHERE) and (FToolbar.Visible) then
r.Left := rCaptionRect.Left + 2 + GetSystemMetrics(SM_CXSMICON) + SPALCE_CAPTIONAREA;
R.Top := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
R.Right := R.Left + FToolbar.Border.W
R.Bottom := R.Top + FToolbar.Border.H
if FToolbar.FOffset.X = -1 then
FToolbar.FOffset := r.TopL
if PtInRect(r, p) then
Result := HTCAPTIONTOOLBAR;
366 constructor TskForm.Create(AOwner: TWinControl);
FControl := AO
FRegion := 0;
FChangeSizeCalled := F
FCallDefaultProc := F
FWidth := FControl.W
FHeight := FControl.H
FIcon := nil;
FIconHandle := 0;
FToolbar := TcpToolbar.Create(Self);
381 destructor TskForm.D
FToolbar.F
FIconHandle := 0;
if FIcon && nil then
if FRegion && 0 then
DeleteObject(FRegion);
inherited;
391 function TskForm.DoHandleMessage(var message: TMessage): B
Result := F
if not FCallDefaultProc then
FHandled := F
WndProc(message);
Result := H
402 function TskForm.GetFrameSize: TR
Result := SIZE_FRAME;
407 function TskForm.GetCaptionRect(AMaxed: Boolean): TR
rFrame: TR
rFrame := GetFrameS
// 最大化状态简易处理
if AMaxed then
Result := Rect(8, 8, FWidth - 9 , rFrame.Top)
Result := Rect(rFrame.Left, 3, FWidth - rFrame.right, rFrame.Top);
419 function TskForm.GetCaption: string;
Buffer: array [0..255] of C
if Handle && 0 then
iLen := GetWindowText(Handle, Buffer, Length(Buffer));
SetString(Result, Buffer, iLen);
Result := '';
433 function TskForm.GetForm: TCustomF
Result := TCustomForm(Control);
438 function TskForm.GetHandle: HWND;
if FControl.HandleAllocated then
Result := FControl.Handle
Result := 0;
446 function TskForm.GetIcon: TI
IconX, IconY:
TmpHandle: TH
Info: TWndClassEx;
Buffer: array [0 .. 255] of C
/// 获取当前form的图标
/// 这个图标和App的图标是不同的
TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_SMALL, 0));
if TmpHandle = 0 then
TmpHandle := THandle(SendMessage(Handle, WM_GETICON, ICON_BIG, 0));
if TmpHandle = 0 then
{ Get instance }
GetClassName(Handle, @Buffer, SizeOf(Buffer));
FillChar(Info, SizeOf(Info), 0);
Info.cbSize := SizeOf(Info);
if GetClassInfoEx(GetWindowLong(Handle, GWL_HINSTANCE), @Buffer, Info) then
TmpHandle := Info.hIconSm;
if TmpHandle = 0 then
TmpHandle := Info.HICON;
if FIcon = nil then
FIcon := TIcon.C
if TmpHandle && 0 then
IconX := GetSystemMetrics(SM_CXSMICON);
if IconX = 0 then
IconX := GetSystemMetrics(SM_CXSIZE);
IconY := GetSystemMetrics(SM_CYSMICON);
if IconY = 0 then
IconY := GetSystemMetrics(SM_CYSIZE);
FIcon.Handle := CopyImage(TmpHandle, IMAGE_ICON, IconX, IconY, 0);
FIconHandle := TmpH
Result := FI
494 function TskForm.GetIconFast: TI
if (FIcon = nil) or (FIconHandle = 0) then
Result := GetIcon
Result := FI
502 procedure TskForm.InvalidateNC;
if FControl.HandleAllocated then
SendMessage(Handle, WM_NCPAINT, 1, 0);
508 procedure TskForm.M
if Handle && 0 then
FPressedHit := 0;
FHotHit := 0;
if IsZoomed(Handle) then
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
521 procedure TskForm.M
if Handle && 0 then
FPressedHit := 0;
FHotHit := 0;
if IsIconic(Handle) then
SendMessage(Handle, WM_SYSCOMMAND, SC_RESTORE, 0)
SendMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
534 procedure TskForm.PaintNC(DC: HDC);
HITVALUES: array [TFormButtonKind] of integer = (HTMINBUTTON, HTMAXBUTTON, HTMAXBUTTON, HTCLOSE, HTHELP);
function GetBtnState(AKind: TFormButtonKind): TSkinI
if (FPressedHit = FHotHit) and (FPressedHit = HITVALUES[AKind]) then
Result := siPressed
else if FHotHit = HITVALUES[AKind] then
Result := siHover
Result := siI
bClipRegion:
hB: HBRUSH;
rFrame: TR
rButton: TR
SaveIndex:
ClipRegion: HRGN;
CurrentIdx: I
rCaptionRect : TR
sData: string;
iLeftOff: I
iTopOff: I
SaveColor:
SaveIndex := SaveDC(DC);
bMaxed := IsZoomed(Handle);
// 扣除客户区域
rFrame := GetFrameS
ExcludeClipRect(DC, rFrame.Left, rFrame.Top, FWidth - rFrame.Right, FHeight - rFrame.Bottom);
rCaptionRect := GetCaptionRect(bMaxed);
// 填充整个窗体背景
hB := CreateSolidBrush(SKINCOLOR_BAKCGROUND);
FillRect(DC, Rect(0, 0, FWidth, FHeight), hB);
DeleteObject(hB);
/// 绘制窗体图标
rButton := BuildRect(rCaptionRect.Left + 2, rCaptionRect.Top, GetSystemMetrics(SM_CXSMICON), GetSystemMetrics(SM_CYSMICON));
rButton.Top := rButton.Top + (rFrame.Top - rButton.Bottom) div 2;
DrawIconEx(DC, rButton.Left, rButton.Top, GetIconFast.Handle, 0, 0, 0, 0, DI_NORMAL);
rCaptionRect.Left := rButton.Right + SPALCE_CAPTIONAREA; //
/// 绘制窗体按钮区域
rButton.Right := rCaptionRect.Right - 1;
rButton.Top := 0;
if bMaxed then
rButton.Top := rCaptionRect.T
rButton.Top := rButton.Top + (rFrame.Top - rButton.Top - SIZE_SYSBTN.cy) div 2;
rButton.Left := rButton.Right - SIZE_SYSBTN.
rButton.Bottom := rButton.Top + SIZE_SYSBTN.
SkinData.DrawButton(Dc, fbkClose, GetBtnState(fbkClose), rButton);
OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);
if bMaxed then
SkinData.DrawButton(Dc, fbkRestore, GetBtnState(fbkRestore), rButton)
SkinData.DrawButton(Dc, fbkMax, GetBtnState(fbkMax), rButton);
OffsetRect(rButton, - SIZE_SYSBTN.cx, 0);
SkinData.DrawButton(Dc, fbkMin, GetBtnState(fbkMin), rButton);
rCaptionRect.Right := rButton.Left - SPALCE_CAPTIONAREA; // 后部空出
/// 绘制工具条
if FToolbar.Visible and (rCaptionRect.Right & rCaptionRect.Left) then
/// 防止出现绘制出多余区域，当区域不够时需要进行剪切。
如： 窗体缩小时
CurrentIdx := 0;
bClipRegion := rCaptionRect.Width & FToolbar.Border.W
if bClipRegion then
ClipRegion := CreateRectRgnIndirect(rCaptionRect);
CurrentIdx := SelectClipRgn(DC, ClipRegion);
DeleteObject(ClipRegion);
iLeftOff := rCaptionRect.L
iTopOff := rCaptionRect.Top + (rCaptionRect.Height - FToolbar.Border.Height) div 2;
MoveWindowOrg(DC, iLeftOff, iTopOff);
FToolbar.Paint(DC);
MoveWindowOrg(DC, -iLeftOff, -iTopOff);
if bClipRegion then
SelectClipRgn(DC, CurrentIdx);
/// 扣除工具条区域
rCaptionRect.Left := rCaptionRect.Left + FToolbar.Border.Width + SPALCE_CAPTIONAREA;
/// 绘制Caption
if rCaptionRect.Right & rCaptionRect.Left then
SetBkMode(DC, TRANSPARENT);
SaveColor := SetTextColor(DC, $00FFFFFF);
Flag := DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
DrawTextEx(DC, PChar(sData), Length(sData), rCaptionRect, Flag, nil);
SetTextColor(DC, SaveColor);
RestoreDC(DC, SaveIndex);
655 procedure TskForm.PaintBackground(DC: HDC);
hB: HBRUSH;
GetClientRect(Handle, R);
hB := CreateSolidBrush($00F0F0F0);
FillRect(DC, R, hB);
DeleteObject(hB);
666 procedure TskForm.Paint(DC: HDC);
// PaintBackground(DC);
// TODO -cMM: TskForm.Paint default body inserted
672 procedure TskForm.WMEraseBkgnd(var message: TWMEraseBkgnd);
SaveIndex:
DC := Message.DC;
if DC && 0 then
SaveIndex := SaveDC(DC);
PaintBackground(DC);
RestoreDC(DC, SaveIndex);
Handled := T
Message.Result := 1;
689 procedure TskForm.WMNCActivate(var message: TMessage);
// FFormActive := Message.WParam & 0;
Message.Result := 1;
InvalidateNC;
Handled := T
697 procedure TskForm.WMNCCalcSize(var message: TWMNCCalcSize);
// 改变边框尺寸
R := GetFrameS
with TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0] do
Inc(Left, R.Left);
Inc(Top, R.Top);
Dec(Right, R.Right);
Dec(Bottom, R.Bottom);
Message.Result := 0;
Handled := T
714 procedure TskForm.WMNCHitTest(var Message: TWMNCHitTest);
// 需要把位置转换到实际窗口位置
P := NormalizePoint(Point(Message.XPos, Message.YPos));
// 获取 位置
iHit := HitTest(p);
if FHotHit & HTNOWHERE then
Message.Result := iH
Handled := T
if iHit && FHotHit then
if FHotHit = HTCAPTIONTOOLBAR then
FToolbar.MouseL
FHotHit := iH
InvalidateNC;
741 procedure TskForm.WMWindowPosChanging(var message: TWMWindowPosChanging);
bChanged: B
CallDefaultProc(TMessage(Message));
Handled := T
bChanged := F
/// 防止嵌套
if FChangeSizeCalled then
if (Message.WindowPos^.flags and SWP_NOSIZE = 0) or (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
if (Message.WindowPos^.flags and SWP_NOMOVE = 0) then
FLeft := Message.WindowPos^.x;
FTop := Message.WindowPos^.y;
if (Message.WindowPos^.flags and SWP_NOSIZE = 0) then
bChanged := ((Message.WindowPos^.cx && FWidth) or (Message.WindowPos^.cy && FHeight)) and
(Message.WindowPos^.flags and SWP_NOSIZE = 0);
FWidth := Message.WindowPos^.
FHeight := Message.WindowPos^.
if (Message.WindowPos^.flags and SWP_FRAMECHANGED && 0) then
bChanged := T
if bChanged then
InvalidateNC;
780 procedure TskForm.WMNCLButtonDown(var message: TWMNCLButtonDown);
iHit := HTNOWHERE;
if (Message.HitTest = HTCLOSE) or (Message.HitTest = HTMAXBUTTON) or (Message.HitTest = HTMINBUTTON) or
(Message.HitTest = HTHELP) or (Message.HitTest & HTCUSTOM) then
iHit := Message.HitT
/// 只处理系统按钮和自定义区域
if iHit && HTNOWHERE then
if iHit && FPressedHit then
FPressedHit := iH
if FPressedHit = HTCAPTIONTOOLBAR then
FToolbar.HandleMessage(TMessage(message));
InvalidateNC;
Message.Result := 0;
Message.Msg := WM_NULL;
Handled := T
807 procedure TskForm.WMNCLButtonUp(var Message: TWMNCLButtonUp);
iWasHit: I
iWasHit := FPressedH
if iWasHit && HTNOWHERE then
FPressedHit := HTNOWHERE;
//InvalidateNC;
if iWasHit = FHotHit then
case Message.HitTest of
: SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
HTMAXBUTTON
HTMINBUTTON
: SendMessage(Handle, WM_SYSCOMMAND, SC_CONTEXTHELP, 0);
HTCAPTIONTOOLBAR
: FToolbar.HandleMessage(TMessage(Message));
Message.Result := 0;
Message.Msg := WM_NULL;
Handled := T
835 procedure TskForm.WMNCMouseMove(var Message: TWMNCMouseMove);
if Message.HitTest = HTCAPTIONTOOLBAR then
FToolbar.HandleMessage(TMessage(Message));
Handled := T
if (FPressedHit && HTNOWHERE) and (FPressedHit && Message.HitTest) then
FPressedHit := HTNOWHERE;
849 procedure TskForm.WMSetText(var Message: TMessage);
CallDefaultProc(Message);
InvalidateNC;
Handled :=
856 procedure TskForm.WMNCPaint(var message: TWMNCPaint);
DC := GetWindowDC(Control.Handle);
PaintNC(DC);
ReleaseDC(Handle, DC);
Handled := T
866 procedure TskForm.WMNCUAHDrawCaption(var message: TMessage);
/// 这个消息会在winxp下产生，是内部Bug处理，直接丢弃此消息
Handled := T
872 procedure TskForm.WMPaint(var message: TWMPaint);
DC, hPaintDC: HDC;
cBuffer: TB
PS: TPaintS
/// 绘制客户区域
DC := Message.DC;
hPaintDC := DC;
if DC = 0 then
hPaintDC := BeginPaint(Handle, PS);
if DC = 0 then
/// 缓冲模式绘制，减少闪烁
cBuffer := TBitmap.C
cBuffer.SetSize(FWidth, FHeight);
PaintBackground(cBuffer.Canvas.Handle);
Paint(cBuffer.Canvas.Handle);
/// 通知子控件进行绘制
/// 主要是些图形控件的重绘制（如TShape），否则停靠在Form上的图像控件无法正常显示
if Control is TWinControl then
TacWinControl(Control).PaintControls(cBuffer.Canvas.Handle, nil);
BitBlt(hPaintDC, 0, 0, FWidth, FHeight, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
Paint(hPaintDC);
// 通知子控件重绘
if Control is TWinControl then
TacWinControl(Control).PaintControls(hPaintDC, nil);
if DC = 0 then
EndPaint(Handle, PS);
Handled := T
918 procedure TskForm.WndProc(var message: TMessage);
FHandled := F
Dispatch(message);
924 class procedure Res.LoadBitmap(const AName: string; AGraphic: TBitmap);
cPic: TPngI
cBmp := AG
cPic := TPngImage.C
cBmp.PixelFormat := pf32
cBmp.alphaFormat := afI
LoadGraphic(AName, cPic);
cBmp.SetSize(cPic.Width, cPic.Height);
cBmp.Canvas.Brush.Color := clB
cBmp.Canvas.FillRect(Rect(0, 0, cBmp.Width, cBmp.Height));
cBmp.Canvas.Draw(0, 0, cPic);
// 不处理空图片
948 class procedure Res.LoadGraphic(const AName: string; AGraphic: TGraphic);
cStream: TResourceS
/// 加载图片资源
cStream := TResourceStream.Create(h, AName, RT_RCDATA);
AGraphic.LoadFromStream(cStream);
964 class constructor SkinData.C
// 加载资源
FData := TBitmap.C
Res.LoadBitmap('MySkin', FData);
971 class destructor SkinData.D
976 class procedure SkinData.DrawButton(DC: HDC; AKind: TFormButtonK AState:
TSkinI const R: TRect);
rSrcOff: TP
/// 绘制背景
DrawButtonBackground(DC, AState, R);
/// 绘制图标
rSrcOff := Point(SIZE_RESICON * ord(AKind), 0);
x := R.Left + (R.Right - R.Left - SIZE_RESICON) div 2;
y := R.Top + (R.Bottom - R.Top - SIZE_RESICON) div 2;
DrawTransparentBitmap(FData, rSrcOff.X, rSrcOff.Y, DC, x, y, SIZE_RESICON, SIZE_RESICON);
992 class procedure SkinData.DrawButtonBackground(DC: HDC; AState: TSkinI const R: TR const Opacity: Byte = 255);
hB: HBRUSH;
if AState && siInactive then
/// 绘制背景
case AState of
: iColor := SKINCOLOR_BTNHOT;
: iColor := SKINCOLOR_BTNPRESSED;
siSelected
: iColor := SKINCOLOR_BTNPRESSED;
siHoverSelected : iColor := SKINCOLOR_BTNHOT;
iColor := SKINCOLOR_BAKCGROUND;
hB := CreateSolidBrush(iColor);
FillRect(DC, R, hB);
DeleteObject(hB);
1013 class procedure SkinData.DrawElement(DC: HDC; AItem: TSkinToolbarE const R: TRect);
rSrc: TResA
1017 begin
rSrc := RES_CAPTIONTOOLBAR;
rSrc.x + rSrc.w * (ord(AItem) - ord(Low(TSkinToolbarElement)));
/// 绘制图标
x := R.Left + (R.Right - R.Left - rSrc.w) div 2;
y := R.Top + (R.Bottom - R.Top - rSrc.h) div 2;
DrawTransparentBitmap(FData, rSrc.x, rSrc.y, DC, x, y, rSrc.w, rSrc.h);
1027 class procedure SkinData.DrawIcon(DC: HDC; R: TR ASrc: TB const Opacity: Byte = 255);
1031 begin
iXOff := r.Left + (R.Right - R.Left - ASrc.Width) div 2;
iYOff := r.Top + (r.Bottom - r.Top - ASrc.Height) div 2;
DrawTransparentBitmap(ASrc, 0, 0, DC, iXOff, iYOff, ASrc.Width, ASrc.Height, Opacity);
1037 { TcpToolbar }
1038 constructor TcpToolbar.Create(AOwner: TskForm);
1039 begin
inherited;
FHotIndex := -1;
FPressedIndex := -1;
1045 procedure TcpToolbar.Add(Action: TBasicA AImageIndex: Integer);
1046 begin
if FCount &= Length(FItems) then
SetLength(FItems, FCount + 5);
ZeroMemory(@FItems[FCount], SizeOf(TcpToolButton));
FItems[FCount].Action := A
FItems[FCount].Enabled :=
FItems[FCount].Visible := T
FItems[FCount].ImageIndex := AImageI
FItems[FCount].Width := 20;
FItems[FCount].Fade
FItems[FCount].SaveEvent := TacAction(Action).OnC
TacAction(Action).OnChange := DoOnActionC
inc(FCount);
1065 function TcpToolbar.CalcSize: TR
1066 const
SIZE_SPLITER = 10;
SIZE_POPMENU = 10;
SIZE_BUTTON
1073 begin
如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。
w := SIZE_SPLITER * 2 + SIZE_POPMENU;
for I := 0 to FCount - 1 do
w := w + FItems[i].W
h := SIZE_BUTTON;
Result := Rect(0, 0, w, h);
1085 procedure TcpToolbar.Delete(Index: Integer);
1086 begin
if (Index &= 0) and (Index & FCount) then
/// 删除时需要恢复
TacAction(FItems[Index].Action).OnChange := FItems[Index].SaveE
if Index & (FCount - 1) then
Move(FItems[Index+1], FItems[Index], sizeof(TcpToolButton) * (FCount - Index - 1));
dec(FCount);
1100 procedure TcpToolbar.DoOnActionChange(Sender: TObject);
bResize: B
1104 begin
if Sender is TBasicAction then
idx := IndexOf(TBasicAction(Sender));
if (idx &= 0) and (idx & FCount) then
外部状态改变响应
if FItems[idx].Action.InheritsFrom(TContainedAction) then
FItems[idx].Enabled := TContainedAction(Sender).E
bResize := FItems[idx].Visible && TContainedAction(Sender).V
if bResize then
FItems[idx].Visible := not FItems[idx].V
/// 执行原有事件
if Assigned(FItems[idx].SaveEvent) then
FItems[idx].SaveEvent(Sender);
1133 function TcpToolbar.HitTest(P: TPoint):
1138 begin
检测鼠标位置
鼠标位置的 FCount位 为工具条系统菜单位置。
iIdx := -1;
iOff := RES_CAPTIONTOOLBAR.w;
if p.x & iOff then
for I := 0 to FCount - 1 do
if p.X & iOff then
inc(iOff, FItems[i].Width);
if p.x & iOff then
iIdx := -1;
inc(iOff, RES_CAPTIONTOOLBAR.w);
if p.x & iOff then
iIdx := FC
// FCount 为系统菜单按钮
Result := iI
1167 procedure TcpToolbar.ExecAction(Index: Integer);
1168 begin
/// 执行命令
if (Index &= 0) and (Index & FCount) then
FItems[Index].Action.E
// FCount位 为系统配置按钮
if Index = FCount then
PopConfigM
1180 procedure TcpToolbar.PopConfigM
1181 begin
1184 procedure TcpToolbar.SetImages(const Value: TCustomImageList);
1185 begin
FImages := V
1190 function TcpToolbar.IndexOf(Action: TBasicAction): I
1193 begin
Result := -1;
for I := 0 to FCount - 1 do
if FItems[i].Action = Action then
1203 procedure TcpToolbar.MouseDown(Button: TMouseB p: TPoint);
1204 begin
if (mbLeft = Button) then
FPressedIndex := HitTest(p);
1212 procedure TcpToolbar.MouseL
1213 begin
if FHotIndex &= 0 then
FHotIndex := -1;
1221 procedure TcpToolbar.HitWindowTest(P: TPoint);
1222 begin
FHotIndex := HitTest(P);
1226 procedure TcpToolbar.MouseMove(p: TPoint);
1229 begin
iIdx := HitTest(p);
if iIdx && FHotIndex then
FHotIndex := iI
1238 procedure TcpToolbar.MouseUp(Button: TMouseB p: TPoint);
iAction: I
1241 begin
if (mbLeft = Button) and (FPressedIndex &= 0) and (FHotIndex = FPressedIndex) then
iAction := FPressedI
FPressedIndex := -1;
ExecAction(iAction);
1252 function TcpToolbar.LoadActionIcon(Idx: I AImg: TBitmap):B
bHasImg: B
1255 begin
/// 获取Action的图标
AImg.Canvas.Brush.Color := clB
AImg.Canvas.FillRect(Rect(0,0, AImg.Width, AImg.Height));
bHasImg := F
if (FImages && nil) and (FItems[Idx].ImageIndex &= 0) then
bHasImg := FImages.GetBitmap(FItems[Idx].ImageIndex, AImg);
if not bHasImg and (FItems[Idx].Action is TCustomAction) then
with TCustomAction(FItems[Idx].Action) do
if (Images && nil) and (ImageIndex &= 0) then
bHasImg := Images.GetBitmap(ImageIndex, AImg);
Result := bHasI
1269 procedure TcpToolbar.Paint(DC: HDC);
function GetActionState(Idx: Integer): TSkinI
Result := siI
if (Idx = FPressedIndex) and (FHotIndex = FPressedIndex) then
Result := siPressed
else if Idx = FHotIndex then
Result := siH
1285 begin
工具条绘制
/// 分割线
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, steSplitter, r);
OffsetRect(r, r.Right - r.Left, 0);
/// 绘制Button
cIcon := TBitmap.C
cIcon.PixelFormat := pf32
cIcon.alphaFormat := afI
for I := 0 to FCount - 1 do
r.Right := r.Left + FItems[i].W
if FItems[I].Enabled then
SkinData.DrawButtonBackground(DC, GetActionState(i), r, FItems[i].Fade);
if LoadActionIcon(i, cIcon) then
iOpacity := 255;
/// 处理不可用状态，图标颜色变暗。
简易处理，增加绘制透明度。
if not FItems[i].Enabled then
iOpacity := 100;
SkinData.DrawIcon(DC, r, cIcon, iOpacity);
OffsetRect(r, r.Right - r.Left, 0);
/// 分割条
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, steSplitter, r);
OffsetRect(r, r.Right - r.Left, 0);
/// 绘制下拉菜单
r.Right := r.Left + RES_CAPTIONTOOLBAR.w;
SkinData.DrawElement(DC, stePopdown, r);
1329 constructor TFormCaptionPlugin.Create(AOwner: TskForm);
1330 begin
FOwner := AO
FVisible := T
FBorder := CalcS
FOffset.X := -1;
1337 function TFormCaptionPlugin.ScreenToClient(x, y: Integer): TP
1340 begin
/// 调整位置
以 FOffset 为中心位置
P := FOwner.NormalizePoint(Point(x, Y));
p.X := p.X - FOffset.X;
p.Y := p.y - FOffset.Y;
1351 function TFormCaptionPlugin.HandleMessage(var Message: TMessage): B
1352 begin
Result := T
case Message.Msg of
WM_NCMOUSEMOVE
: MouseMove(ScreenToClient(TWMNCMouseMove(Message).XCursor, TWMNCMouseMove(Message).YCursor));
WM_NCLBUTTONDOWN
: MouseDown(mbLeft, ScreenToClient(TWMNCLButtonDown(Message).XCursor, TWMNCLButtonDown(Message).YCursor));
WM_NCHITTEST
: HitWindowTest(ScreenToClient(TWMNCHitTest(Message).XPos, TWMNCHitTest(Message).YPos));
WM_NCLBUTTONUP
: MouseUp(mbLeft, ScreenToClient(TWMNCLButtonUp(Message).XCursor, TWMNCLButtonUp(Message).YCursor));
Result := F
1366 procedure TFormCaptionPlugin.HitWindowTest(P: TPoint);
1367 begin
1370 procedure TFormCaptionPlugin.I
1371 begin
FOwner.InvalidateNC;
1375 procedure TFormCaptionPlugin.MouseDown(Button: TMouseB p: TPoint);
1376 begin
1379 procedure TFormCaptionPlugin.MouseL
1380 begin
1383 procedure TFormCaptionPlugin.MouseMove(p: TPoint);
1384 begin
1387 procedure TFormCaptionPlugin.MouseUp(Button: TMouseB p: TPoint);
1388 begin
1391 procedure TFormCaptionPlugin.U
1392 begin
FBorder := CalcS
uFormSkins.pas
1 unit ufrmCaptionT
3 interface
Messages, SysUtils, Variants, Types, Controls, Forms, Dialogs, StdCtrls,
ExtCtrls, ComCtrls, Windows, Classes, Graphics, Actions, ActnList, ToolWin,
Vcl.ImgList, Vcl.Buttons,
TForm11 = class(TForm)
Button1: TB
Shape1: TS
ToolBar1: TToolB
ToolButton1: TToolB
ToolButton2: TToolB
ToolButton3: TToolB
ActionList1: TActionL
Action1: TA
Action2: TA
Action3: TA
ImageList1: TImageL
ImageList2: TImageL
CheckBox1: TCheckB
procedure FormCreate(Sender: TObject);
procedure Action1Execute(Sender: TObject);
procedure Action2Execute(Sender: TObject);
procedure Action3Execute(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
FTest: TskF
procedure WndProc(var message: TMessage); override;
constructor Create(AOwner: TComponent); override;
destructor D override;
Form11: TForm11;
50 implementation
53 {$R *.dfm}
57 { TForm11 }
59 constructor TForm11.Create(AOwner: TComponent);
FTest := TskForm.Create(Self);
inherited;
65 procedure TForm11.FormCreate(Sender: TObject);
FTest.Toolbar.Images := ImageList2;
FTest.Toolbar.Add(Action1, 0);
FTest.Toolbar.Add(Action2, 1);
FTest.Toolbar.Add(Action3, 2);
73 destructor TForm11.D
inherited;
FreeAndNil(FTest);
79 procedure TForm11.Action1Execute(Sender: TObject);
Tag := Tag + 1;
Caption := format('test %d', [Tag]);
85 procedure TForm11.Action2Execute(Sender: TObject);
if Shape1.Shape && High(TShapeType) then
Shape1.Shape := Succ(Shape1.Shape)
Shape1.Shape := low(TShapeType);
93 procedure TForm11.Action3Execute(Sender: TObject);
Action1.Enabled := not Action1.E
98 procedure TForm11.CheckBox1Click(Sender: TObject);
if CheckBox1.Checked then
FTest.Toolbar.Images := nil
FTest.Toolbar.Images := ImageList2;
106 procedure TForm11.SpeedButton1Click(Sender: TObject);
Caption := format('test %d', [1]);
111 procedure TForm11.WndProc(var message: TMessage);
if not FTest.DoHandleMessage(Message) then
inherited;
ufrmCaptionToolbar.pas
&&MoveWindowOrg & & & & & & & &---- 设置绘制原点
& CreateRectRgnIndirect& & & & ---- 创建区域
& SelectClipRgn & & & & & & & & & & ---- 剪切绘制区域
相关功能实现：
& 其实这个功能在Win7下已经有此接口可以实现（很久以前用过具体名字忘记了，没写日志的后果-_-），系统自带的画图就是使用此接口实现的。但有个问题就是XP下木有此功能。感兴趣的可以Google一下。 &&
完整源代码
& & /cmacro/simple/tree/master/TestCaptionToolbar
窗体皮肤实现
在标题栏上增加快速工具条（四）
自定义皮肤很方便，基础开发的工作也是很大的。不过还好一般产品真正需要开发的并不是很多。现在比较漂亮的界面产品都会有个大大的工具条。Toolbar工具条实现皮肤的方法还是可以使用Form的处理方案
窗体边框基本的绘制和控制完成，在第二篇中主要遗留的问题。标题区域图标和按钮没绘制缩放时客户区显示有问题解决完下面的问题，皮肤处理基本完整。大致的效果GIFGIF中TShape的颜色表现有些问题，实际
第一个实现了基本处理。窗体边框的宽度有些肥大，需要进行瘦身。实现：1、改变外框线宽度（WM_NCCALCSIZE）2、改变外框样式（WM_WINDOWPOSCHANGING）通过
现在皮肤控件也很多，但每次装一堆控件，使用又繁琐。稍微研究一下内部机制，还是比较简单的。主要会使用到下面几个消息1const2WM_NCUAHDRAWCAPTION=$00AE
到第四部分DelphiXE3的代码能基本完成窗体界面的绘制。窗口中的其他控件的处理方法也是相同的，截获消息处理消息。问题这个编译出来的个头可不小。Release版本竟然2.43M，完全是个胖子。系统
:如何去读取zip文件中的资源以及皮肤文件存放方式实现方案：如果软件每次启动都去读取SD卡上的皮肤文件，速度会比较慢。较好的做法是提供一个皮肤设置的界面，用户选择了哪一个皮肤，就把那个皮肤文件解压缩到
标题栏窗口。2、为了使Form可以像标准的Windows窗体那样拥有系统菜单和拖动改变窗体大小，加入WS_THICKFRAME和WS_SYSMENU窗体样式。3、处理相应得窗体消息，实现窗体的标准操作
查看对方的消息，其实在C#中也可以实现此功能。之前看别的博客上也说到过，不过没测试成功，我进行了修改。首先声明API函数FlashWindow
正则表达式在线测试工具
FaceYe @ 2015 &&&&
ICP备案号:粤ICP备1500070