从实作标题栏按钮开始浅谈组件的制作

 



开发组件的过程,其实就是从某一对象派生出一个新的对象,并且为该对象声明新的属性、方法和事件。下面我将通过制作一个标题栏按钮来讲述如何制作组件。


       标题栏按钮组件TTitleBarButtonTComponent为直接继承对象,它是一个可以在窗体标题栏上显示按钮的组件,像最大化、最小化和关闭按钮等。最新的Winamp MP3播放器,它有一个插件可以在任何窗体上显示一排播放按钮,我想通过下面的技术也可以实现。


 


1、首性确定组件的属性。属性是组件的重要组成部分,它相当于组件的门面,因为一旦一个组件被置于窗体中时,用户必然想到去设置组件的各种属性,编写各种事件的处理过程。TTitleBarButton有以下属性:


Color:用来决定按钮表面的颜色。


Glyph:用来决定按钮表面的图片。


PopupMenu:用来决定右键单击按钮时的弹出菜单。


RightMargin:用来确定按钮的位置,以窗体右边界为基准。


Visible:用来决定按钮是否可见。


2、确定组件的方法。方法是组件的基本构成部分之一,在编写方法时,尽量减少方法间的依赖关系,并确定方法的可见度,以及是否为虚函数等。在本例中,主要方法如下:


function GetBoundsRect: TRect;   用来确定按钮的边界矩形,可见度为private


procedure NewWndProc(var message: TMessage);  窗体的新的窗口过程,private


procedure Paint; virtual; 该类的继承者可以override该方法,但用户不能直接调该方法


procedure Repaint; Paint方法的对外接口,用户可以调用此方法,以强制重新画按钮


3、确定组件的事件。事件实际上是一种特殊的属性,它也是组件的很重要组成部分,事件为组件响应系统发生的行为而执行的一段代码连接。事件就是方法指针,是方法的触发器。TtitleBarButton只有一个事件:


OnClick事件,用来响应用户的Click事件代码。


 


另外,要减少组件的依赖关系。使一个组件在执行其代码时所受的约束尽可能地少,这是开发组件的一个主要目标,它也是衡量一个组件性能好坏的重要标准之一。


 


实现标题栏按钮需要解决以下主要问题:


1、  如何确定按钮的边界,即LeftTopWidthHeight


通过GetWindowRect来取得窗体的边界矩形,通过GetSystemMetrics取得窗体的框架宽度和标题栏按钮的高度、宽度。再加上RightMargin属性就可以基本上确定按钮的边界了。


2、  如何画按钮的外观(包括按下和凸起)


通过GetWindowDC来取得窗体DC(包括标题栏、菜单、滚动条等),我们就可以在这个DC上画按钮了。


3、  如何让按钮响应消息(比如Click,单击右键弹出菜单等)


我们可以通过GetWindowLong取得窗体的窗口过程,然后把我们新定义的窗口过程通过SetWindowLong给这个窗体,然后我们在自己的窗口过程中来让按钮响应消息。


 


 


全部代码如下:


unit TitleBarButton;


 


interface


 


uses


  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, Dialogs;


 


type


 


  TTitleBarButton = class(TComponent)


  private


    FColor: TColor;


    FGlyph: TBitmap;


    FForm: TCustomForm;


    FOldWndProc: Pointer;


    FButtonDown: Boolean;


    FVisible: Boolean;


    FRightMargin: Cardinal;


    FPopup: TPopupMenu;


    FOnClick: TNotifyEvent;


    procedure SetGlyph(const Value: TBitmap);


    procedure SetVisible(const Value: Boolean);


    procedure SetRightMargin(const Value: Cardinal);


    function GetBoundsRect: TRect;


    procedure NewWndProc(var message: TMessage);


  protected


    procedure Notification(Component: TComponent;Operation: TOperation); override;


    procedure Paint; virtual;


  public


    constructor Create(AOwner: TComponent); override;


    destructor Destroy; override;


    procedure Repaint;


    property BoundsRect: TRect read GetBoundsRect;


  published


    property Color: TColor read FColor write FColor default clBtnFace;


    property Glyph: TBitmap read FGlyph write SetGlyph;


    property PopupMenu: TPopupMenu read FPopup write FPopup;


    property RightMargin: Cardinal read FRightMargin write SetRightMargin default 66;


    property Visible: Boolean read FVisible write SetVisible default False;


    property OnClick: TNotifyEvent read FOnClick write FOnClick;


  end;


 


