2013-06-19 07:53

' Direct3D model viewer for Rapid-Q by William Yu
' Only loads mesh objects.

     $TYPECHECK ON
     $INCLUDE "RAPIDQ.INC"
     $INCLUDE "RapidQ_D3D.INC"		'constants

     DECLARE SUB dxInitialize(sender AS QDXSCREEN)
     DECLARE SUB dxInitializeSurface(sender AS QDXSCREEN)
     DECLARE SUB dxTimerExpired
     DECLARE SUB exitItemClick(sender AS QMENUITEM)
     DECLARE SUB openItemClick(sender AS QMENUITEM)
     DECLARE SUB rotateButtonClick(sender AS QBUTTON)
     DECLARE SUB rotateStopButtonClick(sender AS QBUTTON)
     DECLARE SUB upButtonMouseDown(button%, x%, y%, shift%, sender AS QBUTTON)
     DECLARE SUB upButtonMouseUp(button%, x%, y%, shift%, sender AS QBUTTON)
     DECLARE SUB textureButtonClick(sender AS QBUTTON)


     CONST Max3DObjects = 12
     DIM dxTimer AS QDXTIMER
     dxTimer.enabled = 1
     dxTimer.interval = 0
     dxTimer.activeOnly = 0
     dxTimer.onTimer = dxTimerExpired
     DIM frameView AS DOUBLE
     frameView = 10
     DIM wrapType AS LONG
     wrapType = D3DRMWRAP_SPHERE
     DIM T! 				AS SINGLE
     DIM TheObjectNum	AS INTEGER
     TheObjectNum = 0

     DIM meshFrame 		AS QD3DFRAME
     DIM meshBuilder(1 TO Max3DObjects) AS QD3DMESHBUILDER
     DIM wrap AS QD3DWRAP


     CREATE form AS QFORM
      CAPTION = "Direct3D Model Viewer"
      width = 640
      height = 480
      center
      CREATE panel AS QPANEL
       width = 150
       align = alRight
       bevelOuter = bvLowered
       CREATE upButton AS QBUTTON
        CAPTION = "/\"
        hint = "up"
        width = 30
        left = 60
        top = 10
        tabOrder = 0
        onMouseDown = upButtonMouseDown
        onMouseUp = upButtonMouseUp
       END CREATE
       CREATE downButton AS QBUTTON
        CAPTION = "\/"
        hint = "down"
        left = 60
        width = 30
        top = 40
        tabOrder = 0
        onMouseDown = upButtonMouseDown
        onMouseUp = upButtonMouseUp
       END CREATE
       CREATE textureImage AS QIMAGE
        left = 25
        width = 100
        top = 70
        onClick = textureButtonClick
       END CREATE
       CREATE textureButton AS QBUTTON
        CAPTION = "Texture..."
        left = 50
        width = 60
        top = 180
        onClick = textureButtonClick
       END CREATE
       CREATE rotateLabelAngle AS QLABEL
        top = 273
        left = 15
        CAPTION = "Angle:"
       END CREATE
       CREATE rotateEditAngle AS QEDIT
        top = 270
        left = 60
        width = 40
        text = "1"
       END CREATE
       CREATE rotateLabelX AS QLABEL
        top = 303
        left = 15
        CAPTION = "X:"
       END CREATE
       CREATE rotateEditX AS QEDIT
        top = 300
        left = 60
        width = 40
        text = "1"
       END CREATE
       CREATE rotateLabelY AS QLABEL
        top = 333
        left = 15
        CAPTION = "Y:"
       END CREATE
       CREATE rotateEditY AS QEDIT
        top = 330
        left = 60
        width = 40
        text = "1"
       END CREATE
       CREATE rotateLabelZ AS QLABEL
        top = 363
        left = 15
        CAPTION = "Z:"
       END CREATE
       CREATE rotateEditZ AS QEDIT
        top = 360
        left = 60
        width = 40
        text = "1"
       END CREATE
       CREATE rotateButton AS QBUTTON
        left = 10
        top = 390
        width = 60
        CAPTION = "&Rotate"
        onClick = rotateButtonClick
       END CREATE
       CREATE rotateStopButton AS QBUTTON
        left = 80
        top = 390
        width = 60
        CAPTION = "&Stop"
        onClick = rotateStopButtonClick
       END CREATE
      END CREATE
      CREATE dxScreen AS QDXSCREEN
       align = alClient
       bitCount = 32
       use3D = 1
       useHardware = 1
       onInitialize = dxInitialize
       onInitializeSurface = dxInitializeSurface
      END CREATE
      CREATE mainMenu AS QMAINMENU
       CREATE fileMenu AS QMENUITEM
        CAPTION = "&File"
        CREATE openItem AS QMENUITEM
         CAPTION = "&Open..."
         onClick = openItemClick
        END CREATE
        CREATE breakItem1 AS QMENUITEM
         CAPTION = "-"
        END CREATE
        CREATE exitItem AS QMENUITEM
         CAPTION = "E&xit"
         onClick = exitItemClick
        END CREATE
       END CREATE
      END CREATE
      SHOWMODAL
     END CREATE



     SUB exitItemClick(sender AS QMENUITEM)
      DIM i AS INTEGER

      FOR i = 1 TO TheObjectNum
       meshFrame.deleteVisual(meshBuilder(TheObjectNum))' possible not released
      NEXT i
      form.CLOSE
     END SUB


     SUB openItemClick(sender AS QMENUITEM)
      DIM openDialog AS QOPENDIALOG

      openDialog.filter = "*.x (X models)|*.x"
      IF openDialog.EXECUTE THEN
       '-- Remove previous object from frame
