Помощь - Поиск - Пользователи - Календарь
Полная версия: Как включить BGI драйвер в EXE файл?
Форум «Всё о Паскале» > Pascal, Object Pascal > Теоретические вопросы
sheka
открыл binobj.exe из командной строки.
а как туда вписать
binobj egavga.bgi egavga.obj egavgaDriverProc ?
volvo
Что значит "открыл binobj.exe из командной строки." ? Все, что надо сделать - это запустить командную строку, и с помощью команды CD (change dir) перейти туда, где лежит binobj.exe. А дальше уже - по инструкции... печатаешь приведенный тобой текст, binobj конвертирует BGI-файл в OBJ, который потом может быть прилинкован к программе...

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

По окончании вышеперечисленных операций в папке F:\Tp70\Tp70\BIN лежит кроме всего прочего еще и egavga.obj, забираешь его, кладешь в папку со своим проектом и компилируешь программу (я надеюсь, {$L ...} сделать не забыл?)...
Айвенго
А никто не подскажет, что дальше делать? В смысле чтобы объектник вличился в ехешник?
Айвенго
Ошибка 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
Цитата(Айвенго @ 22.01.2016 18:55) *

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

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

binobj egavga.bgi egavga.obj egavga.bgi


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




Айвенго
А случайно не надо прямо вызвать
code...
EgaVgaDriverProc;
code...
?
OCTAGRAM
Assign(DriverF, 'EGAVGA.BGI'); и всё, что до регистрации как не было убрано, так и осталось.

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

Если это вызвать, программа должна зависнуть или вылететь с ошибкой, так как это не настоящая процедура
Айвенго
Цитата(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.



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


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.



Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.