Question

怎么用free pascal编游戏

怎么用free pascal编游戏

Answer 1

当然可以了。编程序写到手腕酸到时候敲一个游戏进去是最好不过到啦。
用pascal有一点点麻烦，但是也是可以轻松实现的。不过用delphi更方便。
用pascal可以用面向单元的程序，但是不怎么好看。给你一点样本代码吧。
俄罗斯方块：
USES Crt;
CONST
Change:Array [0..6,0..3,0..7] Of Byte =(((0,1,1,1,2,1,3,1),(1,0,1,1,1,2,1,3),(0,1,1,1,2,1,3,1),(1,0,1,1,1,2,1,3)),
((1,0,0,1,1,1,2,1),(1,0,1,1,1,2,2,1),(0,1,1,1,2,1,1,2),(1,0,0,1,1,1,1,2)),
((1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1),(1,0,2,0,1,1,2,1)),
((1,0,2,0,0,1,1,1),(0,0,0,1,1,1,1,2),(1,0,2,0,0,1,1,1),(0,0,0,1,1,1,1,2)),
((0,0,1,0,1,1,2,1),(1,0,0,1,1,1,0,2),(0,0,1,0,1,1,2,1),(1,0,0,1,1,1,0,2)),
((1,0,2,0,1,1,1,2),(0,0,0,1,1,1,2,1),(1,0,0,2,1,1,1,2),(2,2,0,1,1,1,2,1)),
((0,0,1,0,1,1,1,2),(2,0,0,1,1,1,2,1),(2,2,1,0,1,1,1,2),(0,2,0,1,1,1,2,1)));
VAR
Board:Array [0..3,0..11,1..25] Of Byte;
Players,N,Nowx,Nowy,Kind,Trans,Speed:Byte;
Time,Score:Word;
Now:Array [0..7] Of Byte;
PROCEDURE Furbish;
VAR B,C:Byte;
Begin
For C:=24 Downto 2 Do Begin
Gotoxy(1,C);
For B:=1 To 10 Do
If Board[0,B,C]=0 Then Write(' ')
Else Write('圹');
End;
End;
PROCEDURE Clear;
Var A,B,C:Byte;D:Boolean;
Begin
For A:=24 Downto 1 Do
Begin
D:=True;
For B:=1 To 10 Do
If Board[0,B,A]=0 Then D:=False;
If D=True Then
Begin
Score:=Score+10;Gotoxy(1,1);Write(Score:5,'0');
For C:=A Downto 2 Do
For B:=1 To 10 Do
Board[0,B,C]:=Board[0,B,C-1];
A:=A+1;
End;
End;
Furbish;
End;
FUNCTION Canmove(X,Y:Byte):Boolean;
BEGIN
Canmove:=True;
If Board[0,X+Now[0],Y+Now[1]]>0 Then Canmove:=False;
If Board[0,X+Now[2],Y+Now[3]]>0 Then Canmove:=False;
If Board[0,X+Now[4],Y+Now[5]]>0 Then Canmove:=False;
If Board[0,X+Now[6],Y+Now[7]]>0 Then Canmove:=False;
End;
PROCEDURE Clean;
Begin
Gotoxy((Nowx+Now[0])*2-1,Nowy+Now[1]);Write(' ');
Gotoxy((Nowx+Now[2])*2-1,Nowy+Now[3]);Write(' ');
Gotoxy((Nowx+Now[4])*2-1,Nowy+Now[5]);Write(' ');
Gotoxy((Nowx+Now[6])*2-1,Nowy+Now[7]);Write(' ');
End;
PROCEDURE Show;
Begin
Gotoxy((Nowx+Now[0])*2-1,Nowy+Now[1]);Write('圹');
Gotoxy((Nowx+Now[2])*2-1,Nowy+Now[3]);Write('圹');
Gotoxy((Nowx+Now[4])*2-1,Nowy+Now[5]);Write('圹');
Gotoxy((Nowx+Now[6])*2-1,Nowy+Now[7]);Write('圹');
End;
BEGIN
Fillchar(Board,Sizeof(Board),0);
Randomize;Score:=0;
For N:=1 To 24 Do
Board[0,0,N]:=1;
For N:=1 To 24 Do
Board[0,11,N]:=1;
For N:=1 To 10 Do
Board[0,N,25]:=1;
Window(31,2,50,25);Textcolor(White);Textbackground(Blue);
Clrscr;Window(31,2,51,25);
Speed:=1;
Kind:=Random(7);Trans:=Random(4);Nowx:=4;Nowy:=1;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
While Canmove(Nowx,Nowy) Do
Begin
Repeat
Clean;Nowy:=Nowy+1;Show;
Repeat
If Keypressed Then
Case Upcase(Readkey) Of
#0:Case Readkey Of
#75:If Canmove(Nowx-1,Nowy) Then Begin Clean;Nowx:=Nowx-1;Show;End;
#77:If Canmove(Nowx+1,Nowy) Then Begin Clean;Nowx:=Nowx+1;Show;End;
#80:Begin Clean;Repeat
If Canmove(Nowx,Nowy+1) Then Nowy:=Nowy+1;
Until Not(Canmove(Nowx,Nowy+1));Show;End;
#61:Begin Gotoxy(9,12);Write('Pause');Repeat Delay(1000);Until Keypressed;Furbish;End;
End;
#27:Exit;
' ',#13:Begin
Clean;Trans:=Trans+1;
If Trans=4 Then Trans:=0;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
If Not(Canmove(Nowx,Nowy)) Then Begin Trans:=Trans-1;For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];Show;End
Else Show;
End;
End;
Until Not(Keypressed);
Delay((10-Speed)*50);
Until Not(Canmove(Nowx,Nowy+1));
Score:=Score+1;Gotoxy(1,1);Write(Score:5,'0');Speed:=(Score Div 300)+1;
Board[0,Nowx+Now[0],Nowy+Now[1]]:=1;
Board[0,Nowx+Now[2],Nowy+Now[3]]:=1;
Board[0,Nowx+Now[4],Nowy+Now[5]]:=1;
Board[0,Nowx+Now[6],Nowy+Now[7]]:=1;
Clear;
Kind:=Random(7);Trans:=Random(4);Nowx:=4;Nowy:=1;
For N:=0 To 7 Do
Now[N]:=Change[Kind,Trans,N];
End;
Gotoxy(7,12);Write('GAME OVER');Readln;
END.

