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