Agregar caracteres uno a uno a TMemo

Question

¿Alguien podría decirme cómo puedo agregar caracteres uno por uno desde un archivo de texto a un Memo? El archivo de texto contiene diferentes párrafos de textos. Quiero agregar los caracteres de cada párrafo uno por uno hasta el final del párrafo. Luego, después de 10 segundos, demore el próximo párrafo que se mostrará en la nota.

Gracias, Sei

Answer 1

Probablemente usaría un TTimer. Coloque un TTimer, un TMemo y un TButton en su formulario. A continuación, hacer

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; 

Animated sample image http://privat.rejbrand.se/autotype.gif

Answer 2

Hay un montón de maneras de hacer esto, y no estoy seguro de cómo se va a manejar los saltos de línea. Sin embargo, todas las rutas conducen a TMemo.Lines que es una instancia TStrings que envuelve los mensajes de Windows necesarios para interactuar con el control de edición subyacente de Windows.

Por ejemplo, estas rutinas deben comenzar.

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; 

Answer 3

Una alternativa hilo a un temporizador. Prueba un 'retorno de carro' en el archivo de un párrafo:

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;