Adding Characters one by one to TMemo

Question

Could any one tell me how can I add characters one by one from a text file to a Memo? The text file contains different paragraphs of texts. I want to add the characters of each paragraph one by one till the end of the paragraph. Then after 10 seconds delay the next paragraph to be shown in the Memo.

Thanks, Sei

Answer 1

You would probably use a TTimer. Drop a TTimer, a TMemo and a TButton on your form. Then do

var
  lines: TStringList;
  pos: TPoint;

const
  CHAR_INTERVAL = 75;
  PARAGRAPH_INTERVAL = 1000;

procedure TForm6.Button1Click(Sender: TObject);
const
  S_EMPTY_FILE = 'You are trying to display an empty file!';
begin
  Memo1.ReadOnly := true;
  Memo1.Clear;
  Memo1.Lines.Add('');
  pos := Point(0, 0);
  if lines.Count = 0 then
    raise Exception.Create(S_EMPTY_FILE);
  while (pos.Y < lines.Count) and (length(lines[pos.Y]) = 0) do inc(pos.Y);
  if pos.Y = lines.Count then
    raise Exception.Create(S_EMPTY_FILE);
  NextCharTimer.Enabled := true;
end;

procedure TForm6.FormCreate(Sender: TObject);
begin
  lines := TStringList.Create;
  lines.LoadFromFile('C:\Users\Andreas Rejbrand\Desktop\Test.txt');
end;

procedure TForm6.NextCharTimerTimer(Sender: TObject);
begin
  NextCharTimer.Interval := CHAR_INTERVAL;

  Memo1.Lines[Memo1.Lines.Count - 1] := Memo1.Lines[Memo1.Lines.Count - 1] + lines[pos.Y][pos.X + 1];
  inc(pos.X);

  if pos.X = length(lines[pos.Y]) then
  begin
    NextCharTimer.Interval := PARAGRAPH_INTERVAL;
    pos.X := 0;
    repeat
      inc(pos.Y);
      Memo1.Lines.Add('');
    until (pos.Y = lines.Count) or (length(lines[pos.Y]) > 0);
  end;

  if pos.Y = lines.Count then
    NextCharTimer.Enabled := false;
end;

Answer 2

A thread alternative to a timer. Tests a 'carriage return' in the file for a paragraph:

const
  UM_MEMOCHAR = WM_USER + 22;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure UMMemoChar(var Msg: TMessage); message UM_MEMOCHAR;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TCharSender = class(TThread)
  private
    FCharWait, FParWait: Integer;
    FFormHandle: HWND;
    FFS: TFileStream;
  protected
    procedure Execute; override;
  public
    constructor Create(FileName: string; CharWait, ParagraphWait: Integer;
        FormHandle: HWND);
    destructor Destroy; override;
  end;

constructor TCharSender.Create(FileName: string; CharWait, ParagraphWait: Integer;
    FormHandle: HWND);
begin
  FCharWait := CharWait;
  FParWait := ParagraphWait;
  FFormHandle := FormHandle;
  FFS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  FreeOnTerminate := True;
  inherited Create(False);
end;

destructor TCharSender.Destroy;
begin
  FFS.Free;
  inherited;
end;

procedure TCharSender.Execute;
var
  C: Char;
begin
  while (FFS.Position < FFS.Size) and not Terminated do begin
    FFS.Read(C, SizeOf(C));
    if (C <> #10) then
      PostMessage(FFormHandle, UM_MEMOCHAR, Ord(C), 0);

    if C = #13 then
      Sleep(FParWait)
    else
      Sleep(FCharWait);
  end;
end;

{TForm1}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  TCharSender.Create(
      ExtractFilePath(Application.ExeName) + 'text.txt', 20, 1000, Handle);
end;

procedure TForm1.UMMemoChar(var Msg: TMessage);
begin
  Memo1.SelStart := Memo1.Perform(WM_GETTEXTLENGTH, 0, 0);
  Memo1.Perform(WM_CHAR, Msg.WParam, 0);
end;

Answer 3

There's lots of ways to do this, and I'm not sure how you intend to handle newlines. However, all routes lead to TMemo.Lines which is a TStrings instance that wraps up the windows messages needed to interact with the underlying Windows edit control.

For example, these routines should get you started.

procedure AddNewLine(Memo: TMemo);
begin
  Memo.Lines.Add('');
end;

procedure AddCharacter(Memo: TMemo; const C: Char);
var
  Lines: TStrings;
begin
  Lines := Memo.Lines;
  if Lines.Count=0 then
    AddNewLine(Memo);
  Lines[Lines.Count-1] := Lines[Lines.Count-1]+C;
end;