Skip to main content
removeu 127 caracteres do conteúdo
Fonte Link
Tmc
  • 2,5mil
  • 3
  • 25
  • 46

Cara, eu nãoNão aconselho você a fazer isso, porque é uma bela duma gambiarra. Mas se você quiser dar uma olhada segue o código:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}


 

procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;

 

function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;

 

function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;

 

function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;

 

procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
    Timer1.Enabled := True;
 
end;

 

procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;

  X, Y: Integer;
  Coordinate: TPoint;
begin
  X := getCurrentColumn(AMemo);
  Y := getCurrentLine(AMemo);

  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

  Coordinate.X := X -1;
  Coordinate.Y := Y -1;

  AMemo.CaretPos := Coordinate;
 
end;

 

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
 
end;

  

function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + '-';
end;

end.

EditEdit1: Adicionado método MemoAdjustment.

Cara, eu não aconselho você a fazer isso, porque é uma bela duma gambiarra. Mas se você quiser dar uma olhada segue o código:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}


 

procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;

 

function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;

 

function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;

 

function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;

 

procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
    Timer1.Enabled := True;
 
end;

 

procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;

  X, Y: Integer;
  Coordinate: TPoint;
begin
  X := getCurrentColumn(AMemo);
  Y := getCurrentLine(AMemo);

  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

  Coordinate.X := X -1;
  Coordinate.Y := Y -1;

  AMemo.CaretPos := Coordinate;
 
end;

 

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
 
end;

 

function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + '-';
end;

end.

Edit: Adicionado método MemoAdjustment.

Não aconselho você a fazer isso, porque é uma bela duma gambiarra. Mas se você quiser dar uma olhada segue o código:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;

function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;

function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;

function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;

procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
    Timer1.Enabled := True;
end;

procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;

  X, Y: Integer;
  Coordinate: TPoint;
begin
  X := getCurrentColumn(AMemo);
  Y := getCurrentLine(AMemo);

  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

  Coordinate.X := X -1;
  Coordinate.Y := Y -1;

  AMemo.CaretPos := Coordinate;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
end; 

function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + '-';
end;

end.

Edit1: Adicionado método MemoAdjustment.

Ajustado para atender sugestões nos comentários
Fonte Link
Victor Tadashi
  • 1,1mil
  • 8
  • 20
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm} 




procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
  begin

    if (Length(Memo1.Lines[getCurrentLine(Memo1) - 1]) = (getCurrentColumn(Memo1) - 1)) then
      MemoAdjustment(Memo1)
    else
      Timer1.Enabled := True;

  end;

end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer; 

  X, Y: Integer;
  Coordinate: TPoint;
begin
  X := getCurrentColumn(AMemo);
  Y := getCurrentLine(AMemo);

  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

  Coordinate.X := X -1;
  Coordinate.Y := Y -1;

  AMemo.CaretPos := Coordinate;

end;



procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1); 

end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + ' -';
end;

end.

Edit2: Mudei um pouco a Lógica, e fiz alguns ajustes baseado nos testes o TMC

Edit3: Adicionado método para voltar o foco para a posição inicial no memo.

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
  begin

    if (Length(Memo1.Lines[getCurrentLine(Memo1) - 1]) = (getCurrentColumn(Memo1) - 1)) then
      MemoAdjustment(Memo1)
    else
      Timer1.Enabled := True;

  end;

end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;
begin
  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

end;



procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + ' ';
end;

end.

Edit2: Mudei um pouco a Lógica, e fiz alguns ajustes baseado nos testes o TMC

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Button1: TButton;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm} 




procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
    Timer1.Enabled := True;

end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer; 

  X, Y: Integer;
  Coordinate: TPoint;
begin
  X := getCurrentColumn(AMemo);
  Y := getCurrentLine(AMemo);

  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

  Coordinate.X := X -1;
  Coordinate.Y := Y -1;

  AMemo.CaretPos := Coordinate;

end;



procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1); 

end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + '-';
end;

end.

Edit2: Mudei um pouco a Lógica, e fiz alguns ajustes baseado nos testes o TMC

Edit3: Adicionado método para voltar o foco para a posição inicial no memo.

Mudança na logica para atender as sugestões
Fonte Link
Victor Tadashi
  • 1,1mil
  • 8
  • 20
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Button1Timer1: TButton;TTimer;
    procedure Memo1KeyPressMemo1KeyDown(Sender: TObject; var Key: CharWord; Shift: TShiftState);
    procedure Button1ClickTimer1Timer(Sender: TObject);

  private 

    CurrentKeyfunction getBiggestLine(AMemo: Word;
TMemo): Integer;
    function getBiggestLinegetCurrentLine(AMemo: TMemo): Integer;
    function getCurrentLinegetCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
 



procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
Varvar
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyPressMemo1KeyDown(Sender: TObject; var Key: CharWord;
  Shift: TShiftState);
begin
  if (Key = #13VK_RETURN) and (Memo1.Lines.Count > 0) then
  begin
    Key := #0;

    //if MemoAdjustment(Length(Memo1.Lines[getCurrentLine(Memo1); não sei- se1]) encaixa= legal(getCurrentColumn(Memo1) esse- méto1)) aquithen
    Memo1.Lines.Insert(getCurrentLine(Memo1), whiteSpaceCountToString(getBiggestLine MemoAdjustment(Memo1)));
    PostMessage(Memo1.Handle,else
 WM_KEYDOWN, VK_HOME, 0);   Timer1.Enabled := True;

  end; 

end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;
begin
  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

end;



procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + ' ';
end;

end.

Edit: Adicionado método MemoAdjustment.

Edit2: Mudei um pouco a Lógica, e fiz alguns ajustes baseado nos testes o TMC

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);

  private
    CurrentKey: Word;

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
 



procedure TForm2.Button1Click(Sender: TObject);
begin
  MemoAdjustment(Memo1);
end;



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
Var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #13) and (Memo1.Lines.Count > 0) then
  begin
    Key := #0;

    // MemoAdjustment(Memo1); não sei se encaixa legal esse méto aqui
    Memo1.Lines.Insert(getCurrentLine(Memo1), whiteSpaceCountToString(getBiggestLine(Memo1)));
    PostMessage(Memo1.Handle, WM_KEYDOWN, VK_HOME, 0);
  end;
end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;
begin
  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + ' ';
end;

end.

Edit: Adicionado método MemoAdjustment.

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);

  private 

    function getBiggestLine(AMemo: TMemo): Integer;
    function getCurrentLine(AMemo: TMemo): Integer;
    function getCurrentColumn(AMemo: TMemo): Integer;
    function whiteSpaceCountToString(ASpaces: Integer): String;

    procedure MemoAdjustment(var AMemo: TMemo);

  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}



function TForm2.getBiggestLine(AMemo: TMemo): Integer;
var
  i: Integer;
  iCurrentLinesCount: Integer;
  iBiggestLinesCount: Integer;
begin
  iBiggestLinesCount := 0;

  for i := 0 to AMemo.Lines.Count - 1 do
  begin
    iCurrentLinesCount := Length(AMemo.Lines[i]);
    if (iCurrentLinesCount > iBiggestLinesCount) then
    begin
      iBiggestLinesCount := iCurrentLinesCount;
      Result             := iBiggestLinesCount;
    end;
  end;
end;



function TForm2.getCurrentColumn(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.X + 1;
End;



function TForm2.getCurrentLine(AMemo: TMemo): Integer;
var
  Coordinate: TPoint;
Begin
  Coordinate := AMemo.CaretPos;
  Result     := Coordinate.Y + 1;
End;



procedure TForm2.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) and (Memo1.Lines.Count > 0) then
  begin

    if (Length(Memo1.Lines[getCurrentLine(Memo1) - 1]) = (getCurrentColumn(Memo1) - 1)) then
      MemoAdjustment(Memo1)
    else
      Timer1.Enabled := True;

  end; 

end;



procedure TForm2.MemoAdjustment(var AMemo: TMemo);
var
  i: Integer;
  whiteSpaceCount: Integer;
  whiteSpaceToAdd: Integer;
begin
  whiteSpaceCount := getBiggestLine(Memo1);
  for i           := 0 to AMemo.Lines.Count - 1 do
  begin
    whiteSpaceToAdd := whiteSpaceCount - Length(trim(AMemo.Lines[i]));
    AMemo.Lines[i]  := trim(AMemo.Lines[i]) + whiteSpaceCountToString(whiteSpaceToAdd);
  end;

end;



procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  MemoAdjustment(Memo1);
end;



function TForm2.whiteSpaceCountToString(ASpaces: Integer): String;
var
  i: Integer;
begin
  Result   := '';
  for i    := 1 to ASpaces do
    Result := Result + ' ';
end;

end.

Edit: Adicionado método MemoAdjustment.

Edit2: Mudei um pouco a Lógica, e fiz alguns ajustes baseado nos testes o TMC

Ajustado para atender sugestões nos comentários
Fonte Link
Victor Tadashi
  • 1,1mil
  • 8
  • 20
Carregando
removeu 50 caracteres do conteúdo
Fonte Link
Junior Moreira
  • 7mil
  • 4
  • 22
  • 50
Carregando
Fonte Link
Victor Tadashi
  • 1,1mil
  • 8
  • 20
Carregando