Answer 2

建议你放弃把，可以去学c或者c++，用他们编，用free pascal很麻烦，很难，而且编出来的质量很不好
当然如果你非要用不可，那么free pascal有一个绘图单元，用这个来绘图，游戏主要就是绘图，所以，绘图有了，其他的就很好编了

Answer 3

{
$Id: samegame.pp,v 1.3 2002/02/22 21:41:22 carl Exp $

This program is both available in XTDFPC as in the FPC demoes.
Copyright (C) 1999 by Marco van de Voort

SameGame is a standard game in GNOME and KDE. I liked it, and I
automatically brainstormed how I would implement it.
It turned out to be really easy, and is basically only 100 lines or so,
the rest is scorekeeping, helptext, menu etc.

The game demonstrates some features of the MSMOUSE unit, and some of
the Crt and Graph units. (depending whether it is compiled with
UseGraphics or not)

See the file COPYING.FPC, included in this distribution,
for details about the copyright.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

**********************************************************************}
PROGRAM SameGame;

{$ifdef UseGraphics}
{$ifdef Win32}
{$define Win32Graph}
{$apptype GUI}
{$endif}
{$endif}

Uses
{$ifdef Win32}
Windows,
{$endif}
{$ifdef Win32Graph}
WinCrt,
{$else}
Crt,
{$endif}
Dos,
{$IFDEF UseGraphics}
Graph,
{$INFO GRAPH}
{$ENDIF}
GameUnit;

