Paskalabc da grafiklarga oid dastlabki ma'lumotlar Program g 1; uses Graphabc; //1-kurs kt: Informatika va axborot texnologiyalar yo`nalishi talabasi Faxriddinov Sherzod


Download 98.52 Kb.
bet5/5
Sana25.10.2019
Hajmi98.52 Kb.
1   2   3   4   5

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;

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;
end.

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;


function test_collision(n1,n2:integer):boolean; {renvoie vrai s'il y collision entre les deux boules, sinon renvoie non}
var dx,dy,dx2,dy2:single;
begin
dx:=(boule[n1].x+boule[n1].vx-boule[n2].x-boule[n2].vx); {ecart sur x entre les 2 boules}
dy:=(boule[n1].y+boule[n1].vy-boule[n2].y-boule[n2].vy);{ecart sur y}
dx2:=(boule[n1].x-boule[n2].x);
dy2:=(boule[n1].y-boule[n2].y);
if ((dx*dx+dy*dy)<={390}324) and ((dx2*dx2+dy2*dy2)>=320) {formule de pythagore}
then result:=true
else result:=false;
end;

function test_collision2(n1,n2:integer):boolean; {renvoie vrai s'il y collision entre les deux boules, sinon renvoie non}


var dx,dy:single;
begin
dx:=(boule[n1].x-boule[n2].x); {ecart sur x entre les 2 boules}
dy:=(boule[n1].y-boule[n2].y); {acart sur y}
if (dx*dx+dy*dy)<={390}320 {formule de pythagore}
then result:=true
else result:=false;
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.

++++++++++++++++++++++++++++++++++++++++++++++++



Paskal da chiziqli algoritmlarga doir dasturlar tuzish.

1.1-masala. A va B ikkita haqiqy sonlar berilgan. Ularning yig`indisi va ko’paytmasini hisoblash dasturini tuzing



Dastur matni 
program yg`indi;
var a,b,s,p:real;
begin
write('a='); read(a);
write('b='); read(b);
s:=a+b;
p:=a*b;
write('s=',s);
write('p=',p);
end.

1.2-masala. Ikkita musbat son berilgan, bu sonlarning o’rta arifmetik va o’rta geometrik qiymatlarini hisoblash dasturini tuzing.



Dastur matni 
program misol 2;
var a,b,s,p:real;
begin
write('a='); read(a);;
write('b='); read(b);
s:=(a+b)/2;
p:=sqrt(a*b);
write('s=',s);
write('p=',p);

end.


1.3-masala. Tomonlari a va b ga teng bo’lgan to’g’ri to’rtburchakning yuzi va peremetrini hisoblash dasturini tuzing.

Dastur matni 
program misol 3;
var
a,b,s,p: real;
begin
write('a='); read(a);
write('b='); read(b);
s:=a*b; p:=2*(a+b);
write('s=',s);
write('p=',p);

end.


1.4-masala. Teng tomonli uchburchakning tomoni A ga teng. Uchburchakning yuzini topish dasturini tuzing.

Dastur matni 
program misol 4;
var a,s:real;
begin
write('a='); read(a);
S:=(sqrt(3))*a*a/4;
write('S=',S);
end.

1.5-masala. Koordinatalari x1,y1 va x2, y2 ga teng bo’lgan nuqtalar orasidagi masofani hisoblash dasturini tuzing.



Dastur matni 
program misol 5;
var x1,x2,y1,y2,d:real;
begin
write('x1='); read(x1);
write('x2='); read(x2);
write('y1='); read(y1);
write('y2='); read(y2);
d:=sqrt(sqr(x2-x1)+sqr(y2-y1));
write('d=',d);
end.

1.6-masala. Birinchi hadi a1, ayirmasi d, hadlari soni n ga teng arifmetik progressiyaning hadlarining yig’indisini hisoblash dasturini tuzing.



Dastur matni 
program misol 6;
var a1,d,n,S: real;
begin
write('a1='); read(a1);
write('d='); read(d);
write('n='); read(n);
S:=(2*a1+d*(n-1))/2*n;
write('S=',S);
end.

1.7-masala. Birinchi hadi b, maxraji q va hadlari soni n ga teng geometrik progressiyaning hadlarining yig’indisi S ni hisoblash dasturini tuzing.



Dastur matni 
program misol 7;
var B,N,Q,S:real;
begin
write('B='); read(B);
write('Q='); read(Q);
write('B='); read(B);
S:=(B*(1-exp(N*ln(Q))))/(1-Q);
write('S=',S);
end.

1.8-masala. Berilgan sonning butun qismini aniqlang.



Dastur matni 
program misol 8;
var a,b,s:real;
begin
write('a='); read(a);
write('b='); read(b);
s:=a div b;
write('s=',s);
end.

1.9-masala. Bir tomoni va unga yopishgan ikkita burchagi berilgan uchburchakning uchinchi burchagi va qolgan ikki tomonini aniqlang.



Dastur matni

program misol 9;


var a,ab,bb,b,c,cb:real; 
begin
write('a='); read(a);
write('ab='); read(ab);
write('cb='); read(cb);
cb:=pi-ab*pi/180-bb*pi/180;
b:=a*sin(bb)/sin(ab);
c:=a*sin(cb)/sin(ab);
write('cb=',cb);
write('b=',b);

write('c=',c);

end.

Paskal da tarmoqlanuvchi algoritmlarga doir dasturlar tuzish.

2.1-masala. Tarmoqlanuvchi dasturlarga doir Paskal da kvadrat tenglamaning haqiqiy ildizlarini topish dasturi tuzilgan. Bu dasturga mos prosteduralarning ko’rinishi quyidagicha bo’ladi:

Program kvadrat;
var d,a,b,c,x1,x2:real;
begin
write('a=');read(a);

write('b=');read(b);

write('c=');read(c);
d:=b*b-4*a*c;
if d<0 then Write('xaqiqiy echimi yo`k')
else begin x1:=(-b-sqrt(d))/(2*a);
x2:=(-b+sqrt(d))/(2*a);

Write(''x1= ,x1);

Write(''x2= ,x2);;
end;
end;

end.


2.2masala. Ikki butun musbat son m va n larning eng katta umumiy bo’luvchisi (EKUB) ni aniqlash dasturini tuzing.

Dastur matni 
program ekub;
label 1,2;
var m,n,x,y:ineteger; 
begin
write('m=');read(m);
write('n=');read(n);
x:=m;y:=n;
1: if x=y then goto 2;
if x>y then x:=x-y else y:=y-x; goto 1;
2: write('x=',x);;
end.

2.3masala. Ikkita x va y sonlarning kattasini tanlash (EKT) dacturini tuzing.



Dastur matni 
program ekt;
var m,y,x:ineteger; 
begin
write('x=');read(x);
write('y=');read(y);
if x>y then begin m:=x; write('m=',m); end
else if y>x then begin m:=y; write('m=',m); end
else write('‘Bu sonlar teng!’);
end.

2.4 masala. Raketa v (km/soat) tezlik bilan Er ekvatoridagi nuqtadan Erning quyosh atrofidagi orbitasi bo’ylab uchiriladi. Raketani uchirish natijasi qanday bo’ladi?



Dastur matni 
program raketa;

var a:real;


begin
write('a=');read(a);
if a<7.9 then write('Raketa Yerga qaytib tushadi');
if (a>=7.9) and (a<11.2) then write('Raketa Yerning sun`iy yo`ldoshiga aylanadi');
if (a>=11.2) and (a<16.7) then write(' Quyoshning sun`iy yo`ldoshiga aylanadi');
if a>=16.7 then write('Raketa Galaktikaning sun`iy yo`ldoshiga aylanadi');
end. 

2.5-masala. Optimal og’irlikni aniqlash dasturini yozing. Dastur formasi quyidagicha ko’rinishga ega.

Dastur matni

program optimal;


var w,h,opt,d:real;
begin
write('w=');read(w);
write('h=');read(h);
opt:=h-100;
if w=opt then
begin

write('optimal');


end
else
if wbegin d:=opt-w;
write('siz semirishingiz kerak');
end
else
begin
d:=w-opt;
write('siz ozishingiz kerak',d ,'ga');
end;
end;
end.

2.6-masala. Agar kvadratning tomoni A, doiraning radiusi r ga teng bo’lsa, kvadrat va doiraning yuzlarini solishtirib kattasini aniqlang.

Dastur matni

program kvadrat;


var a,r,sk,sd:real; 
begin
write('a=');read(a);
write('r=');read(r);
sk:=a*a;sd:=pi*r*r;
if sk>sd then write(’Kvadratning yuzi katta!’) else if skend.

2.7-masala. Quyidagi funkstiya hisoblansin: x>0 bo’lganda 1 ga teng; x=0 da nolga teng; x<0 da -1 ga teng.



Dastur matni 
progran funksiya;
var x,y:real; 
begin
write('x=');read(x);
if x>0 then y:=1 else if x=0 then y:=0 else y:=-1;
write('y=',y); 
end.

2.8-masala. Berilgan N yil kabisa yili bo’lish-bo’lmasligini aniqlang. 


Izoh. Agar N 100 ga karrali son bo’lmasa va uning oxirgi ikki raqami 4 ga karrali son bo’lsa, u holda N-yil kabisa yilidir. Agar N soni 100 karrali bo’lsa, u holda N soni 400 ga karrali bo’lgandagina mazkur yil kabisa yili bo’ladi.

Dastur matni 
program kabisa;
var n:integer; 
begin
write('n=');read(n);
if n mod 100=0 then begin if n mod 400 =0 then write('Bu yil kabisa yili!') else write('Bu yil kabisa yili emas!'); end else

if n mod 4 =0 then write('Bu yil kabisa yili!') else write('Bu yil kabisa yili emas!');


end.

 

2.9-masala. a, b, c sonlar mos ravishda uchta kesmaning uzunliklarini ifodalaydi. Agar kesmalar uchburchakning tomonlarini ifodalasa, uchburchakning yuzi s, uchburchakka tashqi va ichki chizilgan aylanalarning radiuslari r1 va r2 larni toping.



Dastur matni 
program uchburchak;
var a,b,c,r1,r2,s,p:real; 
begin
write('a=');read(a);
write('b=');read(b);
write('c=');read(c);
if ((a+b)>c) and ((a+c)>b) and ((b+c)>a) then begin
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-c));
r2:=s/p;
r1:=a*b*c/(4*s);
write('r1=',r1);
write('r2=',r2);
write('s=',s); end else write('Kiritilgan sonlar uchburchak tomonlarini ifodalamaydi!');
end.

Download 98.52 Kb.

Do'stlaringiz bilan baham:
1   2   3   4   5




Ma'lumotlar bazasi mualliflik huquqi bilan himoyalangan ©fayllar.org 2020
ma'muriyatiga murojaat qiling