Версия для печати темы

Автор: klem4 12.08.2007 23:43

Поискал по форуму, особо ничего не нашел, так что предлагайте свои варианты

Вот мой вариант, но есть пара нюансов. Первый связан с чтением текста из файла, есть 2 варианта, 1 - читать по строкам, суммировать длины строк, а потом вторым проходом по файлу опять же читать строками и присоединять к динамическому массиву (вариант подсказан volvo). Этот вариант быстрее, но из-за чтения строками проскакивают управляющие символы, что неприемлемо + строки в файле могут быть > 255 символов. Второй вариант - сначала читать посимвольно, вычисляя размерность массива, а потом опять же посимвольно читать и заносить в массив, попутно проверяя, является ли символ допустимым. 2-й вариант годится, но работает медленнее.

И вторая проблема - это мерцание из-за clrscr. Ну тут видимо надо просто алгоритм вывода другой придумать, чтобы не затирать постоянно экран (clreol дает тот же эффект)

управление: "-","+" - уменьшение/увеличение скорости "бега" строки
"c" - поменять цвет ))

ps текстовый файлик в аттаче.
pps комилятор BP 7.0 Так что для FPC например придется подкорректировать задержку и дельту изменения задержки, у меня по дефолту 25000 и 5000 соответвенно.

program _running_string;

uses crt;

type

  PTMESSAGE = ^TMESSAGE;
  TMESSAGE  = array [1..1] of char;
  INT       = word;
  LINT      = longint;

  TRUNSTR = object
    msg: PTMESSAGE;
    msg_len: INT;

    _delay: INT;
    color: byte;

    rows, cols: byte;

    constructor create(const file_name: string;
     const delay_time: INT; const _color: byte);

    destructor  free;
    procedure   run;

    procedure define_scrmode;

    { test procs }
    procedure msg_print;
    { test procs }
  end;



{ test procs }
procedure TRUNSTR.msg_print;
var
  i: INT;
begin
  clrscr;
  for i := 1 to msg_len do begin
    if i mod cols = 0 then writeln;
    write(msg^[i]);
  end;
end;
{ test procs }

procedure TRUNSTR.define_scrmode;

  function get_scrsize: INT;
  var
    r: byte absolute $0000:$0484;
    c: byte absolute $0000:$044A;
  begin
    if Hi ( LastMode ) = 1 then
      get_scrsize := succ( r ) * c * 2
    else
      get_scrsize := 25 * c * r;
  end;

  function get_col_count: INT;
  begin
    get_col_count := MEM[0:$44A];
  end;

  function get_row_count: INT;
  begin
    get_row_count := get_scrsize div get_col_count div 2;
  end;

begin
  rows := get_row_count;
  cols := get_col_count;
end;

constructor TRUNSTR.create(const file_name: string;
 const delay_time: INT; const _color: byte);
var
  f: text;
  temp: string;
  symbs: INT;
  ch: char;
begin
  define_scrmode;
  _delay := delay_time;
  color  := _color;

  textcolor(color);

  assign(f, file_name);
  reset(f);

  (* 1 variant *)
  msg_len := 0;

  while not(eof(f)) do begin
    read(f, ch);
    if byte(ch) in [32..125] then inc(msg_len);
  end;

  reset(f);

  getmem(msg, msg_len * sizeof(char));

  symbs := 0;

  while not(eof(f)) do begin
    read(f, ch);
    if byte(ch) in [32..125] then begin
      inc(symbs);
      msg^[symbs] := ch;
    end;
  end;

  {

  (* 2 variant *)

  reset(f);
  msg_len := 0;

  while not(eof(f)) do begin
    readln(f, temp);
    inc(msg_len, length(temp));
  end;

  getmem(msg, msg_len * sizeof(char));

  reset(f);

  symbs := 0;

  while not(eof(f)) do begin
    readln(f, temp);
    move(temp, msg^[symbs], sizeof(temp));
    inc(symbs, length(temp));
  end;
  }
  close(f);
end;

destructor TRUNSTR.free;
begin
  freemem(msg, msg_len * sizeof(char));
end;

procedure TRUNSTR.run;
var
  first, p: LINT;
  i: INT;
  ch: char;
begin
  first := cols;

  repeat

    if first = 1 then first := cols + msg_len
     else dec(first);

    if (first <= cols) and (first > 0) then begin
      gotoxy(first, rows div 2); write(msg^[1]);
    end;

    for i := 2 to msg_len do begin

       p := first + i - 1;

      if p > cols + msg_len then
       p := p - cols - msg_len;


      if (p <= cols) and (p > 0) then begin
        gotoxy(p, rows div 2); write(msg^[i]);
      end;

    end;

    if keypressed then begin
      ch := readkey;
      case ch of
        '-': if _delay + 5000 < 65500 then inc(_delay, 5000);
        '=': if _delay - 5000 > 0 then dec(_delay, 5000);
        'c','C': textcolor(1 + random(15));
      end;
    end;

    delay(_delay);
    clrscr;
  until ch = #27;
end;

var
  running_string: TRUNSTR;

begin
  running_string.create('runstr.txt', 25000, WHITE);
  running_string.run;
  running_string.free;
end.

Прикрепленные файлы
 runstr.txt ( 1015 байт ) Кол-во скачиваний: 309

Автор: мисс_граффити 12.08.2007 23:50

Ассемблерные вставки допустимы? (просто не знаю, для чего это пишется... просто из интереса?)

Автор: klem4 12.08.2007 23:57

В принципе можно, только что они дадут ? Мне думается сам алгоритм надо менять ...



ага)) давным давно хотел бегущую строку сделать, на море когда был, вспомнил про нее)

в принципе есть у меня еще одна идея, может завтра сделаю, выложу.

Автор: мисс_граффити 13.08.2007 0:40

просто подумала про использование видеопамяти.

Автор: klem4 13.08.2007 0:50

Так ее из без ассемблера можно напрямую юзать, в общем я уже кое-что придумал, если сделаю завтра покажу

Автор: volvo 13.08.2007 16:58

Немного изменяем метод TRunStr.Run, и избавляемся необходимости постоянной очистки экрана:

procedure TRUNSTR.run;
var
  first, p: LINT;
  i: INT;
  ch: char;
  s, init_s: string;
begin
  init_s := '';
  for i := 1 to cols do init_s := init_s + ' ';

  first := cols;

  repeat
    gotoxy(1, rows div 2);
    s := init_s;

    if first = 1 then first := cols + msg_len
     else dec(first);

    if (first <= cols) and (first > 0) then begin
      { gotoxy(first, rows div 2); write(msg^[1]); }
      s[first] := msg^[1];
    end;

    for i := 2 to msg_len do begin

       p := first + i - 1;

      if p > cols + msg_len then
       p := p - cols - msg_len;


      if (p <= cols) and (p > 0) then begin
        {gotoxy(p, rows div 2); write(msg^[i]);}
        s[p] := msg^[i];
      end;

    end;
    write(s);

    if keypressed then begin
      ch := readkey;
      case ch of
        '-': if _delay + 5000 < 65500 then inc(_delay, 5000);
        '=': if _delay - 5000 > 0 then dec(_delay, 5000);
        'c','C': textcolor(1 + random(15));
      end;
    end;

    delay(_delay);
    { clrscr; }
  until ch = #27;
end;