1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Изобразить текстовое окно на экране, в котором содержится информация о текущем фоне окна и фона экрана и текущем цвете текста в окне.Окно двигается по экрану с постоянной скоростью слева направо паралельно горизонтальной оси. При нажатии клавиши 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;
Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п. Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п. Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..
Удалось сделать: -текстовое окно с текстом -при нажатии '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 of 0: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 div 2-136; y:=getmaxy div 2; set_font(x,y); while c<>#27 do begin if 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. Как можно реализовать движение окна слева направа по горизонтальной оси с постоянной скорость? наверна с помощью цикла?))
Нет, так нельзя, ты перемешиваешь графический и текстовый режимы, ClrEOL доступно только в текстовом. Попробуй рисовать прямоугольник цвета фона, и закрывать им все, что было в окне раньше. Или устанавливать ViewPort, и чистить его через ClearViewport. Первый вариант делается так:
Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...
Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...
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;
if change then begin n := random(6); Case n of 0 .. 5: outtextxy(x-10,y+13,'COLOR TEXT:'+colors[n]); end; prev_n := n; setcolor(n); outtextxy(x-10,y-12,' TEXT IN WINDOW '); end else begin 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 div 2;
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.
Если непонятно - говори, где. Я добавлю комментарии.
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;
if change then begin n := random(6); Case n of 0 .. 5: outtextxy(x-10,y+13,'COLOR TEXT:'+colors[n]); end; prev_n := n; setcolor(n); outtextxy(x-10,y-12,' TEXT IN WINDOW '); end else begin 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 div 2;
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 рабочий, другие программы работают