控件编写：增强 TMEMO （一）

     相信没有什么人对 MEMO 陌生了吧。尽管其组件的功能不错。但是，对它进行一些功能的改进，可以更好的使用。

     有的时候，我们想要知道，当前的坐标是什么？甚至，想要在 滚动条滚动时触发一些事件。 但，TMemo 本身并没有这样的功能。那我们就要扩展它；

     那我们现在就来作：

     file -> new -> other -> package

     在 dpk 窗口上， Add 。

     New component 如下图：

   
    

     完整的程序源代码如下：

1. unit JoeMemo;
2. 
   

2. interface
   
3. 
   
5. uses
6.   Windows,Classes, Controls, StdCtrls,Messages ;
8. type
9.   TJoeMemo = class(TMemo)
10.   private
11.     { Private declarations }
12.     FRow : LongInt;
13.     FCol : LongInt;
14.     FOnHScroll : TNotifyEvent;
15.     FOnVScroll : TNotifyEvent;
17.     procedure WMHScroll(var msg : TWMHScroll);message WM_HSCROLL;
18.     procedure WMVScroll(var msg : TWMVScroll);message WM_VSCROLL;
20.     procedure SetRow(value : LongInt);
21.     procedure SetCol(value : LongInt);
23.     function GetRow : LongInt;
24.     function GetCol : LongInt;
25.   protected
26.     { Protected declarations }
27.     procedure HScroll; dynamic;
28.     procedure VScroll; dynamic;
29.   public
30.     { Public declarations }
31.     property Row : LongInt read GetRow write SetRow;
32.     property Col : LongInt read GetCol write SetCol;
33.   published
34.     { Published declarations }
35.     property OnHScroll : TNotifyEvent read FOnHScroll write FOnHScroll;
36.     property OnVScroll : TNotifyEvent read FOnVScroll write FOnVScroll;
37.   end;
39. procedure Register;
41. implementation
43. procedure Register;
44. begin
45.   RegisterComponents('JoeTools', [TJoeMemo]);
46. end;
48. { TJoeMemo }
50. function TJoeMemo.GetCol: LongInt;
51. begin
52.   Result := Perform(EM_LINEINDEX,-1,0);
53. end;
55. function TJoeMemo.GetRow: LongInt;
56. begin
57.   Result := Perform(EM_LINEFROMCHAR,-1,0);
58. end;
60. procedure TJoeMemo.HScroll;
61. begin
62.   if Assigned(FOnHScroll) then FOnHScroll(Self);
64. end;
66. procedure TJoeMemo.SetCol(value: Integer);
67. begin
68.   if FCol > value  then FCol :=value;
69.   SelStart := Perform(EM_LINEINDEX,GetRow,0)+FCol;
71. end;
73. procedure TJoeMemo.SetRow(value: Integer);
74. begin
75.   SelStart := Perform(EM_LINEINDEX,value,0);
76.   FRow := SelStart;
77. end;
79. procedure TJoeMemo.VScroll;
80. begin
81.   if Assigned(FOnVScroll)  then FOnVScroll(Self);
82. end;
84. procedure TJoeMemo.WMHScroll(var msg: TWMHScroll);
85. begin
86.   inherited;
87.   HScroll;
88. end;
90. procedure TJoeMemo.WMVScroll(var msg: TWMVScroll);
91. begin
92.   inherited;
93.   VScroll;
94. end;
96. end.