SHARE
TWEET

PingPong game

a guest Nov 15th, 2011 308 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
Top