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中的实现方式了！另外我对于按钮的几个不同方式的图片最开始就初始化了，而没有在按钮类的内部创建，可以想象一下，是为啥！

 

Delphi组件开发教程指南目录

转载于:https://www.cnblogs.com/DxSoft/archive/2010/05/27/1745552.html