'       meshFrame.deleteVisual(meshBuilder(TheObjectNum))		'use this to always overwrite the current 3D Object
       INC TheObjectNum
       '-- Rebuilds mesh, removing the old object
       dxScreen.createMeshBuilder(meshBuilder(TheObjectNum))
       '-- Load a new object
       meshBuilder(TheObjectNum).load(openDialog.fileName)
       '-- Add this new object to the frame
       meshBuilder(TheObjectNum).SetQuality(D3DRMRENDER_PHONG)	' possible- D3DRMRENDER_WIREFRAME, D3DRMRENDER_UNLITFLAT, D3DRMRENDER_FLAT, D3DRMRENDER_GOURAUD, D3DRMRENDER_PHONG
		'meshBuilder(1).SetRGB(R#, G#, B#) 						'Set object's color 3
       meshBuilder(TheObjectNum).SetRGBA(1, 1, 1, .2)		' Add color w/alphablending  R, G, B,  Ascale from 0 to 1.0
       meshFrame.addVisual(meshBuilder(TheObjectNum))
      END IF
     END SUB


     SUB textureButtonClick(sender AS QBUTTON)
      DIM openDialog AS QOPENDIALOG

      openDialog.filter = "*.bmp (Bitmap files)|*.bmp"
      IF openDialog.EXECUTE THEN
       textureImage.BMP = openDialog.fileName
       meshBuilder(TheObjectNum).loadTexture(openDialog.fileName)
       dxScreen.createWrap(wrapType, 0,0,0, 0,0,1, 0,1,0, 0,0, 1,1, wrap)
       wrap.apply(meshBuilder(TheObjectNum))
      END IF
     END SUB


     SUB upButtonMouseDown(button%, x%, y%, shift%, sender AS QBUTTON)
      DEFSNG T!

      T! = TIMER
      IF button% = 0 THEN
       sender.tabOrder = 0
       DO
        IF sender.hint = "up" THEN
         INC(frameView)
        ELSE
         DEC(frameView)
        END IF
        meshFrame.setPosition(0, 0, frameView)
        DOEVENTS
        dxTimerExpired
       LOOP UNTIL sender.tabOrder = 1
      END IF
     END SUB

     SUB upButtonMouseUp(button%, x%, y%, shift%, sender AS QBUTTON)
      IF button% = 0 THEN
       sender.tabOrder = 1
      END IF
     END SUB


     SUB rotateButtonClick(sender AS QBUTTON)
      meshFrame.setRotation(VAL(rotateEditX.text), _
       VAL(rotateEditY.text), _
       VAL(rotateEditZ.text), _
       VAL(rotateEditAngle.text)/10)
     END SUB


     SUB rotateStopButtonClick(sender AS QBUTTON)
      meshFrame.setRotation(0, 0, 0, 0)
     END SUB

     SUB ChangeZoomFactor (TheSelectedObjectNum AS INTEGER)
	'meshBuilder(TheObjectNum).Scale(X#,Y#,Z#)
     END SUB

     SUB TranslateMoveMeshs (TheSelectedObjectNum AS INTEGER)
	'meshBuilder(TheObjectNum).Translate(TX#, TY#, TZ#)
     END SUB

     SUB ChangeAlphaBlend (TheSelectedObjectNum AS INTEGER)
      meshBuilder(TheObjectNum).SetRGBA(1, 1, 1, 1)		' Add color w/alphablending  R, G, B,  Ascale from 0 to 1.0
      meshFrame.addVisual(meshBuilder(TheObjectNum))
     END SUB


     SUB ChangeRenderQuality (TheSelectedObjectNum AS INTEGER)
      meshBuilder(TheObjectNum).SetQuality(D3DRMRENDER_PHONG)	' possible- D3DRMRENDER_WIREFRAME, D3DRMRENDER_UNLITFLAT, D3DRMRENDER_FLAT, D3DRMRENDER_GOURAUD, D3DRMRENDER_PHONG
      meshFrame.addVisual(meshBuilder(TheObjectNum))
     END SUB



     SUB dxInitialize(sender AS QDXSCREEN)
      DIM light AS QD3DLIGHT, ambient AS QD3DLIGHT
      DIM lightFrame AS QD3DFRAME

      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)

      meshFrame.setPosition(0, 0, frameView)

      dxScreen.setCameraPosition(0, 0, 0)
     END SUB


     SUB dxInitializeSurface(sender AS QDXSCREEN)
      dxScreen.setRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY OR D3DRMRENDERMODE_SORTEDTRANSPARENCY)
     END SUB


     SUB dxTimerExpired
      dxScreen.forceUpdate(0,0,50,40)    '-- Update FPS text only
      meshFrame.Move(1)                   '-- whatever move parameters are set, this line does the animation
      dxScreen.render						'draw the scene on the back screen buffer
      dxScreen.textOut(10,10,"FPS: "+STR$(dxTimer.frameRate), &HFFFFFF, -1)
      dxScreen.flip						'bring back buffer to screen by bitBlt
     END SUB

2013-06-19 07:53