Изобразить текстовое окно на экране, в котором содержится информация о текущем фоне окна и фона экрана и текущем цвете текста в окне.Окно двигается по экрану с постоянной скоростью слева направо паралельно горизонтальной оси. При нажатии клавиши ENTER меняется меняется текущий цвет фона экрана и текущий цвет текста в окне. Получилось только вот -( Не знаю как реализовать смену цвета и вывести его. Помогите...)
Код
uses crt,graph; var gd,gm,x,y:integer; c:char;
procedure set_font(x,y:integer); begin setlinestyle(0,0,3); rectangle(x-20,y-18,x+280,y+24); outtextxy(x,y,TEST:'); outtextxy(x,y,BKCOLOR:'); end;
Procedure SetColor;
end;
begin gd:=detect; initgraph(gd,gm,'c:\bgi');
x:=getmaxx div 2-136; y:=getmaxy div 2; set_font(x,y); while c<>#27 do begin if keypressed then c:=readkey; if c=#13 then setcolor;
end; closegraph; end.
Lapp
16.05.2009 1:19
Цитата(D1ma @ 15.05.2009 19:05)
Получилось только вот -
Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п. Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..
D1ma
16.05.2009 21:45
Цитата(Lapp @ 15.05.2009 22:19)
Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п. Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..
Куда мне до Вас...
Lapp
17.05.2009 0:37
Цитата(D1ma @ 16.05.2009 18:45)
Куда мне до Вас...
Ну при чем тут это? Ты хотя бы закрой незакрытые строки сам. По сути программы поможем.
D1ma
17.05.2009 18:56
Удалось сделать: -текстовое окно с текстом -при нажатии 'ENTER' меняется цвет текста -На след. строке выводится цвет текста -при нажатии 'ESC' выход
uses crt,graph;
var gd,gm,x,y:integer;
c:char;
n:integer;
procedure set_font(x,y:integer);
begin
setlinestyle(0,0,3);
rectangle(x-20,y-18,x+280,y+24);
end;
Procedure CaseColor(C:char;n:integer);
begin
randomize;
n:=random(5);
Case n of0:outtextxy(x-10,y+13,'COLOR TEXT:BLACK');
1:outtextxy(x-10,y+13,'COLOR TEXT:BLUE');
2:outtextxy(x-10,y+13,'COLOR TEXT:GREEN');
3:outtextxy(x-10,y+13,'COLOR TEXT:GYAN');
4:outtextxy(x-10,y+13,'COLOR TEXT:RED');
5:outtextxy(x-10,y+13,'COLOR TEXT:MAGENTA');
end;
setcolor(n);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
end;
begin
gd:=detect;
initgraph(gd,gm,'c:\bgi');
x:=getmaxx div2-136; y:=getmaxy div2;
set_font(x,y);
while c<>#27dobeginif keypressed then c:=readkey;
case c of#13 : BEGIN
casecolor(c,n);
c:='0';
end;
end;
end;
closegraph;
end.
Только вот при смене цвета, информация о нем накладывается на предыдущий, пробывал так стереть предыдущую запись
moveto(x-10,y+13);clreol
не получилось Подскажите, как правильно p.s. Как можно реализовать движение окна слева направа по горизонтальной оси с постоянной скорость? наверна с помощью цикла?))
volvo
18.05.2009 0:15
Цитата
пробывал так стереть предыдущую запись
Нет, так нельзя, ты перемешиваешь графический и текстовый режимы, ClrEOL доступно только в текстовом. Попробуй рисовать прямоугольник цвета фона, и закрывать им все, что было в окне раньше. Или устанавливать ViewPort, и чистить его через ClearViewport. Первый вариант делается так:
Procedure CaseColor(C:char;n:integer);
const
colors: array[0 .. 5] ofstring = (
'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
);
begin
setfillstyle(solidfill, getbkcolor);
bar(x-17, y-15, x+277, y+21);
n:=random(5);
Case n of0 .. 5:
outtextxy(x-10,y+13,'COLOR TEXT:'+colors[n]);
end;
setcolor(n);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
end;
Randomize я убрал отсюда, ее лучше вызывать один раз, при старте программы
Цитата
Как можно реализовать движение окна слева направа по горизонтальной оси с постоянной скорость? наверна с помощью цикла?))
Да, в цикле меняй значение X, и перерисовывай не только строки внутри окна, но и его бордюр (set_font) тоже...
D1ma
18.05.2009 19:50
Как я понял, надо сделать так:
Код
........ a:=1; repeat x:=x+a; {двигаем по оси x} set_font(x,y);{Сама фигура} ....... delay(100); until Keypressed;
Но что-то не работает... Видно не правильно понял, напишите, пожалуйста как надо -) , скоро сдавать
volvo
18.05.2009 23:47
Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...
D1ma
18.05.2009 23:52
Цитата(volvo @ 18.05.2009 20:47)
Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...
Именно так...
volvo
19.05.2009 0:06
uses crt, graph;
procedure set_font(x,y:integer);
var color: integer;
begin
color := getcolor;
setcolor(white);
setlinestyle(0,0,3);
rectangle(x-20,y-18,x+280,y+24);
setcolor(color);
end;
var
x, y: integer;
Procedure CaseColor(change: boolean; var n:integer);
const
prev_n: integer = 0;
colors: array[0 .. 5] ofstring = (
'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
);
begin
setfillstyle(solidfill, getbkcolor);
bar(x-17, y-15, x+277, y+21);
if change thenbegin
n := random(6);
Case n of0 .. 5:
outtextxy(x-10,y+13,'COLOR TEXT:'+colors[n]);
end;
prev_n := n;
setcolor(n);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
endelsebegin
outtextxy(x-10,y+13,'COLOR TEXT:'+colors[prev_n]);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
end;
end;
var
gd, gm: integer;
c: char;
n: integer;
begin
randomize;
gd := detect;
initgraph(gd,gm,'');
x := 25;
y := getmaxy div2;
c := #0;
repeat
set_font(x,y);
casecolor(false, n);
if keypressed then c := readkey;
case c of#13 :
begin
casecolor(true, n);
c:=#0;
end;
end;
delay(40);
setfillstyle(solidfill, getbkcolor);
bar(x-21,y-19,x+281,y+25);
inc(x);
until (x + 280 > getmaxx) or (c = #27);
closegraph;
end.
Если непонятно - говори, где. Я добавлю комментарии.
D1ma
19.05.2009 0:23
Цитата(volvo @ 18.05.2009 21:06)
uses crt, graph;
procedure set_font(x,y:integer);
var color: integer;
begin
color := getcolor;
setcolor(white);
setlinestyle(0,0,3);
rectangle(x-20,y-18,x+280,y+24);
setcolor(color);
end;
var
x, y: integer;
Procedure CaseColor(change: boolean; var n:integer);
const
prev_n: integer = 0;
colors: array[0 .. 5] ofstring = (
'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
);
begin
setfillstyle(solidfill, getbkcolor);
bar(x-17, y-15, x+277, y+21);
if change thenbegin
n := random(6);
Case n of0 .. 5:
outtextxy(x-10,y+13,'COLOR TEXT:'+colors[n]);
end;
prev_n := n;
setcolor(n);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
endelsebegin
outtextxy(x-10,y+13,'COLOR TEXT:'+colors[prev_n]);
outtextxy(x-10,y-12,' TEXT IN WINDOW ');
end;
end;
var
gd, gm: integer;
c: char;
n: integer;
begin
randomize;
gd := detect;
initgraph(gd,gm,'');
x := 25;
y := getmaxy div2;
c := #0;
repeat
set_font(x,y);
casecolor(false, n);
if keypressed then c := readkey;
case c of#13 :
begin
casecolor(true, n);
c:=#0;
end;
end;
delay(40);
setfillstyle(solidfill, getbkcolor);
bar(x-21,y-19,x+281,y+25);
inc(x);
until (x + 280 > getmaxx) or (c = #27);
closegraph;
end.
Если непонятно - говори, где. Я добавлю комментарии.
Спасибо за помощь, но что-то у меня токо черный экран и при нажатии любой кнопки выходит из нее. Модуль Graph рабочий, другие программы работают
volvo
19.05.2009 0:50
А ты задержку установил бы побольше, я тестировал на FPC, для Турбо Паскаля надо другие значения для Delay.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.