2004-10-21 04:52

'Here is the correct running verions of the WRAP.BAS program that
'shows you Chrome wrapping of a 3D object. Should be in your
'\examples\direct3d\wrap folder. This is also known
'as "environmental wrapping," which was used to give the metal-chrome
'appearance of the robot in "Terminator2."

' Direct 3D with textured object & alphablending
' for Rapid-Q by William Yu
'fixed by JohnK - needed global MeshBuilder
     $TYPECHECK ON

     CONST alClient = 5

'-- Light Types
     CONST D3DRMLIGHT_AMBIENT = 0
     CONST D3DRMLIGHT_POINT = 1
     CONST D3DRMLIGHT_SPOT = 2
     CONST D3DRMLIGHT_DIRECTIONAL = 3
     CONST D3DRMLIGHT_PARALLELPOINT = 4

'-- Renderer modes
     CONST D3DRMRENDERMODE_BLENDEDTRANSPARENCY = 1
     CONST D3DRMRENDERMODE_SORTEDTRANSPARENCY = 2
     CONST D3DRMRENDERMODE_LIGHTINMODELSPACE = 8
     CONST D3DRMRENDERMODE_VIEWDEPENDENTSPECULAR = 16
     CONST D3DRMRENDERMODE_DISABLESORTEDALPHAZWRITE = 32

'-- Wrap Types
     CONST D3DRMWRAP_FLAT = 0
     CONST D3DRMWRAP_CYLINDER = 1
     CONST D3DRMWRAP_SPHERE = 2
     CONST D3DRMWRAP_CHROME = 3
     CONST D3DRMWRAP_SHEET = 4
     CONST D3DRMWRAP_BOX = 5

     CONST WrapType = D3DRMWRAP_CHROME '-- You can modify this

     DECLARE SUB DXInitialize(Sender AS QDXSCREEN)
     DECLARE SUB DXInitializeSurface(Sender AS QDXSCREEN)
     DECLARE SUB DXTimerExpired

     DIM DXTimer AS QDXTIMER
     DXTimer.Enabled = 1
     DXTimer.Interval = 0
     DXTimer.OnTimer = DXTimerExpired

     DIM MeshFrame AS QD3DFRAME
     DIM Mesh AS QD3DMESH
     DIM Wrap AS QD3DWRAP
     DIM MeshBuilder AS QD3DMESHBUILDER

     CREATE Form AS QFORM
      CAPTION = "Direct 3D Example"
      Center
      Width = 330
      Height = 350
      CREATE DXScreen AS QDXSCREEN
       Init(320,240)
       Align = alClient
       Use3D = 1
       UseHardware = 1 ''for accelerated cards 0 for old ones
       OnInitialize = DXInitialize
       OnInitializeSurface = DXInitializeSurface
      END CREATE
      SHOWMODAL
     END CREATE


     SUB CreateWrap
      DXScreen.CreateWrap(WrapType, 0,0,0, 0,0,1, 0,1,0, 0,0, 1,1, Wrap)
      Wrap.Apply(MeshBuilder)
     END SUB

     SUB DXInitialize(Sender AS QDXSCREEN)
      DIM Light AS QD3DLIGHT, Ambient AS QD3DLIGHT
      DIM LightFrame AS QD3DFRAME
      DIM Texture AS QD3DTEXTURE

      IF FILEEXISTS("back2.bmp") THEN
       DXScreen.LoadTexture("back.bmp", Texture)
       DXScreen.SetBackgroundImage(Texture)
      ELSE
       SHOWMESSAGE "missing bitmap"
      END IF

      DXScreen.CreateFrame(LightFrame)
      DXScreen.CreateFrame(MeshFrame)

      DXScreen.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0.9, 0.9, 0.9, Light)
      LightFrame.AddLight(Light)
      DXScreen.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.1, 0.1, 0.1, Ambient)
      DXScreen.AddLight(Ambient)
      LightFrame.SetPosition(2, 0, 22)
      DXScreen.SetCameraPosition(-5, 5, 0)
      DXScreen.SetCameraOrientation(0.35, -0.45, 1.0, -0.15, 1.0, 0.5)

      MeshFrame.SetPosition(0, 0, 15)
      MeshFrame.SetOrientation(0, 0, 1, 0, 1, 0)
  'the SetRotation is a quaterion!
      MeshFrame.SetRotation(0, 1, 0, 0.05) 'Angle = 0.05

      DXScreen.CreateMeshBuilder(MeshBuilder)
  ' MeshBuilder.Load("cube.x") '-- should be in example folder
      MeshBuilder.Load("egg.x") '-- egg object
      MeshBuilder.Scale(2,2,2)
      MeshBuilder.SetRGBA(1, 1, 1, 0.7) '-- Alpha blending!

      MeshBuilder.LoadTexture("back2.bmp")
      MeshFrame.AddVisual(MeshBuilder)
      CreateWrap
     END SUB

     SUB DXInitializeSurface(Sender AS QDXSCREEN)
      DXScreen.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY OR D3DRMRENDERMODE_SORTEDTRANSPARENCY)
     END SUB

     SUB DXTimerExpired
  'DXScreen.Fill(0) ' Call this or
      DXScreen.ForceUpdate(0,0,40,40) ' Update FPS text only
  'DXScreen.Move(2) ' this is rotation by 2 times
      MeshFrame.Move(1)
      IF WrapType = D3DRMWRAP_CHROME THEN
       Wrap.ApplyRelative(MeshFrame,MeshBuilder) 'for each frame!
      END IF
      DXScreen.Render
      DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), &HFFFFFF, -1)
      DXScreen.Flip
     END SUB

2004-10-21 04:52