首页 > 代码库 > TCoolMemo
TCoolMemo
我们先起个名字叫做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;interfaceuses 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 onm ouseDown; property onm ouseMove; property onm ouseUp; property OnStartDrag; end; procedure Register;implementationprocedure 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; //画笔句柄，APIbegin 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.
参考：
http://blog.csdn.net/iseekcode/article/details/4698412
http://www.delphixe.net/thread-5339-1-1.html
TCoolMemo