CONST
{$IFDEF UseGraphics}
GrFieldX = 10; {X topleft of playfield}
GrFieldY = 70; {Y topleft of playfield}
ScalerX = 22; {ScalerX x Scaler y dots
must be approx a square}
ScalerY = 20;
{$ENDIF}
FieldX = 10; {Top left playfield
coordinates in squares(textmode)}
FieldY = 3; {Top left playfield coordinates}
PlayFieldXDimension = 20; {Dimensions of playfield}
PlayFieldYDimension = 15;
{$IFDEF UseGraphics}
RowDispl = 15;
MenuX = 480;
MenuY = 120;
grNewGameLine = 'NEW GAME';
grHelpLine = 'HELP';
grEndGame = 'END GAME';
{$ENDIF}

{Used colors. Colors[0..2] are the colors used on the playfield, Colors[3]
is the background and Colors[4] is the color used to mark the pieces}
Colors : ARRAY [0..4] OF LONGINT = (White,Blue,Red,Black,LightMagenta);

TYPE PlayFieldType=ARRAY[0..PlayFieldXDimension-1,0..PlayFieldYDimension-1] OF BYTE;

{$IFDEF UseGraphics}
PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
{Screen routine, simply puts the array Playfield on screen.
Both used for displaying the normal grid as the grid with a certain area marked}

VAR X,Y : LONGINT;
LastOne,
NumbLast : LONGINT;

BEGIN
HideMouse;
FOR Y:=0 TO PlayFieldYDimension-1 DO
BEGIN
X:=0;
REPEAT
LastOne:=PlayField[X,Y];
NumbLast:=X;
WHILE (PlayField[X,Y]=LastOne) AND (X<(PlayFieldXDimension-1))DO
INC(X);
SetFillStyle(SolidFill,Colors[LastOne]);
Bar(GrFieldX+NumbLast*ScalerX,GrFieldY+Y*ScalerY,GrFieldX+X*ScalerX-1,GrFieldY+(Y+1)*ScalerY-1);
UNTIL X>=(PlayFieldXDimension-1);
END;
ShowMouse;
END;
{$ELSE}

PROCEDURE DisplayPlayField(CONST PlayField:PlayFieldType);
{Screen routine, simply puts the array Playfield on screen.
Both used for displaying the normal grid as the grid with a certain area marked}

VAR X,Y : LONGINT;