procedure Register;


 


implementation


 


procedure Register;


begin


  RegisterComponents('Liao', [TTitleBarButton]);


end;


 


{ TTitleBarButton }


 


constructor TTitleBarButton.Create(AOwner: TComponent);


var


  ptr: Pointer;


begin


  inherited;


  FForm := GetParentForm(TControl(AOwner));


  FGlyph := TBitmap.Create;


  FColor := clBtnFace;


  FVisible := False;


  FRightMargin := 66;


  FButtonDown := False;


  FOldWndProc := Pointer(GetWindowLong(FForm.Handle,GWL_WNDPROC));


  ptr := MakeObjectInstance(NewWndProc);


  SetWindowLong(FForm.Handle, GWL_WNDPROC, Longint(ptr));


end;


 


destructor TTitleBarButton.Destroy;


begin


  if not (csDestroying in FForm.ComponentState) then


  begin


    SetVisible(false);


    SetWindowLong(FForm.Handle, GWL_WNDPROC, LongInt(FOldWndProc));


  end;


  FGlyph.Free;


  inherited;


end;


 


procedure TTitleBarButton.NewWndProc(var message: TMessage);


 


  function HitButton(APoint: TPoint): Boolean;


  begin


    APoint.x := APoint.x - FForm.Left;


    APoint.y := APoint.y - FForm.Top;


    Result := PtInRect(BoundsRect,APoint);


  end;


 


var


  p: TPoint;


begin


  with message do


  begin


    if Visible then


    begin


      case Msg of


        WM_NCPAINT , WM_NCACTIVATE :


          begin


            Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


            RePaint;


          end;


        WM_NCHITTEST :


          begin


            Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


 


            if Result = HTCAPTION then


            begin


              RePaint;


              p.x := LoWord(LParam);


              ScreenToClient(FForm.Handle,p);


              with BoundsRect do                  //减去框架宽度


                if (p.x >= Left-4) and (p.x <= Right-4) then Result := 888;


            end;


          end;


        WM_NCLBUTTONDOWN,WM_NCLBUTTONDBLCLK:


          begin


            Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


            with TWMNCLButtonDown(message) do


              if not HitButton(Point(XCursor, YCursor)) then Exit;


 


            if WParam = 888 then


            begin


              FButtonDown := True;


              Repaint;


              SetCapture(FForm.Handle);


            end;


          end;


        WM_NCRBUTTONDOWN,WM_NCRBUTTONDBLCLK:


          begin


            if WParam = 888 then


            begin


              if Assigned(FPopup) then


              begin


                p.x := FForm.Left + BoundsRect.Left;


                p.y := FForm.Top + BoundsRect.Bottom;


                FPopup.Popup(p.x,p.y);


              end;


            end


            else


              Result:=CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


          end;


        WM_NCLBUTTONUP,WM_LBUTTONUP :


          begin


            if FButtonDown then


            begin


              FButtonDown := False;


              RePaint;


              ReleaseCapture;


              if Assigned(FOnClick) then FOnClick(self);


            end


            else


              Result:=CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


          end;


        else


          Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


      end;


    end


    else


      Result := CallWindowProc(FOldWndProc,FForm.Handle,Msg,WParam,LParam);


  end;


end;


 


procedure TTitleBarButton.SetGlyph(const Value: TBitmap);


begin


  FGlyph.Assign(Value);


  SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);


end;


 


procedure TTitleBarButton.SetRightMargin(const Value: Cardinal);


begin


  FRightMargin := Value;


  SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);


end;


 


