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

2/4/2006来源:Delphi教程人气:10750

组件的过程,其实就是从某一对象派生出一个新的对象,并且为该对象声明新的属性、方法和事件。下面我将通过制作一个标题栏按钮来讲述如何制作组件。
      标题栏按钮组件TTitleBarButton以TComponent为直接继承对象,它是一个可以在窗体标题栏上显示按钮的组件,像最大化、最小化和关闭按钮等。最新的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、  如何确定按钮的边界,即Left,Top,Width,Height

通过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.