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

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.

Outra hora vou dar uma melhorada nele, mas por hora é isso. Qualquer duvida pergunte.

PS.: Para funcionar corretamente, é necessário mudar a fonte do TMemo para uma fonte onde todos os caracteres tenham o mesmo tamanho. Ex: "Lucida Console".

Edit1: Adicionado método MemoAdjustment.

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.

Victor Tadashi
  • 1,1mil
  • 8
  • 20