unit Unit1; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,StdCtrls, ExtCtrls, Forms; type TForm1 = class(TForm)Memo1: TMemo;procedure FormCreate(Sender: TObject);procedure Memo1KeyPress(Sender: TObject; var Key: Char);publicMaxCharsPerLine, MaxLines: Integer;function MemoLine: Integer;function LineLen(r: Integer): Integer;function NRows: Integer;end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.NRows: Integer; begin with Memo1 doResult := 1 + SendMessage(Handle, EM_LINEFROMCHAR, GetTextLen-1, 0);end; function TForm1.LineLen(r: Integer): Integer; var r1, r2: Integer; begin with Memo1 do beginr1 := SendMessage(Handle, EM_LINEINDEX, r, 0);if (r > NRows-1) thenr2 := SendMessage(Handle, EM_LINEINDEX, r+1, 0)-2 {-CR/LF}elser2 := GetTextLen;end;Result := r2-r1;end; function TForm1.MemoLine: Integer; begin with Memo1 doResult := 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 begincase Key of' '..#255: if (LineLen(MemoLine) >= MaxCharsPerLine) thenKey := #0;#10, #13: if (NRows >= MaxLines) thenKey := #0;#8: if (SelStart = SendMessage(Handle, EM_LINEINDEX, MemoLine, 0)) thenKey := #0;end;end;end; end. |