exmemo.~pas

来自「DBGrid Delphi控件,除了愿有的功能,还上增加了一些东西,值得一看」· ~PAS 代码 · 共 96 行

unit ExMemo;

interface

uses
  Windows,SysUtils, Classes, QControls, QStdCtrls,Messages,StdCtrls;

type
  TddgExtendedMemo = class(TMemo)
  private
    { Private declarations }
    FRow:LongInt;
    FColumn: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 SetColumn(Value:LongInt);
    function GetRow:LongInt ;
    function GetColumn:LongInt ;
  protected
    { Protected declarations }
    procedure HScroll;dynamic;
    procedure VScroll;dynamic;
  public
    { Public declarations }
    property Row:LongInt read GetRow write SetRow;
    property Column:LongInt read GetColumn write SetColumn;
  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('Samples', [TddgExtendedMemo]);
end;

{ TddgExtendedMemo }

function TddgExtendedMemo.GetColumn: LongInt;
begin
  Result := SelStart - Perform(EM_LINEINDEX,-1,0);
end;

function TddgExtendedMemo.GetRow: LongInt;
begin
  Result := Perform(EM_LINEFROMCHAR,-1,0);
end;

procedure TddgExtendedMemo.HScroll;
begin
  if Assigned(FOnHScroll) then
    FOnHScroll(Self);
end;

procedure TddgExtendedMemo.SetColumn(Value: Integer);
begin
  FColumn := Perform(EM_LINELENGTH,Perform(EM_LINEINDEX,GetRow,0);
  if FColumn > Value then
    FColumn := Value;
  SelStart := Perform(EM_LINEINDEX,GetRow,0)+FColumn;
end;

procedure TddgExtendedMemo.SetRow(Value: Integer);
begin
  SelStart := Perform(EM_LINEINDEX,Value,0);
  FRow := SelStart;
end;

procedure TddgExtendedMemo.VScroll;
begin
  if Assigned(FOnVScroll) then
    FOnVScroll(Self);
end;

procedure TddgExtendedMemo.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  HScroll;
end;

procedure TddgExtendedMemo.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  VScroll;
end;

end.