組件制作之四（定制外觀）

2019-11-18 18:17:36

字體：大中小

來源：轉載

供稿：網友

時常想,如果一個組件能夠按自己想要的外觀顯示,那該是件多么COOL的事啊,這一篇就要來做一個精美外觀的組件,但是,做什么好呢.Button? 高手突破>有關于自己定義外觀的Button,以及CheckBox等的做法,Button從CustomPanel繼承,重載Paint方法來畫外觀.如果你有興趣,可以去找來看,這里就不做Button了,做一個Memo如何呢.？是個不錯的主意。

我們先起個名字叫做TCoolMemo。以上篇已經講了很多組件的技術，這里就只說出幾個重點。其余不多說了。

首先，該Memo從CustomMemo繼承，它有這樣外觀：屬于平面的，邊框是可以設置顏色的線，對應的顏色變量為FEdgeColor，另外，離邊框以內的兩個象素處，還有另一個框，當鼠標進入Memo時，這個框會顯示，當鼠標離開時，為個框消失，同樣也可以設置顏色，對應變量為FEnterColor。

那么鼠標進入和離開怎么判斷呢，這里Memo將截獲兩個Delphi的內部消息：

//下面兩個獲得Delphi的內部消息,鼠標進入和離開時發生

     PRocedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;

     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;

其實父類已經截獲了這兩個消息，并作了相應處理，所以TCoolMemo中的消息處理函數要

Inherited;再作自己的處理。這里又用到了一個變量

MouseIn：Boolean;//標識鼠標是否進入組件

接下來TCoolMemo還要截獲兩個消息：

procedure WMPaint (var Message: TMessage); message WM_PAINT;

procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;

第一個很熟悉，當需要重畫時，觸發該消息，

第二個是當窗體需要計算位置和尺寸時觸發，消息中包含了窗口客戶區的大小，我們用這個的目的主要是將客戶區縮小三個象素，以便畫組件時不會畫到客戶區。

procedure TCoolMemo.WMNCCalcSize (var Message: TWMNCCalcSize);

begin

  inherited;

  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);

end;

而上面幾個消息處理函數，CM_MOUSEENTER和CM_MOUSELEAVE;將引起TCoolMemo的外觀變化，WM_PAINT保存其外觀不被擦去。所以要用到一個畫組件的函數，即：

drawBorder;

里面用到了幾個API的GDI函數。我在代碼中有詳細的說明，加上自己看幫助，應該是可以看懂的。

另外，相比于Memo，它的擴展了這樣的功能：設置邊距和獲得光標的位置。這兩個對應的性屬為Margin，Position。他們都是Public的，不可以在對象察看器中看到。

我們一個個來說

邊距設置

property Margin:byte read FMargin write setMargin default 0;

其中setMargin函數中發送了兩個消息：

//該消息取得輸入區的尺寸

SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect));

//該消息設定輸入區的大小

SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect));

光標的位置：

property Position:TPosition read getPosition;

TPostion是一個結構，其中有行和列兩個值：

TPosition=record  //指定光標的行和列

     row:longint;

     col:longint;

   end;

getPosition;中還要處理中文的問題，代碼有詳細說明，如果文本中有中文，一樣也可以得到正確的行和列。

最后增加了兩個事件

property OnEnter;

property OnExit;

都是從父類中顯化出來的，其實就是CM_MOUSEENTER和CM_MOUSELEAVE;消息引起的。，當你想作一個三態按鈕，這兩個事件很有作用。

好了，重點就是上面那幾個了，以下是源代碼，其中也有詳細的說明：

unit CoolMemo;

interface

uses

   Windows, Messages, Classes, Forms,Controls, Graphics, StdCtrls;

type

    //用設定邊緣的空白

   TPosition=record  //指定光標的行和列

     row:longint;

     col:longint;

   end;

   TCoolMemo=class(TCustomMemo)

   private

     FMargin:byte;  //邊距的大小

     FEdgeColor:TColor;//邊框的顏色

     FEnterColor:TColor;//鼠標進入時邊框內側的框顏色

     MouseIn: Boolean; //標識鼠標是否進入

     function getPosition:TPosition;//光標的行和列

     procedure setMargin(value:byte);

     procedure setEdgeColor(Value:TColor);

     procedure setEnterColor(Value:TColor);

     //下面兩個獲得Delphi的內部消息,鼠標進入和離開時發生

     procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;

     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;

     //當一個窗口的外觀必須被畫時,應用程序發送這個消息給該窗口

     procedure WMPaint (var Message: TMessage); message WM_PAINT;

     //窗體需要計算位置和尺寸時觸發

     //我們用這個的目的主要是將客戶區縮小三個象素，以便畫組件時不會畫到客戶區。

  procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;

   protected

   //畫窗體的邊框,使其看起來更美觀.

     procedure drawBorder;

   public

     constructor Create (AOwner: TComponent); override;

     property Position:TPosition read getPosition;

     property Margin:byte read FMargin write setMargin default 0;

   published

    property EdgeColor:TColor read FEdgeColor write SetEdgeColor default $ff0000;

    property EnterColor:TColor read FEnterColor write SetEnterColor default $0000ff;

    //顯式化父類的屬性

    property Align;

    property Alignment;

    property DragCursor;

    property DragMode;

    property Enabled;

    property Color;

    property Font;

    property Lines;

    property MaxLength;

    property OEMConvert;

    property ParentFont;

    property ParentShowHint;

    property PopupMenu;

    property ReadOnly;

    property ShowHint;

    property ScrollBars;

    property TabOrder;

    property TabStop;

    property Visible;

    property WantReturns;

    property WantTabs;

    property WordWrap;

    property OnChange;

    property OnClick;

    property OnDblClick;

    property OnDragDrop;

    property OnDragOver;

    property OnEndDrag;

    //增加這兩個事件，處理鼠標進入和離開

    property OnEnter;

    property OnExit;

    property OnKeyDown;

    property OnKeyPress;

    property OnKeyUp;

    property OnMouseDown;

    property OnMouseMove;

    property OnMouseUp;

    property OnStartDrag;

   end;

