zoukankan      html  css  js  c++  java
  • 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组件开发教程指南目录

  • 相关阅读:
    安装express 新建项目遇到问题汇总
    Java IO
    python3基础之“函数(1)”
    python3基础之“小练习(3)”
    python3基础之“小练习(2)”
    python3基础之“小练习(1)”
    linux命令
    1.环境安装部署汇总
    阶段13-直播~
    docker环境问题
  • 原文地址:https://www.cnblogs.com/DxSoft/p/1745552.html
Copyright © 2011-2022 走看看