時常想,如果一個組件能夠按自己想要的外觀顯示,那該是件多麼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好看多了,功能也強多了。是嗎。