Delphida Billard o`yinini yaratish usulli

Muallif: Mengliyev Sh.

Qo`shilgan sana: 2015-01-06

Delphida Billard o`yinini yaratish usulli

Forma1 yuklanayonganda forma strukturasi rasm1 da keltirilgan

rasm1

unit Noms;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, variables;

type
TForm2 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
Label2: TLabel;
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Dйclarations privйes }
public
{ Dйclarations publiques }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.BitBtn2Click(Sender: TObject);
begin
form2.modalresult:=mrok;
nom1:=edit1.Text;
nom2:=edit2.Text; {pas besoin de close car affectation modale->fermeture automatique}
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
self.ShowModal;
end;

end.

Forma strukturasi

rasm 2.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, StdCtrls,idglobal, zone_de_jeu, canne,
noms, variables,boules, Buttons ;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Fichier1: TMenuItem;
N1: TMenuItem;
Quitter1: TMenuItem;
PaintBox1: TPaintBox;
Nouvellepartie1: TMenuItem;
Panel1: TPanel; {nom1}
Panel2: TPanel; {nom2}
Panel3: TPanel;
Timer1: TTimer; {animation des boules}
Timer2: TTimer;
Timer3: TTimer;
rejouercoup1: TMenuItem;
VitesseJeu2: TMenuItem;
N11: TMenuItem;
N21: TMenuItem;
N51: TMenuItem;
N41: TMenuItem;
N31: TMenuItem;
SpeedButton1: TSpeedButton;

procedure Quitter1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure initialisation;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Nouvellepartie1Click(Sender: TObject);
procedure noms_joueurs;
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure messages;
procedure Timer3Timer(Sender: TObject);
procedure rejouercoup1Click(Sender: TObject);
procedure VitesseJeu1Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure N41Click(Sender: TObject);
procedure N51Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Dйclarations privйes }
public
{ Dйclarations publiques }
function etat_jeu:boolean;
end;

procedure chgt_joueur;
procedure animfin;

var
Form1: TForm1;

implementation

var msgfin:string;

{$R *.dfm}

procedure TForm1.Quitter1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
sleep(500);
phasecanne:=false;
initialisation;
timer2.enabled:=true;
end;

procedure tform1.initialisation;
var i:integer;
begin
bmptravail:=tbitmap.create;
table:=tbitmap.Create;

{rasm2 ni yuklash }
table.LoadFromFile('billard2.bmp');
bmptravail.width:=paintbox1.Width;
bmptravail.height:=paintbox1.height;
bmptravail.assign(table); {copie l'un dans l'autre}
for i:=1 to 16 do
begin
boule[i].x:= xinitial[i]; {boules prкtes au dйpart}
boule[i].y:= yinitial[i];
boule[i].vx:=0;
boule[i].vy:=0;
boule[i].etat:=1; {1 <-> boule sur la table}
if i=1 then
boule[i].couleur:=clwhite;
if i=2 then
boule[i].couleur:=clblack;
if (i>2) and (i<10) then
boule[i].couleur:=clred;
if (i>9) then
boule[i].couleur:=clyellow;
afficher_boule(i);
end;
{ dimensions de la canne }
ro[1]:= rboule*2; ro[2]:= rboule*3;
ro[3]:= rboule*13; ro[4]:= rboule*15;
ro[5]:= rboule*20; ro[6] := rboule*20+3;
if not timer2.enabled then {ie si premier lancement}
{---------------------------------------------}
form1.Repaint;
nvtour:=true;
vites:=3;
jr[1].couleur:=clblue; jr[2].couleur:=clblue;
jr[1].bonus:=false; jr[2].bonus:=false;
jr[1].first:=clblue; jr[2].first:=0;
jr[1].nom:=nom1; jr[2].nom:=nom2;
jr[1].rentrees:=false; jr[2].rentrees:=false;
main:=1; mainpre:=1; {on donne la main au joueur 1}
casse:=false;
panel3.Caption:='Lancer une nouvelle partie';
timer3.Enabled:=false;
end;

procedure tform1.noms_joueurs;
begin
nom1:=form2.edit1.text;
nom2:=form2.edit2.text;
form1.Panel1.Font.Color:=jr[1].couleur;
form1.Panel2.Font.Color:=jr[2].couleur;
if main=1 then
begin
panel1.Font.style := [fsBold,fsUnderline]; {on souligne le nom du joueur qui a la main}
panel2.Font.style := [fsBold];
end
else
begin
panel2.Font.style := [fsBold,fsUnderline]; {on souligne le nom du joueur qui a la main}
panel1.Font.style := [fsBold];
end;
form1.Panel1.Caption:=nom1;
form1.Panel2.Caption:=nom2;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(decalagex,decalagey,bmptravail); {faut afficher manuellement car paintbox}
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
table.free;
bmptravail.free;
end;

function tform1.etat_jeu:boolean;
var i:integer;
begin
result:=true; {true si boules toutes а l'arrкt}
for i:=1 to 16 do
if (boule[i].vx<>0) or (boule[i].vy<>0) then result:=false;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if phasecanne and (boule[1].etat<>0) then {si boule blanche sortie mouseclick prend le relais}
begin
calculcanne(x, y );
afficher_canne(boule[1].x +decalagex, boule[1].y +decalagey,paintbox1 );
end;
{panel1.Caption:=inttostr(x-decalagex);
panel2.caption:=inttostr(y-decalagey); }

end;

procedure TForm1.Nouvellepartie1Click(Sender: TObject);
begin
timer2.enabled:=false;
phasecanne:=false;
if form2.ShowModal=mrok then
begin
initialisation;
rejoue:=true; {йvite bug d'affichage}
end;
timer2.enabled:=true; {normalement le prgm attend la fermeture de form2}
PaintBox1.Canvas.Draw(decalagex,decalagey,bmptravail); {rйaffiche tte la table}
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,j:integer; {boucle avec j si trop lent}
r:trect; {parce qu'il y a un dйcalage par rapport au paintbox}
begin
for j:=1 to vites do
begin
for i:=1 to 16 do
begin
nouvelle_position(i);
end;
efface_tout; {pour que les calculs ne perturbent pas l'affichage}
for i:=1 to 16 do
begin
afficher_boule(i);
end;
{PaintBox1.Canvas.Draw(decalagex,decalagey,bmptravail); }
r:=rect(runion.left+decalagex,runion.top+decalagey,runion.Right+decalagex,runion.Bottom+decalagey);
paintbox1.Canvas.CopyRect(r,bmptravail.Canvas,runion);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
for i:=1 to 16 do
begin
boule[i].vx:=1-random(3);
boule[i].vy:=1-random(3);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
initialisation;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
jr[1].nom:=nom1;jr[2].nom:=nom2;
noms_joueurs;
if not etat_jeu then {au moins une boule en mouvement}
begin
timer1.enabled:=true;
phasecanne:=false; {sыrement inutile dans la version finale}
end
else {boules а l'arrкt on commence un nv tour}
begin
timer1.Enabled:=false;
if not form2.visible then phasecanne:=true; {йvite bug d'affichage avec la fenкtre des noms de joueurs}
if not nvtour then
begin
if (faute=-3) or (faute=4) then
begin
if faute=-3 then
begin
msgfin:=(jr[main].nom+' gagne');
end
else
begin
msgfin:=(jr[inv(main)].nom+' gagne');
end;
animfin;
end
else if jr[main].rentrees=false then
begin

if jr[main].first=clblue then faute:=2 {evite de refaire le test а chaque collision}
else
if (jr[main].couleur<>clblue) and (faute<>-2) and (jr[main].first<>jr[main].couleur) then
faute:=5;
if (jr[main].first=clblack) and (jr[main].rentrees=false) then faute:=6;
if faute<=-1 then jr[main].bonus:=true;
if faute>=1 then jr[main].bonus:=false; {une faute implique la perte du bonus}
end;
chgt_joueur;
messages; {messages aprиs chgt_joueur pour la cohйrence des messages}
{----------------------rиgles--------------------------}
if (not casse) or (faute>=1) then jr[main].bonus:=true;
{------------------------------------------------------}

jr[main].first:=clblue;
nvtour:=true; {nvtour effectif qd on a changй de joueur}
faute:=0;
end;
end;

end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

var i,pasmain:integer;
begin
if (boule[3].etat=0) and (boule[4].etat=0) and (boule[5].etat=0)
and (boule[6].etat=0) and (boule[7].etat=0) and (boule[8].etat=0) and (boule[9].etat=0) then
begin if jr[main].couleur=clred then jr[main].rentrees:=true
end;
if (boule[10].etat=0) and (boule[11].etat=0) and (boule[12].etat=0)
and (boule[13].etat=0) and (boule[14].etat=0) and (boule[15].etat=0) and (boule[16].etat=0) then
begin if jr[main].couleur=clyellow then jr[main].rentrees:=true
end;
if phasecanne then
if boule[1].etat<>0 then
begin {on met la blanche en mouvement}
phasecanne:=false; {pour pas que la canne s'efface automatiquement}
boule[1].vx:= -force*cos1*Kforce;
boule[1].vy:= -force*sin1*kforce;
for i:=1 to 16 do
begin
boule[i].etatpre:=boule[i].etat;
boule[i].xpre:=boule[i].x;
boule[i].ypre:=boule[i].y;
end;
effacecanne(paintbox1);

nvtour:=false;
end
else {remise en place de la blanche}
begin
replacer_blanche(x-decalagex,y-decalagey);
afficher_boule(1);
PaintBox1.Canvas.Draw(decalagex,decalagey,bmptravail); {rйaffiche tte la table}
end;
end;

procedure tform1.messages;
var i:integer;
s:string;
begin
case faute of
-3: s:='!!!!!!! GAGNE !!!!!!!';
-2: s:='!!!!!!!!! Premiиre boule rentrйe !!!!!!!!!';
-1: s:='Joli Coup !';
-4: s:='Bien Jouй';
-7: s:='Pas Mal !!!';
-10: s:='Bravo';
-13: s:='Waouh !';
0: s:='';
1: s:='Faute! Veuillez replacer la boule blanche dans la zone de gauche';
2: s:='Faute! Vous n'+char(658)+'avez touchй aucune boule';
3: s:='Faute! Boule adverse empochйe * 2 coups pour '+jr[main].nom;
4: s:='PERDU...vous avez rentrй la boule noire; '+jr[inv(main)].nom+' gagne la partie';
5: s:='Faute! Boule adverse touchйe';
6: s:='Faute! Boule noire touchйe en premier';
end; {il en faut un pour le case}
panel3.Caption:=s;

end;

procedure chgt_joueur;
begin
mainpre:=main;
if not jr[main].bonus then
begin
if main=1 then main:=2
else main:=1;
end
else
jr[main].bonus:=false; {bonus utilisй}
end;

procedure animfin;
var i:integer ;
begin
bmptravail.assign(table);
form1.PaintBox1.Canvas.Draw(decalagex,decalagey,table);
bmptravail.Canvas.Font.Color:=clblue;
bmptravail.Canvas.Font.Size:=24;
bmptravail.Canvas.Font.Name:='Comic sans ms';
for i:=1 to 16 do
begin
boule[i].x:=xanim[i]; {boules prкtes au dйpart}
boule[i].y:=yanim[i];
boule[i].vx:=0;
boule[i].vy:=0;
boule[i].etat:=1; {1 <-> boule sur la table}
boule[i].couleur:=boulcouleur[i];
afficher_boule(i);
end;
phasecanne:=false;
form1.timer3.Enabled:=true; {а ce point c'est celui qui a rentrй la noire qui a la main}
end;

procedure TForm1.Timer3Timer(Sender: TObject);
var i:integer;
begin
bmptravail.Canvas.brush.color:=$2D6D2B;
for i:=1 to 16 do
begin
boule[i].vx:=1-random(3);
boule[i].vy:=1-random(3);
end;
bmptravail.Canvas.TextOut(180,125,msgfin);
paintbox1.Canvas.Draw(decalagex,decalagey,bmptravail);
end;

procedure TForm1.rejouercoup1Click(Sender: TObject);
var
i:integer;
begin
if (timer3.enabled=false) and etat_jeu then
begin
rejoue:=true;
bleu:=true;
form1.timer3.Enabled:=false;

main:=mainpre;
panel3.caption:='Rejouez votre coup!!!';
for i:=1 to 16 do
begin
if boule[i].etatpre=0 then bleu:=false;
effacer_boule(i);
if i=1 then
boule[i].couleur:=clwhite;
if i=2 then
boule[i].couleur:=clblack;
if (i>2) and (i<10) then
boule[i].couleur:=clred;
if (i>9) then
boule[i].couleur:=clyellow;
boule[i].etat:=boule[i].etatpre;
boule[i].vx:=0; boule[i].vy:=0;
boule[i].x:=boule[i].xpre;
boule[i].y:=boule[i].ypre;
end;
for i:=1 to 16 do afficher_boule(i);
PaintBox1.Canvas.Draw(decalagex,decalagey,bmptravail);
form1.Repaint;
if bleu=true then begin jr[main].couleur:=clblue; jr[inv(main)].couleur:=clblue end
end;
end;

procedure TForm1.VitesseJeu1Click(Sender: TObject);
begin
rejoue:=false;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
vites:=1;
end;

procedure TForm1.N21Click(Sender: TObject);
begin
vites:=2;
end;

procedure TForm1.N31Click(Sender: TObject);
begin
vites:=3;
end;

procedure TForm1.N41Click(Sender: TObject);
begin
vites:=4;
end;

procedure TForm1.N51Click(Sender: TObject);
begin
vites:=5;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var i:integer;
begin
if (timer3.enabled=false) and etat_jeu then
begin
rejoue:=true;
bleu:=true;
form1.timer3.Enabled:=false;

Kordinatalari quyida berilgan

unit Boules;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls,variables ;

procedure nouvelle_position(n:integer); {calcule tout }
procedure collision(n1,n2 :integer); {calcul des vitesses aprиs chocs}
procedure bande(n:integer);
procedure trou(n:integer);
procedure ralentir(n:integer);
procedure replacer_blanche(x,y:integer);
function test_collision2(n1,n2:integer):boolean;
function test_collision(n1,n2:integer):boolean;
function distance(n1,n2:integer):single;
function inv(m:integer):integer; {utilisй pour savoir qui n'a pas la main}

implementation

procedure nouvelle_position(n:integer);
var i,j:integer;
begin
boule[n].xold := boule[n].x;
boule[n].yold := boule[n].y;

for i:=1 to 16 do
if boule[i].etat<>0 then
begin
bande(i);trou(i);
for j:=i+1 to 16 do
begin
if boule[j].etat<>0 then
begin
if test_collision(i,j) then
begin
collision(i,j);
{si collision on assigne la couleur de la premiйre boule touchйe}
if casse then
begin
if (i=1) and (jr[main].first=clblue) then jr[main].first:=boule[j].couleur;
if (j=1) and (jr[main].first=clblue) then jr[main].first:=boule[i].couleur;
end
else casse:=true;
end;
end;
end;

boule[n].x:=boule[n].xold+boule[n].vx;
boule[n].y:=boule[n].yold+boule[n].vy;
end;
ralentir(n);

end;

procedure collision(n1,n2 :integer);
var dy,dx,v1x,v1y,v2x,v2y,a,stock:single;

begin
if test_collision2(n1,n2) then begin stock:=boule[n1].vx;
boule[n1].vx:=boule[n2].vx*3/4+stock*1/4;
boule[n2].vx:=stock*3/4+boule[n2].vx*1/4;
stock:=boule[n1].vy;
boule[n1].vy:=boule[n2].vy*3/4+stock*1/4;
boule[n2].vy:=stock*3/4+boule[n2].vy*1/4
end;

if test_collision(n1,n2) then
dx:=(boule[n1].x+boule[n1].vx-boule[n2].x-boule[n2].vx); {idem}
dy:=(boule[n1].y+boule[n1].vy-boule[n2].y-boule[n2].vy); {idem}
a:=arctan(dy/(dx+0.00000001)); {angle formй par l'axe passant par les centres des boules et l'axe x}
v1x:=boule[n1].vx; {0.000000001 pour enlever la division par 0}
v2x:=boule[n2].vx;
v1y:=boule[n1].vy;
v2y:=boule[n2].vy;
{nouvelles vitesses donnйes par les relations simplificatrices des chocs entre boules}
boule[n1].vx:=(v2x*cos(a)+v2y*sin(a))*cos(a)+(v1x*sin(a)-v1y*cos(a))*sin(a) ;
boule[n1].vy:=(v2x*cos(a)+v2y*sin(a))*sin(a)+(-v1x*sin(a)+v1y*cos(a))*cos(a) ;
boule[n2].vx:=(v1x*cos(a)+v1y*sin(a))*cos(a)+(v2x*sin(a)-v2y*cos(a))*sin(a) ;
boule[n2].vy:=(v1x*cos(a)+v1y*sin(a))*sin(a)+(-v2x*sin(a)+v2y*cos(a))*cos(a) ;
end;

procedure bande(n:integer);
var a,xx,yy:single;
begin
xx:=boule[n].x+boule[n].vx;
yy:=boule[n].y+boule[n].vy;
{bandes horizontales}
if (( (xx>=xb) and (xx<=xc) ) or ( (xx>=xd) and (xx<=xe) )) and ( (yy<=yb) or (yy>=yk) )
then boule[n].vy:=-boule[n].vy;

{bandes verticales}
if ( (yy>=ya) and (yy<=yl) and ( (xx<=xa) or (xx>=xf) ) )
or ( (((xx>=xc) and (xx<=xcp)) or ((xx>=xdp) and (xx<=xd))) and ((yy<=ycp) or (yy>=yjp)) )
then boule[n].vx:=-boule[n].vx;

{droites а 45 degrй montantes}
if ( (xx+yy<=xc+yb) and (xx>=xc) and (yy>=ycp) )
or ( (xx+yy>=xd+yk) and (xx<=xd) and (yy<=yjp) )
or ( (xx+yy<=xa+yl) and (yy>=yl) )
or ( (xx+yy>=xb+yk) and (xx<=xb) )
or ( (xx+yy<=xe+yb) and (xx>=xe) )
or ( (xx+yy>=xf+ya) and (yy<=ya) )
then begin a:=boule[n].vx;
boule[n].vx:=-boule[n].vy;
boule[n].vy:=-a;
exit
end;

{droites а 45 degrйs descendantes}
if ( (xx-xd>=yy-yb) and (xx<=xd) and (yy>=ycp) )
or ( (xx-xc<=yy-yk) and (xx>=xc) and (yy<=yjp) )
or ( (xx-xa<=yy-ya) and (yy<=ya) )
or ( (xx-xb>=yy-yb) and (xx<=xb) )
or ( (xx-xe<=yy-yk) and (xx>=xe) )
or ( (xx-xf>=yy-yl) and (yy>=yl) )
then begin a:=boule[n].vx;
boule[n].vx:=boule[n].vy;
boule[n].vy:=a;
exit
end;
end;

procedure trou(n:integer);
var pasmain:integer; {numйro du joueur qui n'a pas la main}
begin
{disparition des boules}
if ((boule[n].y<=y1)or(boule[n].y>=y2)or(boule[n].x<=x1)or(boule[n].x>=x2))
then begin
boule[n].etat:=2;
boule[n].vx:=0;
boule[n].vy:=0;
{rиgles}
if (n=1) and (faute<>-3) and (faute<>4) then faute:=1;

if (n>=3) and (faute<>-3) and (faute<>4) then
begin
if (jr[main].couleur=clblue) then {assigne des couleurs aux joueurs}
begin
{jr[main].rentrees:=1;}
faute:=-2;
jr[main].couleur:=boule[n].couleur;
pasmain:=inv(main);
if jr[main].couleur=clred then
jr[pasmain].couleur:=clyellow
else
jr[pasmain].couleur:=clred
end
else
if boule[n].couleur=jr[main].couleur then
begin
faute:=-1-3*random(5); {йventuellemant йcrasй si boules adverses rentrйes ensuite}
{jr[main].rentrees:=jr[main].rentrees+1;}
end
else
begin
if jr[main].rentrees=false then faute:=3;
pasmain:=inv(main);
{jr[pasmain].rentrees:=jr[pasmain].rentrees+1;}
end;
end;
if n=2 then {boule noire!}
begin
if jr[main].rentrees=true then faute:=-3
else
faute:=4;
end;

end;
{effet donnй par les bordures des trous, permet aussi а une boule de ne pas s'arreter dans le vide}
{trou 1}
if (((boule[n].x-xt1)*(boule[n].x-xt1)+(boule[n].y-yt1)*(boule[n].y-yt1))<=rtrou2)
then begin
boule[n].vy:=boule[n].vy-0.0007;
boule[n].vx:=boule[n].vx-0.0007
end;
{trou 2}
if (((boule[n].x-xt2)*(boule[n].x-xt2)+(boule[n].y-yt2)*(boule[n].y-yt2))<=rtrou2)
then boule[n].vy:=boule[n].vy-0.0007;
{trou 3}
if (((boule[n].x-xt3)*(boule[n].x-xt3)+(boule[n].y-yt1)*(boule[n].y-yt1))<=rtrou2)
then begin
boule[n].vy:=boule[n].vy-0.0007;
boule[n].vx:=boule[n].vx+0.0007
end;
{trou 4}
if (((boule[n].x-xt1)*(boule[n].x-xt1)+(boule[n].y-yt4)*(boule[n].y-yt4))<=rtrou2)
then begin
boule[n].vy:=boule[n].vy+0.0007;
boule[n].vx:=boule[n].vx-0.0007
end;
{trou 5}
if (((boule[n].x-xt2)*(boule[n].x-xt2)+(boule[n].y-yt5)*(boule[n].y-yt5))<=rtrou2)
then boule[n].vy:=boule[n].vy+0.0007;
{trou 6}
if (((boule[n].x-xt3)*(boule[n].x-xt3)+(boule[n].y-yt4)*(boule[n].y-yt4))<=rtrou2)
then begin
boule[n].vy:=boule[n].vy+0.0007;
boule[n].vx:=boule[n].vx+0.0007
end;
end;

procedure ralentir(n:integer);
begin
boule[n].vx:=boule[n].vx*kralentissement;
boule[n].vy:=boule[n].vy*kralentissement;
if abs(boule[n].vx)<0.01 then
boule[n].vx:=0;
if abs(boule[n].vy)<0.01 then
boule[n].vy:=0;
{autre essai infructueux : cette fois ci on soustrait
au lieu de multiplier par un nombre :
a:=arctan(boule[n].vy/boule[n].vx);
boule[n].vx:=boule[n].vx-kralentissement*cos(a);
boule[n].vy:=boule[n].vy-kralentissement*sin(a);}
end;

procedure replacer_blanche(x,y:integer);
var contact:boolean;
i:integer;
d,dmin:single; {distances}
begin
contact:=false;
dmin:=1000; {distance minimale}
for i:=2 to 16 do
begin
d:=sqrt((x-boule[i].x)*(x-boule[i].x)+(y-boule[i].y)*(y-boule[i].y));
if dmin>d then dmin:=d;
end;
if dmin<=2*rboule then contact:= true; {йvite le chevauchement avec une autre boule}
{petite tricherie pour pas que la boule ne tombe pas ds le trou}
if (x>45+rboule) and (x<=154) and (y>45+rboule) and (y<250-rboule) and not contact then
begin
boule[1].etat:=1;
boule[1].x:=x;
boule[1].y:=y;
end;
end;

function distance(n1,n2:integer):single;
begin
result:=sqrt((boule[n1].x-boule[n2].x)*(boule[n1].x-boule[n2].x)+(boule[n1].y-boule[n2].y)*(boule[n1].y-boule[n2].y))
end;

function inv(m:integer):integer; {utilisй pour savoir qui n'a pas la main}
begin
if m=1 then result:=2
else result:=1;
end;

end.

unit vitesse_jeu;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, variables;

type
TForm5 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Dйclarations privйes }
public
{ Dйclarations publiques }
end;

var
Form5: TForm5;

implementation

{$R *.dfm}

procedure TForm5.Button1Click(Sender: TObject);
begin
vites:=1; close;
end;

procedure TForm5.Button2Click(Sender: TObject);
begin
vites:=2; close;
end;

procedure TForm5.Button3Click(Sender: TObject);
begin
vites:=3; close;
end;

procedure TForm5.Button4Click(Sender: TObject);
begin
vites:=4; close;
end;

procedure TForm5.Button5Click(Sender: TObject);
begin
vites:=5; close;
end;

end.

unit splash;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;

type
TForm4 = class(TForm)
Image1: TImage;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Dйclarations privйes }
public
{ Dйclarations publiques }
end;

var
Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sleep(2000);
end;

end.

unit zone_de_jeu;
{cette unitй gиre l'affichage de la zone de jeu
coordonnйes а retenir:}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, boules ,variables;

procedure afficher_boule(n:integer);
procedure effacer_boule(n:integer);
procedure efface_tout;

implementation

procedure afficher_boule(n:integer);
var xx,yy:integer; {il faut bien des entiers pour la fonction ellipse}
r:trect;
begin
if boule[n].etat=0 then
exit
else
begin
with bmptravail.canvas do
begin
pen.color := boule[n].couleur;
brush.color:= boule[n].couleur;
xx:=trunc(boule[n].x);
yy:=trunc(boule[n].y);
ellipse(xx-rboule,yy-rboule,xx+rboule,yy+rboule);
r:=rect(xx-rboule,yy-rboule,xx+rboule,yy+rboule);
unionrect(runion,runion,r);
end;
end;
end;

procedure effacer_boule(n:integer);
var r:trect;
xx,yy:integer;
begin
if boule[n].etat<>0 then
with bmptravail.Canvas do
begin
xx:=trunc(boule[n].xold);
yy:=trunc(boule[n].yold);
r:=rect(xx - rboule,yy - rboule,xx + rboule,yy + rboule);
copyrect(r,table.Canvas,r);
end;
if boule[n].etat=2 then boule[n].etat:=0 {on efface une derniиre fois la boule rentrйe}
end;

procedure efface_tout;
var i,xx,yy:integer;
r:trect;
begin
runion:=rect(0,0,0,0);
for i:=1 to 16 do
begin
if boule[i].etat<>0 then
begin
xx:=trunc(boule[i].xold);
yy:=trunc(boule[i].yold);
r:=rect(xx - rboule,yy - rboule,xx + rboule,yy + rboule);
bmptravail.Canvas.CopyRect(r,table.Canvas,r);
unionrect(runion,runion,r);
if boule[i].etat=2 then boule[i].etat:=0; {on efface une derniиre fois la boule rentrйe}
end;
end
end;

end.

unit variables;

{dйfinition et dйclaration des variables globales au programmes}

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, idglobal;

const xa:integer=45;
xb:integer=53;
xc:integer=255;
xcp:integer=267;
xdp:integer=277;
ycp:integer=32;
yjp:integer=268;
xd:integer=289;
xe:integer=498;
xf:integer=505;
yb:integer=46;
ya:integer=53;
yl:integer=250;
yk:integer=255;
x1:integer=36;
x2:integer=515;
y1:integer=23;
y2:integer=277;
xt1:integer=30;
xt2:integer=272;
xt3:integer=514;
yt1:integer=30;
yt2:integer=20;
yt4:integer=270;
yt5:integer=280;
rtrou2:integer=500;
rboule:integer= 9; {rayon des boules}
boulcouleur:array[1..16] of tcolor=(clRed, clGreen, clYellow, clBlue, clWhite, clGray, clFuchsia, clTeal, clNavy, clMaroon, clLime, clOlive, clPurple, clSilver, clAqua, clBlack);
xinitial:array[1..16] of integer=({154,404,382,404,404,426,426,448,448,360,382,426,426,448,448,448);}
{154,406,385,406,406,427,427,448,448,364,385,427,427,448,448,448);}
154,412,394,412,430,430,448,448,448,376,394,412,430,430,448,448);
yinitial:array[1..16] of integer=({150,150,139,128,172,139,183,128,172,150,161,117,161,106,150,194);}
150,150,160,130,180,140,150,170,110,150,140,170,160,120,130,190);
xanim:array[1..16] of integer=(154,412,154,197,240,283,326,369,412,154,197,240,283,326,369,412);
yanim:array[1..16] of integer=(150,150,90,90,90,90,90,90,90,210,210,210,210,210,210,210);
{distance entre 2 centres d'une mкme ligne ou d'une mкme rangйe fixйe а 22 pixels}
bande_gauche:integer= 35; {abscisse de la bande gauche}
bande_droite:integer= 515; {abscisse de la bande droite}
decalagex:integer=76; {table n'est pas en 0,0}
decalagey:integer=41; {utilisй dans affichade bmptravail}
{et pour calculcanne}
kforce:single=0.5; {coefficient correcteur pour les vitesses}
{utilisй pour tricher sur la puissance du pc}
kralentissement:single=0.992;

type tboule = record
couleur:tcolor; {'rouge','jaune','blanche','noire'}
x,y,xold,yold,vx,vy,xpre,ypre:single; {position et vitesse}
etat,etatpre:integer; {0:sortie , 1:en jeu, 3:en cours de sortie}
end;
tjoueur = record
couleur:tcolor; {rouge,jaune ou noir au dйbut}
bonus:boolean; {true si le joueur a droit а un coup en plus}
first:tcolor; {numйro de la premiиre boule touchйe а chaque tour; initialisй а 0}
nom:string;
rentrees:boolean; {toutes les boules rentrйes}
end;

var
bleu:boolean;
boutonvalide:boolean;
mainpre:integer;
runion:trect;
table:tbitmap; {table de yahoo 552*302 pixels}
bmptravail:tbitmap; {bmp ou les modifs sont effectuйes
vйrifier l'utilitй....}
boule:array[1..16] of tboule; {cf dйclaration dans boules.pas}
{variables pour la canne}
phasecanne:boolean; {true<->la canne est affichйe}
ro : array[1..6] OF single; { longueurs йlйments de la canne }
nom1,nom2:string; {noms des 2 joueurs}

sin1, cos1 : Single; { relatifs а l'angle de la canne }
Force : Single; { force du coup de canne }

{variables propres aux rиgles}
main:integer; {joueur qui a la main}
nvtour:boolean; {true qd on commence un nveau tour}
{initialisй qd on frappe avec la canne}
faute:integer; {nature de la faute donnйe par l'entier}
jr:array[1..2]of tjoueur;
casse:boolean; {false tt que le cassage n'est pas rйalisй}
rejoue:boolean;
vites:integer;

implementation

end.

3280 marta o`qildi.

shoydullo adminstrator