BEGIN
FOR Y:=0 TO PlayFieldYDimension-1 DO
BEGIN
GotoXY(FieldX,Y+FieldY);
FOR X:=0 TO PlayFieldXDimension-1 DO
BEGIN
TextColor(Colors[PlayField[X,Y]]);
Write(#219#219);
END;
END;
END;
{$ENDIF}

PROCEDURE ShowHelp;
{Shows some explanation of the game and waits for a key}

{$ifndef UseGraphics}
VAR I : LONGINT;
{$endif}

BEGIN
{$IFDEF UseGraphics}
HideMouse;
SetbkColor(black);
SetViewPort(0,0,getmaxx,getmaxy,clipoff);
ClearViewPort;
SetTextStyle(0,Horizdir,2);
OutTextXY(220,10,'SAMEGAME');
SetTextStyle(0,Horizdir,1);
OutTextXY(5,40+1*LineDistY,' is a small game, with a principle copied from some KDE game');
OutTextXY(5,40+3*LineDistY,'I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
OutTextXY(5,40+4*LineDistY,'When it worked, I tried to get it running under Linux. I succeeded,');
OutTextXY(5,40+5*LineDistY,'but the mouse unit of the API doesn'#39't work with GPM 1.17');
OutTextXY(5,40+7*LineDistY,'If you move over the playfield, aggregates of one color will be marked');
OutTextXY(5,40+8*LineDistY,'in purple. If you then press the left mouse button, that aggregate will');
OutTextXY(5,40+9*LineDistY,'disappear, and the playfield will collapse to the bottom-left. Please');
OutTextXY(5,40+10*LineDistY,'keep in mind that only an aggregate of two blocks or more will disappear.');
OutTextXY(5,40+12*LineDistY,'For every aggregate you let disappear you get points, but the score is');
OutTextXY(5,40+13*LineDistY,'quadratic proportional to the number of blocks killed. So 4 times killing');
OutTextXY(5,40+14*LineDistY,' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
OutTextXY(5,40+15*LineDistY,'blocks. The purpose of the game is obtaining the highscore');
OutTextXY(5,40+17*LineDistY,'If you manage to empty the entire playfield, you'#39'll get a bonus');
OutTextXY(5,40+19*LineDistY,'Press any key to get back to the game');
ShowMouse;
{$ELSE}
FOR I:=2 TO 24 DO
BEGIN
GotoXY(1,I);
ClrEol;
END;
GotoXY(1,3); TextColor(White);
Write('SAMEGAME');
SetDefaultColor;
WriteLn(' is a small game, with a principle copied from some KDE game');
WriteLn;
WriteLn('I tried to implement it under Go32V2 to demonstrate the MsMouse unit');
Writeln('When it worked, I tried to get it running under Linux. I succeeded,');
Writeln('but the mouse unit of the API doesn'#39't work with GPM 1.17');
Writeln;
WriteLn('If you move over the playfield, aggregates of one color will be marked');
Writeln('in purple. If you then press the left mouse button, that aggregate will');
Writeln('disappear, and the playfield will collapse to the bottom-left. Please');
Writeln('keep in mind that only an aggregate of two blocks or more will disappear.');
Writeln;
Writeln('For every aggregate you let disappear you get points, but the score is');
Writeln('quadratic proportional to the number of blocks killed. So 4 times killing');
Writeln(' a 4 block aggregate scores 4 points, and one time 16 blocks will score 64');
Writeln('blocks. The purpose of the game is obtaining the highscore');
Writeln;
Writeln('If you manage to empty the entire playfield, you'#39'll get a bonus');
Writeln;
WriteLn('Press any key to get back to the game');
{$ENDIF}
GetKey;
END;

VAR MarkField,PlayField : PlayFieldType; {The playfield, and the marked form}
CubesMarked : LONGINT; {Cubes currently marked}
Score : LONGINT; {The current score}
LastScore : LONGINT;

PROCEDURE ShowButtons;
{Shows the clickable buttons}

BEGIN
{$IFNDEF UseGraphics}
TextColor(Yellow); TextBackGround(Blue);
GotoXY(60,5); Write('NEW game');
GotoXY(60,6); Write('HELP');
GotoXY(60,7); Write('END game');
{$IFDEF Linux}
GotoXY(60,8); Write('Force IBM charset');
{$ENDIF}
SetDefaultColor;
{$ELSE}
SetTextStyle(0,Horizdir,1);
OutTextXY(MenuX,MenuY,grNewGameLine);
OutTextXY(MenuX,MenuY+RowDispl,grHelpLine);
OutTextXY(MenuX,MenuY+2*RowDispl,grEndGame);
{$ENDIF}

END;

FUNCTION PlayFieldPiecesLeft:LONGINT;
{Counts pieces/cubes/blocks left on the playfield}

VAR I,J,K : LONGINT;

BEGIN
K:=0;
FOR I:=0 TO PlayFieldXDimension-1 DO
FOR J:=0 TO PlayFieldYDimension-1 DO
IF PlayField[I,J]<>3 THEN
INC(K);
PlayFieldPiecesLeft:=K;
END;

PROCEDURE ShowScore;
{Simply procedure to update the score}

{$IFDEF UseGraphics}
VAR S : String;
{$ENDIF}
BEGIN
{$IFDEF UseGraphics}
Str(Score:5,S);
SetFillStyle(SolidFill,0);
Bar(300,440,450,458);
OutTextXY(300,440,'Score :'+S);
{$ELSE}
TextColor(White);
GotoXY(20,23); Write(' ':20);
GotoXY(20,23); Write('Score : ',Score);
SetDefaultColor;
{$ENDIF}
END;

FUNCTION CubesToScore : LONGINT;
{Function to calculate score from the number of cubes. Should have a higher
order than linear, or the purpose of the game disappears}

BEGIN
CubesToScore:=(CubesMarked*CubesMarked) DIV 4;
END;

PROCEDURE MarkAfield(X,Y:LONGINT);
{Recursively marks the area adjacent to (X,Y);}

VAR TargetColor : LONGINT;

PROCEDURE MarkRecur(X1,Y1:LONGINT);
{Marks X1,Y1, checks if neighbours (horizontally or vertically) are the
same color}

BEGIN
IF (PlayField[X1,Y1]=TargetColor) AND (MarkField[X1,Y1]<>4) THEN
BEGIN
MarkField[X1,Y1]:=4;
INC(CubesMarked);
IF X1>0 THEN
MarkRecur(X1-1,Y1);
IF Y1>0 THEN
MarkRecur(X1,Y1-1);
IF X1<(PlayFieldXDimension-1) THEN
MarkRecur(X1+1,Y1);
IF Y1<(PlayFieldYDimension-1) THEN
MarkRecur(X1,Y1+1);
END;
END;

BEGIN
CubesMarked:=0;
TargetColor:=PlayField[X,Y];
IF TargetColor<>3 THEN {Can't mark black space}
MarkRecur(X,Y);
END;

PROCEDURE FillPlayfield;
{Initial version, probably not nice to play with.
Some Life'ish algoritm would be better I think. (so that more aggregates exist)}

VAR X,Y,Last,Now : LONGINT;

BEGIN
Last:=0;
FOR X:=0 TO PlayFieldXDimension-1 DO
FOR Y:=0 TO PlayFieldYDimension-1 DO
BEGIN
Now:=RANDOM(4);
IF Now=3 THEN
Now:=Last;
PlayField[X,Y]:=Now;
Last:=Now;
END;
MarkField:=PlayField;
END;

PROCEDURE Colapse;
{Processes the playfield if the mouse button is used.

First the procedure deletes the marked area, and let gravity do its work
Second the procedure uses as if some gravity existed on the left of the
playfield }

VAR X, Y,J :LONGINT;

BEGIN
{Vertical colapse: All marked pieces are deleted, and let gravity do it's work}
IF CubesMarked>1 THEN
BEGIN
FOR X:=0 TO PlayFieldXDimension-1 DO
BEGIN
Y:=PlayFieldYDimension-1; J:=Y;
REPEAT
IF MarkField[X,Y]<>4 THEN
BEGIN
PlayField[X,J]:=PlayField[X,Y];
DEC(J);
END;
DEC(Y);
UNTIL Y<0;
FOR Y:=0 TO J DO
PlayField[X,Y]:=3;
END;
J:=0;
FOR X:=PlayFieldXDimension-2 DOWNTO 0 DO
BEGIN
IF PlayfIeld[X,PlayFieldYDimension-1]=3 THEN
BEGIN
Move(PlayfIeld[X+1,0],PlayField[X,0],PlayFieldYDimension*(PlayFieldXDimension-X-1));
INC(J);
END;
END;
IF J<>0 THEN
FillChar(PlayField[PlayFieldXDimension-J,0],J*PlayFieldYDimension,#3);
INC(Score,CubesToScore);
ShowScore;
END;
END;

PROCEDURE BuildScreen;
{Some procedures that build the screen}

var s : String;

BEGIN
{$IFDEF UseGraphics}
setbkcolor(black);
setviewport(0,0,getmaxx,getmaxy,clipoff);
clearviewport;
{$ELSE}
ClrScr;
{$ENDIF}
Score:=0;
ShowScore;
ShowButtons;
ShowHighScore;
ShowMouse;
{$IFDEF UseGraphics}
SetTextStyle(0,Horizdir,2);
OuttextXY(10,10,'SameGame v0.03, (C) by Marco v/d Voort. ');
SetTextStyle(0,Horizdir,1);
OuttextXY(50,40,'A demo for the FPC RTL and API units Crt,(MS)Mouse and Graph');
{$ELSE}
GotoXY(1,1);
TextColor(Yellow);
Write('SameGame v0.02');
TextColor(White);
Write(' A demo for the ');
TextColor(Yellow); Write('FPC');
TextColor(White); Write(' API or MsMouse unit. By Marco van de Voort');
SetDefaultColor;
{$ENDIF}
IF LastScore<>0 THEN
BEGIN
{$Ifdef UseGraphics}
SetTextStyle(0,Horizdir,1);
Str(LastScore,S);
OuttextXY(50,40,'The Score in the last game was :'+S);
{$else}
GotoXY(10,20);
Write('The score in the last game was :',LastScore);
{$endif}
END;
DisplayPlayField(PlayField);
MarkField:=PlayField;
END;

PROCEDURE DoMainLoopMouse;
{The main game loop. The entire game runs in this procedure, the rest is
initialisation/finalisation (like loading and saving highscores etc etc)}

VAR X,Y,
MX,MY,MState,Dummy : LONGINT;
EndOfGame : LONGINT;
S : String;

BEGIN
RANDOMIZE;
REPEAT
FillPlayField;
BuildScreen;
EndOfGame:=0;
REPEAT
GetMouseState(MX,MY,MState);
{$IFDEF UseGraphics}
X:=2*((MX-GrFieldX) DIV ScalerX) +FieldX;
Y:=((MY-GrFieldY) DIV ScalerY) +FieldY-1;
{$ELSE}
X:=MX SHR 3;
Y:=MY SHR 3;
{$ENDIF}
IF PlayFieldPiecesLeft=0 THEN
BEGIN
INC(Score,1000);
EndOfGame:=1;
END
ELSE
BEGIN
{$IFDEF UseGraphics}
IF (MX>=MenuX) AND (MX<(MenuX+16*Length(GrNewGameLine))) THEN
BEGIN {X in clickable area}
IF (MY>=MenuY) AND (MY<(MenuY+RowDispl*3+2)) THEN
BEGIN
X:=65; {X doesn't matter as long as it is 60..69}
Y:=((MY-MenuY) DIV RowDispl)+4;
END;
END;
{$ENDIF}
IF (X>=60) AND (X<=69) THEN
BEGIN
IF (MState AND LButton) <>0 THEN {If leftbutton pressed,}
BEGIN
IF Y=4 THEN
EndOfGame:=1;
IF Y=6 THEN
EndOfGame:=2;
IF (EndOfGame>0) AND (PlayFieldPiecesLeft=0) THEN
INC(Score,1000);
IF Y=5 THEN
BEGIN
ShowHelp;
BuildScreen;
END;
{$IFDEF Linux}
IF Y=7 THEN
BEGIN
write(#27+'(K');
BuildScreen;
END;
{$ENDIF}
END;
END;
IF (X>=(FieldX-2)) AND (Y>=(FieldY-2)) THEN
BEGIN

DEC(X,FieldX-1);
DEC(Y,FieldY-1);
X:=X SHR 1;
IF (X<PlayFieldXDimension) AND (Y<PlayFieldYDimension) THEN
BEGIN
IF MarkField[X,Y]<>4 THEN
BEGIN
MarkField:=PlayField;
MarkAfield(X,Y);
DisplayPlayField(MarkField);
{$ifdef UseGraphics}
SetFillStyle(SolidFill,black);
Bar(420,440,540,460);
SetTextStyle(0,Horizdir,1);
Str(CubesToScore,S);
OuttextXY(420,440,'Marked : '+S);
{$else}
TextColor(White);
GotoXY(20,22);
Write(' ':20);
GotoXY(20,22);
Write('Marked :',CubesToScore);
{$endif}
END;
IF (MarkField[X,Y]=4) AND ((MState AND LButton) <>0) THEN
{If leftbutton pressed,}
BEGIN
REPEAT {wait untill it's released.
The moment of pressing counts}
GetMouseState(X,Y,Dummy);
UNTIL (Dummy AND LButton)=0;
Colapse;
MarkField:=PlayField;
DisplayPlayField(MarkField);
END
END
END;
IF KeyPressed THEN
BEGIN
X:=GetKey;
IF (CHR(X) IN ['X','x','Q','q']) OR (X=27) THEN
EndOfGame:=2;
END;
END;
UNTIL EndOfGame>0;
ShowScore;
X:=SlipInScore(Score);
IF X<>0 THEN
BEGIN
HideMouse;
ShowHighScore;
{$IFDEF UseGraphics}
Str(Score:5,S);
OutTextXY(HighX+150,HighY+LineDistY*(10-X),S);
GrInputStr(S,HighX,HighY+LineDistY*(10-X),16,12,10,FALSE,AlfaBeta);
{$ELSE}
InputStr(S,HighX,HighY+12-X,10,FALSE,AlfaBeta);
{$ENDIF}
HighScore[X-1].Name:=S;
ShowMouse;
END;
LastScore:=Score;
UNTIL EndOFGame=2;
END;

CONST FileName='samegame.scr';

VAR I : LONGINT;
{$IFDEF UseGraphics}
gd,gm : INTEGER;
Pal : PaletteType;
{$ENDIF}

BEGIN
{$IFDEF UseGraphics}
{$ifdef Win32}
ShowWindow(GetActiveWindow,0);
{$endif}
gm:=vgahi;
gd:=vga;
InitGraph(gd,gm,'');
if GraphResult <> grOk then
begin
Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
Halt(1);
end;
SetFillStyle(SolidFill,1);
GetDefaultPalette(Pal);
SetAllPalette(Pal);
{$ENDIF}
IF NOT MousePresent THEN
BEGIN
Writeln('No mouse found. A mouse is required!');
HALT;
END;
FOR I:=0 TO 9 DO
HighScore[I].Score:=I*1500;
LoadHighScore(FileName);
InitMouse;
{$ifndef Win32Graph}
CursorOff;
{$endif}
{$IFDEF UseGraphics}
HighX:=450; HighY:=220; {the position of the highscore table}
{$else}
HighX:=52; HighY:=10; {the position of the highscore table}
{$endif}

DoMainLoopMouse;

HideMouse;
DoneMouse;
{$ifndef Win32Graph}
CursorOn;
{$endif}
SaveHighScore;
{$IFDEF UseGraphics}
CloseGraph;
{$ENDIF}
{$ifndef Win32Graph}
ClrScr;
Writeln;
Writeln('Last games'#39' score was : ',Score);
{$endif}
END.
{
$Log: samegame.pp,v $
Revision 1.3 2002/02/22 21:41:22 carl
* range check error fix

Revision 1.2 2001/11/11 21:09:50 marco
* Gameunit, Fpctris and samegame fixed for win32 GUI

Revision 1.1 2001/05/03 21:39:33 peter
* moved to own module

Revision 1.2 2000/07/13 11:33:09 michael
+ removed logs

}

Answer 4

您好！
一些简单的游戏很容易实现
如猜拳、猜数等
但一些像炸弹人、飞机大战之类的就比较难实现，即使实现了，视觉效果也不好
所以建议用其他编程软件编

谢谢

Answer 5

纠正楼上：谁说PASCAL编的游戏不能用鼠标。我就看过Pascal编的飞机游戏和小人游戏！
二楼是Delphi的。
pascal的百度一下 有代码。很麻烦。要用很多库 单元。
菜鸟闪过而已。。目的只是为了纠正楼上。。