home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Samples / d3drm / wrap / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  6.3 KB  |  266 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.     Mesh: IDirect3DRMMesh;
  24.     MeshFrame: IDirect3DRMFrame;
  25.     WrapType: D3DRMWRAPTYPE;
  26.     wrap: IDirect3DRMWrap;
  27.     procedure CreateWarp;
  28.     procedure ApplyWarp;
  29.   end;
  30.  
  31. var
  32.   MainForm: TMainForm;
  33.  
  34. implementation
  35.  
  36. {$R *.DFM}
  37.  
  38. procedure TMainForm.CreateWarp;
  39. var
  40.   miny, maxy, height: D3DVALUE;
  41.   box: D3DRMBOX;
  42.   ov, sv: Double;
  43. begin
  44.   Mesh.GetBox(box);
  45.  
  46.   maxy := box.max.y;
  47.   miny := box.min.y;
  48.  
  49.   height := maxy - miny;
  50.   if height=0 then height := 0.00001;
  51.  
  52.   ov := D3DDivide(miny, height);
  53.   sv := D3DDivide(-1.0, height);
  54.  
  55.   if WrapType=D3DRMWRAP_SPHERE then
  56.   begin
  57.     DXDraw.D3DRM.CreateWrap(D3DRMWRAP_SPHERE, nil,
  58.       0, 0, 0,
  59.       0, 0, 1,
  60.       0, 1, 0,
  61.       0, 0,
  62.       1, 1,
  63.       Wrap
  64.     );
  65.     wrap.Apply(Mesh);
  66.   end else
  67.   if WrapType=D3DRMWRAP_CHROME then
  68.   begin
  69.     DXDraw.D3DRM.CreateWrap(D3DRMWRAP_CHROME, DXDraw.Camera,
  70.       0, 0, 0,
  71.       0, 0, 1,
  72.       0, 1, 0,
  73.       0, ov,
  74.       1, sv,
  75.       Wrap
  76.     );
  77.     wrap.ApplyRelative(MeshFrame, Mesh);
  78.   end else
  79.   begin
  80.     DXDraw.D3DRM.CreateWrap(WrapType, nil,
  81.       0, 0, 0,
  82.       0, 0, 1,
  83.       0, 1, 0,
  84.       0, ov,
  85.       1, sv,
  86.       Wrap
  87.     );
  88.     wrap.Apply(Mesh);
  89.   end;
  90. end;
  91.  
  92. procedure TMainForm.ApplyWarp;
  93. begin
  94.   if WrapType=D3DRMWRAP_CHROME then
  95.     wrap.ApplyRelative(MeshFrame, Mesh);
  96. end;
  97.  
  98. procedure TMainForm.DXDrawInitialize(Sender: TObject);
  99. var
  100.   LightFrame: IDirect3DRMFrame;
  101.   Light, AmbientLight: IDirect3DRMLight;
  102.   MeshBuilder: IDirect3DRMMeshBuilder;
  103.   image: IDirect3DRMTexture;
  104. begin
  105.   {  Frame making  }
  106.   DXDraw.D3DRM.CreateFrame(DXDraw.Scene, LightFrame);
  107.   DXDraw.D3DRM.CreateFrame(DXDraw.Scene, MeshFrame);
  108.  
  109.   {  Light setting  }
  110.   DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0.9, 0.9, 0.9, Light);
  111.   LightFrame.AddLight(Light);
  112.  
  113.   DXDraw.D3DRM.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.1, 0.1, 0.1, AmbientLight);
  114.   DXDraw.Scene.AddLight(AmbientLight);
  115.  
  116.   {  Frame position and posture setting  }
  117.   LightFrame.SetPosition(DXDraw.Scene, 2, 0.0, 22);
  118.   DXDraw.Camera.SetPosition(DXDraw.Scene, -5.0, 10.0, 0.0);
  119.   DXDraw.Camera.SetOrientation(DXDraw.Scene, 0.35, -0.65, 1.0, -0.15, 1.0, 0.5);
  120.  
  121.   MeshFrame.SetPosition(DXDraw.Scene, 0.0, 0.0, 15);
  122.   MeshFrame.SetOrientation(DXDraw.Scene, 0.0, 0.0, 1.0, 0.0, 1.0, 0.0);
  123.   MeshFrame.SetRotation(DXDraw.Scene, 0.0, 1.0, 0.0, 0.05);
  124.  
  125.   {  Mesh making  }
  126.   DXDraw.D3DRM.CreateMeshBuilder(MeshBuilder);
  127.  
  128.   if FileName='' then
  129.     FileName := ExtractFilePath(Application.ExeName)+'Egg.x';
  130.   ChDir(ExtractFilePath(FileName));
  131.   MeshBuilder.Load(PChar(FileName), nil, D3DRMLOAD_FROMFILE, nil, nil);
  132.   MeshBuilder.Scale(3, 3, 3);
  133.   //MeshBuilder.SetColor(D3DRGB(1, 1, 1));
  134.  
  135.   DXDraw.D3DRM.LoadTexture(PChar(ExtractFilePath(Application.ExeName)+'lake.bmp'), image);
  136.   MeshBuilder.SetTexture(image);
  137.  
  138.   meshBuilder.CreateMesh(mesh);
  139.   MeshFrame.AddVisual(mesh);
  140.  
  141.  
  142.   CreateWarp;
  143.  
  144.   DXTimer.Enabled := True;
  145. end;
  146.  
  147. procedure TMainForm.DXDrawFinalize(Sender: TObject);
  148. begin
  149.   Wrap := nil;
  150.   Mesh := nil;
  151.   MeshFrame := nil;
  152.  
  153.   DXTimer.Enabled := False;
  154. end;
  155.  
  156. procedure TMainForm.DXDrawInitializeSurface(Sender: TObject);
  157. begin
  158.   if doHardware in DXDraw.NowOptions then
  159.   begin
  160.     {  Bi-linear filtering  }
  161.     DXDraw.D3DRMDevice.SetTextureQuality(D3DRMTEXTURE_LINEAR);
  162.   end;
  163.  
  164.   {  Alpha blending  }
  165.   DXDraw.D3DRMDevice2.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY or
  166.     D3DRMRENDERMODE_SORTEDTRANSPARENCY);
  167. end;
  168.  
  169. procedure TMainForm.DXTimerTimer(Sender: TObject; LagCount: Integer);
  170. const
  171.   DeviceText: array[Boolean] of string =
  172.     ('Software', 'Hardware');
  173.   WrapText: array[D3DRMWRAP_FLAT..D3DRMWRAP_CHROME] of string =
  174.     ('Wrap is flat', 'Wrap is cylindrical', 'Wrap is spherical', 'Wrap is chrome');
  175. var
  176.   s: string;
  177.   r: TRect;
  178. begin
  179.   if not DXDraw.CanDraw then exit;
  180.  
  181.   MeshFrame.Move(1.0);
  182.  
  183.   ApplyWarp;
  184.  
  185.   DXDraw.Viewport.ForceUpdate(0, 0, DXDraw.SurfaceWidth, DXDraw.SurfaceHeight);
  186.   DXDraw.Render;
  187.  
  188.  
  189.   s := Format('FPS: %d', [DXTimer.FrameRate])+#13+
  190.        Format('Device: %s', [DeviceText[doHardware in DXDraw.NowOptions]])+#13+
  191.        #13+
  192.        Format('%s', [WrapText[WrapType]]);
  193.  
  194.   r := DXDraw.Surface.ClientRect;
  195.   with DXDraw.Surface.Canvas do
  196.   begin
  197.     Brush.Style := bsClear;
  198.     Font.Color := clWhite;
  199.     Font.Size := 12;
  200.     DrawText(Handle, PChar(s), Length(s), r, DT_LEFT or DT_NOCLIP);
  201.  
  202.     Release; {  Indispensability  }
  203.   end;
  204.  
  205.   DXDraw.Flip;
  206. end;
  207.  
  208. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  209.   Shift: TShiftState);
  210. const
  211.   WrapChangeList: array[D3DRMWRAP_FLAT..D3DRMWRAP_CHROME] of D3DRMWRAPTYPE =
  212.     (D3DRMWRAP_CYLINDER, D3DRMWRAP_SPHERE, D3DRMWRAP_CHROME, D3DRMWRAP_FLAT);
  213. begin
  214.   {  Wrap method change  }
  215.   if Key=VK_SPACE then
  216.   begin
  217.     WrapType := WrapChangeList[WrapType];
  218.     CreateWarp;
  219.   end;
  220.  
  221.   {  Application end  }
  222.   if Key=VK_ESCAPE then
  223.     Close;
  224.  
  225.   {  Screen mode change  }
  226.   if (ssAlt in Shift) and (Key=VK_RETURN) then
  227.   begin
  228.     DXDraw.Finalize;
  229.  
  230.     if doFullScreen in DXDraw.Options then
  231.     begin
  232.       RestoreWindow;
  233.  
  234.       DXDraw.Cursor := crDefault;
  235.       BorderStyle := bsSizeable;
  236.       DXDraw.Options := DXDraw.Options - [doFullScreen];
  237.     end else
  238.     begin
  239.       StoreWindow;
  240.  
  241.       DXDraw.Cursor := crNone;
  242.       BorderStyle := bsNone;
  243.       DXDraw.Options := DXDraw.Options + [doFullScreen];
  244.     end;
  245.  
  246.     DXDraw.Initialize;
  247.   end;
  248. end;
  249.  
  250. procedure TMainForm.DXDrawClick(Sender: TObject);
  251. var
  252.   w: Word;
  253. begin
  254.   w := VK_RETURN;
  255.   if doFullScreen in DXDraw.Options then
  256.     FormKeyDown(nil, w, [ssAlt]);
  257.  
  258.   if OpenDialog.Execute then
  259.   begin
  260.     FileName := OpenDialog.FileName;
  261.     DXDraw.Initialize;
  262.   end;
  263. end;
  264.  
  265. end.
  266.