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