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

> Правила раздела!

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

 
 Ответить  Открыть новую тему 
> Как включить BGI драйвер в EXE файл?
сообщение
Сообщение #1


Я.
****

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

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


открыл binobj.exe из командной строки.
а как туда вписать
binobj egavga.bgi egavga.obj egavgaDriverProc ?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Что значит "открыл binobj.exe из командной строки." ? Все, что надо сделать - это запустить командную строку, и с помощью команды CD (change dir) перейти туда, где лежит binobj.exe. А дальше уже - по инструкции... печатаешь приведенный тобой текст, binobj конвертирует BGI-файл в OBJ, который потом может быть прилинкован к программе...

Вот так вот:
Прикрепленное изображение
(файл egavga.bgi я перед конвертацией скопировал в тот же каталог, где лежит binobj.exe)

По окончании вышеперечисленных операций в папке F:\Tp70\Tp70\BIN лежит кроме всего прочего еще и egavga.obj, забираешь его, кладешь в папку со своим проектом и компилируешь программу (я надеюсь, {$L ...} сделать не забыл?)...

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


А никто не подскажет, что дальше делать? В смысле чтобы объектник вличился в ехешник?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Большевик–концептуал
**

Группа: Пользователи
Сообщений: 134
Пол: Мужской
Реальное имя: Иван Левашев
Jabber: octagram@jabber.ru
Skype: i.levashew
QQ: 3152538431
WeChat
Ада: Сторонник
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик
Turbo Pascal: Установлен

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


  1. Утилита BINOBJ
  2. $L: Компоновать объектный файл
  3. RegisterBGIDriver (функция) (модуль Graph)


--------------------
If you want to get to the top, you have to start at the bottom
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

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

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


Ошибка 002. Я чего-то спойлеры не нашёл как делать, извините.

Program Space;
Uses Dos,CRT,Graph;
const centrx=300;
centry=160;
Var
ch:char;
{for graphic driver}


{$L EGAVGA.OBJ}
procedure vretrace;
begin
repeat until port [$3da] and 8=0;
repeat until port [$3da] and 8>0;
end;

procedure game;
var ZemX, ZemY,MercX,MercY,MarsX,MarsY,VenerX,VenerY,UpiterX,UpiterY,SatX,SatY:integer;
VisualPage,i:Integer;
begin
repeat
SetVisualPage(1-VisualPage);
VisualPage := VisualPage+1;
SetActivePage(1 -VisualPage);
vretrace;
ClearDevice;

For i := 1 to 100 do
PutPixel(centrx+Round(70*cos((i+VisualPage/9)*Pi/50+0.7)),
centry+Round(60*sin((i+VisualPage/9)*Pi/50-Pi/500)),1);

For i := 1 to 100 do
PutPixel(centrx+Round(90*cos((i+visualpage/7)*Pi/50+0.7)),
centry+Round(83*sin((i+visualpage/7)*Pi/50-Pi/500)),2);

