控件编写:增强 TMEMO (一)(增加对WM_HSCROLL消息的处理)

时间:2021-10-08 23:13:01

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

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

那我们现在就来作:

file -> new -> other -> package

在 dpk 窗口上, Add 。

New component 如下图:

控件编写:增强 TMEMO (一)(增加对WM_HSCROLL消息的处理)控件编写:增强 TMEMO (一)(增加对WM_HSCROLL消息的处理)

完整的程序源代码如下:

  1. unit JoeMemo;
    1. interface
    2. uses
    3. Windows,Classes, Controls, StdCtrls,Messages ;
    4. type
    5. TJoeMemo = class(TMemo)
    6. private
    7. { Private declarations }
    8. FRow : LongInt;
    9. FCol : LongInt;
    10. FOnHScroll : TNotifyEvent;
    11. FOnVScroll : TNotifyEvent;
    12. procedure WMHScroll(var msg : TWMHScroll);message WM_HSCROLL;
    13. procedure WMVScroll(var msg : TWMVScroll);message WM_VSCROLL;
    14. procedure SetRow(value : LongInt);
    15. procedure SetCol(value : LongInt);
    16. function GetRow : LongInt;
    17. function GetCol : LongInt;
    18. protected
    19. { Protected declarations }
    20. procedure HScroll; dynamic;
    21. procedure VScroll; dynamic;
    22. public
    23. { Public declarations }
    24. property Row : LongInt read GetRow write SetRow;
    25. property Col : LongInt read GetCol write SetCol;
    26. published
    27. { Published declarations }
    28. property OnHScroll : TNotifyEvent read FOnHScroll write FOnHScroll;
    29. property OnVScroll : TNotifyEvent read FOnVScroll write FOnVScroll;
    30. end;
    31. procedure Register;
    32. implementation
    33. procedure Register;
    34. begin
    35. RegisterComponents('JoeTools', [TJoeMemo]);
    36. end;
    37. { TJoeMemo }
    38. function TJoeMemo.GetCol: LongInt;
    39. begin
    40. Result := Perform(EM_LINEINDEX,-1,0);
    41. end;
    42. function TJoeMemo.GetRow: LongInt;
    43. begin
    44. Result := Perform(EM_LINEFROMCHAR,-1,0);
    45. end;
    46. procedure TJoeMemo.HScroll;
    47. begin
    48. if Assigned(FOnHScroll) then FOnHScroll(Self);
    49. end;
    50. procedure TJoeMemo.SetCol(value: Integer);
    51. begin
    52. if FCol > value  then FCol :=value;
    53. SelStart := Perform(EM_LINEINDEX,GetRow,0)+FCol;
    54. end;
    55. procedure TJoeMemo.SetRow(value: Integer);
    56. begin
    57. SelStart := Perform(EM_LINEINDEX,value,0);
    58. FRow := SelStart;
    59. end;
    60. procedure TJoeMemo.VScroll;
    61. begin
    62. if Assigned(FOnVScroll)  then FOnVScroll(Self);
    63. end;
    64. procedure TJoeMemo.WMHScroll(var msg: TWMHScroll);
    65. begin
    66. inherited;
    67. HScroll;
    68. end;
    69. procedure TJoeMemo.WMVScroll(var msg: TWMVScroll);
    70. begin
    71. inherited;
    72. VScroll;
    73. end;
    74. end.

http://blog.csdn.net/aroc_lo/article/details/3075814