Doubt with cursor in memo

Question

In my project VCL, I have a TMemo with the following text(| is cursor):

|                   |
|Hello world |      |
|                   |
|test               |
|                   |
|                   |

When I press on Down button, the cursor moves here:

|                   |
|Hello world        |
||                  |
|test               |
|                   |
|                   |

What I need is for him to move in here:

|                   |
|Hello world        |
|            |      |
|test               |
|                   |
|                   |

My goal would be memo become the same as the editor of delphi by pressing the down key and it goes to the row below but in the same column. Is there any way to do it other than through the event onKeyDown of memo?

Answer 1

I wouldn’t advise you to do that, 'cause you’re one hell of a tramp. But if you want to take a look follow the code:

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.

Another time I’ll give him an upgrade, but for now that’s it. Any questions ask.

PS.: To work properly, you need to change the source of the TMemo for a font where all characters are the same size. Ex: "Lucida Console".

Edit1: Added Memoadjustment method.

Edit2: I changed the logic a little bit, and I made some adjustments based on the TMC tests

Edit3: Added method to refocus to the initial position in memo.

Answer 2

With the help of @Victorzanella and his response I developed the Project is not yet 100%, but already does what I wanted, when I finish I update:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    function GetCurrentLine(AMemo: TMemo): Integer;
    function whiteSpaceCount(ASpaces: Integer): String;
    function GetMaxCharacter(AMemo: TMemo): Integer;
    procedure CleanWhiteSpace(var AMemo: TMemo);
    procedure CreateWhiteSpace(var AMemo: TMemo);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

function TForm1.GetMaxCharacter(AMemo: TMemo): Integer;
Var MaxChar: Integer;
Begin
  MaxChar := (AMemo.Width div 7) - 1; //feito para font_name := "courier new"; size := "8"

  Result := MaxChar;
End;

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

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
var ILine, WSCount, WSAdd: Integer;
begin
  CleanWhiteSpace(Memo1); 

  if Key = #13 then 
    Begin
      ILine := GetCurrentLine(Memo1) - 1;

      WSCount := GetMaxCharacter(Memo1);
      WSAdd := WSCount - Length(Memo1.Lines[ILine]);

      Memo1.Lines[ILine] := Memo1.Lines[ILine] + WhiteSpaceCount(WSAdd);
    End; 
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  CreateWhiteSpace(Memo1);
end;

procedure TForm1.CreateWhiteSpace(AMemo: TMemo);
var ILine, ILine2, PColuna, WSAdd, WSCount: Integer;
Begin
  ILine2 := GetCurrentLine(AMemo);
  PColuna := Amemo.SelStart - Perform(EM_LINEINDEX, ILine2, 0);
    ILine := GetCurrentLine(AMemo) - 1;

    WSCount := GetMaxCharacter(AMemo);
    WSAdd := WSCount - Length(AMemo.Lines[ILine]);

    AMemo.Lines[ILine] := AMemo.Lines[ILine] + WhiteSpaceCount(WSAdd);
  Amemo.SelStart := Perform(EM_LINEINDEX, ILine2, 0) + PColuna;
End;

procedure TForm1.CleanWhiteSpace(var AMemo: TMemo);
var ILine, PColuna: Integer;
    SLine, CLine: String;
begin
  ILine := GetCurrentLine(AMemo);

  SLine := AMemo.Lines.Strings[ILine - 1];
  SLine := Copy(SLine, GetMaxCharacter(AMemo)-2, 2);

  if SLine = '  ' then
    Begin
      PColuna := AMemo.SelStart - Perform(EM_LINEINDEX, ILine, 0);

        CLine := AMemo.lines[ILine - 1];
        CLine := copy(CLine, 1, Length(CLine) - 1);
        AMemo.lines[ILine - 1] := CLine;

      AMemo.SelStart := Perform(EM_LINEINDEX, ILine, 0) + PColuna;
    End;
end;

UPDATE 1

Key correction enter, before he jumped lines or did not advance.