相信没有什么人对 MEMO 陌生了吧。尽管其组件的功能不错。但是,对它进行一些功能的改进,可以更好的使用。
有的时候,我们想要知道,当前的坐标是什么?甚至,想要在 滚动条滚动时触发一些事件。 但,TMemo 本身并没有这样的功能。那我们就要扩展它;
那我们现在就来作:
file -> new -> other -> package
在 dpk 窗口上, Add 。
New component 如下图:
完整的程序源代码如下:
- unit JoeMemo;
- interface
- uses
- Windows,Classes, Controls, StdCtrls,Messages ;
- type
- TJoeMemo = class(TMemo)
- private
- { Private declarations }
- FRow : LongInt;
- FCol : LongInt;
- FOnHScroll : TNotifyEvent;
- FOnVScroll : TNotifyEvent;
- procedure WMHScroll(var msg : TWMHScroll);message WM_HSCROLL;
- procedure WMVScroll(var msg : TWMVScroll);message WM_VSCROLL;
- procedure SetRow(value : LongInt);
- procedure SetCol(value : LongInt);
- function GetRow : LongInt;
- function GetCol : LongInt;
- protected
- { Protected declarations }
- procedure HScroll; dynamic;
- procedure VScroll; dynamic;
- public
- { Public declarations }
- property Row : LongInt read GetRow write SetRow;
- property Col : LongInt read GetCol write SetCol;
- published
- { Published declarations }
- property OnHScroll : TNotifyEvent read FOnHScroll write FOnHScroll;
- property OnVScroll : TNotifyEvent read FOnVScroll write FOnVScroll;
- end;
- procedure Register;
- implementation
- procedure Register;
- begin
- RegisterComponents(‘JoeTools‘, [TJoeMemo]);
- end;
- { TJoeMemo }
- function TJoeMemo.GetCol: LongInt;
- begin
- Result := Perform(EM_LINEINDEX,-1,0);
- end;
- function TJoeMemo.GetRow: LongInt;
- begin
- Result := Perform(EM_LINEFROMCHAR,-1,0);
- end;
- procedure TJoeMemo.HScroll;
- begin
- if Assigned(FOnHScroll) then FOnHScroll(Self);
- end;
- procedure TJoeMemo.SetCol(value: Integer);
- begin
- if FCol > value then FCol :=value;
- SelStart := Perform(EM_LINEINDEX,GetRow,0)+FCol;
- end;
- procedure TJoeMemo.SetRow(value: Integer);
- begin
- SelStart := Perform(EM_LINEINDEX,value,0);
- FRow := SelStart;
- end;
- procedure TJoeMemo.VScroll;
- begin
- if Assigned(FOnVScroll) then FOnVScroll(Self);
- end;
- procedure TJoeMemo.WMHScroll(var msg: TWMHScroll);
- begin
- inherited;
- HScroll;
- end;
- procedure TJoeMemo.WMVScroll(var msg: TWMVScroll);
- begin
- inherited;
- VScroll;
- end;
- end.
http://blog.csdn.net/aroc_lo/article/details/3075814
时间: 2024-11-05 11:39:07