Guest User

PingPong game

a guest
Nov 15th, 2011
591
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit1;
  2. {pozn. úhly v delphi
  3.               |270
  4.               |
  5.               |
  6. 180           |              360 (0)
  7. --------------|--------------
  8.               |
  9.               |
  10.               |
  11.               |
  12.              90
  13. }
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  18.   Dialogs, ExtCtrls, StdCtrls, ComCtrls, Math, CPort;
  19.  
  20. type
  21.   TForm1 = class(TForm)
  22.     image1: TImage;
  23.     Timer1: TTimer;
  24.     Memo1: TMemo;
  25.     ComPort1: TComPort;
  26.     procedure DrawPadR(height: integer); //nakreslí pravou pálku (parametr udává výšku)
  27.     procedure DrawPadL(height: integer); //nakreslí levou pálku (parametr udává výšku)
  28.     procedure ResetCanvas; //překreslí plochu na černo, rozdělí na půl, zapíše skóre z proměnných scoreR a scoreL
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure Timer1Timer(Sender: TObject);
  31.     function drawball(pos: TPoint; angle: real): TPoint; //nakreslí míček, pos je aktuální pozice, angle je úhel, kterým má míček letět
  32.     procedure FormKeyPress(Sender: TObject; var Key: Char); //klávesa R pro reset hry, enter nebo P pro pauzu
  33.     procedure ComPort1RxChar(Sender: TObject; Count: Integer); //stará se o příchozí data, vyrovnává pálky, filtruje neplatná data
  34.   private
  35.     { Private declarations }
  36.   public
  37.     PadR, PadL, BallX, ScoreL, ScoreR: integer;
  38.     BallAngle, BallSpeed: real;
  39.     BallPosition: TPoint;
  40.     temp: integer;
  41.     ShowInfo: boolean;
  42.     stabilizationR, stabilizationL: array of integer;
  43.   end;
  44. Const
  45.   Space = 5; //mezera mezi okrajem a pálkou
  46.   PadLength  = 200; //délka pálky
  47.   PadWidth = 10; //šířka pálky
  48.   BallSize = 10; //šířka míčku
  49.   SpeedUp = 0.01;
  50.   //BallSpeed = 6; //rychlost míčku
  51.   SensorMin = 200; //minimální přijatelná hodnota senzoru
  52.   SensorMax = 3000; //maximální přijatelná hodnota senzoru
  53.   Fluidity = 5; //z kolika předchozích záznamů se má vyrovnávat
  54. var
  55.   Form1: TForm1;
  56.  
  57. implementation
  58.  
  59. {$R *.dfm}
  60.  
  61. procedure TForm1.DrawPadL(height: integer);
  62. begin
  63.   if height+PadLength>image1.Height then //pálka nebude nikdy vykreslena pod obrazovkou
  64.     height:=image1.Height-PadLength;
  65.   if height<0 then //pálka nebude nikdy vykreslena nad obrazovkou
  66.     height:=0;
  67.   image1.Canvas.Pen.Color:=clwhite;
  68.   image1.Canvas.Brush.Color:=clwhite;
  69.   image1.Canvas.Rectangle(space, height, space+padwidth, height+PadLength);
  70. end;
  71.  
  72. procedure TForm1.DrawPadR(height: integer);
  73. begin
  74.   if height+PadLength>image1.Height then //pálka nebude nikdy vykreslena pod obrazovkou
  75.     height:=image1.Height-PadLength;
  76.   if height<0 then //pálka nebude nikdy vykreslena nad obrazovkou
  77.     height:=0;
  78.   image1.Canvas.Pen.Color:=clwhite;
  79.   image1.Canvas.Brush.Color:=clwhite;
  80.   image1.Canvas.Rectangle(image1.Width-space, height, image1.Width-(space+padwidth), height+PadLength);
  81. end;
  82.  
  83. procedure TForm1.ResetCanvas;
  84. begin
  85. with image1.Canvas do begin
  86.   Pen.Color:=clblack;
  87.   Brush.color:=clblack;
  88.   Rectangle(0,0,image1.Width, image1.Height);
  89.   pen.Color:=clWhite;
  90.   PenPos:=point(screen.Width div 2, 0);
  91.   LineTo(screen.Width div 2, screen.Height);
  92.   font.Color:=clwhite;
  93.   font.name:='Courier New';
  94.   font.Style:=[fsBold];
  95.   font.Size:=72;
  96.   if scorel>9 then //pokud má skóre víc jak dvě desetinná místa bude posunuto dolevo
  97.     textout(screen.Width div 2-140, 0, inttostr(ScoreL))
  98.   else
  99.     textout(screen.Width div 2-78, 0, inttostr(ScoreL));
  100.   textout(screen.Width div 2+18, 0, inttostr(ScoreR)); //zapíše skóre pro hráče vpravo
  101. end;
  102. end;
  103.  
  104. procedure TForm1.FormCreate(Sender: TObject);
  105. begin
  106.   ShowInfo:=false;
  107.   BallSpeed:=7;
  108.   timer1.Enabled:=true;
  109.   setlength(stabilizationR, fluidity); //nastaví velikost polí podle plynulosti
  110.   setlength(stabilizationL, fluidity);
  111.   ScoreL:=0; //vynuluje skóre
  112.   ScoreR:=0;
  113.   padl:=image1.Height div 2 - padlength div 2; //umístí pálky doprostřed obrazovky
  114.   padr:=padl;
  115.   BallAngle:=degtorad(2); //nastaví úhel
  116.   BallPosition:=point(screen.Height div 2, space+padwidth); //nastaví základní pozici
  117.   image1.Top:=0;   //roztáhnout image přes celou obrazovku
  118.   image1.Left:=0;
  119.   image1.Width:=screen.Width;
  120.   image1.Height:=screen.Height;
  121.   resetcanvas; //inicializace canvasu
  122. end;
  123.  
  124. procedure TForm1.Timer1Timer(Sender: TObject);
  125. begin
  126. resetcanvas;  //zakreslit pálky, resetovat
  127. drawpadl(padl);
  128. drawpadr(padr);
  129.  
  130. BallSpeed:=BallSpeed+SpeedUp;
  131. if showinfo then begin
  132.   image1.Canvas.Font.Size:=8;          //pomocné informace
  133.   image1.Canvas.Brush.Style := bsClear;
  134.   image1.Canvas.Font.Color:=clwhite;
  135.   image1.Canvas.TextOut(50, 30, 'Right pad = '+inttostr(padr));
  136.   image1.Canvas.TextOut(50, 40, 'Left pad = '+inttostr(padl));
  137.   image1.Canvas.TextOut(50, 50, 'Ball X = '+inttostr(ballposition.X));
  138.   image1.Canvas.TextOut(50, 60, 'Ball Y = '+inttostr(ballposition.Y));
  139.   image1.Canvas.TextOut(50, 70, 'Speed = '+floattostr(BallSpeed));
  140. end;
  141.  
  142. Ballposition:=drawball(BallPosition, BallAngle); //nakreslit míček
  143.  
  144. //odrážení od stěn
  145. if ballposition.y>=image1.height then begin
  146.   if (ballangle>degtorad(0)) and (ballangle < degtorad(90)) then begin
  147.     memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  148.     ballangle:=degtorad(360)-ballangle;
  149.     memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  150.     ballposition.Y:=image1.Height;
  151.   end else
  152.     if (ballangle > degtorad(90)) and (ballangle < degtorad(180)) then begin
  153.       memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  154.       ballangle:=degtorad(360)-ballangle;
  155.       memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  156.       ballposition.Y:=image1.Height;
  157.     end;
  158. end;
  159. if ballposition.y<=0 then begin
  160.   if (ballangle > degtorad(180)) and (ballangle < degtorad(270)) then begin
  161.     memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  162.     ballangle:=degtorad(90)+(degtorad(270)-ballangle);
  163.     memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  164.     ballposition.Y:=0;
  165.   end else begin
  166.     if (ballangle > degtorad(270)) and (ballangle < degtorad(360)) then begin
  167.       memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  168.       ballangle:=degtorad(360)-ballangle;
  169.       memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  170.       ballposition.Y:=0;
  171.     end;
  172.   end;
  173. end;
  174.  
  175. //odrážení od pálek
  176. if ballposition.X>=(image1.width-space-padwidth-ballsize div 2) then begin
  177.   if (ballposition.Y>=padr) and (ballposition.Y<=padr+padlength) then begin
  178.       memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  179.       ballangle:=degtorad(255-(ballposition.Y-padr)/padlength*120);
  180.       memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  181.   end;
  182. end;
  183. if ballposition.X<=(space+padwidth+ballsize div 2) then begin
  184.   if (ballposition.Y>=padl) and (ballposition.Y<=padl+padlength) then begin
  185.     memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
  186.     ballangle:=degtorad(300+(ballposition.Y-padl)/padlength*120);
  187.     memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
  188.     if radtodeg(ballangle)>360 then begin
  189.       ballangle:=ballangle-degtorad(360);
  190.       memo1.Lines.Text:=memo1.Lines.text+' (corrected '+floattostr(radtodeg(ballangle))+')';
  191.     end;
  192.   end;
  193. end;
  194.  
  195. //počítání skóre
  196. if ballposition.x<0 then begin
  197.   ballposition:=point(image1.Width div 2, image1.Height div 2);
  198.   ballangle:=degtorad(179);
  199.   inc(scorer);
  200.   if scorer=21 then begin
  201.     timer1.Enabled:=false;
  202.     showmessage('Hráč 2 vyhrál!');
  203.     formcreate(form1);
  204.   end;
  205.   BallSpeed:=6;
  206. end;
  207. if image1.width<ballposition.x then begin
  208.   ballposition:=point(image1.Width div 2, image1.Height div 2);
  209.   ballangle:=degtorad(1);
  210.   inc(scorel);
  211.   if scorel=21 then begin
  212.     timer1.Enabled:=false;
  213.     showmessage('Hráč 1 vyhrál!');
  214.     formcreate(form1);
  215.   end;
  216.   BallSpeed:=6;
  217. end;
  218.  
  219. //hlídání špatných úhlů, teoreticky by se podmínka nikdy splnit neměla
  220. If (radtodeg(ballangle) >= 360) or (radtodeg(ballangle) = 270)
  221.     or (radtodeg(ballangle) = 180) or (radtodeg(ballangle) = 90)
  222.     or (radtodeg(ballangle) = 0) then
  223.       memo1.lines.Add('Invalid angle ('+floattostr(radtodeg(ballangle))+')');
  224. end;
  225.  
  226. function TForm1.drawball(pos: TPoint; angle: real): TPoint;
  227. begin
  228.   image1.Canvas.Pen.color:=clwhite; //barvy
  229.   image1.canvas.Brush.Color:=clwhite;
  230.   pos.x:=pos.x+round(cos(angle)*BallSpeed);
  231.   pos.y:=pos.y+round(sin(angle)*BallSpeed);
  232.   image1.Canvas.Ellipse(pos.x-round(BallSize/2), pos.y-round(BallSize/2), pos.x+round(BallSize/2), pos.y+round(BallSize/2));
  233.   result:=pos;
  234. end;
  235.  
  236. procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
  237. begin
  238.   if key = ';' then ShowInfo:=not ShowInfo;
  239.   if key = #27 then Close; //při zmáčknutí esc vypnout aplikaci
  240.   if key = 'r' then begin  //reset všeho, volání procedury formcreate (jen kvůli obsahu)
  241.     formcreate(form1);
  242.   end;
  243.   if (key = 'p') or (key = #13) then //vypnutí timer = pauza
  244.     timer1.Enabled:= not timer1.Enabled;
  245.  
  246. end;
  247.  
  248. procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
  249. var
  250. x, r, l: integer;
  251. data: string;
  252. begin
  253. ComPort1.ReadStr(data, Count);
  254. for x:=1 to length(data) do begin
  255.   case data[x] of
  256.     '0'..'9': begin //pokud je aktuálně analyzovaný  znak mezi 0 a 9 přičte se do temp
  257.                 temp := temp * 10 + strtoint(data[x]);
  258.               end;
  259.     ';':      begin  //pokud se aktuální znak rovná ; přiřadit zatím načtené číslo do r
  260.                 r:=temp;
  261.                 temp:=0;
  262.               end;
  263.     ':':      begin  //pokud se aktuální znak rovná : přiřadit zatím načtené číslo do r
  264.                 l:=temp;
  265.                 temp:=0;
  266.               end;
  267.   end;
  268. end;
  269.  
  270. for x:=0 to fluidity-2 do begin //posune pole se starými záznami dat o 1
  271.   stabilizationL[x]:=stabilizationL[x+1];
  272. end;
  273. if (l>SensorMin) and (l<SensorMax) then //načte aktuální hodnotu do l, vyřadí neplatná data
  274.   stabilizationL[fluidity-1]:=l;
  275. l:=0;
  276. for x:=0 to fluidity-1 do begin //sečte stabilizationL
  277.   inc(l, stabilizationL[x]);
  278. end;
  279. l:=round(l/fluidity); //vydělí součet počtem záznamů (průměr)
  280.  
  281. for x:=0 to fluidity-2 do begin //posune pole se starými záznami dat o 1
  282.   stabilizationR[x]:=stabilizationR[x+1];
  283. end;
  284. if (r>SensorMin) and (r<SensorMax) then //načte aktuální hodnotu do l, vyřadí neplatná data
  285.   stabilizationR[fluidity-1]:=r;
  286. r:=0;
  287. for x:=0 to fluidity-1 do begin //sečte stabilizationR
  288.   inc(r, stabilizationR[x]);
  289. end;
  290. r:=round(r/fluidity); //vydělí součet počtem záznamů (průměr)
  291.  
  292. {pozn. přesnějších výsledků a rychlejších reakcí by bylo možné dosáhnout
  293.  použitím váženého průměru (vyšší váhu by měli novější hodnoty,
  294.  menší váhu hodnoty starší)}
  295.  
  296. if (l>SensorMin) and (l<SensorMax) then                      //znovu vyřadí neplatná data i z průměru
  297.     padl:=screen.Height-round((l/SensorMax)*screen.Height);  //přepočte čas, za který se vrátil signál ze senzoru na výšku obrazovky
  298. if (r>SensorMin) and (r<SensorMax) then                      //znovu vyřadí neplatná data i z průměru
  299.     padr:=screen.Height-round((r/SensorMax)*screen.Height);  //přepočte čas, za který se vrátil signál ze senzoru na výšku obrazovky
  300. end;
  301.  
  302. end.
  303.  
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×