IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> GRAPH/CRT, Help
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


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


Сообщение отредактировано: D1ma -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(D1ma @ 15.05.2009 19:05) *

Получилось только вот -
Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п.
Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


Цитата(Lapp @ 15.05.2009 22:19) *

Ты меня извини, но просто неприлично помещать настолько сырой код, заставляя тех, кто тебе помогает, вычищать за тебя все ошибки/опечатки и т.п.
Поимей хоть какое-то уважение. Спрашиваешь про одно, а программа кишит всякими другими ошибками..

Куда мне до Вас...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(D1ma @ 16.05.2009 18:45) *
Куда мне до Вас...
Ну при чем тут это? Ты хотя бы закрой незакрытые строки сам. По сути программы поможем.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


Удалось сделать:
-текстовое окно с текстом
-при нажатии '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. Как можно реализовать движение окна слева направа по горизонтальной оси с постоянной скорость?
наверна с помощью цикла?))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Цитата
пробывал так стереть предыдущую запись
Нет, так нельзя, ты перемешиваешь графический и текстовый режимы, 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) тоже...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


Как я понял, надо сделать так:
Код

........
a:=1;
repeat
x:=x+a; {двигаем по оси x}
set_font(x,y);{Сама фигура}
.......
delay(100);
until Keypressed;

Но что-то не работает... Видно не правильно понял, напишите, пожалуйста как надо -) , скоро сдавать
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


Цитата(volvo @ 18.05.2009 20:47) *

Хм... То есть, тебе "обязательно нужна сразу и дудочка и кувшинчик" (С) ? И обрабатывать нажатие Enter-а, чтоб менялся цвет выводимых строк, и при этом чтоб окно ползло по экрану? Это уже сложнее, но все равно реализуемо... Если это - то что тебе надо, покажу, как сделать...

Именно так...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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.
Если непонятно - говори, где. Я добавлю комментарии.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 32
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


Цитата(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 рабочий, другие программы работают
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






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

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.03.2024 23:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name