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

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ GRAPH/CRT

Автор: D1ma 15.05.2009 22:05

Изобразить текстовое окно на экране, в котором содержится информация о текущем фоне окна и фона экрана и текущем цвете текста в окне.Окно двигается по экрану с постоянной скоростью слева направо паралельно горизонтальной оси. При нажатии клавиши 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 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. Как можно реализовать движение окна слева направа по горизонтальной оси с постоянной скорость?
наверна с помощью цикла?))

Автор: volvo 18.05.2009 0:15

Цитата

пробывал так стереть предыдущую запись

Нет, так нельзя, ты перемешиваешь графический и текстовый режимы, ClrEOL доступно только в текстовом. Попробуй рисовать прямоугольник цвета фона, и закрывать им все, что было в окне раньше. Или устанавливать ViewPort, и чистить его через ClearViewport. Первый вариант делается так:

Procedure CaseColor(C:char;n:integer);
const
  colors: array[0 .. 5] of string = (
    'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
  );
begin
  setfillstyle(solidfill, getbkcolor);
  bar(x-17, y-15, x+277, y+21);

  n:=random(5);
  Case n of
    0 .. 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)

Именно так...

Автор: 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] of string = (
    'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
  );
begin
  setfillstyle(solidfill, getbkcolor);
  bar(x-17, y-15, x+277, y+21);

  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.

Если непонятно - говори, где. Я добавлю комментарии.

Автор: 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] of string = (
    'BLACK', 'BLUE', 'GREEN', 'CYAN', 'RED', 'MAGENTA'
  );
begin
  setfillstyle(solidfill, getbkcolor);
  bar(x-17, y-15, x+277, y+21);

  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 рабочий, другие программы работают

Автор: volvo 19.05.2009 0:50

А ты задержку установил бы побольше, я тестировал на FPC, для Турбо Паскаля надо другие значения для Delay.