home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / opengl / glctrolP.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-11-29  |  28.7 KB  |  1,045 lines
  1. unit glctrolP;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
  7.   glAbsWin,glWin,opengl,GLFuncs, GLStereo, StdCtrls, ExtCtrls, Buttons, ComCtrls, Menus,
  8.   ActnList, StdActns, Mask, Grids ;
  9.  
  10. type
  11.  
  12.   TOpenGLWindow=class;
  13.  
  14.   glTestScene = (tsNone,tsBasicScene,tsColorTriangle,tsBlackWhite,tsRandomTerrain,tsScene3);
  15.  
  16.   TGLController = class(TForm)
  17.     PC1: TPageControl;
  18.     TS1: TTabSheet;
  19.     TS2: TTabSheet;
  20.     View: TRadioGroup;
  21.     TS3: TTabSheet;
  22.     MoveState: TRadioGroup;
  23.     RM1: TRadioGroup;
  24.     SpeedButton2: TSpeedButton;
  25.     SpeedButton3: TSpeedButton;
  26.     Perspective1: TCheckBox;
  27.     TS4: TTabSheet;
  28.     SpeedButton1: TSpeedButton;
  29.     Select: TRadioGroup;
  30.     SpeedButton7: TSpeedButton;
  31.     MaxFR: TCheckBox;
  32.     HUD: TCheckBox;
  33.     Grid: TCheckBox;
  34.     Gridtext: TCheckBox;
  35.     Scene: TTabSheet;
  36.     TestScene: TRadioGroup;
  37.     Warning1: TLabel;
  38.     aboutsheet: TTabSheet;
  39.     SpeedButton5: TSpeedButton;
  40.     LightingOn: TCheckBox;
  41.     GrabFocus: TCheckBox;
  42.     GroupBox1: TGroupBox;
  43.     HA: TCheckBox;
  44.     CPixelFormat: TStaticText;
  45.     DB: TCheckBox;
  46.     DW: TCheckBox;
  47.     SC: TCheckBox;
  48.     CBits: TStaticText;
  49.     DBits: TStaticText;
  50.     SBits: TStaticText;
  51.     ABits: TStaticText;
  52.     BM: TCheckBox;
  53.     SE: TCheckBox;
  54.     GL: TCheckBox;
  55.     DeleteMeasure: TSpeedButton;
  56.     Error: TTabSheet;
  57.     errorgrid: TStringGrid;
  58.     StaticText2: TStaticText;
  59.     GetError: TBitBtn;
  60.     ClearError: TBitBtn;
  61.     StaticText3: TStaticText;
  62.     StaticText4: TStaticText;
  63.     StaticText5: TStaticText;
  64.     Vendor: TStaticText;
  65.     Renderer: TStaticText;
  66.     Version: TStaticText;
  67.     Extension: TMemo;
  68.     Stereo: TCheckBox;
  69.     Image1: TImage;
  70.     TabSheet1: TTabSheet;
  71.     Animateon: TCheckBox;
  72.     AnimateP: TPanel;
  73.     GD: TCheckBox;
  74.     SpeedButton4: TSpeedButton;
  75.     WBG: TCheckBox;
  76.     SpeedButton6: TSpeedButton;
  77.     Cursor3D: TCheckBox;
  78.     SpeedButton8: TSpeedButton;
  79.     SDL: TCheckBox;
  80.     procedure ViewClick(Sender: TObject);
  81.     procedure MoveStateClick(Sender: TObject);
  82.     procedure SelectClick(Sender: TObject);
  83.     procedure Perspective1Click(Sender: TObject);
  84.     procedure SpeedButton2Click(Sender: TObject);
  85.     procedure SpeedButton3Click(Sender: TObject);
  86.     procedure SpeedButton4Click(Sender: TObject);
  87.     procedure SpeedButton6Click(Sender: TObject);
  88.     procedure SpeedButton1Click(Sender: TObject);
  89.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  90.     procedure RM1Click(Sender: TObject);
  91.     procedure SpeedButton7Click(Sender: TObject);
  92.     procedure ResetBtnClick(Sender: TObject);
  93.     procedure MaxFRClick(Sender: TObject);
  94.     procedure AnimateClick(Sender: TObject);
  95.     procedure HUDClick(Sender: TObject);
  96.     procedure PrintClick(Sender: TObject);
  97.     procedure GridClick(Sender: TObject);
  98.     procedure TestSceneClick(Sender: TObject);
  99.     procedure GridtextClick(Sender: TObject);
  100.     procedure SpeedButton5Click(Sender: TObject);
  101.     procedure GrabFocusClick(Sender: TObject);
  102.     procedure LightOnClick(Sender: TObject);
  103.     procedure FormShow(Sender: TObject);
  104.     procedure DeleteMeasureClick(Sender: TObject);
  105.     procedure measuredataClick(Sender: TObject);
  106.     procedure GetErrorClick(Sender: TObject);
  107.     procedure ClearErrorClick(Sender: TObject);
  108.     procedure GDClick(Sender: TObject);
  109.     procedure AnimateonClick(Sender: TObject);
  110.     procedure WBGClick(Sender: TObject);
  111.     procedure LightXChange(Sender: TObject);
  112.     procedure LightXKeyPress(Sender: TObject; var Key: Char);
  113.     procedure YLightExit(Sender: TObject);
  114.     procedure Cursor3DClick(Sender: TObject);
  115.     procedure SpeedButton8Click(Sender: TObject);
  116.     procedure SDLClick(Sender: TObject);
  117.   private
  118.     { Private declarations }
  119.     fGLControlledWindow:TOpenGLWindow ;
  120.     fUpdating   : Boolean;
  121.     fMeasureData:tMeasureRecord;
  122.  
  123.    Procedure  UpDateMeasure;
  124.   public
  125.     { Public declarations }
  126.     Procedure AddWindow(aWin:TOpenGLWindow);
  127.     // add a Window to the list
  128.     Procedure UpDateControl;
  129.     //Update the controller for the current window state
  130.     Procedure Lock;
  131.     //Lock all the controls while update happening
  132.     Procedure UnLock;
  133.     //UnLock all the controls while update happening
  134.   end;
  135.  
  136.   TOpenGLController=Class(TAbstractOpenGLControl)
  137.     Published
  138.  
  139.     Property RenderDC;
  140.     Property PixelFormat;
  141.  
  142.   end;
  143.  
  144.   TOpenGLWindow=class(TCustomGLStereo)
  145.  // All the bits for controlling
  146.     Private
  147.      fGLControl    : TGLController;
  148.      fControlStart : TObject;
  149.      fSurfaceID    : LongInt;
  150. // various test scenes
  151.      Procedure DrawBasicScene;
  152.      Procedure DrawColorTriangleScene;
  153.      Procedure DrawRBStereo;
  154.      Procedure DrawRandomGroundScene;
  155.      Procedure DrawSelectScene;
  156.  
  157.      Procedure SetTestScene(val:glTestScene);
  158.     Protected
  159.  
  160.     fTestScene     : glTestScene;
  161.  
  162.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  163.       X, Y: Integer);                                            override;
  164.  
  165.     Procedure SetMoveMode(aMode:GLMoveMode);       override;
  166.     Procedure SetToolMode(aMode:GLToolMode);       Override;
  167.  
  168.     Procedure Do3DRenderScene;                     override;
  169.     {Render the scene}
  170.     Protected
  171.  
  172.     Procedure DoCustomViewSetUp;                   Override;
  173.  // handle the setup of the ModelView Matrix for vmCustomview
  174.  
  175.  
  176.     Public
  177.      constructor Create(AOwner: TComponent); Override;
  178.      Procedure BuildDisplayLists;            override;
  179.  
  180.      Procedure ShowGLControl(Sender:TObject);
  181.      //Show the windows controller
  182.      Procedure HideGLControl;
  183.      //Hide the controller
  184.      Procedure GLControlFreed;
  185.      //Control freed self
  186.     Published
  187.     // publish all ancestor properties
  188.  //TCustomWindow
  189.      Property Align;
  190.  
  191.      Property OnPaint     ;
  192.      property OnMouseDown;
  193.      property OnMouseMove;
  194.      property OnMouseUp;
  195.  
  196.   //TAbstractOpenGL
  197.      Property GrabFocus;
  198.      Property ShareGL ;
  199.      Property GenericGDI;
  200.  
  201.   //TCustomOpenGLWindow
  202.     Property Cursor3D;
  203.     Property Animate ;
  204.     Property BackGround ;
  205.     Property BoxSizeX  ;
  206.     Property BoxSizeY  ;
  207.     Property BoxSizeZ  ;
  208.     Property Grid      ;
  209.     Property GridText  ;
  210.     Property HUD       ;
  211.     Property MaxFrmRate;
  212.     Property Perspective;
  213.     Property SimpleAxis ;
  214.     Property Scale      ;
  215.     Property ViewMode   ;
  216.     Property RenderState;
  217.     Property StdDisplayList;
  218.  
  219.     {GL Specific RENDERING EVENTS}
  220.  
  221.     Property On2DForeGrnd;
  222.     Property On3DRender  ;
  223.     Property On2DBackGrnd;
  224.     Property OnAnimate   ;
  225.     Property OnBuildDisplayList;
  226.     Property OnCustomView;
  227.     Property OnHUDUpdate ;
  228.     Property OnSelectDown;
  229.     Property OnSelectMove;
  230.     Property OnSelectUp ;
  231.  
  232.   // TCustomGLLightWindow
  233.  
  234.     Property HeadLightOn:Boolean Read fHeadLightState Write SetHeadLightOn;
  235.     Property LightingOn:Boolean Read fLightingState Write SetLightingState;
  236.  
  237.  // TCustomGLStereo
  238.  
  239.     Property StereoOn;
  240.     Property StereoState;
  241.     //new property
  242.      Property TestScene:glTestScene Read fTestScene Write SetTestScene;
  243.   end;
  244.  
  245. var
  246.   GLController: TGLController;
  247.  
  248.   procedure Register;
  249.  
  250. implementation
  251.  
  252. {$R *.DFM}
  253. {$R *.dcr}   // glwindow bitmaps for the components
  254.  
  255. {*********************************************************}
  256.   constructor TOpenGLWindow.Create(AOwner: TComponent);
  257.    Begin
  258.       Inherited Create(aOwner);
  259.       fTestScene:=tsNone;
  260.    end;
  261. {*********************************************************}
  262.   Procedure TOpenGLWindow.ShowGLControl(Sender:TObject);
  263.      //Show the windows controller
  264.      Begin
  265.        fControlStart:=Sender;
  266.        If Animate then animate:=False;
  267.        Application.Processmessages;
  268.        Application.CreateForm(TGLController,fGLControl);
  269.        With fGLControl do
  270.          Begin
  271.            AddWindow(Self);
  272.            Show;
  273.          end;
  274.      end;
  275. {*********************************************************}
  276.   Procedure TOpenGLWindow.HideGLControl;
  277.      //Hide the controller
  278.      Begin
  279.        If assigned(fGLControl) then
  280.         Begin
  281.           fGLControl.Free;
  282.           fGLControl:=Nil;
  283.         end;
  284.      end;
  285. (*************************************************************)
  286. Procedure  TOpenGLWindow.GLControlFreed;
  287.      //Control freed self
  288.    Begin
  289.        fGLControl:=Nil;
  290.        If Not assigned(fControlStart) then exit;
  291.        If (fControlStart is TCheckBox) then
  292.          TCheckBox(fControlStart).Checked:=False;
  293.        If (fControlStart is TSpeedButton) then
  294.          TSpeedButton(fControlStart).Down:=False;
  295.        If (fControlStart is TMenuItem) then
  296.          TMenuItem(fControlStart).Checked:=False;
  297.    end;
  298. (*************************************************************)
  299.  procedure TOpenGLWindow.MouseUp(Button: TMouseButton; Shift: TShiftState;
  300.  X, Y: Integer);
  301.  begin
  302.    Inherited MouseUp(Button,Shift,X,Y);
  303.  
  304.  end;
  305. {*********************************************************}
  306.  Procedure TOpenGLWindow.SetMoveMode(aMode:GLMoveMode);
  307.   Begin
  308.     If aMode=Movemode then exit;
  309.     Inherited SetMoveMode(aMode);
  310.     //settle everything down
  311.     Application.Processmessages;
  312.     If Assigned(fGLControl) then fGLControl.UpDateControl;
  313.   end;
  314. (******************************************************)
  315.  Procedure TOpenGLWindow.SetToolMode(aMode:GLToolMode);
  316.    Begin
  317.      If (aMode<>toolmode)and(MoveMode=mmNone) then
  318.          Inherited SetToolMode(aMode);
  319.      Application.ProcessMessages;
  320.      If Assigned(fGLControl) then fGLControl.UpDateControl;
  321.  
  322.   end;
  323. (*************************************************************)
  324. Procedure TOpenGLWindow.DrawRandomGroundScene  ;
  325.   Begin
  326.      DrawBasicScene;
  327.      CallList(fsurfaceID);
  328.   end;
  329. (*************************************************************)
  330. Procedure TOpenGLWindow.DrawSelectScene;
  331.   var P1,P2,P3:tGLPoint;
  332.   Begin
  333.    DrawBasicScene;
  334.     With glCanvas do
  335.      Begin
  336.         P1.X:=200;P1.Y:=150;P1.Z:=0;
  337.         P2.X:=300;P2.Y:=250;P2.Z:=0;
  338.         P3.X:=100;P3.Y:=150;P3.Z:=0;
  339.         MoveTo(P1);
  340.         DrawLockedSelectHandle(10);
  341.         LineTo(P2);
  342.         DrawLockedSelectHandle(20);
  343.         LineTo(P3);
  344.         DrawSelectHandle(10);
  345.      end;
  346.  
  347.   end;
  348. (*************************************************************)
  349. Procedure TOpenGLWindow.DrawColorTriangleScene;
  350.   var pt,pt1,pt2:tGLPoint;
  351.       c1,c2,c3:glColorVal;
  352.   Begin
  353.      pt.X:=200;pt.Y:=-200;pt.z:=0;
  354.      pt1.X:=0;pt1.Y:=200;pt1.z:=0;
  355.      pt2.X:=-200;pt2.Y:=-200;pt2.z:=0;
  356.      With glCanvas do
  357.       Begin
  358.        Linewidth:=1;
  359.        C1:=glRed;c2:=glBlue;c3:=glLime;
  360.        DrawTriangle(pt,pt1,pt2,c1,c2,c3);
  361.        Pt1.Y:=150;pt1.z:=20;
  362.        TextOut3D(pt1,20,'Open GL - Colour Triangle');
  363.      end;
  364.   end;
  365. (*************************************************************)
  366. Procedure TOpenGLWindow.DrawRBStereo;
  367.   var pt,pt1,pt2:tGLPoint;
  368.       c1,c2,c3:glColorVal;
  369.   Begin
  370.      callList(DisplayList+dlGridFront);
  371.      callList(DisplayList+dlGridBack);
  372.      {glCallList(fsurfaceID);}
  373.      pt.X:=50;pt.Y:=-50;pt.z:=0;
  374.      pt1.X:=-50;pt1.Y:=50;pt1.z:=0;
  375.      pt2.X:=150;pt2.Y:=150;pt2.z:=0;
  376.      With glCanvas do
  377.       Begin
  378.        LineWidth:=5;
  379.        CircleXY(pt,50,50);
  380.        CircleXZ(pt,50,50);
  381.        CircleYZ(pt,50,50);
  382.        Linewidth:=1;
  383.        C1:=glGray20;c2:=glGray60;c3:=glwhite;
  384.        DrawTriangle(pt,pt1,pt2,c1,c2,c3)
  385.      end;
  386.  
  387.  
  388.   end;
  389. (**************************************************************)
  390.  Procedure TOpenGLWindow.SetTestScene(val:glTestScene);
  391.    Begin
  392.      If fTestScene=Val then exit;
  393.      fTestScene:=val;
  394.      repaint
  395.    end;
  396. (**************************************************************)
  397.   Procedure TOpenGLWindow.DoCustomViewSetUp;
  398.  // handle the setup of the ModelView Matrix for vmCustomview
  399.    Begin
  400.      Inherited DoCustomViewSetUp;
  401.      glTranslatef(100,100,100);
  402.    end;
  403. (**************************************************************)
  404. Procedure TOpenGLWindow.BuildDisplayLists;
  405.  
  406.   const NoPts=50;
  407.         MPt = 200;
  408.         foffSet=300;
  409.  
  410.   Var TempPt1,TempPt2,TempPt3,TempPt4,N:tGLPoint;
  411.       i,j:LongInt;
  412.       ElevDat:Array[0..NoPts,0..noPts]of Double;
  413.       ElevCol:glColorVal;
  414.       Offset:Double;
  415.  
  416.    Procedure SetCol(tPt:tGLPoint);
  417.      Begin
  418.        ElevCol[1]:=(tPt.Z+foffSet)/MPt;
  419.        ElevCol[2]:=(tPt.Z+foffSet)/MPt;
  420.        ElevCol[3]:=(tPt.Z+foffSet)/MPt;
  421.        glColor4fv(@ElevCol);
  422.      end;
  423.   Begin
  424.     If assigned(fShareGL) or not fStdDisplayList then exit;
  425.     Inherited;
  426.        ElevCol[4]:=1;
  427.        Randomize;
  428.         For i:=0 to NoPts do
  429.           For j:=0 to NoPts do
  430.              ElevDat[i,j]:=Random(mPt)-foffset;
  431.  
  432.        Offset:= MPt*NoPts/2;
  433.  
  434.        fSurfaceID:=glGenLists(1);
  435.        glNewList(fSurfaceID,GL_COMPILE);
  436.         saveState(stDrawing);
  437.         For i:=0 to NoPts-1 do
  438.          Begin
  439.           glBegin(gl_QUAD_STRIP);
  440.             For j:=0 to NoPts-1 do
  441.               Begin
  442.               TempPt1.X:=(i*MPt)-offset;
  443.               TempPt1.Y:=(j*MPt)-offset;
  444.               TempPt1.Z:=ElevDat[i,j];
  445.  
  446.               TempPt2.X:=((i)*MPt)-offset;
  447.               TempPt2.Y:=((j+1)*MPt)-offset;
  448.               TempPt2.Z:=ElevDat[i,j+1];
  449.  
  450.               TempPt3.X:=((i+1)*MPt)-offset;
  451.               TempPt3.Y:=((j)*MPt)-offset;
  452.               TempPt3.Z:=ElevDat[i+1,j];
  453.  
  454.               TempPt4.X:=((i+1)*MPt)-offset;
  455.               TempPt4.Y:=((j+1)*MPt)-offset;
  456.               TempPt4.Z:=ElevDat[i+1,j+1];
  457.  
  458.  
  459.               If CalcUnitNormal(tempPt1,tempPt2,tempPt3,N) then
  460.                glNormal3Dv(@N);
  461.  
  462.               SetCol(TempPt1);
  463.               glvertex3dv(@TempPt1);
  464.               SetCol(TempPt2);
  465.               glvertex3dv(@TempPt2);
  466.               If CalcUnitNormal(tempPt2,tempPt3,tempPt4,N) then
  467.                glNormal3Dv(@N);
  468.               SetCol(TempPt3);
  469.               glvertex3dv(@TempPt3);
  470.               SetCol(TempPt4);
  471.               glvertex3dv(@TempPt4);
  472.               end;
  473.            glEnd;
  474.          end;
  475.         RestoreState;
  476.        glEndList;
  477.   end;
  478. (*************************************************************)
  479. Procedure TOpenGLWindow.DrawBasicScene;
  480.     {Render the scene}
  481.           var aPt,aPt1,apt2:tGLPoint;
  482.       {Col1,Col2,amb:GLLightVal;}
  483.       {Pos1:tGLPoint;}
  484.  
  485.   begin
  486.   Inherited Do3DRenderScene;
  487.   aPt.X:=0;aPt.Y:=0;aPt.Z:=0;
  488.   glCanvas.DrawAxis(apt,50,RenderState);
  489.   aPt1.X:=-200;aPt1.Y:=-200;aPt1.Z:=-200;
  490.   aPt2.X:=200;aPt2.Y:=200;aPt2.Z:=200;
  491.  
  492.   glCanvas.linestyle:=stcontinous;
  493.   (*gldisable(gl_Line_Stipple);*)
  494.   glcolor3fv(@glBlack);
  495. (*  CreateGrid(aPt1,apt2,gtFront,5);
  496.   CreateGrid(aPt1,apt2,gtback,5);*)
  497.  
  498.   callList(DisplayList+dlGridFront);
  499.   callList(DisplayList+dlGridBack);
  500.   With glCanvas do
  501.    Begin
  502.     PointMode:=ptSimple;
  503.     aPt2.X:=110;aPt2.Y:=110;aPt2.Z:=0;
  504.     PointSize:=5;
  505.     DrawPoint(aPt2);
  506.     PointMode:=ptShpere;
  507.     aPt2.X:=150;aPt2.Y:=150;aPt2.Z:=0;
  508.     PointSize:=1;
  509.     {DrawPoint(aPt2);}
  510.     PointMode:=ptX;
  511.     aPt2.X:=130;aPt2.Y:=130;aPt2.Z:=0;
  512.     PointSize:= 10*UnitsPerPixel;
  513.     DrawPoint(aPt2);
  514.     PointMode:=ptShpere;
  515.     aPt2.X:=140;aPt2.Y:=140;aPt2.Z:=0;
  516.     DrawPoint(aPt2);
  517.     PointMode:=ptCube;
  518.     aPt2.X:=150;aPt2.Y:=150;aPt2.Z:=100;
  519.     DrawPoint(aPt2);
  520.     aPt2.X:=50;aPt2.Y:=50;aPt2.Z:=100;
  521.     TextOut3D(apt2,20,'Open GL');
  522.     end;
  523.  end;
  524. (*************************************************************)
  525.  Procedure TOpenGLWindow.Do3DRenderScene;
  526.    Begin
  527.     Inherited;
  528.     Case ord(fTestScene) of
  529.       0:{do Nothing};
  530.       1:DrawBasicScene;
  531.       2:DrawColorTriangleScene;
  532.       3:DrawRBStereo;
  533.       4:DrawRandomGroundScene;
  534.       5:DrawSelectScene;
  535.       6:;
  536.  
  537.     end
  538.    end;
  539. {*********************************************************}
  540. {*********************************************************}
  541.  
  542.  Procedure TGLController.AddWindow(aWin:TOpenGLWindow);
  543.  // add a Window to the list
  544.   Begin
  545.     fGLControlledWindow:=aWin;
  546.     If Assigned(fGLControlledWindow) then UpDateControl;
  547.   end;
  548.  
  549. {*********************************************************}
  550.   Procedure TGLController.UpDateMeasure;
  551.     begin
  552.     end;
  553. {*********************************************************}
  554. Procedure TGLController.UpDateControl;
  555.     //Update the controller for the current window state
  556.    Begin
  557.         fUpdating:=True;
  558.         MoveState.ItemIndex:=ord(fGLControlledWindow.MoveMode);
  559.         View.ItemIndex:=Ord(fGLControlledWindow.ViewMode);
  560.         Select.ItemIndex:=ord(fGLControlledWindow.ToolMode);
  561.         RM1.ItemIndex:=Ord(fGLControlledWindow.RenderState);
  562.         Perspective1.Checked:=fGLControlledWindow.perspective;
  563.         HUD.Checked:=fGLControlledWindow.HUD;
  564.         Grid.Checked:=fGLControlledWindow.grid;
  565.         LightingOn.Checked:=fGLControlledWindow.LightingOn;
  566.         {HeadLight.Checked:=fGLControlledWindow.HeadLightOn;}
  567.         GrabFocus.Checked:=fGLControlledWindow.GrabFocus;
  568.         TestScene.ItemIndex:= ord(fGLControlledWindow.TestScene);
  569.         GD.Checked:=fGLControlledWindow.GenericGDI;
  570.         WBG.Checked:=fGLControlledWindow.BackGround=glWhiteBkgd;
  571.         Cursor3D.Checked:= fGLControlledWindow.cursor3D;
  572.         SDL.Checked:=fGLControlledWindow.StdDisplayList;
  573.         UpDateMeasure;
  574.  
  575.         fUpdating:=False;
  576.    end;
  577.  
  578. {*********************************************************}
  579. Procedure TGLController.Lock;
  580.     //Lock all the controls while update happening
  581.   Begin
  582.     Screen.Cursor:=crHourglass;
  583.     TS1.Enabled:=False;
  584.     TS2.Enabled:=False;
  585.     TS3.Enabled:=False;
  586.     TS4.Enabled:=False;
  587.     Application.Processmessages;
  588.   end;
  589. Procedure TGLController.UnLock;
  590.     //UnLock all the controls while update happening
  591.   Begin
  592.     TS1.Enabled:=true;
  593.     TS2.Enabled:=true;
  594.     TS3.Enabled:=true;
  595.     TS4.Enabled:=true;
  596.     Screen.Cursor:=crDefault;
  597.     Application.Processmessages;
  598. end;
  599.  
  600. procedure TGLController.ViewClick(Sender: TObject);
  601. begin
  602.     Application.ProcessMessages;
  603.     If fUpdating then exit;
  604.     Lock;
  605.      If Assigned(fGLControlledWindow) then
  606.         fGLControlledWindow.ViewMode:=GLViewMode(View.ItemIndex);
  607.     UnLock;
  608. end;
  609.  
  610. procedure TGLController.MoveStateClick(Sender: TObject);
  611. begin
  612.     Application.ProcessMessages;
  613.     If fUpdating then exit;
  614.     Lock;
  615.      If Assigned(fGLControlledWindow) then
  616.       Begin
  617.         fGLControlledWindow.MoveMode:=GLMoveMode(MoveState.ItemIndex);
  618.         If (MoveState.ItemIndex=7) and  not Perspective1.Checked then
  619.           Perspective1.Checked:=True;
  620.       end;
  621.     Select.Enabled:=not (MoveState.ItemIndex>0);
  622.     Warning1.Visible:=(MoveState.ItemIndex>0);
  623.     UnLock;
  624. end;
  625.  
  626. procedure TGLController.SelectClick(Sender: TObject);
  627. begin
  628.     Application.ProcessMessages;
  629.     If fUpdating then exit;
  630.     Lock;
  631.      If Assigned(fGLControlledWindow) then
  632.         fGLControlledWindow.ToolMode:=glToolMode(Select.ItemIndex);
  633.     UnLock;
  634. end;
  635.  
  636. procedure TGLController.Perspective1Click(Sender: TObject);
  637. begin
  638.     Application.ProcessMessages;
  639.     If fUpdating then exit;
  640.     Lock;
  641.     If Assigned(fGLControlledWindow) then
  642.       fGLControlledWindow.perspective:=Perspective1.Checked;
  643.     UnLock;
  644. end;
  645.  
  646. procedure TGLController.SpeedButton2Click(Sender: TObject);
  647. begin
  648.     If fUpdating then exit;
  649.     Lock;
  650.      If Assigned(fGLControlledWindow) then
  651.         fGLControlledWindow.DoZoomIn;
  652.     UnLock;
  653. end;
  654.  
  655. procedure TGLController.SpeedButton3Click(Sender: TObject);
  656. begin
  657.     Application.ProcessMessages;
  658.     If fUpdating then exit;
  659.     Lock;
  660.      If Assigned(fGLControlledWindow) then
  661.         fGLControlledWindow.DoZoomOut;
  662.     UnLock;
  663. end;
  664.  
  665. procedure TGLController.SpeedButton4Click(Sender: TObject);
  666. begin
  667.     Application.ProcessMessages;
  668.     If fUpdating then exit;
  669.     Lock;
  670.      If Assigned(fGLControlledWindow) then
  671.         fGLControlledWindow.MoveViewByDelta(-10,-10,-10);
  672.     UnLock;
  673. end;
  674.  
  675. procedure TGLController.SpeedButton6Click(Sender: TObject);
  676. begin
  677.     Application.ProcessMessages;
  678.     If fUpdating then exit;
  679.     Lock;
  680.      If Assigned(fGLControlledWindow) then
  681.         fGLControlledWindow.MoveViewByDelta(10,10,10);
  682.     UnLock;
  683. end;
  684.  
  685.  
  686. procedure TGLController.SpeedButton1Click(Sender: TObject);
  687. begin
  688.     Application.ProcessMessages;
  689.     If fUpdating then exit;
  690.     Lock;
  691.      If Assigned(fGLControlledWindow) then
  692.         fGLControlledWindow.ClearSelectList;
  693.     UnLock;
  694. end;
  695.  
  696.  
  697.  
  698. procedure TGLController.FormClose(Sender: TObject;
  699.   var Action: TCloseAction);
  700. begin
  701.  fGLControlledWindow.GLControlFreed;
  702.  Action:=caFree;
  703. end;
  704.  
  705. procedure TGLController.RM1Click(Sender: TObject);
  706. begin
  707.     Application.ProcessMessages;
  708.     If fUpdating then exit;
  709.     Lock;
  710.      If Assigned(fGLControlledWindow) then
  711.         fGLControlledWindow.RenderState:=GLRenderState(RM1.ItemIndex);
  712.     UnLock;
  713. end;
  714.  
  715. procedure TGLController.SpeedButton7Click(Sender: TObject);
  716. begin
  717.   fGLControlledWindow.RestoreLastView;
  718. end;
  719.  
  720. procedure TGLController.ResetBtnClick(Sender: TObject);
  721. begin
  722.     Application.ProcessMessages;
  723.     If fUpdating then exit;
  724.     Lock;
  725.      If Assigned(fGLControlledWindow) then
  726.        With  fGLControlledWindow do
  727.        Begin
  728.         ResetView(True);
  729.         Repaint;
  730.        end;
  731.  
  732.     UnLock;
  733. end;
  734. procedure TGLController.MaxFRClick(Sender: TObject);
  735. begin
  736.   fGLControlledWindow.MaxFrmRate:=MaxFR.Checked;
  737. end;
  738.  
  739. procedure TGLController.AnimateClick(Sender: TObject);
  740. begin
  741. end;
  742. (*************************************************************)
  743. procedure Register;
  744. begin
  745.   RegisterComponents('OpenGL', [TOpenGLWindow]);
  746. end;
  747.  
  748.  
  749.  
  750. procedure TGLController.HUDClick(Sender: TObject);
  751. begin
  752.   fGLControlledWindow.HUD:=HUD.Checked;
  753. end;
  754.  
  755. procedure TGLController.PrintClick(Sender: TObject);
  756. begin
  757.   Screen.Cursor:=crHourglass;
  758.  (* glPrinter.Begindoc;
  759. //printing of attached gl window
  760.   {fGLControlledWindow.PrintWindow(Printer);}
  761.  
  762.   glprinter.EndDoc;*)
  763.   Screen.Cursor:=crDefault;
  764. end;
  765.  
  766. procedure TGLController.GridClick(Sender: TObject);
  767. begin
  768.   fGLControlledWindow.Grid:=Grid.checked;
  769. end;
  770.  
  771. procedure TGLController.TestSceneClick(Sender: TObject);
  772. begin
  773.  fGLControlledWindow.TestScene:=glTestScene(TestScene.ItemIndex);
  774.  fGLControlledWindow.Repaint;
  775. end;
  776.  
  777. procedure TGLController.GridtextClick(Sender: TObject);
  778. begin
  779.     Application.ProcessMessages;
  780.     If fUpdating then exit;
  781.     Lock;
  782.     If Assigned(fGLControlledWindow) then
  783.       fGLControlledWindow.GridText:=GridText.Checked;
  784.     UnLock;
  785. end;
  786.  
  787. procedure TGLController.SpeedButton5Click(Sender: TObject);
  788. begin
  789.     Application.ProcessMessages;
  790.     If fUpdating then exit;
  791.     Lock;
  792.     If Assigned(fGLControlledWindow) then
  793.       fGLControlledWindow.CopyToClipboard;
  794.     UnLock;
  795. end;
  796.  
  797. procedure TGLController.GrabFocusClick(Sender: TObject);
  798. begin
  799.     Application.ProcessMessages;
  800.     If fUpdating then exit;
  801.     If Assigned(fGLControlledWindow) then
  802.       fGLControlledWindow.GrabFocus:=GrabFocus.Checked;
  803.     Lock;
  804.     UnLock;
  805. end;
  806.  
  807. procedure TGLController.LightOnClick(Sender: TObject);
  808. begin
  809.     Application.ProcessMessages;
  810.     If fUpdating then exit;
  811.     Lock;
  812.     {If Assigned(fGLControlledWindow) then
  813.       fGLControlledWindow.LightOn:=HeadLight.Checked;}
  814.     UpDateControl;
  815.     UnLock;
  816. end;
  817.  
  818. procedure TGLController.FormShow(Sender: TObject);
  819. Var St:String;
  820.     Dt:TPixelFormatDescriptor;
  821. begin
  822.   If not Assigned(fGLControlledWindow) then exit;
  823.   Str(fGLControlledWindow.PixelFormat,St);
  824.   CPixelFormat.Caption:=CPixelFormat.caption+' '+St;
  825.   Vendor.Caption:=fGLControlledWindow.GetGLVendor;
  826.   Renderer.Caption:=fGLControlledWindow.GetGLRenderer;
  827.   version.Caption:=fGLControlledWindow.GetGLVersion;
  828.   Extension.LInes[0]:=fGLControlledWindow.GetGLExtensions;
  829.   DT:=fGLControlledWindow.PixelData;
  830.  
  831.   With  fGLControlledWindow do
  832.    Begin
  833.       DW.Checked:= pfd_Win_Draw;
  834.       BM.Checked:= fpfd_BitMap;
  835.       HA.Checked:= fpfd_Accel;
  836.       DB.Checked:= fpfdDoubleBuf;
  837.       SC.Checked:= fpfd_Swap_Copy;
  838.       SE.Checked:= fpfd_swap_exhg;
  839.       GL.Checked:= fpfd_GL_sup;
  840.       GD.Checked:= GenericGDI;
  841.       stereo.checked:=fpfd_Stereo;
  842.    end;
  843.   Str(DT.cColorBits,St);
  844.   CBits.Caption:=CBits.caption+' '+St;
  845.   Str(DT.cDepthBits,St);
  846.   DBits.Caption:=DBits.caption+' '+St;
  847.   Str(DT.cStencilBits,St);
  848.   SBits.Caption:=SBits.caption+' '+St;
  849.   Str(DT.cAccumBits,St);
  850.   ABits.Caption:=ABits.caption+' '+St;
  851.  
  852.   UpDateMeasure;
  853. end;
  854.  
  855. (******* ******************************************************)
  856. procedure TGLController.DeleteMeasureClick(Sender: TObject);
  857. begin
  858.     Application.ProcessMessages;
  859.     If fUpdating then exit;
  860.     Lock;
  861.      If Assigned(fGLControlledWindow) then
  862.         fGLControlledWindow.ClearMoveList;
  863.     UnLock;
  864.  
  865. end;
  866.  
  867. procedure TGLController.measuredataClick(Sender: TObject);
  868. begin
  869.     Application.ProcessMessages;
  870.     If fUpdating then exit;
  871.     Lock;
  872.      If Assigned(fGLControlledWindow) then UpDatemeasure;
  873.     UnLock;
  874.  
  875. end;
  876.  
  877. procedure TGLController.GetErrorClick(Sender: TObject);
  878.  Var i:Longint;
  879. begin
  880.     Application.ProcessMessages;
  881.     If fUpdating then exit;
  882.     Lock;
  883.      If Assigned(fGLControlledWindow) Then
  884.      If fGLControlledWindow.GetError then
  885.       Begin
  886.       If fGLControlledWindow.ErrorList.Count>0 then
  887.        With ErrorGrid do
  888.         Begin
  889.            RowCount:=fGLControlledWindow.ErrorList.Count-1;
  890.            For i:=0 to RowCount-1 do
  891.             Cells[0,i]:=fGLControlledWindow.ErrorList.Strings[i];
  892.         end;
  893.       end else
  894.        With ErrorGrid do
  895.        Begin
  896.         RowCount:=1;
  897.         Cells[0,0]:='';
  898.        end;
  899.     UnLock;
  900. end;
  901.  
  902. procedure TGLController.ClearErrorClick(Sender: TObject);
  903. begin
  904.     Application.ProcessMessages;
  905.     If fUpdating then exit;
  906.     Lock;
  907.      If Assigned(fGLControlledWindow) then fGLControlledWindow.ClearError;
  908.      With ErrorGrid do
  909.      Begin
  910.        RowCount:=1;
  911.        Cells[0,0]:='';
  912.      end;
  913.     UnLock;
  914. end;
  915.  
  916. procedure TGLController.GDClick(Sender: TObject);
  917. begin
  918.     Application.ProcessMessages;
  919.     If fUpdating then exit;
  920.     Lock;
  921.      If Assigned(fGLControlledWindow) then
  922.         fGLControlledWindow.GenericGDI:=GD.Checked;
  923.     UpdateControl;
  924.     UnLock;
  925. end;
  926.  
  927. procedure TGLController.AnimateonClick(Sender: TObject);
  928. begin
  929.     AnimateP.Visible:=AnimateOn.Checked;
  930.      If Assigned(fGLControlledWindow) then
  931.         fGLControlledWindow.Animate:=Animateon.Checked;
  932.     UpdateControl;
  933. end;
  934.  
  935. procedure TGLController.WBGClick(Sender: TObject);
  936. begin
  937.     Application.ProcessMessages;
  938.     If fUpdating then exit;
  939.     Lock;
  940.      If Assigned(fGLControlledWindow) then
  941.         fGLControlledWindow.BackGround:=GLBackground(not WBG.Checked);
  942.     UnLock;
  943. end;
  944.  
  945. procedure TGLController.LightXChange(Sender: TObject);
  946.   Var aVal:Double;
  947.       Code:Integer;
  948.       aEdit:TMaskEdit;
  949.       s:String;
  950. begin
  951.   If (Sender is tMaskEdit) and TMaskEdit(Sender).Modified then
  952.      Begin
  953.        aEdit:=TMaskEdit(sender);
  954.        s:= TMaskEdit(Sender).Text;
  955.        If length(s)=0 then exit;
  956.        If length(s)=1 then
  957.         Begin
  958.           If s='-' then exit;
  959.           If s='+' then exit;
  960.           If s=' ' then exit;
  961.           If s='.' then exit;
  962.         end;
  963.      {$HINTS OFF}
  964.        Val(s,aVal,code);
  965.        If code<>0 then
  966.         Begin
  967.           MessageDlg('Invalid value',mtError,[mbok],0);
  968.           aEdit.SetFocus;
  969.         end;
  970.      {$HINTS ON}    
  971.      end;
  972. end;
  973.  
  974. procedure TGLController.LightXKeyPress(Sender: TObject; var Key: Char);
  975. begin
  976.   Case Key of
  977.     '0'..'9','-','+','.',#8:;
  978.     else
  979.      Begin
  980.        Key:=#0;
  981.        Beep;
  982.      end;
  983.  
  984.   end;
  985. end;
  986.  
  987. procedure TGLController.YLightExit(Sender: TObject);
  988.   Var aVal:Double;
  989.       Code:Integer;
  990.       aEdit:TMaskEdit;
  991.       s:String;
  992. begin
  993.   If (Sender is tMaskEdit) and TMaskEdit(Sender).Modified then
  994.      Begin
  995.        aEdit:=TMaskEdit(sender);
  996.        s:= TMaskEdit(Sender).Text;
  997.        If length(s)=0 then exit;
  998.        If length(s)=1 then
  999.         Begin
  1000.           If s='-' then exit;
  1001.           If s='+' then exit;
  1002.           If s=' ' then exit;
  1003.           If s='.' then exit;
  1004.         end;
  1005.        Val(s,aVal,code);
  1006.        If code<>0 then
  1007.         Begin
  1008.           MessageDlg('Invalid value',mtError,[mbok],0);
  1009.           aEdit.SetFocus;
  1010.         end;
  1011.      end;
  1012. end;
  1013.  
  1014. procedure TGLController.Cursor3DClick(Sender: TObject);
  1015. begin
  1016.     Application.ProcessMessages;
  1017.     If fUpdating then exit;
  1018.     Lock;
  1019.      If Assigned(fGLControlledWindow) then
  1020.         fGLControlledWindow.Cursor3D:=Cursor3D.Checked;
  1021.     UnLock;
  1022. end;
  1023.  
  1024. procedure TGLController.SpeedButton8Click(Sender: TObject);
  1025. begin
  1026.     Application.ProcessMessages;
  1027.     If fUpdating then exit;
  1028.     Lock;
  1029.      If Assigned(fGLControlledWindow) then
  1030.         fGLControlledWindow.repaint;
  1031.     UnLock;
  1032. end;
  1033.  
  1034. procedure TGLController.SDLClick(Sender: TObject);
  1035. begin
  1036.     Application.ProcessMessages;
  1037.     If fUpdating then exit;
  1038.     Lock;
  1039.      If Assigned(fGLControlledWindow) then
  1040.         fGLControlledWindow.StdDisplayList:=SDL.Checked;
  1041.     UnLock;
  1042. end;
  1043.  
  1044. end.
  1045.