home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Samples / d3drm / Basic / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  4.1 KB  |  163 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, DXClass, DXDraws, DirectX;
  8.  
  9. type
  10.   TMainForm = class(TDXForm)
  11.     DXDraw: TDXDraw;
  12.     DXTimer: TDXTimer;
  13.     OpenDialog: TOpenDialog;
  14.     procedure DXDrawInitialize(Sender: TObject);
  15.     procedure DXDrawFinalize(Sender: TObject);
  16.     procedure DXTimerTimer(Sender: TObject; LagCount: Integer);
  17.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  18.       Shift: TShiftState);
  19.     procedure DXDrawClick(Sender: TObject);
  20.     procedure DXDrawInitializeSurface(Sender: TObject);
  21.   private
  22.     FileName: string;
  23.   end;
  24.  
  25. var
  26.   MainForm: TMainForm;
  27.  
  28. implementation
  29.  
  30. {$R *.DFM}
  31.  
  32. procedure TMainForm.DXDrawInitialize(Sender: TObject);
  33. var
  34.   LightFrame, MeshFrame: IDirect3DRMFrame;
  35.   Light, AmbientLight: IDirect3DRMLight;
  36.   MeshBuilder: IDirect3DRMMeshBuilder;
  37. begin
  38.   {  Frame making  }
  39.   DXDraw.D3DRM.CreateFrame(DXDraw.Scene, LightFrame);
  40.   DXDraw.D3DRM.CreateFrame(DXDraw.Scene, MeshFrame);
  41.  
  42.   {  Light setting  }
  43.   DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0.9, 0.9, 0.9, Light);
  44.   LightFrame.AddLight(Light);
  45.  
  46.   DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.1, 0.1, 0.1, AmbientLight);
  47.   DXDraw.Scene.AddLight(AmbientLight);
  48.  
  49.   {  Frame position and posture setting  }
  50.   LightFrame.SetPosition(DXDraw.Scene, 2, 0.0, 22);
  51.   DXDraw.Camera.SetPosition(DXDraw.Scene, -5.0, 10.0, 0.0);
  52.   DXDraw.Camera.SetOrientation(DXDraw.Scene, 0.35, -0.65, 1.0, -0.15, 1.0, 0.5);
  53.  
  54.   MeshFrame.SetPosition(DXDraw.Scene, 0.0, 0.0, 15);
  55.   MeshFrame.SetOrientation(DXDraw.Scene, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0);
  56.   MeshFrame.SetRotation(DXDraw.Scene, 0.0, 1.0, 0.0, 0.05);
  57.  
  58.   {  Mesh making  }
  59.   DXDraw.D3DRM.CreateMeshBuilder(MeshBuilder);
  60.  
  61.   if FileName='' then
  62.     FileName := ExtractFilePath(Application.ExeName)+'cube.x';
  63.   ChDir(ExtractFilePath(FileName));
  64.   MeshBuilder.Load(PChar(FileName), nil, D3DRMLOAD_FROMFILE, nil, nil);
  65.   MeshBuilder.Scale(3, 3, 3);
  66.   MeshFrame.AddVisual(MeshBuilder);
  67.  
  68.   DXTimer.Enabled := True;
  69. end;
  70.  
  71. procedure TMainForm.DXDrawFinalize(Sender: TObject);
  72. begin
  73.   DXTimer.Enabled := False;
  74. end;
  75.  
  76. procedure TMainForm.DXDrawInitializeSurface(Sender: TObject);
  77. begin
  78.   if doHardware in DXDraw.NowOptions then
  79.   begin
  80.     {  Bi-linear filtering  }
  81.     DXDraw.D3DRMDevice.SetTextureQuality(D3DRMTEXTURE_LINEAR);
  82.   end;
  83.  
  84.   {  Alpha-blending  }
  85.   DXDraw.D3DRMDevice2.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY or
  86.     D3DRMRENDERMODE_SORTEDTRANSPARENCY);
  87. end;
  88.  
  89. procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
  90. begin
  91.   if not DXDraw.CanDraw then exit;
  92.  
  93.   DXDraw.Viewport.ForceUpdate(0, 0, DXDraw.SurfaceWidth, DXDraw.SurfaceHeight);
  94.  
  95.   DXDraw.Scene.Move(1.0);
  96.   DXDraw.Render;
  97.  
  98.   with DXDraw.Surface.Canvas do
  99.   begin
  100.     Brush.Style := bsClear;
  101.     Font.Color := clWhite;
  102.     Font.Size := 12;
  103.     Textout(0, 0, 'FPS: '+inttostr(DXTimer.FrameRate));
  104.     if doHardware in DXDraw.NowOptions then
  105.       Textout(0, 14, 'Device: Hardware')
  106.     else
  107.       Textout(0, 14, 'Device: Software');
  108.  
  109.     Release; {  Indispensability  }
  110.   end;
  111.  
  112.   DXDraw.Flip;
  113. end;
  114.  
  115. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  116.   Shift: TShiftState);
  117. begin
  118.   {  Application end  }
  119.   if Key=VK_ESCAPE then
  120.     Close;
  121.  
  122.   {  Screen mode change  }
  123.   if (ssAlt in Shift) and (Key=VK_RETURN) then
  124.   begin
  125.     DXDraw.Finalize;
  126.  
  127.     if doFullScreen in DXDraw.Options then
  128.     begin
  129.       RestoreWindow;
  130.  
  131.       DXDraw.Cursor := crDefault;
  132.       BorderStyle := bsSizeable;
  133.       DXDraw.Options := DXDraw.Options - [doFullScreen];
  134.     end else
  135.     begin
  136.       StoreWindow;
  137.  
  138.       DXDraw.Cursor := crNone;
  139.       BorderStyle := bsNone;
  140.       DXDraw.Options := DXDraw.Options + [doFullScreen];
  141.     end;
  142.  
  143.     DXDraw.Initialize;
  144.   end;
  145. end;
  146.  
  147. procedure TMainForm.DXDrawClick(Sender: TObject);
  148. var
  149.   w: Word;
  150. begin
  151.   w := VK_RETURN;
  152.   if doFullScreen in DXDraw.Options then
  153.     FormKeyDown(nil, w, [ssAlt]);
  154.  
  155.   if OpenDialog.Execute then
  156.   begin
  157.     FileName := OpenDialog.FileName;
  158.     DXDraw.Initialize;
  159.   end;
  160. end;
  161.  
  162. end.
  163.