home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / TeeChartPro / TeeChart5Delphi5Eval.exe / %MAINDIR% / Examples / Features / OpenGL_Football.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-10  |  10.6 KB  |  447 lines
  1. unit OpenGL_Football;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   TeeOpenGL, TeeComma, ExtCtrls, TeeProcs, StdCtrls, ComCtrls, TeCanvas,
  8.   TeeDraw3D;
  9.  
  10. { Show 5 football players... }
  11. Const NumPlayers=5;
  12.  
  13. type
  14.   TOpenGLFootBall = class(TForm)
  15.     Draw3D1: TDraw3D;
  16.     TeeCommander1: TTeeCommander;
  17.     TeeOpenGL1: TTeeOpenGL;
  18.     Timer1: TTimer;
  19.     Panel1: TPanel;
  20.     Button1: TButton;
  21.     Button2: TButton;
  22.     CheckBox2: TCheckBox;
  23.     Button3: TButton;
  24.     Button4: TButton;
  25.     Label1: TLabel;
  26.     TrackBar1: TTrackBar;
  27.     Label2: TLabel;
  28.     TrackBar2: TTrackBar;
  29.     TrackBar3: TTrackBar;
  30.     Label3: TLabel;
  31.     CheckBox3: TCheckBox;
  32.     CheckBox1: TCheckBox;
  33.     procedure Draw3D1Paint(Sender: TObject; const Rect: TRect);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure Timer1Timer(Sender: TObject);
  36.     procedure Button1Click(Sender: TObject);
  37.     procedure Button2Click(Sender: TObject);
  38.     procedure CheckBox2Click(Sender: TObject);
  39.     procedure Button3Click(Sender: TObject);
  40.     procedure Button4Click(Sender: TObject);
  41.     procedure TrackBar2Change(Sender: TObject);
  42.     procedure TrackBar3Change(Sender: TObject);
  43.     procedure CheckBox1Click(Sender: TObject);
  44.   private
  45.     { Private declarations }
  46.   public
  47.     { Public declarations }
  48.  
  49.     DeltaBall,Ball:TPoint;  { coordinates of the ball }
  50.  
  51.     Players,DeltaPlayers:Array[1..NumPlayers] of TPoint; 
  52.  
  53.     W,D,DeltaZoom:Integer;
  54.  
  55.     { colors }
  56.     FBall,FLines,FGreen:TColor;
  57.   end;
  58.  
  59. Procedure DrawPlayer(ACanvas:TCanvas3D; x,y,z:Integer;
  60.                     BodyColor,ArmColor,PantsColor,LegsColor:TColor);
  61.  
  62. implementation
  63.  
  64. {$R *.DFM}
  65. Uses TeePenDlg;
  66.  
  67. { Create some 3D objects (cube, sphere, etc) to form
  68.   a person like a football player }
  69.  
  70. Procedure DrawPlayer(ACanvas:TCanvas3D; x,y,z:Integer;
  71.                     BodyColor,ArmColor,PantsColor,LegsColor:TColor);
  72. var clSkin:TColor;
  73. begin
  74.  clSkin:=RGB(241,226,190);
  75.  
  76.  With ACanvas do
  77.  begin
  78.    Pen.Style:=psClear;
  79.  
  80.    { head }
  81.    Brush.Color:=clSkin;
  82.    Sphere(x,y-20,z,2.5);
  83.  
  84.    { neck }
  85.    Cylinder(True,x-1,y-18,x+1,y-16,z-1,z+1,True);
  86.  
  87.    { eyes }
  88.    Brush.Color:=clBlack;
  89.    Sphere(x-2,y-21,z-1,0.5);
  90.    Sphere(x-2,y-21,z+1,0.5);
  91.  
  92.    { body }
  93.    Brush.Color:=BodyColor;
  94.    Cube(x-2,x+2,y-16,y-8,z-3,z+3,True);
  95.  
  96.    { arms }
  97.    Brush.Color:=ArmColor;
  98.    Cylinder(True,x-1,y-16,x+2,y-10,z-5,z-3,True);
  99.    Cylinder(True,x-1,y-16,x+2,y-10,z+5,z+3,True);
  100.  
  101.    { bottom arms }
  102.    Brush.Color:=clSkin;
  103.    Cylinder(True,x-1,y-10,x+2,y-5,z-5,z-3,True);
  104.    Cylinder(True,x-1,y-10,x+2,y-5,z+5,z+3,True);
  105.  
  106.    { pants }
  107.    Brush.Color:=PantsColor;
  108.    Cube(x-2,x+2,y-8,y-4,z-3,z+3,True);
  109.  
  110.    { legs }
  111.    Brush.Color:=clSkin;
  112.    Cylinder(True,x-1,y-4,x+2,y,z-4,z,True);
  113.    Cylinder(True,x-1,y-4,x+2,y,z+4,z,True);
  114.  
  115.    { bottom legs }
  116.    Brush.Color:=LegsColor;
  117.    Cylinder(True,x-2,y,x+2,y+8,z-3,z,True);
  118.    Cylinder(True,x-2,y,x+2,y+8,z+4,z+1,True);
  119.  
  120.    { feet }
  121.    Brush.Color:=clBlack;
  122.    Cube(x-3,x+2,y+8,y+10,z-2,z-1,True);
  123.    Cube(x-3,x+2,y+8,y+10,z+2,z+1,True);
  124.  end;
  125. end;
  126.  
  127. procedure TOpenGLFootBall.Draw3D1Paint(Sender: TObject; const Rect: TRect);
  128. var y:Integer;
  129.  
  130.  { The lines in front of gates }
  131.  Procedure DrawGateArea(x1,w,zSize:Integer);
  132.  begin
  133.    With Draw3D1,Canvas do
  134.    begin
  135.      MoveTo3D(x1,y,50-zSize);
  136.      LineTo3D(x1+w,y,50-zSize);
  137.      LineTo3D(x1+w,y,50+zSize);
  138.      LineTo3D(x1,y,50+zSize);
  139.    end;
  140.  end;
  141.  
  142.  { The gate poles }
  143.  Procedure DrawGate(x,h,z,zSize:Integer);
  144.  begin
  145.    With Draw3D1,Canvas do
  146.    begin
  147.     MoveTo3D(x,y,z-zSize);
  148.     LineTo3D(x,y-h,z-zSize);
  149.     LineTo3D(x,y-h,z+zSize);
  150.     LineTo3D(x,y,z+zSize);
  151.    end;
  152.  end;
  153.  
  154.  { The plastic net }
  155.  Procedure DrawGateNet(x,xSize:Integer);
  156.  var t:Integer;
  157.  begin
  158.    With Draw3D1,Canvas do
  159.    begin
  160.      Pen.Style:=psDot;
  161.      for t:=-9 to 9 do
  162.      begin
  163.        MoveTo3D(x,y-18,50+Round(2.1*t));
  164.        LineTo3D(x-xSize,y-12,50+2*t);
  165.      end;
  166.      for t:=-9 to 9 do
  167.      begin
  168.        MoveTo3D(x-xSize,y-12,50+2*t);
  169.        LineTo3D(x-xSize,y,50+2*t);
  170.      end;
  171.      for t:=0 to 6 do
  172.      begin
  173.        MoveTo3D(x,y-Round(2.2*t),50+20);
  174.        LineTo3D(x-xSize,y-2*t,50+18);
  175.        LineTo3D(x-xSize,y-2*t,50-18);
  176.        LineTo3D(x,y-Round(2.2*t),50-20);
  177.      end;
  178.      Pen.Style:=psSolid;
  179.    end;
  180.  end;
  181.  
  182.  { Generic method to draw a portion of a circle }
  183.  Procedure DrawArc(x,z,Radius,MinAngle,MaxAngle:Integer);
  184.  var t:Integer;
  185.      s,c:Extended;
  186.  begin
  187.    With Draw3D1,Canvas do
  188.    for t:=MinAngle to MaxAngle do
  189.    begin
  190.      SinCos(t*pi/18.0,s,c);
  191.      if t=MinAngle then MoveTo3D(x-Round(Radius*s),y,z+Round(Radius*c))
  192.                    else LineTo3D(x-Round(Radius*s),y,z+Round(Radius*c));
  193.    end;
  194.  end;
  195.  
  196.  { The football corners }
  197.  Procedure DrawCorner(x,z,MinAngle,MaxAngle:Integer);
  198.  begin
  199.    DrawArc(x,z,12,MinAngle,MaxAngle);
  200.  end;
  201.  
  202.  { Draw an stair to simulate a building with many rows of seats }
  203.  Procedure DrawSeats(tmp:Integer);
  204.  var x1,x2,t,z:Integer;
  205.  begin
  206.    With Draw3D1.Canvas do
  207.    begin
  208.      Pen.Style:=psClear;
  209.      x1:=tmp-W+12;
  210.      x2:=tmp+W-12;
  211.      y:=y+6;
  212.      for t:=1 to 10 do
  213.      begin
  214.        z:=200+16*(t-1);
  215.        Brush.Color:=RGB($B0,$60,$70);
  216.        RectangleWithZ(Classes.Rect(x1,y,x2,y-6),z);
  217.        Brush.Color:=RGB($70,$70,$B0);
  218.        RectangleY(x1,y-6,x2,z,z+16);
  219.        y:=y-6;
  220.      end;
  221.    end;
  222.  end;
  223.  
  224.  Procedure DrawPlayer1(x,y,z:Integer);
  225.  begin
  226.    DrawPlayer(Draw3D1.Canvas as TCanvas3D,x,y,z,
  227.               clNavy,clBlue,clMaroon,RGB(231,116,118));
  228.  end;
  229.  
  230.  Procedure DrawPlayer2(x,y,z:Integer);
  231.  begin
  232.    DrawPlayer(Draw3D1.Canvas as TCanvas3D,x,y,z,
  233.               clWhite,clLime,clRed,clYellow);
  234.  end;
  235.  
  236. var r,t,tmp:Integer;
  237. begin
  238.   R:=40;
  239.   With Draw3D1,Canvas do
  240.   begin
  241.     { green color }
  242.     Brush.Color:=FGreen;
  243.     Pen.Color:=RGB(0,$80,0);
  244.  
  245.     { bottom base }
  246.     tmp:=ChartXCenter;
  247.     Cube(tmp-230,tmp+230,ChartYCenter-2,ChartYCenter+4,-100,200,False);
  248.  
  249.     { bottom carpet }
  250.     y:=ChartYCenter-8;
  251.  
  252.     { light gray color to draw lines }
  253.     Pen.Style:=psSolid;
  254.     Pen.Color:=FLines;
  255.  
  256.     Brush.Style:=bsClear;
  257.  
  258.     { big rectangle }
  259.     RectangleY(tmp-W+20,y,tmp+W-20,-80,180);
  260.  
  261.     { center line }
  262.     MoveTo3D(tmp,y,-80);
  263.     LineTo3D(tmp,y,180);
  264.  
  265.     { middle circle }
  266.     DrawArc(tmp,50,R,0,36);
  267.  
  268.     { left gate area lines }
  269.     DrawGateArea(tmp-W+20,60,70);
  270.     DrawArc(tmp-W+20+35,50,40,22,32);
  271.     DrawGateArea(tmp-W+20,20,30);
  272.  
  273.     { left gate and net }
  274.     DrawGate(tmp-W+20,18,50,20);
  275.     DrawGate(tmp-W+10,12,50,18);
  276.     DrawGateNet(tmp-W+20,10);
  277.  
  278.     { right gate area lines }
  279.     DrawGateArea(tmp+W-20,-60,70);
  280.     DrawArc(tmp+W-20-35,50,40,4,14);
  281.     DrawGateArea(tmp+W-20,-20,30);
  282.  
  283.     { right gate and net }
  284.     DrawGate(tmp+W-20,18,50,20);
  285.     DrawGate(tmp+W-10,12,50,18);
  286.     DrawGateNet(tmp+W-20,-10);
  287.  
  288.     { the four corners }
  289.     DrawCorner(tmp-W+20,-80,27,36);
  290.     DrawCorner(tmp+W-20,-80,0,9);
  291.     DrawCorner(tmp-W+20,180,18,27);
  292.     DrawCorner(tmp+W-20,180,9,18);
  293.  
  294.     { the two penalties and center point }
  295.     DrawArc(tmp-W+20+45,50,1,0,36);
  296.     DrawArc(tmp+W-20-45,50,1,0,36);
  297.     DrawArc(tmp,50,1,0,36);
  298.  
  299.     { the ball }
  300.     Brush.Color:=FBall;
  301.     Sphere(ChartXCenter+Ball.X,y-TrackBar1.Position+1,50+Ball.Y,TrackBar1.Position);
  302.  
  303.     { the back public seats }
  304.     if CheckBox2.Checked then DrawSeats(tmp);
  305.  
  306.     { Draw players }
  307.     if CheckBox3.Checked then
  308.     begin
  309.       y:=ChartYCenter-17;
  310.       for t:=1 to NumPlayers do
  311.         if t>=NumPlayers-1 then
  312.            DrawPlayer2(ChartXCenter+Players[t].X,y,50+Players[t].Y)
  313.         else
  314.            DrawPlayer1(ChartXCenter+Players[t].X,y,50+Players[t].Y);
  315.     end;
  316.   end;
  317. end;
  318.  
  319. procedure TOpenGLFootBall.FormCreate(Sender: TObject);
  320. var t:Integer;
  321. begin
  322.   { default button in toolbar: rotate field }
  323.   TeeCommander1.ButtonRotate.Down:=True;
  324.  
  325.   { initialize constants }
  326.   W:=210;
  327.   D:=100;
  328.   Ball.X:=-20;
  329.   Ball.Y:=20;
  330.   for t:=1 to NumPlayers do
  331.   begin
  332.     Players[t].X:=Random(200)-100;
  333.     Players[t].Y:=Random(100)-50;
  334.     DeltaPlayers[t].X:=0;
  335.     DeltaPlayers[t].Y:=0;
  336.   end;
  337.   DeltaBall.X:=2;
  338.   DeltaBall.Y:=3;
  339.   DeltaZoom:=2;
  340.  
  341.   { colors }
  342.   FGreen:=RGB(0,$90,0);
  343.   FLines:=RGB($B0,$B0,$B0);
  344.   FBall:=RGB($B0,$B0,$B0);
  345. end;
  346.  
  347. procedure TOpenGLFootBall.Timer1Timer(Sender: TObject);
  348.  
  349.   { Apply X and Y "deltas" to APoint }
  350.   Procedure MovePoint(Var APoint,ADelta:TPoint);
  351.   begin
  352.     With APoint do
  353.     begin
  354.       Inc(X,ADelta.X);
  355.       if (X<-W) or (X>W) then ADelta.X:=-ADelta.X;
  356.       Inc(Y,ADelta.Y);
  357.       if (Y<-D) or (Y>D) then ADelta.Y:=-ADelta.Y;
  358.     end;
  359.   end;
  360.  
  361. var t:Integer;
  362. begin
  363.   { move the ball... }
  364.   MovePoint(Ball,DeltaBall);
  365.  
  366.   { move the players... }
  367.   for t:=1 to NumPlayers do
  368.   begin
  369.     if Random(100)<5 then  { stop it }
  370.     begin
  371.       DeltaPlayers[t].X:=0;
  372.       DeltaPlayers[t].Y:=0;
  373.     end
  374.     else
  375.     begin  { move it }
  376.       if DeltaPlayers[t].X=0 then
  377.          if Random(100)<10 then DeltaPlayers[t].X:=2 else
  378.          if Random(100)<10 then DeltaPlayers[t].X:=-2;
  379.       if DeltaPlayers[t].Y=0 then
  380.          if Random(100)<10 then DeltaPlayers[t].Y:=2 else
  381.          if Random(100)<10 then DeltaPlayers[t].Y:=-2;
  382.       MovePoint(Players[t],DeltaPlayers[t]);
  383.     end;
  384.   end;
  385.  
  386.   { rotate the field... }
  387.   if CheckBox1.Checked then
  388.   begin
  389.     With Draw3D1.View3DOptions do
  390.     begin
  391.       Rotation:=Rotation+1;
  392.       Zoom:=Zoom+DeltaZoom;
  393.       if (Zoom<60) or (Zoom>500) then DeltaZoom:=-DeltaZoom;
  394.     end;
  395.   end;
  396.  
  397.   { show changes... }
  398.   Draw3D1.Repaint;
  399. end;
  400.  
  401. procedure TOpenGLFootBall.Button1Click(Sender: TObject);
  402. begin
  403.   With Draw3D1 do Color:=EditColor(Self,Color);
  404. end;
  405.  
  406. procedure TOpenGLFootBall.Button2Click(Sender: TObject);
  407. begin
  408.   FGreen:=EditColor(Self,FGreen);
  409.   Draw3D1.Repaint;
  410. end;
  411.  
  412. procedure TOpenGLFootBall.CheckBox2Click(Sender: TObject);
  413. begin
  414.   Draw3D1.Repaint;
  415. end;
  416.  
  417. procedure TOpenGLFootBall.Button3Click(Sender: TObject);
  418. begin
  419.   FLines:=EditColor(Self,FLines);
  420.   Draw3D1.Repaint;
  421. end;
  422.  
  423. procedure TOpenGLFootBall.Button4Click(Sender: TObject);
  424. begin
  425.   FBall:=EditColor(Self,FBall);
  426.   Draw3D1.Repaint;
  427. end;
  428.  
  429. procedure TOpenGLFootBall.TrackBar2Change(Sender: TObject);
  430. begin
  431.   Draw3D1.View3DOptions.Perspective:=TrackBar2.Position;
  432. end;
  433.  
  434. procedure TOpenGLFootBall.TrackBar3Change(Sender: TObject);
  435. begin
  436.   TeeOpenGL1.Light.Position.X:=TrackBar3.Position
  437. end;
  438.  
  439. procedure TOpenGLFootBall.CheckBox1Click(Sender: TObject);
  440. begin
  441.   Timer1.Enabled:=CheckBox1.Checked;
  442. end;
  443.  
  444. initialization
  445.   RegisterClass(TOpenGLFootBall);
  446. end.
  447.