时常想,如果一个组件能够按自己想要的外观显示,那该是件多么COOL的事啊,这一篇就要来做一个精美外观的组件,但是,做什么好呢.Button? 高手突破>有关于自己定义外观的Button,以及CheckBox等的做法,Button从CustomPanel继承,重载Paint方法来画外观.如果你有兴趣,可以去找来看,这里就不做Button了,做一个Memo如何呢.？是个不错的主意。
我们先起个名字叫做TCoolMemo。以上篇已经讲了很多组件的技术，这里就只说出几个重点。其余不多说了。
首先，该Memo从CustomMemo继承，它有这样外观：属于平面的，边框是可以设置颜色的线，对应的颜色变量为FEdgeColor，另外，离边框以内的两个象素处，还有另一个框，当鼠标进入Memo时，这个框会显示，当鼠标离开时，为个框消失，同样也可以设置颜色，对应变量为FEnterColor。
那么鼠标进入和离开怎么判断呢，这里Memo将截获两个Delphi的内部消息：
//下面两个获得Delphi的内部消息,鼠标进入和离开时发生
rocedure CMMouseEnter (var Me age: TMe age) me age CM_MOUSEENTER;
rocedure CMMouseLeave (var Me age: TMe age) me age CM_MOUSELEAVE;
其实父类已经截获了这两个消息，并作了相应处理，所以TCoolMemo中的消息处理函数要
Inherited;再作自己的处理。这里又用到了一个变量
MouseIn：Boolea //标识鼠标是否进入组件
接下来TCoolMemo还要截获两个消息：
procedure WMPaint (var Me age: TMe age) me age WM_PAINT;
procedure WMNCCalcSize (var Me age: TWMNCCalcSize) me age WM_NCCALCSIZE;
第一个很熟悉，当需要重画时，触发该消息，
第二个是当窗体需要计算位置和尺寸时触发，消息中包含了窗口客户区的大小，我们用这个的目的主要是将客户区缩小三个象素，以便画组件时不会画到客户区。
procedure TCoolMemo.WMNCCalcSize (var Me age: TWMNCCalcSize);
begin
inherited;
InflateRect(Me age.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 FMargi write etMargi default 0;
其中setMargin函数中发送了两个消息：
//该消息取得输入区的尺寸
SendMe age(Handle, EM_GETRECT, 0, Longint(@Rect));
//该消息设定输入区的大小
SendMe age(Handle, EM_SETRECT, 0, Longint(@Rect));
光标的位置：
property osition:TPositio read getPositio
TPostion是一个结构，其中有行和列两个值：
TPosition=record //指定光标的行和列
row:longint;
col:longint;
end;
getPositio 中还要处理中文的问题，代码有详细说明，如果文本中有中文，一样也可以得到正确的行和列。
最后增加了两个事件
property OnEnter;
property OnExit;
都是从父类中显化出来的，其实就是CM_MOUSEENTER和CM_MOUSELEAVE;消息引起的。，当你想作一个三态按钮，这两个事件很有作用。
好了，重点就是上面那几个了，以下是源代码，其中也有详细的说明：
unit CoolMemo;
interface
uses
Windows, Me ages, Cla es, Forms,Controls, Graphics, tdCtrl
type
//用设定边缘的空白
TPosition=record //指定光标的行和列
row:longint;
col:longint;
end;
TCoolMemo=cla (TCustomMemo)
rivate
FMargin:byte //边距的大小
FEdgeColor:TColor;//边框的颜色
FEnterColor:TColor;//鼠标进入时边框内侧的框颜色
MouseIn: oolea //标识鼠标是否进入
functio getPosition:TPositio //光标的行和列
rocedure etMargin(value:byte);
rocedure etEdgeColor(Value:TColor);
rocedure etEnterColor(Value:TColor);
//下面两个获得Delphi的内部消息,鼠标进入和离开时发生
rocedure CMMouseEnter (var Me age: TMe age) me age CM_MOUSEENTER;
rocedure CMMouseLeave (var Me age: TMe age) me age CM_MOUSELEAVE;
//当一个窗口的外观必须被画时,应用程序发送这个消息给该窗口
rocedure WMPaint (var Me age: TMe age) me age WM_PAINT;
//窗体需要计算位置和尺寸时触发
//我们用这个的目的主要是将客户区缩小三个象素，以便画组件时不会画到客户区。
rocedure WMNCCalcSize (var Me age: TWMNCCalcSize) me age WM_NCCALCSIZE;
rotected
//画窗体的边框,使其看起来更美观.
rocedure drawBorder;
ublic
co tructor Create (AOwner: TComponent) override;
roperty osition:TPositio read getPositio
roperty Margin:byte read FMargi write etMargi default 0;
ublished
roperty EdgeColor:TColor read FEdgeColor write etEdgeColor default $ff0000;
roperty EnterColor:TColor read FEnterColor write etEnterColor default $0000ff;
//显式化父类的属性
roperty Alig
roperty Alignment;
roperty DragCursor;
roperty DragMode;
roperty Enabled;
roperty Color;
roperty Font;
roperty Line
roperty MaxLength;
roperty OEMConvert;
roperty arentFont;
roperty arentShowHint;
roperty opupMenu;
roperty ReadOnly;
roperty howHint;
roperty crollBar
roperty TabOrder;
roperty Ta to
roperty Visible;
roperty WantRetur
roperty WantTa
roperty WordWra
roperty OnChange;
roperty OnClick;
roperty OnDblClick;
roperty OnDragDro
roperty OnDragOver;
roperty OnEndDrag;
//增加这两个事件，处理鼠标进入和离开
roperty OnEnter;
roperty OnExit;
roperty OnKeyDow
roperty OnKeyPre
roperty OnKeyU
roperty OnMouseDow
roperty OnMouseMove;
roperty OnMouseU
roperty O tartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TCoolMemo]);
end;
co tructor TCoolMemo.Create(AOwner:TComponent);
begin
inherited Create(Aowner);
ControlStyle := ControlStyle - [csFramed];
arentFont := True;
FEdgeColor := $ff0000;
FEnterColor := $0000ff;
//设定外观,平面无边形
Ctl3D := False;
FMargin:=0;
orderStyle:= one;
height:=150;
width:=200;
end;
procedure TCoolMemo.setMargin(Value:byte);
var
Rect: TRect;
begin
//该消息取得客户区的尺寸
endMe age(Handle, EM_GETRECT, 0, Longint(@Rect));
//以下是重新确定尺寸
Rect.To := Value;
Rect.Left := Value;
Rect.Right := Width -Value;
Rect.Bottom := Height -Value;
//该消息设定客户区的大小
endMe age(Handle, EM_SETRECT, 0, Longint(@Rect));
Fmargin:=value;
end;
functio TCoolMemo.getPosition:TPositio
var
row,Col:longint;
CBLines:longint;
tr:WideString;
begin
//该消息取得光标所在的行,
row:= endMe age(Handle,EM_LINEFROMCHAR,SelStart,0);
//该消息取得光标所在行开始的位置,位置从第一行的0开始计数,
//每过一个字符增加1,
CBLines:=SendMe age(Handle,EM_LINEINDEX,row,0);
//得到光标的所在行的所在列
Col:=SelStart-CBLine
//为了解决中文的问题,需要用宽字符型来取得光标所在行
//,行中光标所在列之前的字符串,这样可以解决中文列数的确定问题.
tr:=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< gt;value then
egin
FEdgeColor:=value;
drawBorder;
end;
end;
procedure TCoolMemo.setEnterColor(Value:TColor);
begin
if FEnterColor< gt;value then
egin
FEnterColor:=value;
drawBorder;
end;
end;
procedure TCoolMemo.CMMouseEnter(var Me age: TMe age);
begin
inherited;
MouseIn:= True;
drawBorder;
end;
procedure TCoolMemo.CMMouseLeave(var Me age:TMe age);
begin
inherited;
MouseIn:=False;
drawBorder;
end;
procedure TCoolMemo.WMPaint (var Me age: TMe age);
begin
inherited;
drawBorder;
end;
procedure TCoolMemo.WMNCCalcSize (var Me age: TWMNCCalcSize);
begin
inherited;
InflateRect(Me age.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) //左上偏移
//创建画笔，两个，分别代码边框，边框内，白色画笔
orderBrush := CreateSolidBrush(ColorToRGB(FEdgeColor));
EnterBrush:= CreateSolidBrush(ColorToRGB(FEnterColor));
OuterBrush:=CreateSolidBrush(ColorToRGB(clWhite));
//not(csDesigning i ComponentState保证在设计期不变
if (not(csDesigning i ComponentState)) and
(MouseIn=true) the //如果鼠标进入
egin
//画一个矩形框，用BorderBrush画笔
FrameRect(DC, R, orderBrush);
//把R缩小一个象素
InflateRect(R, -1, -1);
//画一个矩形框，用outerBrush画笔
FrameRect(DC, R, outerBrush);
InflateRect(R, -1, -1);
FrameRect(DC, R, EnterBrush);
end
else //如果鼠标没有进入
egin
FrameRect(DC, R, orderBrush);
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好看多了，功能也强多了。是吗。
