首页 > 其他 > 详细

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

时间:2016-04-17 07:56:07      阅读:193      评论:0      收藏:0      [点我收藏+]

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

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

     那我们现在就来作:

     file -> new -> other -> package 

     在 dpk 窗口上, Add 。

     New component 如下图:

    技术分享技术分享
     

     完整的程序源代码如下:

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

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

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

原文:http://www.cnblogs.com/findumars/p/5400235.html

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!