Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Ограничение длины и количества строк компонента TMemo

01.01.2007
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);
 
public
   
MaxCharsPerLine, 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 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;
 
end.
 

https://delphiworld.narod.ru/

DelphiWorld 6.0

 


procedure TForm1.Memo1Change(Sender: TObject);
 
const
   
MaxLineCount = 5;
 
begin
   
if Memo1.Lines.Count > MaxLineCount then
     
// undo the last change
   
// letze Дnderung rьckgдngig machen
    Memo1
.Perform(EM_UNDO, 0, 0);
   
// The EM_EMPTYUNDOBUFFER message clears the undo flag,
 
// which means that you can no longer undo your last change
 
// to the edit control.
 
// Die Message EM_EMPTYUNDOBUFFER lцscht das UnDo Flag,
 
// damit kann die letzte Дnderung nicht Rьckgдngig gemacht werden.
  Memo1
.Perform(EM_EMPTYUNDOBUFFER, 0, 0);
 
end;

Взято с сайта: https://www.swissdelphicenter.ch