首页  编辑  

限制Memo的行数和行宽

Tags: /超级猛料/VCL/Memo&Edit&Richedit/Edit和Memo/   Date Created:

限制Memo的行数和行宽

type

 TForm1 = class(TForm)

   Memo1: TMemo;

   procedure FormCreate(Sender: TObject);

   procedure Memo1KeyPress(Sender: TObject; var Key: Char);

 public

   MaxCharsPerLine, MaxLines: Integer;

   function MemoLine: Integer;

   function LineLen(r: Integer): Integer;

   function NRows: Integer;

 end;

function TForm1.NRows: Integer;

begin

 with Memo1 do

   Result:=1+SendMessage(Handle,EM_LINEFROMCHAR,GetTextLen-1,0);

end;

function TForm1.LineLen(r: Integer): Integer;

var

 r1,r2:Integer;

begin

 with Memo1 do begin

   r1:=SendMessage(Handle,EM_LINEINDEX,r,0);

   if r<NRows-1 then

     r2:=SendMessage(Handle,EM_LINEINDEX,r+1,0)-2{-CR/LF}

   else

     r2:=GetTextLen;

 end;

 Result:=r2-r1;

end;

function TForm1.MemoLine: Integer;

begin

 with Memo1 do

   Result:=SendMessage(Handle,EM_LINEFROMCHAR,SelStart,0);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

 MaxCharsPerLine := 8;

 MaxLines := 4;

end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

 with Memo1 do

 begin

   case Key of

     ' '..#255: if LineLen(MemoLine)>=MaxCharsPerLine then

       Key:=#0;

     #10, #13: if NRows>=MaxLines then

       Key:=#0;

     #8: if SelStart=SendMessage(Handle,EM_LINEINDEX,MemoLine,0) then

       Key:=#0;

   end;

 end;

end;