Добавление персонажей один за другим в TMemo - PullRequest
Новая
       0

Добавление персонажей один за другим в TMemo

6 голосов
/ 16 апреля 2011

Может ли кто-нибудь сказать мне, как я могу добавить символы один за другим из текстового файла в заметку?Текстовый файл содержит разные абзацы текстов.Я хочу добавить символы каждого абзаца по одному до конца абзаца.Затем через 10 секунд задержите следующий абзац, который будет показан в заметке.

Спасибо, Сей

Ответы [ 3 ]

12 голосов
/ 16 апреля 2011

Возможно, вы бы использовали TTimer.Оставьте TTimer, TMemo и TButton в вашей форме.Тогда сделай 

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;

2 голосов
/ 17 апреля 2011

Поток альтернатива таймеру. Проверяет «возврат каретки» в файле для абзаца: 

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;
1 голос
/ 16 апреля 2011

Есть много способов сделать это, и я не уверен, как вы собираетесь обрабатывать переводы строк. Однако все маршруты приводят к TMemo.Lines, который является экземпляром TStrings, который оборачивает сообщения Windows, необходимые для взаимодействия с базовым элементом управления редактирования Windows.

Например, эти процедуры должны помочь вам начать работу. 

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