For i := 1 to 100 do
PutPixel(centrx+Round(110*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(100*sin((i+VisualPage/7)*Pi/50-Pi/500)),3);

For i := 1 to 100 do
PutPixel(centrx+Round(131*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(120*sin((i+VisualPage/7)*Pi/50-Pi/500)),4);

For i := 1 to 100 do
PutPixel(centrx+Round(173*cos((i+VisualPage/5)*Pi/50+0.70)),
centry+Round(155*sin((i+VisualPage/5)*Pi/50-Pi/500)),5);

For i := 1 to 100 do
PutPixel(centrx+Round(212*cos((i+VisualPage/5)*Pi/50+0.65)),
centry+Round(195*sin((i+VisualPage/5)*Pi/50-Pi/500)),6);
{--------------------------------------------------------------}
{mercury}
MercX :=centrx-Round(70*cos((i-VisualPage/5)*Pi/50+0.7));
MercY:=centry-Round(60*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(lightgray);
circle(MercX,MercY,4);
SetFillStyle(1,LightGray);
floodfill(MercX,MercY,lightgray);
outtextxy(MercX-13,MercY-8,'1');
{---------------------------------------------------------------}
{venera}
VenerX :=centrx-Round(90*cos((i-VisualPage/4)*Pi/50+0.7));
VenerY:=centry-Round(83*sin((i-VisualPage/4)*Pi/50-Pi/500));
setcolor(lightred);
circle(VenerX,VenerY,7);
SetFillStyle(1,Lightred);
floodfill(VenerX,VenerY,lightred);
outtextxy(VenerX-13,VenerY-10,'2');
{-----------------------------------------------------------------}
{zemlia}
ZemX:=centrX+Round(110*cos((i-VisualPage/3)*Pi/50+0.65));
ZemY:=centrY+Round(100*sin((i-1-VisualPage/3)*Pi/50-Pi/500));
setcolor(lightblue);
circle(ZemX,ZemY,7);
SetFillStyle(1,Lightblue);
setcolor(2);
circle(ZemX,ZemY,7);
SetFillStyle(1,2);
floodfill(ZemX,ZemY,2);
setcolor(blue);
circle(zemx+1,zemy+1,3);
SetFillStyle(1,blue);
floodfill(ZemX,ZemY,blue);
circle(zemx+3,zemy-3,2);
SetFillStyle(1,blue);
floodfill(ZemX+3,ZemY-3,blue);
circle(zemx-4,zemy-4,2);
SetFillStyle(1,blue);
floodfill(ZemX-4,ZemY-4,blue);
setcolor(2);
outtextxy(ZemX-13,ZemY-10,'3');
{-----------------------------------------------------------------}
MarsX:=Centrx+Round(131*cos((i-VisualPage/2)*Pi/50+0.65));
MarsY:=Centry+Round(120*sin((i-VisualPage/2)*Pi/50-Pi/500));
setcolor(6);
circle(MarsX,MarsY,4);
SetFillStyle(1, 6);
floodfill(MarsX,MarsY,6);
outtextxy(Marsx-11,MarsY-1,'4');
{---------------------------------------------------------------------}
{Upiter}
UpiterX:=Centrx+Round(173*cos((i-VisualPage/1)*Pi/50+0.7));
UpiterY:=Centry+Round(155*sin((i-VisualPage/1)*Pi/50-Pi/500));
setcolor(6);
circle(UpiterX,UpiterY,12);
SetFillStyle(1, 6);
floodfill(UpiterX,UpiterY,6);
outtextxy(Upiterx-15,UpiterY+10,'5');
{---------------------------------------------------------------------}
{Saturn}
SatX:=Centrx+Round(212*cos((i-VisualPage/5)*Pi/50+0.65));
SatY:=Centry+Round(195*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(9);
circle(SatX,SatY,12);
setfillstyle(1,9);
floodfill(SatX,SatY,9);
setcolor(13);
ellipse(Satx,Saty-1,29,20,28,5);
outtextxy(Satx-22,SatY+10,'6');
setcolor(9);
line(satx-10,saty-6,satx+10,saty-6);
{---------------------------------------------------------------------}
{solnce}
setcolor(yellow);
circle(300,160,30);
SetFillStyle(1, yellow);
floodfill(300,160,yellow);
For i := 1 to 100 do
line(300,160,centrx+Round(31*cos((i+VisualPage/2)*Pi/50)),centry+Round(25*sin((i+VisualPage/2)*Pi/50-Pi/500)));
{----------------------------------------------------------------}
OutTextXY(centrx+215,centry+20,'Planets');
OutTextXY(centrx+200,centry+35,'1 - Mercury');
OutTextXY(centrx+200,centry+50,'2 - Venera');
OutTextXY(centrx+200,centry+65,'3 - Earth');
OutTextXY(centrx+200,centry+80,'4 - Mars');
OutTextXY(centrx+200,centry+95,'5 - Upiter');
OutTextXY(centrx+200,centry+110,'6 - Saturn');


until keyPressed

end;
Procedure MainMenu;
Const menu:array[1..2] of string[20]=('New game!','Exit');
Var i,y1: integer;
pos:byte;
kb:char;
Begin
kb:=#1;
SetTextStyle(4,0,2);
pos:=1; y1:=centry-30;
for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,'New game!');
end
else begin
setcolor(15);
OutTextXY(230,y1,'Exit');
end;

y1:=y1+30;
end;
repeat
y1:=centry-30;
kb:=readkey;
case kb of
#72:if pos>1 then
Dec(pos)
else pos:=3;

#80:if pos<2 then
Inc(pos)
else pos:=1;
end;

for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,menu[i]);
end
else begin
setcolor(15);
OutTextXY(230,y1,menu[i]);
end;
y1:=y1+30;
end;
until kb=#13;
begin
if pos=1 then begin game;
cleardevice;
end;

if pos=2 then
halt;
end;

end;


procedure grinit;
var GrMode, GrError,GrDriver:Integer;
{for graphic driver}
Driver, Mode: Integer;
DriverF: file;
DriverP: pointer;

begin
Assign(DriverF, 'EGAVGA.BGI');
Reset(DriverF, 1);
GetMem(DriverP, FileSize(DriverF));
BlockRead(DriverF, DriverP^,
FileSIze(DriverF));
if RegisterBGIdriver(DriverP) < 0 then
begin
WriteLn('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;

Driver := EGA;
Mode := EGAHi;
InitGraph(Driver, Mode,' ');
if GraphResult < 0 then
Halt(1);

BEGIN
Grinit;
MainMenu;
END.


драйвер конвертил

binobj egavga.bgi egavga.obj egavga.bgi

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


Большевик–концептуал
**

Группа: Пользователи
Сообщений: 134
Пол: Мужской
Реальное имя: Иван Левашев
Jabber: octagram@jabber.ru
Skype: i.levashew
QQ: 3152538431
WeChat
Ада: Сторонник
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик
Turbo Pascal: Установлен

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


Цитата(Айвенго @ 22.01.2016 18:55) *

Ошибка 002. Я чего-то спойлеры не нашёл как делать, извините.

драйвер конвертил

binobj egavga.bgi egavga.obj egavga.bgi


Здесь стоило бы BINOBJ пожаловаться на третий параметр, потому что под таким именем его, наверное, не достать из Паскаля. Надо переделать так, чтоб там было что–то, что годится для имени процедуры, и объявить эту процедуру через «procedure; external;» как в примерах. А та часть, где файл открывается извне и читается в память, не нужна, если файл встраивается.

Сообщение отредактировано: OCTAGRAM -


--------------------
If you want to get to the top, you have to start at the bottom
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

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

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


Не получается. Программа не может зарегистрировать драйвер. Invalid файл драйвера.
Текст моей программы. Загрузка драйвера не отключена.
Исходный код



Program Space;
Uses Dos,CRT,Graph;
const centrx=300;
centry=160;
Var
ch:char;

procedure EgaVgaDriverProc; external;
{$L EGAVGA.OBJ}

procedure vretrace;
begin
repeat until port [$3da] and 8=0;
repeat until port [$3da] and 8>0;
end;

procedure game;
var ZemX, ZemY,MercX,MercY,MarsX,MarsY,VenerX,VenerY,UpiterX,UpiterY,SatX,SatY:integer;
VisualPage,i:Integer;
begin
repeat
SetVisualPage(1-VisualPage);
VisualPage := VisualPage+1;
SetActivePage(1 -VisualPage);
vretrace;
ClearDevice;

For i := 1 to 100 do
PutPixel(centrx+Round(70*cos((i+VisualPage/9)*Pi/50+0.7)),
centry+Round(60*sin((i+VisualPage/9)*Pi/50-Pi/500)),1);

For i := 1 to 100 do
PutPixel(centrx+Round(90*cos((i+visualpage/7)*Pi/50+0.7)),
centry+Round(83*sin((i+visualpage/7)*Pi/50-Pi/500)),2);

For i := 1 to 100 do
PutPixel(centrx+Round(110*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(100*sin((i+VisualPage/7)*Pi/50-Pi/500)),3);

For i := 1 to 100 do
PutPixel(centrx+Round(131*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(120*sin((i+VisualPage/7)*Pi/50-Pi/500)),4);

For i := 1 to 100 do
PutPixel(centrx+Round(173*cos((i+VisualPage/5)*Pi/50+0.70)),
centry+Round(155*sin((i+VisualPage/5)*Pi/50-Pi/500)),5);

For i := 1 to 100 do
PutPixel(centrx+Round(212*cos((i+VisualPage/5)*Pi/50+0.65)),
centry+Round(195*sin((i+VisualPage/5)*Pi/50-Pi/500)),6);
{--------------------------------------------------------------}
{mercury}
MercX :=centrx-Round(70*cos((i-VisualPage/5)*Pi/50+0.7));
MercY:=centry-Round(60*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(lightgray);
circle(MercX,MercY,4);
SetFillStyle(1,LightGray);
floodfill(MercX,MercY,lightgray);
outtextxy(MercX-13,MercY-8,'1');
{---------------------------------------------------------------}
{venera}
VenerX :=centrx-Round(90*cos((i-VisualPage/4)*Pi/50+0.7));
VenerY:=centry-Round(83*sin((i-VisualPage/4)*Pi/50-Pi/500));
setcolor(lightred);
circle(VenerX,VenerY,7);
SetFillStyle(1,Lightred);
floodfill(VenerX,VenerY,lightred);
outtextxy(VenerX-13,VenerY-10,'2');
{-----------------------------------------------------------------}
{zemlia}
ZemX:=centrX+Round(110*cos((i-VisualPage/3)*Pi/50+0.65));
ZemY:=centrY+Round(100*sin((i-1-VisualPage/3)*Pi/50-Pi/500));
setcolor(lightblue);
circle(ZemX,ZemY,7);
SetFillStyle(1,Lightblue);
setcolor(2);
circle(ZemX,ZemY,7);
SetFillStyle(1,2);
floodfill(ZemX,ZemY,2);
setcolor(blue);
circle(zemx+1,zemy+1,3);
SetFillStyle(1,blue);
floodfill(ZemX,ZemY,blue);
circle(zemx+3,zemy-3,2);
SetFillStyle(1,blue);
floodfill(ZemX+3,ZemY-3,blue);
circle(zemx-4,zemy-4,2);
SetFillStyle(1,blue);
floodfill(ZemX-4,ZemY-4,blue);
setcolor(2);
outtextxy(ZemX-13,ZemY-10,'3');
{-----------------------------------------------------------------}
MarsX:=Centrx+Round(131*cos((i-VisualPage/2)*Pi/50+0.65));
MarsY:=Centry+Round(120*sin((i-VisualPage/2)*Pi/50-Pi/500));
setcolor(6);
circle(MarsX,MarsY,4);
SetFillStyle(1, 6);
floodfill(MarsX,MarsY,6);
outtextxy(Marsx-11,MarsY-1,'4');
{---------------------------------------------------------------------}
{Upiter}
UpiterX:=Centrx+Round(173*cos((i-VisualPage/1)*Pi/50+0.7));
UpiterY:=Centry+Round(155*sin((i-VisualPage/1)*Pi/50-Pi/500));
setcolor(6);
circle(UpiterX,UpiterY,12);
SetFillStyle(1, 6);
floodfill(UpiterX,UpiterY,6);
outtextxy(Upiterx-15,UpiterY+10,'5');
{---------------------------------------------------------------------}
{Saturn}
SatX:=Centrx+Round(212*cos((i-VisualPage/5)*Pi/50+0.65));
SatY:=Centry+Round(195*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(9);
circle(SatX,SatY,12);
setfillstyle(1,9);
floodfill(SatX,SatY,9);
setcolor(13);
ellipse(Satx,Saty-1,29,20,28,5);
outtextxy(Satx-22,SatY+10,'6');
setcolor(9);
line(satx-10,saty-6,satx+10,saty-6);
{---------------------------------------------------------------------}
{solnce}
setcolor(yellow);
circle(300,160,30);
SetFillStyle(1, yellow);
floodfill(300,160,yellow);
For i := 1 to 100 do
line(300,160,centrx+Round(31*cos((i+VisualPage/2)*Pi/50)),centry+Round(25*sin((i+VisualPage/2)*Pi/50-Pi/500)));
{----------------------------------------------------------------}
OutTextXY(centrx+215,centry+20,'Planets');
OutTextXY(centrx+200,centry+35,'1 - Mercury');
OutTextXY(centrx+200,centry+50,'2 - Venera');
OutTextXY(centrx+200,centry+65,'3 - Earth');
OutTextXY(centrx+200,centry+80,'4 - Mars');
OutTextXY(centrx+200,centry+95,'5 - Upiter');
OutTextXY(centrx+200,centry+110,'6 - Saturn');


until keyPressed

end;
Procedure MainMenu;
Const menu:array[1..2] of string[20]=('New game!','Exit');
Var i,y1: integer;
pos:byte;
kb:char;
Begin
kb:=#1;
SetTextStyle(4,0,2);
pos:=1; y1:=centry-30;
for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,'New game!');
end
else begin
setcolor(15);
OutTextXY(230,y1,'Exit');
end;

y1:=y1+30;
end;
repeat
y1:=centry-30;
kb:=readkey;
case kb of
#72:if pos>1 then
Dec(pos)
else pos:=3;

#80:if pos<2 then
Inc(pos)
else pos:=1;
end;

for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,menu[i]);
end
else begin
setcolor(15);
OutTextXY(230,y1,menu[i]);
end;
y1:=y1+30;
end;
until kb=#13;
begin
if pos=1 then begin game;
cleardevice;
end;

if pos=2 then
halt;
end;

end;


procedure grinit;
var GrMode, GrError,GrDriver:Integer;
{for graphic driver}
Driver, Mode: Integer;
DriverF: file;
DriverP: pointer;
begin
Assign(DriverF, 'EGAVGA.BGI');
Reset(DriverF, 1);
GetMem(DriverP, FileSize(DriverF));
BlockRead(DriverF, DriverP^,
FileSIze(DriverF));

if RegisterBGIdriver(DriverP) < 0 then
begin
WriteLn('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;
Driver := EGA;
Mode := EGAHi;
InitGraph(Driver, Mode,' ');
if GraphResult < 0 then
Halt(1);
end;

BEGIN
Grinit;
MainMenu;
END.






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


Новичок
*

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

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


А случайно не надо прямо вызвать
code...
EgaVgaDriverProc;
code...
?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Большевик–концептуал
**

Группа: Пользователи
Сообщений: 134
Пол: Мужской
Реальное имя: Иван Левашев
Jabber: octagram@jabber.ru
Skype: i.levashew
QQ: 3152538431
WeChat
Ада: Сторонник
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик
Turbo Pascal: Установлен

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


Assign(DriverF, 'EGAVGA.BGI'); и всё, что до регистрации как не было убрано, так и осталось.

А регистрировать нужно не DriverP, которого не должно быть, а @EgaVgaDriverProc

Если это вызвать, программа должна зависнуть или вылететь с ошибкой, так как это не настоящая процедура


--------------------
If you want to get to the top, you have to start at the bottom
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

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

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


Цитата(OCTAGRAM @ 25.01.2016 18:27) *

Assign(DriverF, 'EGAVGA.BGI'); и всё, что до регистрации как не было убрано, так и осталось.

А регистрировать нужно не DriverP, которого не должно быть, а @EgaVgaDriverProc

Если это вызвать, программа должна зависнуть или вылететь с ошибкой, так как это не настоящая процедура

Вот спасибо!! Толком ни в хелпе, ни в книжках описания нет, сам бы я в жизни не догадался.
Кому нужен рабочий пример
Исходный код



Program Space;
Uses Dos,CRT,Graph;
const centrx=300;
centry=160;
Var
ch:char;

procedure EgaVgaDriverProc; external;
{$L EGAVGA.OBJ}

procedure vretrace;
begin
repeat until port [$3da] and 8=0;
repeat until port [$3da] and 8>0;
end;

procedure game;
var ZemX, ZemY,MercX,MercY,MarsX,MarsY,VenerX,VenerY,UpiterX,UpiterY,SatX,SatY:integer;
VisualPage,i:Integer;
begin
repeat
SetVisualPage(1-VisualPage);
VisualPage := VisualPage+1;
SetActivePage(1 -VisualPage);
vretrace;
ClearDevice;

For i := 1 to 100 do
PutPixel(centrx+Round(70*cos((i+VisualPage/9)*Pi/50+0.7)),
centry+Round(60*sin((i+VisualPage/9)*Pi/50-Pi/500)),1);

For i := 1 to 100 do
PutPixel(centrx+Round(90*cos((i+visualpage/7)*Pi/50+0.7)),
centry+Round(83*sin((i+visualpage/7)*Pi/50-Pi/500)),2);

For i := 1 to 100 do
PutPixel(centrx+Round(110*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(100*sin((i+VisualPage/7)*Pi/50-Pi/500)),3);

For i := 1 to 100 do
PutPixel(centrx+Round(131*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(120*sin((i+VisualPage/7)*Pi/50-Pi/500)),4);

For i := 1 to 100 do
PutPixel(centrx+Round(173*cos((i+VisualPage/5)*Pi/50+0.70)),
centry+Round(155*sin((i+VisualPage/5)*Pi/50-Pi/500)),5);

For i := 1 to 100 do
PutPixel(centrx+Round(212*cos((i+VisualPage/5)*Pi/50+0.65)),
centry+Round(195*sin((i+VisualPage/5)*Pi/50-Pi/500)),6);
{--------------------------------------------------------------}
{mercury}
MercX :=centrx-Round(70*cos((i-VisualPage/5)*Pi/50+0.7));
MercY:=centry-Round(60*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(lightgray);
circle(MercX,MercY,4);
SetFillStyle(1,LightGray);
floodfill(MercX,MercY,lightgray);
outtextxy(MercX-13,MercY-8,'1');
{---------------------------------------------------------------}
{venera}
VenerX :=centrx-Round(90*cos((i-VisualPage/4)*Pi/50+0.7));
VenerY:=centry-Round(83*sin((i-VisualPage/4)*Pi/50-Pi/500));
setcolor(lightred);
circle(VenerX,VenerY,7);
SetFillStyle(1,Lightred);
floodfill(VenerX,VenerY,lightred);
outtextxy(VenerX-13,VenerY-10,'2');
{-----------------------------------------------------------------}
{zemlia}
ZemX:=centrX+Round(110*cos((i-VisualPage/3)*Pi/50+0.65));
ZemY:=centrY+Round(100*sin((i-1-VisualPage/3)*Pi/50-Pi/500));
setcolor(lightblue);
circle(ZemX,ZemY,7);
SetFillStyle(1,Lightblue);
setcolor(2);
circle(ZemX,ZemY,7);
SetFillStyle(1,2);
floodfill(ZemX,ZemY,2);
setcolor(blue);
circle(zemx+1,zemy+1,3);
SetFillStyle(1,blue);
floodfill(ZemX,ZemY,blue);
circle(zemx+3,zemy-3,2);
SetFillStyle(1,blue);
floodfill(ZemX+3,ZemY-3,blue);
circle(zemx-4,zemy-4,2);
SetFillStyle(1,blue);
floodfill(ZemX-4,ZemY-4,blue);
setcolor(2);
outtextxy(ZemX-13,ZemY-10,'3');
{-----------------------------------------------------------------}
MarsX:=Centrx+Round(131*cos((i-VisualPage/2)*Pi/50+0.65));
MarsY:=Centry+Round(120*sin((i-VisualPage/2)*Pi/50-Pi/500));
setcolor(6);
circle(MarsX,MarsY,4);
SetFillStyle(1, 6);
floodfill(MarsX,MarsY,6);
outtextxy(Marsx-11,MarsY-1,'4');
{---------------------------------------------------------------------}
{Upiter}
UpiterX:=Centrx+Round(173*cos((i-VisualPage/1)*Pi/50+0.7));
UpiterY:=Centry+Round(155*sin((i-VisualPage/1)*Pi/50-Pi/500));
setcolor(6);
circle(UpiterX,UpiterY,12);
SetFillStyle(1, 6);
floodfill(UpiterX,UpiterY,6);
outtextxy(Upiterx-15,UpiterY+10,'5');
{---------------------------------------------------------------------}
{Saturn}
SatX:=Centrx+Round(212*cos((i-VisualPage/5)*Pi/50+0.65));
SatY:=Centry+Round(195*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(9);
circle(SatX,SatY,12);
setfillstyle(1,9);
floodfill(SatX,SatY,9);
setcolor(13);
ellipse(Satx,Saty-1,29,20,28,5);
outtextxy(Satx-22,SatY+10,'6');
setcolor(9);
line(satx-10,saty-6,satx+10,saty-6);
{---------------------------------------------------------------------}
{solnce}
setcolor(yellow);
circle(300,160,30);
SetFillStyle(1, yellow);
floodfill(300,160,yellow);
For i := 1 to 100 do
line(300,160,centrx+Round(31*cos((i+VisualPage/2)*Pi/50)),centry+Round(25*sin((i+VisualPage/2)*Pi/50-Pi/500)));
{----------------------------------------------------------------}
OutTextXY(centrx+215,centry+20,'Planets');
OutTextXY(centrx+200,centry+35,'1 - Mercury');
OutTextXY(centrx+200,centry+50,'2 - Venera');
OutTextXY(centrx+200,centry+65,'3 - Earth');
OutTextXY(centrx+200,centry+80,'4 - Mars');
OutTextXY(centrx+200,centry+95,'5 - Upiter');
OutTextXY(centrx+200,centry+110,'6 - Saturn');


until keyPressed

end;
Procedure MainMenu;
Const menu:array[1..2] of string[20]=('New game!','Exit');
Var i,y1: integer;
pos:byte;
kb:char;
Begin
kb:=#1;
SetTextStyle(4,0,2);
pos:=1; y1:=centry-30;
for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,'New game!');
end
else begin
setcolor(15);
OutTextXY(230,y1,'Exit');
end;

y1:=y1+30;
end;
repeat
y1:=centry-30;
kb:=readkey;
case kb of
#72:if pos>1 then
Dec(pos)
else pos:=3;

#80:if pos<2 then
Inc(pos)
else pos:=1;
end;

for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,menu[i]);
end
else begin
setcolor(15);
OutTextXY(230,y1,menu[i]);
end;
y1:=y1+30;
end;
until kb=#13;
begin
if pos=1 then begin game;
cleardevice;
end;

if pos=2 then halt;

end;
end;

procedure grinit;
var GrMode, GrError,GrDriver:Integer;
Driver, Mode: Integer;
begin

if RegisterBGIdriver(@EgaVgaDriverProc) < 0 then
begin
WriteLn('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;
Driver := EGA;
Mode := EGAHi;
InitGraph(Driver, Mode,' ');
if GraphResult < 0 then
Halt(1);
end;

BEGIN
Grinit;
MainMenu;
Closegraph;
ClrScr;
END.



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


Новичок
*

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

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


А теперь врежем в исполняемый файл готический шрифт.
Исходный код


Program Space;
Uses Dos,CRT,Graph;
const centrx=300;
centry=160;
Var
ch:char;

procedure EgaVgaDriverProc; external;
{$L EGAVGA.OBJ}

procedure FontProc; external;
{$L GOTH.OBJ}

procedure vretrace;
begin
repeat until port [$3da] and 8=0;
repeat until port [$3da] and 8>0;
end;

procedure game;
var ZemX, ZemY,MercX,MercY,MarsX,MarsY,VenerX,VenerY,UpiterX,UpiterY,SatX,SatY:integer;
VisualPage,i:Integer;
begin
repeat
SetVisualPage(1-VisualPage);
VisualPage := VisualPage+1;
SetActivePage(1 -VisualPage);
vretrace;
ClearDevice;

For i := 1 to 100 do
PutPixel(centrx+Round(70*cos((i+VisualPage/9)*Pi/50+0.7)),
centry+Round(60*sin((i+VisualPage/9)*Pi/50-Pi/500)),1);

For i := 1 to 100 do
PutPixel(centrx+Round(90*cos((i+visualpage/7)*Pi/50+0.7)),
centry+Round(83*sin((i+visualpage/7)*Pi/50-Pi/500)),2);

For i := 1 to 100 do
PutPixel(centrx+Round(110*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(100*sin((i+VisualPage/7)*Pi/50-Pi/500)),3);

For i := 1 to 100 do
PutPixel(centrx+Round(131*cos((i+VisualPage/7)*Pi/50+0.65)),
centry+Round(120*sin((i+VisualPage/7)*Pi/50-Pi/500)),4);

For i := 1 to 100 do
PutPixel(centrx+Round(173*cos((i+VisualPage/5)*Pi/50+0.70)),
centry+Round(155*sin((i+VisualPage/5)*Pi/50-Pi/500)),5);

For i := 1 to 100 do
PutPixel(centrx+Round(212*cos((i+VisualPage/5)*Pi/50+0.65)),
centry+Round(195*sin((i+VisualPage/5)*Pi/50-Pi/500)),6);
{--------------------------------------------------------------}
{mercury}
MercX :=centrx-Round(70*cos((i-VisualPage/5)*Pi/50+0.7));
MercY:=centry-Round(60*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(lightgray);
circle(MercX,MercY,4);
SetFillStyle(1,LightGray);
floodfill(MercX,MercY,lightgray);
outtextxy(MercX-13,MercY-8,'1');
{---------------------------------------------------------------}
{venera}
VenerX :=centrx-Round(90*cos((i-VisualPage/4)*Pi/50+0.7));
VenerY:=centry-Round(83*sin((i-VisualPage/4)*Pi/50-Pi/500));
setcolor(lightred);
circle(VenerX,VenerY,7);
SetFillStyle(1,Lightred);
floodfill(VenerX,VenerY,lightred);
outtextxy(VenerX-13,VenerY-10,'2');
{-----------------------------------------------------------------}
{zemlia}
ZemX:=centrX+Round(110*cos((i-VisualPage/3)*Pi/50+0.65));
ZemY:=centrY+Round(100*sin((i-1-VisualPage/3)*Pi/50-Pi/500));
setcolor(lightblue);
circle(ZemX,ZemY,7);
SetFillStyle(1,Lightblue);
setcolor(2);
circle(ZemX,ZemY,7);
SetFillStyle(1,2);
floodfill(ZemX,ZemY,2);
setcolor(blue);
circle(zemx+1,zemy+1,3);
SetFillStyle(1,blue);
floodfill(ZemX,ZemY,blue);
circle(zemx+3,zemy-3,2);
SetFillStyle(1,blue);
floodfill(ZemX+3,ZemY-3,blue);
circle(zemx-4,zemy-4,2);
SetFillStyle(1,blue);
floodfill(ZemX-4,ZemY-4,blue);
setcolor(2);
outtextxy(ZemX-13,ZemY-10,'3');
{-----------------------------------------------------------------}
MarsX:=Centrx+Round(131*cos((i-VisualPage/2)*Pi/50+0.65));
MarsY:=Centry+Round(120*sin((i-VisualPage/2)*Pi/50-Pi/500));
setcolor(6);
circle(MarsX,MarsY,4);
SetFillStyle(1, 6);
floodfill(MarsX,MarsY,6);
outtextxy(Marsx-11,MarsY-1,'4');
{---------------------------------------------------------------------}
{Upiter}
UpiterX:=Centrx+Round(173*cos((i-VisualPage/1)*Pi/50+0.7));
UpiterY:=Centry+Round(155*sin((i-VisualPage/1)*Pi/50-Pi/500));
setcolor(6);
circle(UpiterX,UpiterY,12);
SetFillStyle(1, 6);
floodfill(UpiterX,UpiterY,6);
outtextxy(Upiterx-15,UpiterY+10,'5');
{---------------------------------------------------------------------}
{Saturn}
SatX:=Centrx+Round(212*cos((i-VisualPage/5)*Pi/50+0.65));
SatY:=Centry+Round(195*sin((i-VisualPage/5)*Pi/50-Pi/500));
setcolor(9);
circle(SatX,SatY,12);
setfillstyle(1,9);
floodfill(SatX,SatY,9);
setcolor(13);
ellipse(Satx,Saty-1,29,20,28,5);
outtextxy(Satx-22,SatY+10,'6');
setcolor(9);
line(satx-10,saty-6,satx+10,saty-6);
{---------------------------------------------------------------------}
{solnce}
setcolor(yellow);
circle(300,160,30);
SetFillStyle(1, yellow);
floodfill(300,160,yellow);
For i := 1 to 100 do
line(300,160,centrx+Round(31*cos((i+VisualPage/2)*Pi/50)),centry+Round(25*sin((i+VisualPage/2)*Pi/50-Pi/500)));
{----------------------------------------------------------------}
OutTextXY(centrx+215,centry+20,'Planets');
OutTextXY(centrx+200,centry+35,'1 - Mercury');
OutTextXY(centrx+200,centry+50,'2 - Venera');
OutTextXY(centrx+200,centry+65,'3 - Earth');
OutTextXY(centrx+200,centry+80,'4 - Mars');
OutTextXY(centrx+200,centry+95,'5 - Upiter');
OutTextXY(centrx+200,centry+110,'6 - Saturn');


until keyPressed

end;
Procedure MainMenu;
Const menu:array[1..2] of string[20]=('New game!','Exit');
Var i,y1: integer;
pos:byte;
kb:char;
Begin
kb:=#1;
SetTextStyle(4,0,2);
pos:=1; y1:=centry-30;
for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,'New game!');
end
else begin
setcolor(15);
OutTextXY(230,y1,'Exit');
end;

y1:=y1+30;
end;
repeat
y1:=centry-30;
kb:=readkey;
case kb of
#72:if pos>1 then
Dec(pos)
else pos:=3;

#80:if pos<2 then
Inc(pos)
else pos:=1;
end;

for i:=1 to 2 do
begin
if i=pos then
begin
setcolor(1);
OutTextXY(230,y1,menu[i]);
end
else begin
setcolor(15);
OutTextXY(230,y1,menu[i]);
end;
y1:=y1+30;
end;
until kb=#13;
begin
if pos=1 then begin game;
cleardevice;
end;

if pos=2 then halt;

end;
end;

procedure grinit;
var
Driver, Mode: Integer;
begin
if RegisterBGIFont(@FontProc) < 0 then
begin
WriteLn('Error registering font: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;
if RegisterBGIdriver(@EgaVgaDriverProc) < 0 then
begin
WriteLn('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
end;
Driver := EGA;
Mode := EGAHi;
InitGraph(Driver, Mode,' ');
if GraphResult < 0 then
Halt(1);
end;

BEGIN
Grinit;
MainMenu;
Closegraph;
ClrScr;
END.



 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 




- Текстовая версия 19.02.2018 11:22
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"