开发者

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;

Adding Characters one by one to TMemo


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;
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