home *** CD-ROM | disk | FTP | other *** search
/ Microsoft DirectX SDK 7.0 / Dx7.bin / DXF / samples / multimedia / vbsamples / d3drm / src / rmcontrol / demo.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-08-10  |  4.2 KB  |  128 lines
  1. VERSION 5.00
  2. Object = "*\Armcontrol.vbp"
  3. Begin VB.Form Form1 
  4.    Caption         =   "Test Canvas"
  5.    ClientHeight    =   4980
  6.    ClientLeft      =   45
  7.    ClientTop       =   270
  8.    ClientWidth     =   6600
  9.    Icon            =   "Demo.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   332
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   440
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin RMControl7Sample.RMCanvas RMCanvas1 
  16.       Height          =   4095
  17.       Left            =   0
  18.       TabIndex        =   0
  19.       Top             =   0
  20.       Width           =   5415
  21.       _ExtentX        =   9551
  22.       _ExtentY        =   7223
  23.    End
  24.    Begin VB.Timer Timer1 
  25.       Left            =   5496
  26.       Top             =   4620
  27.    End
  28. Attribute VB_Name = "Form1"
  29. Attribute VB_GlobalNameSpace = False
  30. Attribute VB_Creatable = False
  31. Attribute VB_PredeclaredId = True
  32. Attribute VB_Exposed = False
  33. Dim framebox  As Direct3DRMFrame3
  34. Dim framesheet  As Direct3DRMFrame3
  35. Dim meshbox As Direct3DRMMeshBuilder3
  36. Dim meshsheet As Direct3DRMMeshBuilder3
  37. Dim texturesheet As Direct3DRMTexture3
  38. Dim texturesurf As DirectDrawSurface4
  39. Private Sub Form_Load()
  40.     Dim b as boolean           
  41.     Me.ScaleMode = 3 'pixel
  42.     Me.Show
  43.     With RMCanvas1
  44.         .UseBackBuffer=TRUE
  45.         b=.InitWindowed("","")
  46.         if not b then 
  47.       MsgBox "Please run this sample in high color resolution"
  48.           end
  49.         end if
  50.         
  51.         'Create A rotating box
  52.         Set framebox = .D3DRM.CreateFrame(.SceneFrame)
  53.         Set meshbox = .CreateBoxMesh(4, 4, 4)
  54.         meshbox.SetName "Color Box"
  55.         framebox.SetPosition Nothing, -5, 0, 10
  56.         framebox.SetRotation Nothing, 1, 1, 1, 0.05
  57.         
  58.         'Color its faces
  59.         meshbox.GetFace(0).SetColor .dx.CreateColorRGB(1, 0, 0)
  60.         meshbox.GetFace(1).SetColor .dx.CreateColorRGB(0, 1, 0)
  61.         meshbox.GetFace(2).SetColor .dx.CreateColorRGB(0, 0, 1)
  62.         meshbox.GetFace(3).SetColor .dx.CreateColorRGB(1, 1, 0)
  63.         meshbox.GetFace(4).SetColor .dx.CreateColorRGB(0, 1, 1)
  64.         meshbox.GetFace(5).SetColor .dx.CreateColorRGB(1, 1, 1)
  65.         
  66.         
  67.         'Create A sheet with text as the texture
  68.         Set framesheet = .D3DRM.CreateFrame(.SceneFrame)
  69.         Set meshsheet = .CreateSheetMesh(2, 5, 10)
  70.         meshsheet.SetName "Hello World"
  71.         framebox.AddVisual meshbox
  72.         framesheet.AddVisual meshsheet
  73.         framesheet.SetPosition Nothing, 5, 0, 20
  74.         
  75.         'Create a Texture we can draw text to
  76.         'note texture w and h should be power of 2
  77.         
  78.         Set texturesheet = .CreateUpdateableTexture(128, 32, "")
  79.         Set texturesurf = texturesheet.GetSurface(0)
  80.         
  81.         'Draw to the texture
  82.         Dim r(1) As RECT
  83.         texturesurf.SetFillColor vbWhite
  84.         Me.FontSize = 14
  85.         texturesurf.SetFont Me.Font
  86.         texturesurf.SetForeColor vbRed
  87.         texturesurf.setDrawWidth 4
  88.         texturesurf.DrawBox 0, 0, 128, 32
  89.         texturesurf.DrawText 15, 2, "Hello World", False
  90.         texturesheet.Changed D3DRMTEXTURE_CHANGEDPIXELS, 0, r()
  91.                 
  92.         'Apply the texure to the sheet
  93.         meshsheet.SetTexture texturesheet
  94.         
  95.         'turn lighting off for the sheet
  96.         meshsheet.SetQuality D3DRMRENDER_UNLITFLAT
  97.         
  98.         'Enable autorotation UI
  99.         Set .RotateFrame = framesheet
  100.                
  101.         
  102.         .Device.SetTextureQuality D3DRMTEXTURE_LINEAR
  103.         
  104.     End With
  105.     'Timers are slow but cooperative..
  106.     'for beter performance use doevents loop
  107.     Timer1.Interval = 1
  108. End Sub
  109. Private Sub Form_Resize()
  110.     RMCanvas1.Width = Me.ScaleWidth
  111.     RMCanvas1.Height = Me.ScaleHeight
  112. End Sub
  113. Private Sub Form_Unload(Cancel As Integer)
  114.     End
  115. End Sub
  116. Private Sub RMCanvas1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  117.     Dim meshB As Direct3DRMMeshBuilder3
  118.     Set meshB = RMCanvas1.PickTopMesh(CLng(X), CLng(Y))
  119.     If meshB Is Nothing Then
  120.         Me.Caption = "Test Canvas"
  121.         Exit Sub
  122.     End If
  123.     Form1.Caption = "Over " + meshB.GetName()
  124. End Sub
  125. Private Sub Timer1_Timer()
  126.     RMCanvas1.Update
  127. End Sub
  128.