Бегущая строка Опции

[klem4]

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

Вот мой вариант, но есть пара нюансов. Первый связан с чтением текста из файла, есть 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.

[мисс_граффити]

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

[klem4]

Ассемблерные вставки допустимы?

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

(просто не знаю, для чего это пишется... просто из интереса?)

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

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

Сообщение отредактировано: klem4 - 12.08.2007 20:40

[мисс_граффити]

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

[klem4]

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

[volvo]

Немного изменяем метод 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;