Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- {pozn. úhly v delphi
- |270
- |
- |
- 180 | 360 (0)
- --------------|--------------
- |
- |
- |
- |
- 90
- }
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ExtCtrls, StdCtrls, ComCtrls, Math, CPort;
- type
- TForm1 = class(TForm)
- image1: TImage;
- Timer1: TTimer;
- Memo1: TMemo;
- ComPort1: TComPort;
- procedure DrawPadR(height: integer); //nakreslí pravou pálku (parametr udává výšku)
- procedure DrawPadL(height: integer); //nakreslí levou pálku (parametr udává výšku)
- procedure ResetCanvas; //překreslí plochu na černo, rozdělí na půl, zapíše skóre z proměnných scoreR a scoreL
- procedure FormCreate(Sender: TObject);
- procedure Timer1Timer(Sender: TObject);
- 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
- procedure FormKeyPress(Sender: TObject; var Key: Char); //klávesa R pro reset hry, enter nebo P pro pauzu
- procedure ComPort1RxChar(Sender: TObject; Count: Integer); //stará se o příchozí data, vyrovnává pálky, filtruje neplatná data
- private
- { Private declarations }
- public
- PadR, PadL, BallX, ScoreL, ScoreR: integer;
- BallAngle, BallSpeed: real;
- BallPosition: TPoint;
- temp: integer;
- ShowInfo: boolean;
- stabilizationR, stabilizationL: array of integer;
- end;
- Const
- Space = 5; //mezera mezi okrajem a pálkou
- PadLength = 200; //délka pálky
- PadWidth = 10; //šířka pálky
- BallSize = 10; //šířka míčku
- SpeedUp = 0.01;
- //BallSpeed = 6; //rychlost míčku
- SensorMin = 200; //minimální přijatelná hodnota senzoru
- SensorMax = 3000; //maximální přijatelná hodnota senzoru
- Fluidity = 5; //z kolika předchozích záznamů se má vyrovnávat
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- procedure TForm1.DrawPadL(height: integer);
- begin
- if height+PadLength>image1.Height then //pálka nebude nikdy vykreslena pod obrazovkou
- height:=image1.Height-PadLength;
- if height<0 then //pálka nebude nikdy vykreslena nad obrazovkou
- height:=0;
- image1.Canvas.Pen.Color:=clwhite;
- image1.Canvas.Brush.Color:=clwhite;
- image1.Canvas.Rectangle(space, height, space+padwidth, height+PadLength);
- end;
- procedure TForm1.DrawPadR(height: integer);
- begin
- if height+PadLength>image1.Height then //pálka nebude nikdy vykreslena pod obrazovkou
- height:=image1.Height-PadLength;
- if height<0 then //pálka nebude nikdy vykreslena nad obrazovkou
- height:=0;
- image1.Canvas.Pen.Color:=clwhite;
- image1.Canvas.Brush.Color:=clwhite;
- image1.Canvas.Rectangle(image1.Width-space, height, image1.Width-(space+padwidth), height+PadLength);
- end;
- procedure TForm1.ResetCanvas;
- begin
- with image1.Canvas do begin
- Pen.Color:=clblack;
- Brush.color:=clblack;
- Rectangle(0,0,image1.Width, image1.Height);
- pen.Color:=clWhite;
- PenPos:=point(screen.Width div 2, 0);
- LineTo(screen.Width div 2, screen.Height);
- font.Color:=clwhite;
- font.name:='Courier New';
- font.Style:=[fsBold];
- font.Size:=72;
- if scorel>9 then //pokud má skóre víc jak dvě desetinná místa bude posunuto dolevo
- textout(screen.Width div 2-140, 0, inttostr(ScoreL))
- else
- textout(screen.Width div 2-78, 0, inttostr(ScoreL));
- textout(screen.Width div 2+18, 0, inttostr(ScoreR)); //zapíše skóre pro hráče vpravo
- end;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- ShowInfo:=false;
- BallSpeed:=7;
- timer1.Enabled:=true;
- setlength(stabilizationR, fluidity); //nastaví velikost polí podle plynulosti
- setlength(stabilizationL, fluidity);
- ScoreL:=0; //vynuluje skóre
- ScoreR:=0;
- padl:=image1.Height div 2 - padlength div 2; //umístí pálky doprostřed obrazovky
- padr:=padl;
- BallAngle:=degtorad(2); //nastaví úhel
- BallPosition:=point(screen.Height div 2, space+padwidth); //nastaví základní pozici
- image1.Top:=0; //roztáhnout image přes celou obrazovku
- image1.Left:=0;
- image1.Width:=screen.Width;
- image1.Height:=screen.Height;
- resetcanvas; //inicializace canvasu
- end;
- procedure TForm1.Timer1Timer(Sender: TObject);
- begin
- resetcanvas; //zakreslit pálky, resetovat
- drawpadl(padl);
- drawpadr(padr);
- BallSpeed:=BallSpeed+SpeedUp;
- if showinfo then begin
- image1.Canvas.Font.Size:=8; //pomocné informace
- image1.Canvas.Brush.Style := bsClear;
- image1.Canvas.Font.Color:=clwhite;
- image1.Canvas.TextOut(50, 30, 'Right pad = '+inttostr(padr));
- image1.Canvas.TextOut(50, 40, 'Left pad = '+inttostr(padl));
- image1.Canvas.TextOut(50, 50, 'Ball X = '+inttostr(ballposition.X));
- image1.Canvas.TextOut(50, 60, 'Ball Y = '+inttostr(ballposition.Y));
- image1.Canvas.TextOut(50, 70, 'Speed = '+floattostr(BallSpeed));
- end;
- Ballposition:=drawball(BallPosition, BallAngle); //nakreslit míček
- //odrážení od stěn
- if ballposition.y>=image1.height then begin
- if (ballangle>degtorad(0)) and (ballangle < degtorad(90)) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(360)-ballangle;
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- ballposition.Y:=image1.Height;
- end else
- if (ballangle > degtorad(90)) and (ballangle < degtorad(180)) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(360)-ballangle;
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- ballposition.Y:=image1.Height;
- end;
- end;
- if ballposition.y<=0 then begin
- if (ballangle > degtorad(180)) and (ballangle < degtorad(270)) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(90)+(degtorad(270)-ballangle);
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- ballposition.Y:=0;
- end else begin
- if (ballangle > degtorad(270)) and (ballangle < degtorad(360)) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(360)-ballangle;
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- ballposition.Y:=0;
- end;
- end;
- end;
- //odrážení od pálek
- if ballposition.X>=(image1.width-space-padwidth-ballsize div 2) then begin
- if (ballposition.Y>=padr) and (ballposition.Y<=padr+padlength) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(255-(ballposition.Y-padr)/padlength*120);
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- end;
- end;
- if ballposition.X<=(space+padwidth+ballsize div 2) then begin
- if (ballposition.Y>=padl) and (ballposition.Y<=padl+padlength) then begin
- memo1.Lines.Add('Changing angle from '+floattostr(radtodeg(ballangle)));
- ballangle:=degtorad(300+(ballposition.Y-padl)/padlength*120);
- memo1.Lines.Text:=memo1.Lines.text+' to '+floattostr(radtodeg(ballangle));
- if radtodeg(ballangle)>360 then begin
- ballangle:=ballangle-degtorad(360);
- memo1.Lines.Text:=memo1.Lines.text+' (corrected '+floattostr(radtodeg(ballangle))+')';
- end;
- end;
- end;
- //počítání skóre
- if ballposition.x<0 then begin
- ballposition:=point(image1.Width div 2, image1.Height div 2);
- ballangle:=degtorad(179);
- inc(scorer);
- if scorer=21 then begin
- timer1.Enabled:=false;
- showmessage('Hráč 2 vyhrál!');
- formcreate(form1);
- end;
- BallSpeed:=6;
- end;
- if image1.width<ballposition.x then begin
- ballposition:=point(image1.Width div 2, image1.Height div 2);
- ballangle:=degtorad(1);
- inc(scorel);
- if scorel=21 then begin
- timer1.Enabled:=false;
- showmessage('Hráč 1 vyhrál!');
- formcreate(form1);
- end;
- BallSpeed:=6;
- end;
- //hlídání špatných úhlů, teoreticky by se podmínka nikdy splnit neměla
- If (radtodeg(ballangle) >= 360) or (radtodeg(ballangle) = 270)
- or (radtodeg(ballangle) = 180) or (radtodeg(ballangle) = 90)
- or (radtodeg(ballangle) = 0) then
- memo1.lines.Add('Invalid angle ('+floattostr(radtodeg(ballangle))+')');
- end;
- function TForm1.drawball(pos: TPoint; angle: real): TPoint;
- begin
- image1.Canvas.Pen.color:=clwhite; //barvy
- image1.canvas.Brush.Color:=clwhite;
- pos.x:=pos.x+round(cos(angle)*BallSpeed);
- pos.y:=pos.y+round(sin(angle)*BallSpeed);
- image1.Canvas.Ellipse(pos.x-round(BallSize/2), pos.y-round(BallSize/2), pos.x+round(BallSize/2), pos.y+round(BallSize/2));
- result:=pos;
- end;
- procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
- begin
- if key = ';' then ShowInfo:=not ShowInfo;
- if key = #27 then Close; //při zmáčknutí esc vypnout aplikaci
- if key = 'r' then begin //reset všeho, volání procedury formcreate (jen kvůli obsahu)
- formcreate(form1);
- end;
- if (key = 'p') or (key = #13) then //vypnutí timer = pauza
- timer1.Enabled:= not timer1.Enabled;
- end;
- procedure TForm1.ComPort1RxChar(Sender: TObject; Count: Integer);
- var
- x, r, l: integer;
- data: string;
- begin
- ComPort1.ReadStr(data, Count);
- for x:=1 to length(data) do begin
- case data[x] of
- '0'..'9': begin //pokud je aktuálně analyzovaný znak mezi 0 a 9 přičte se do temp
- temp := temp * 10 + strtoint(data[x]);
- end;
- ';': begin //pokud se aktuální znak rovná ; přiřadit zatím načtené číslo do r
- r:=temp;
- temp:=0;
- end;
- ':': begin //pokud se aktuální znak rovná : přiřadit zatím načtené číslo do r
- l:=temp;
- temp:=0;
- end;
- end;
- end;
- for x:=0 to fluidity-2 do begin //posune pole se starými záznami dat o 1
- stabilizationL[x]:=stabilizationL[x+1];
- end;
- if (l>SensorMin) and (l<SensorMax) then //načte aktuální hodnotu do l, vyřadí neplatná data
- stabilizationL[fluidity-1]:=l;
- l:=0;
- for x:=0 to fluidity-1 do begin //sečte stabilizationL
- inc(l, stabilizationL[x]);
- end;
- l:=round(l/fluidity); //vydělí součet počtem záznamů (průměr)
- for x:=0 to fluidity-2 do begin //posune pole se starými záznami dat o 1
- stabilizationR[x]:=stabilizationR[x+1];
- end;
- if (r>SensorMin) and (r<SensorMax) then //načte aktuální hodnotu do l, vyřadí neplatná data
- stabilizationR[fluidity-1]:=r;
- r:=0;
- for x:=0 to fluidity-1 do begin //sečte stabilizationR
- inc(r, stabilizationR[x]);
- end;
- r:=round(r/fluidity); //vydělí součet počtem záznamů (průměr)
- {pozn. přesnějších výsledků a rychlejších reakcí by bylo možné dosáhnout
- použitím váženého průměru (vyšší váhu by měli novější hodnoty,
- menší váhu hodnoty starší)}
- if (l>SensorMin) and (l<SensorMax) then //znovu vyřadí neplatná data i z průměru
- 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
- if (r>SensorMin) and (r<SensorMax) then //znovu vyřadí neplatná data i z průměru
- 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
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement