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

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

Форум «Всё о Паскале» _ Теоретические вопросы _ Как включить BGI драйвер в EXE файл?

Автор: sheka 6.06.2009 17:04

открыл binobj.exe из командной строки.
а как туда вписать
binobj egavga.bgi egavga.obj egavgaDriverProc ?

Автор: volvo 6.06.2009 17:16

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

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

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

Автор: Айвенго 22.01.2016 0:13

А никто не подскажет, что дальше делать? В смысле чтобы объектник вличился в ехешник?

Автор: OCTAGRAM 22.01.2016 11:36

  1. http://pascal.net.ru/BINOBJ
  2. http://pascal.net.ru/%24L+%D0%9A%D0%BE%D0%BC%D0%BF%D0%BE%D0%BD%D0%BE%D0%B2%D0%B0%D1%82%D1%8C+%D0%BE%D0%B1%D1%8A%D0%B5%D0%BA%D1%82%D0%BD%D1%8B%D0%B9+%D1%84%D0%B0%D0%B9%D0%BB
  3. http://pascal.net.ru/RegisterBGIdriver

Автор: Айвенго 22.01.2016 17:55

Ошибка 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

Автор: OCTAGRAM 23.01.2016 1:16

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

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

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

binobj egavga.bgi egavga.obj egavga.bgi


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

Автор: Айвенго 24.01.2016 21:46

Не получается. Программа не может зарегистрировать драйвер. 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.





Автор: Айвенго 25.01.2016 18:00

А случайно не надо прямо вызвать
code...
EgaVgaDriverProc;
code...
?

Автор: OCTAGRAM 25.01.2016 22:27

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

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

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

Автор: Айвенго 26.01.2016 14:40

Цитата(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.




Автор: Айвенго 28.01.2016 15:26

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

Исходный код


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.