Adding Characters one by one to TMemo
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 o开发者_如何学Cne by one till the end of the paragraph. Then after 10 seconds delay the next paragraph to be shown in the Memo.
Thanks, Sei
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;
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;
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;
精彩评论