程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 組件制作之四(定制外觀)

組件制作之四(定制外觀)

編輯:Delphi
時常想,如果一個組件能夠按自己想要的外觀顯示,那該是件多麼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好看多了,功能也強多了。是嗎。
 
  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved