我们先起个名字叫做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;消息引起的。,当你想作一个三态按钮,这两个事件很有作用。

好了,重点就是上面那几个了,以下是源代码,其中也有详细的说明:

  1. unit CoolMemo;
  2.  
  3. interface
  4. uses
  5. Windows, Messages, Classes, Forms,Controls, Graphics, StdCtrls;
  6.  
  7. type
  8. //用设定边缘的空白
  9. TPosition=record //指定光标的行和列
  10. row:longint;
  11. col:longint;
  12. end;
  13.  
  14. TCoolMemo=class(TCustomMemo)
  15. private
  16. FMargin:byte; //边距的大小
  17. FEdgeColor:TColor;//边框的颜色
  18. FEnterColor:TColor;//鼠标进入时边框内侧的框颜色
  19. MouseIn: Boolean; //标识鼠标是否进入
  20.  
  21. function getPosition:TPosition;//光标的行和列
  22. procedure setMargin(value:byte);
  23. procedure setEdgeColor(Value:TColor);
  24. procedure setEnterColor(Value:TColor);
  25.  
  26. //下面两个获得Delphi的内部消息,鼠标进入和离开时发生
  27. procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
  28. procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
  29. //当一个窗口的外观必须被画时,应用程序发送这个消息给该窗口
  30. procedure WMPaint (var Message: TMessage); message WM_PAINT;
  31. //窗体需要计算位置和尺寸时触发
  32. //我们用这个的目的主要是将客户区缩小三个象素,以便画组件时不会画到客户区。
  33. procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  34.  
  35. protected
  36. //画窗体的边框,使其看起来更美观.
  37. procedure drawBorder;
  38.  
  39. public
  40. constructor Create (AOwner: TComponent); override;
  41. property Position:TPosition read getPosition;
  42. property Margin:byte read FMargin write setMargin default 0;
  43. published
  44. property EdgeColor:TColor read FEdgeColor write SetEdgeColor default $ff0000;
  45. property EnterColor:TColor read FEnterColor write SetEnterColor default $0000ff;
  46. //显式化父类的属性
  47. property Align;
  48. property Alignment;
  49. property DragCursor;
  50. property DragMode;
  51. property Enabled;
  52. property Color;
  53. property Font;
  54. property Lines;
  55. property MaxLength;
  56. property OEMConvert;
  57. property ParentFont;
  58. property ParentShowHint;
  59. property PopupMenu;
  60. property ReadOnly;
  61. property ShowHint;
  62. property ScrollBars;
  63. property TabOrder;
  64. property TabStop;
  65. property Visible;
  66. property WantReturns;
  67. property WantTabs;
  68. property WordWrap;
  69. property OnChange;
  70. property OnClick;
  71. property OnDblClick;
  72. property OnDragDrop;
  73. property OnDragOver;
  74. property OnEndDrag;
  75. //增加这两个事件,处理鼠标进入和离开
  76. property OnEnter;
  77. property OnExit;
  78. property OnKeyDown;
  79. property OnKeyPress;
  80. property OnKeyUp;
  81. property OnMouseDown;
  82. property OnMouseMove;
  83. property OnMouseUp;
  84. property OnStartDrag;
  85. end;
  86.  
  87. procedure Register;
  88.  
  89. implementation
  90.  
  91. procedure Register;
  92. begin
  93. RegisterComponents('Samples', [TCoolMemo]);
  94. end;
  95.  
  96. constructor TCoolMemo.Create(AOwner:TComponent);
  97. begin
  98. inherited Create(Aowner);
  99. ControlStyle := ControlStyle - [csFramed];
  100. ParentFont := True;
  101. FEdgeColor := $ff0000;
  102. FEnterColor := $0000ff;
  103. //设定外观,平面无边形
  104. Ctl3D := False;
  105. FMargin:=0;
  106. BorderStyle:=bsNone;
  107. height:=150;
  108. width:=200;
  109. end;
  110.  
  111. procedure TCoolMemo.setMargin(Value:byte);
  112. var
  113. Rect: TRect;
  114. begin
  115. //该消息取得客户区的尺寸
  116. SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect));
  117. //以下是重新确定尺寸
  118. Rect.Top := Value;
  119. Rect.Left := Value;
  120. Rect.Right := Width -Value;
  121. Rect.Bottom := Height -Value;
  122. //该消息设定客户区的大小
  123. SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect));
  124. Fmargin:=value;
  125. end;
  126.  
  127. function TCoolMemo.getPosition:TPosition;
  128. var
  129. row,Col:longint;
  130. CBLines:longint;
  131. str:WideString;
  132. begin
  133. //该消息取得光标所在的行,
  134. row:= SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);
  135. //该消息取得光标所在行开始的位置,位置从第一行的0开始计数,
  136. //每过一个字符增加1,
  137. CBLines:=SendMessage(Handle,EM_LINEINDEX,row,0);
  138. //得到光标的所在行的所在列
  139. Col:=SelStart-CBLines;
  140. //为了解决中文的问题,需要用宽字符型来取得光标所在行
  141. //,行中光标所在列之前的字符串,这样可以解决中文列数的确定问题.
  142. str:=Copy(Lines[row],1,col);
  143. col:=Length(Str)+1;
  144. result.row:=row+1;
  145. result.col:=col;
  146. end;
  147.  
  148. procedure TCoolMemo.setEdgeColor(Value:TCOlor);
  149. begin
  150. if FEdgeColor<>value then
  151. begin
  152. FEdgeColor:=value;
  153. drawBorder;
  154. end;
  155. end;
  156.  
  157. procedure TCoolMemo.setEnterColor(Value:TColor);
  158. begin
  159. if FEnterColor<>value then
  160. begin
  161. FEnterColor:=value;
  162. drawBorder;
  163. end;
  164. end;
  165.  
  166. procedure TCoolMemo.CMMouseEnter(var Message: TMessage);
  167. begin
  168. inherited;
  169. MouseIn:= True;
  170. drawBorder;
  171. end;
  172.  
  173. procedure TCoolMemo.CMMouseLeave(var Message:TMessage);
  174. begin
  175. inherited;
  176. MouseIn:=False;
  177. drawBorder;
  178. end;
  179.  
  180. procedure TCoolMemo.WMPaint (var Message: TMessage);
  181. begin
  182. inherited;
  183. drawBorder;
  184. end;
  185.  
  186. procedure TCoolMemo.WMNCCalcSize (var Message: TWMNCCalcSize);
  187. begin
  188. inherited;
  189. InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
  190. end;
  191.  
  192. procedure TCoolMemo.drawBorder;
  193. var
  194. DC: HDC; //设备描述表
  195. R: TRect; //客户区
  196. EnterBrush,OuterBrush,BorderBrush:HBRUSH; //画笔句柄,API
  197. begin
  198. DC:= GetWindowDC(Handle); //取得该组件的设备描述表
  199. try
  200. GetWindowRect(Handle, R); //取得该组件的客户区尺寸
  201. OffsetRect(R, -R.Left, -R.Top); //左上偏移
  202. //创建画笔,两个,分别代码边框,边框内,白色画笔
  203. BorderBrush := CreateSolidBrush(ColorToRGB(FEdgeColor));
  204. EnterBrush:= CreateSolidBrush(ColorToRGB(FEnterColor));
  205. OuterBrush:=CreateSolidBrush(ColorToRGB(clWhite));
  206. //not(csDesigning in ComponentState保证在设计期不变
  207. if (not(csDesigning in ComponentState)) and
  208. (MouseIn=true) then //如果鼠标进入
  209. begin
  210. //画一个矩形框,用BorderBrush画笔
  211. FrameRect(DC, R, BorderBrush);
  212. //把R缩小一个象素
  213. InflateRect(R, -1, -1);
  214. //画一个矩形框,用outerBrush画笔
  215. FrameRect(DC, R, outerBrush);
  216. InflateRect(R, -1, -1);
  217. FrameRect(DC, R, EnterBrush);
  218. end
  219. else //如果鼠标没有进入
  220. begin
  221. FrameRect(DC, R, BorderBrush);
  222. InflateRect(R, -1, -1);
  223. FrameRect(DC, R, outerBrush);
  224. InflateRect(R, -1, -1);
  225. FrameRect(DC, R, outerBrush);
  226. end;
  227. finally
  228. ReleaseDC(Handle, DC); //释放设备描述表
  229. end;
  230. DeleteObject(BorderBrush); //释放画笔
  231. DeleteObject(EnterBrush);
  232. DeleteObject(OuterBrush);
  233. end;
  234.  
  235. end.

参考:
http://blog.csdn.net/iseekcode/article/details/4698412
http://www.delphixe.net/thread-5339-1-1.html

TCoolMemo的更多相关文章

随机推荐

  1. Webserver issues | PHP manager for IIS

    4 down vote accepted In order to successfully install the PHP manager for IIS 8, you need the .NET 3 ...

  2. MediaRecorder类介绍

    audiocallbackvideojavadescriptorencoding 目录(?)[+] 找到个MediaRecorder类介绍和大家分享一下. Mediarecorder类在官网的介绍和在 ...

  3. 利用ajax在javascript中获取后台的值

    <script type="text/javascript"> function login() { var sa = WebForm1.Hello().value; ...

  4. springMVC之事务配置(问题来源:为什么数据保存不了)

    参考文章:http://www.cnblogs.com/leiOOlei/p/3725911.html 自己的亲身体会,来源问题this.sessionFactory.getCurrentSessio ...

  5. Oracle 的证也会过期咯

    How does this recertification requirement affect me? If your Database Certification credential is re ...

  6. 【F#】核心数据多线程处理的首选

    http://www.cnblogs.com/zilin-xiao/archive/2011/08/26/2155124.html

  7. matlab实现的嵌套乘法、高精度、二分法

    嵌套乘法的计算: \[ P(x) = 1 - x + x^2 - x^3 + ...+ x ^ {98} - x^{99} \] function y = nest( d, c, x, b ) if ...

  8. .Xresources 配置文件

    安装rxvt-unicode-256color,如果不是这个版本的话VIM配色会显示不正常. ~/.Xresources配置文件如下 !urxvt color scheme: URxvt*backgr ...

  9. 7zip 命令行

    转自 http://www.cnblogs.com/langlang/archive/2010/12/01/1893866.html 7z.exe 是 7-Zip 的命令行版本.7z.exe 使用 7 ...

  10. matlab查找回车字符

    Hi all, I would like to read the data all at once with: `file_text = fread(fid, inf, 'uint8=>char ...