procedure Register;

implementation

procedure Register;

begin

  RegisterComponents('Samples', [TCoolMemo]);

end;

constructor TCoolMemo.Create(AOwner:TComponent);

begin

  inherited Create(Aowner);

  ControlStyle := ControlStyle - [csFramed];

  ParentFont := True;

  FEdgeColor := $ff0000;

  FEnterColor := $0000ff;

  //設定外觀,平面無邊形

  Ctl3D := False;

  FMargin:=0;

  BorderStyle:=bsNone;

  height:=150;

  width:=200;

end;

procedure TCoolMemo.setMargin(Value:byte);

var

  Rect: TRect;

begin

//該消息取得客戶區的尺寸

  SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect));

  //以下是重新確定尺寸

  Rect.Top := Value;

  Rect.Left := Value;

  Rect.Right := Width -Value;

  Rect.Bottom := Height -Value;

//該消息設定客戶區的大小

  SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect));

  Fmargin:=value;

end;

function TCoolMemo.getPosition:TPosition;

var

  row,Col:longint;

  CBLines:longint;

  str:WideString;

begin

//該消息取得光標所在的行,

  row:= SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);

  //該消息取得光標所在行開始的位置,位置從第一行的0開始計數,

  //每過一個字符增加1,

  CBLines:=SendMessage(Handle,EM_LINEINDEX,row,0);

  //得到光標的所在行的所在列

  Col:=SelStart-CBLines;

  //為了解決中文的問題,需要用寬字符型來取得光標所在行

  //,行中光標所在列之前的字符串,這樣可以解決中文列數的確定問題.

  str:=Copy(Lines[row],1,col);

  col:=Length(Str)+1;

  result.row:=row+1;

  result.col:=col;

end;

procedure TCoolMemo.setEdgeColor(Value:TCOlor);

begin

if FEdgeColor<>value then

begin

  FEdgeColor:=value;

  drawBorder;

end;

end;

procedure TCoolMemo.setEnterColor(Value:TColor);

begin

if FEnterColor<>value then

begin

   FEnterColor:=value;

   drawBorder;

end;

end;

procedure TCoolMemo.CMMouseEnter(var Message: TMessage);

begin

  inherited;

    MouseIn:= True;

    drawBorder;

end;

procedure TCoolMemo.CMMouseLeave(var Message:TMessage);

begin

  inherited;

  MouseIn:=False;

  drawBorder;

end;

procedure TCoolMemo.WMPaint (var Message: TMessage);

begin

  inherited;

  drawBorder;

end;

procedure TCoolMemo.WMNCCalcSize (var Message: TWMNCCalcSize);

begin

  inherited;

  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);

end;

procedure TCoolMemo.drawBorder;

var

  DC: HDC;  //設備描述表

  R: TRect; //客戶區

  EnterBrush,OuterBrush,BorderBrush:HBRUSH;  //畫筆句柄，API

begin

  DC:= GetWindowDC(Handle);  //取得該組件的設備描述表

  try

    GetWindowRect(Handle, R);  //取得該組件的客戶區尺寸

    OffsetRect(R, -R.Left, -R.Top); //左上偏移

    //創建畫筆，兩個，分別代碼邊框，邊框內，白色畫筆

    BorderBrush := CreateSolidBrush(ColorToRGB(FEdgeColor));

    EnterBrush:= CreateSolidBrush(ColorToRGB(FEnterColor));

    OuterBrush:=CreateSolidBrush(ColorToRGB(clWhite));

//not(csDesigning in ComponentState保證在設計期不變

    if (not(csDesigning in ComponentState)) and

    (MouseIn=true) then  //如果鼠標進入

    begin

      //畫一個矩形框，用BorderBrush畫筆

      FrameRect(DC, R, BorderBrush);

      //把R縮小一個象素

      InflateRect(R, -1, -1);

      //畫一個矩形框，用outerBrush畫筆

      FrameRect(DC, R, outerBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, EnterBrush);

    end

    else  //如果鼠標沒有進入

    begin

      FrameRect(DC, R, BorderBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, outerBrush);

      InflateRect(R, -1, -1);

      FrameRect(DC, R, outerBrush);

    end;

  finally

    ReleaseDC(Handle, DC);  //釋放設備描述表

  end;

  DeleteObject(BorderBrush);   //釋放畫筆

  DeleteObject(EnterBrush);

  DeleteObject(OuterBrush);

end;

end.

安裝上去試試吧，比Memo1好看多了，功能也強多了。是嗎。

上一篇：組件制作之五（托盤組件）

下一篇：組件制作之三（圖形控件)