Delphi 组件开发教程指南（9）定制特色Button之QQ按钮
在上一章节，咱们实现了一个定制特色按钮的框架，不晓得列位看官，将里面的信息都消化了没有。如果都消化完全，那么现在请跟着俺的脚本来着手定制一个QQ的效果按钮。常理上，先分析一下，需要的几个效果还是上章所说的那几个效果，只是本次我们需要将上次的那个丑陋的效果换成皮肤的效果，这个皮肤的效果怎么来呢！呵呵，很简单，会PS的自己PS，不会的就直接去搞QQ的图片，抓个图，然后搞出来就行啦！抓到的图，我们可以将各个状态下的图片都弄到资源文件中去，然后就可以直接从资源文件中取得图片，之后在不同的状态下，进行贴图操作就可以了。资源文件的制作，应该都还小的怎么做吧，在很早前的一章中，就说明道了，怎么制作资源文件了。
那个asdf那个就是我新做的具备有皮肤效果的按钮了，当然，这只是一个列子，代码中没有考虑到的地方有很多很多，比如说按钮大小的变化（现在这个按钮的大小事固定了的），还有就是边角的透明处理，现在是没做任何处理的，我仅仅是用Canvas.Draw来实现了。
代码
unit
DxButton;
interface
uses
Windows,Messages,Classes,SysUtils,Controls,Graphics;
type
{
$R BtnRes.RES
}
TDxButton
=
class
(TCustomControl)
private
FIsDown:Boolean;
FInButtonArea: Boolean;
FOnClick: TNotifyEvent;
protected
procedure
Paint;
override
;
procedure
CMTextChanged(
var
msg: TMessage);
message
CM_TEXTCHANGED;
procedure
CMEnabledChanged(
var
Message: TMessage);
message
CM_ENABLEDCHANGED;
procedure
CMMouseEnter(
var
Message: TMessage);
message
CM_MOUSEENTER;
procedure
CMMouseLeave(
var
Message: TMessage);
message
CM_MOUSELEAVE;
procedure
MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
override
;
procedure
MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
override
;
procedure
WMEnable(
var
Message: TMessage);
message
WM_ENABLE;
procedure
WMKillFocus(
var
msg: TWMKillFocus);
message
WM_KILLFOCUS;
procedure
WMS(
var
msg: TWMSetFocus);
message
WM_SETFOCUS;
public
constructor
Create(AOwner: TComponent);
override
;
procedure
Click;
override
;
published
property
Color;
property
Enabled;
property
Caption;
property
OnClick: TNotifyEvent
read
FOnClick
write
FOnClick;
end
;
var
BtnBmp:
array
[
0
..
3
]
of
TBitmap;
implementation
procedure
Frame3D(Canvas: TCanvas;
var
Rect: TRect; TopColor, BottomColor: TColor;
Width: Integer);
procedure
DoRect;
var
TopRight, BottomLeft: TPoint;
begin
with
Canvas, Rect
do
begin
TopRight.X :
=
Right;
TopRight.Y :
=
Top;
BottomLeft.X :
=
Left;
BottomLeft.Y :
=
Bottom;
Pen.Color :
=
TopColor;
PolyLine([BottomLeft, TopLeft, TopRight]);
Pen.Color :
=
BottomColor;
Dec(BottomLeft.X);
PolyLine([TopRight, BottomRight, BottomLeft]);
end
;
end
;
begin
Canvas.Pen.Width :
=
1
;
Dec(Rect.Bottom); Dec(Rect.Right);
while
Width
>
0
do
begin
Dec(Width);
DoRect;
InflateRect(Rect,
-
1
,
-
1
);
end
;
Inc(Rect.Bottom); Inc(Rect.Right);
end
;
function
GetNearColor(
const
Color: TColor;OffsetValue: integer): TColor;
var
R, G, B, dR, dG, dB: Byte;
begin
if
(OffsetValue
>
127
)
or
(OffsetValue
<
-
127
)
then
raise
Exception.Create(
'
偏移值为-127-127之间
'
)
else
if
OffsetValue
=
0
then
Result :
=
Color
else
begin
Result :
=
($
80
+
OffsetValue)
shl
24
or
(ColorToRGB(Color));
R :
=
Byte(Result
shr
0
);
G :
=
Byte(Result
shr
8
);
B :
=
Byte(Result
shr
16
);
if
OffsetValue
>
0
then
begin
Inc(OffsetValue);
dR :
=
not
R;
dG :
=
not
G;
dB :
=
not
B;
end
else
begin
dR :
=
R;
dG :
=
G;
dB :
=
B;
end
;
R :
=
R
+
(dR
*
OffsetValue)
shr
7
;
G :
=
G
+
(dG
*
OffsetValue)
shr
7
;
B :
=
B
+
(dB
*
OffsetValue)
shr
7
;
Result :
=
RGB(R,G,B)
end
;
end
;
{
TDxButton
}
procedure
TDxButton.Click;
begin
if
Visible
and
Enabled
then
begin
if
Assigned(FOnClick)
then
FOnClick(Self);
end
;
end
;
procedure
TDxButton.CMEnabledChanged(
var
Message: TMessage);
begin
inherited
;
if
Parent
<>
nil
then
Invalidate;
end
;
procedure
TDxButton.CMMouseEnter(
var
Message: TMessage);
begin
FInButtonArea:
=
True;
Invalidate;
inherited
;
end
;
procedure
TDxButton.CMMouseLeave(
var
Message: TMessage);
begin
FInButtonArea:
=
False;
Invalidate;
inherited
;
end
;
procedure
TDxButton.CMTextChanged(
var
msg: TMessage);
begin
Invalidate;
end
;
constructor
TDxButton.Create(AOwner: TComponent);
begin
inherited
;
ControlStyle :
=
[csSetCaption, csCaptureMouse];
Width :
=
69
;
Height :
=
21
;
end
;
procedure
TDxButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited
;
if
Enabled
then
begin
SetFocus;
FIsDown:
=
True;
Invalidate;
end
;
end
;
procedure
TDxButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
IsClick: Boolean;
begin
inherited
;
IsClick :
=
FIsDown;
FIsDown :
=
False;
Invalidate;
if
IsClick
and
FInButtonArea
then
begin
Click;
FIsDown:
=
False;
end
;
end
;
procedure
TDxButton.Paint;
var
r: TRect;
begin
r :
=
ClientRect;
{
$IFDEF NoSKIN
}
if
not
FIsDown
then
Frame3D(Canvas,r,GetNearColor(Color,
80
),GetNearColor(Color,
-
80
),
1
)
else
Frame3D(Canvas,r,GetNearColor(Color,
-
80
),GetNearColor(Color,
80
),
1
);
//
然后绘制文字
if
Focused
then
begin
Canvas.Brush.Color :
=
not
Color;
InflateRect(r,
-
1
,
-
1
);
DrawFocusRect(Canvas.Handle,r)
end
;
{
$ELSE
}
//
采用皮肤
if
not
Enabled
then
Canvas.draw(
0
,
0
,BtnBmp[
1
])
else
if
not
FIsDown
then
begin
if
FInButtonArea
then
Canvas.draw(
0
,
0
,BtnBmp[
3
])
else
Canvas.draw(
0
,
0
,BtnBmp[
0
])
end
else
Canvas.Draw(
0
,
0
,BtnBmp[
2
]);
{
$ENDIF
}
Canvas.Brush.Style :
=
bsClear;
Canvas.Font.Assign(Font);
if
not
Enabled
then
begin
OffsetRect(r,
1
,
1
);
Canvas.Font.Color :
=
clWhite;
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), r, DT_CENTER
or
DT_VCENTER
or
DT_SINGLELINE);
Canvas.Font.Color :
=
clGray;
OffsetRect(r,
-
1
,
-
1
);
end
;
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), r, DT_CENTER
or
DT_VCENTER
or
DT_SINGLELINE);
end
;
procedure
TDxButton.WMEnable(
var
Message: TMessage);
begin
SetEnabled(Message.WParam
<>
0
);
end
;
procedure
TDxButton.WMKillFocus(
var
msg: TWMKillFocus);
begin
inherited
;
Invalidate;
end
;
procedure
TDxButton.WMS(
var
msg: TWMSetFocus);
begin
inherited
;
Invalidate;
end
;
initialization
BtnBmp[
0
] :
=
TBitmap.Create;
BtnBmp[
0
].Handle :
=
LoadBitmap(HInstance,
'
NormalBtn
'
);
BtnBmp[
1
] :
=
TBitmap.Create;
BtnBmp[
1
].Handle :
=
LoadBitmap(HInstance,
'
disableBtn
'
);
BtnBmp[
2
] :
=
TBitmap.Create;
BtnBmp[
2
].Handle :
=
LoadBitmap(HInstance,
'
DownBtn
'
);
BtnBmp[
3
] :
=
TBitmap.Create;
BtnBmp[
3
].Handle :
=
LoadBitmap(HInstance,
'
HotBtn
'
);
finalization
BtnBmp[
0
].Free;
BtnBmp[
1
].Free;
BtnBmp[
2
].Free;
BtnBmp[
3
].Free;
end
.
可以比较一下这个代码与上个代码的区别之处在什么地方！基本上最大的区别就是Paint中的实现方式了！另外我对于按钮的几个不同方式的图片最开始就初始化了，而没有在按钮类的内部创建，可以想象一下，是为啥！