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

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/控件开发和设计/ Date Created:

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

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

标题栏按钮组件 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;
interfaceuses 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;
implementationprocedure 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 就行了。