procedure TTitleBarButton.SetVisible(const Value: Boolean);


begin


  FVisible := Value;


  SendMessage(FForm.Handle,WM_NCACTIVATE,0,0);


end;


 


procedure TTitleBarButton.Notification(Component: TComponent;


  Operation: TOperation);


begin


  inherited;


  if (Operation = opRemove) and (Component = FPopup) then


    FPopup := nil;


end;


 


function TTitleBarButton.GetBoundsRect: TRect;


var


  Rec: TRect;


  FrameThick: Integer; //窗体框架厚度


  BtnWidth,BtnHeight: Integer; //标题栏按钮的宽度和高度


begin


  GetWindowRect(FForm.Handle,Rec); //得到窗体边界矩形,相对于屏幕左上角


 


  with Result do


  begin


    FrameThick := GetSystemMetrics(SM_CYFRAME);


    Left := (Rec.Right - Rec.Left) - RightMargin - FrameThick;


    Top := FrameThick;


    if FForm.Borderstyle in [bsSizeToolWin, bsSizeable] then


    begin


      Dec(Left, 2); Inc(Top, 2);


    end


    else begin


      Dec(Left); Inc(Top);


    end;


    if (FForm.Borderstyle in [bsSizeToolWin,bsToolWindow]) then


    begin


      BtnWidth := GetSystemMetrics(SM_CXSMSIZE) - 2;


      BtnHeight := GetSystemMetrics(SM_CYSMSIZE) - 4;


    end


    else begin


      BtnWidth := GetSystemMetrics(SM_CXSIZE) - 2;


      BtnHeight := GetSystemMetrics(SM_CYSIZE) - 4;


    end;


    Right := Left + BtnWidth;


    Bottom := Top + BtnHeight;


  end;


end;


 


procedure TTitleBarButton.Paint;


var


  GlyphRect: TRect;


begin


  if not FVisible then Exit;


  with TCanvas.Create do


  begin


    try


      Handle := GetWindowDC(FForm.Handle); //得到窗体DC,包括标题栏、菜单、滚动条等


 


      Brush.Color := FColor;         //Button凸起和按下时的外观


      if FButtonDown then


        Pen.Color := clBtnHighlight


      else


        Pen.Color := cl3DDkShadow;


      Rectangle(BoundsRect);


      with BoundsRect do


      begin


        if FButtonDown then


          Pen.Color := cl3DDkShadow


        else


          Pen.Color := clBtnHighLight;


        MoveTo(Left,Bottom-2);


        LineTo(Left,Top);


        LineTo(Right-1,Top);


        Pen.Color := clGray;


        if FButtonDown then


        begin


          MoveTo(Left+1,Bottom-3);


          LineTo(Left+1,Top+1);


          LineTo(Right-2,Top+1);


        end


        else begin


          MoveTo(Left+1,Bottom-2);


          LineTo(Right-2,Bottom-2);


          LineTo(Right-2,Top);


        end;


      end;


 


      if Assigned(Glyph) then      //如果关联了图片,则画图片


      begin


        GlyphRect := BoundsRect;


        GlyphRect.Right := GlyphRect.Right - 7;


        GlyphRect.Bottom := GlyphRect.Bottom - 5;


        if FButtonDown then


          OffsetRect(GlyphRect,4,3)


        else


          OffsetRect(GlyphRect,3,2);


 


        with GlyphRect do


          StretchBlt(Handle, Left, Top, Right-Left, Bottom-Top,


            FGlyph.Canvas.Handle, 0, 0, FGlyph.Width, FGlyph.Height, srcCopy);


      end;


    finally


      ReleaseDC(FForm.Handle,Handle);


      Free;


    end;


  end;


end;


 


procedure TTitleBarButton.Repaint;


begin


  Paint;


end;


 


end.


另外,还可以对这个组件进一步扩展,扩展其它任一窗体,只要知道了窗体的Handle就行了。

  • 0
    点赞
  • 0
    收藏
  • 打赏
    打赏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页
评论

打赏作者

liaohz

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值