├── .gitattributes ├── .gitignore ├── Demos ├── 3DForm │ ├── ThreeDimForm.vbp │ ├── clsTrickSubclass2.cls │ ├── frm3D.frm │ └── frm3D.frx ├── CornerPin │ ├── CornerPin.vbp │ ├── frmMain.frm │ └── test.jpg ├── CubeDemo │ ├── Texture.jpg │ ├── frmMain.frm │ └── prjCubeDemo.vbp ├── Fire │ ├── Texture.bmp │ ├── frmMain.frm │ └── prjFireDemo.vbp ├── Landscape │ ├── HeightMap.jpg │ ├── Texture.jpg │ ├── frmMain.frm │ └── prjLandscape.vbp ├── LaserLines │ ├── LaserLines.vbp │ ├── frmLaserLines.frm │ └── space.jpg ├── Raymarching │ ├── Raymarching.vbp │ ├── frmMain.frm │ ├── ps.bin │ ├── ps.txt │ ├── vs.bin │ └── vs.txt ├── SharedResources │ ├── Direct3D_MT.vbp │ ├── frmMain.frm │ ├── modAPI.bas │ ├── modMultiThreading.bas │ ├── modRender.bas │ └── modSharedResources.bas ├── SimpleScene │ ├── CCamera.cls │ ├── CMaterial.cls │ ├── CMesh.cls │ ├── CScene.cls │ ├── Scene.exe │ ├── SceneDemo.vbp │ ├── ctlVector.ctl │ ├── frmMain.frm │ ├── frmMain.frx │ ├── icons │ │ ├── box.jpg │ │ ├── cone.jpg │ │ ├── icon.bmp │ │ ├── icon.ico │ │ └── sphere.jpg │ └── modMain.bas ├── TextDraw │ ├── Font.bmp │ ├── frmMain.frm │ └── prjDrawText.vbp └── TriangleRotation │ ├── frmMain.frm │ └── prjTriangleDemo.vbp ├── Math ├── D3DX_COLOR.bas ├── D3DX_MATRICES.bas ├── D3DX_MISC.bas ├── D3DX_PLANE.bas ├── D3DX_QUATERNION.bas ├── D3DX_VECTOR2.bas ├── D3DX_VECTOR3.bas └── D3DX_VECTOR4.bas ├── README.md ├── d3dxvb.tlb └── dx9vb.tlb /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | # Auto detect text files and perform LF normalization 3 | * text=auto 4 | 5 | * text eol=crlf 6 | 7 | *.tlb binary 8 | *.png binary 9 | *.jpg binary 10 | *.bmp binary 11 | *.ico binary 12 | *.Png binary 13 | *.exe binary 14 | *.dll binary 15 | *.frx binary 16 | *.exp binary 17 | *.lib binary 18 | *.pdb binary 19 | *.RES binary 20 | *.obj binary 21 | *.bin binary 22 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.vbw 2 | home 3 | Old 4 | Recover 5 | DX9VB.zip 6 | -------------------------------------------------------------------------------- /Demos/3DForm/ThreeDimForm.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.1#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.10 4 | Form=frm3D.frm 5 | Class=clsTrickSubclass2; clsTrickSubclass2.cls 6 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 7 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 8 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 9 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 10 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 11 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 12 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 13 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 14 | IconForm="frm3D" 15 | Startup="frm3D" 16 | HelpFile="" 17 | Title="ThreeDimForm" 18 | ExeName32="ThreeDimForm.exe" 19 | Command32="" 20 | Name="ThreeDimForm" 21 | HelpContextID="0" 22 | CompatibleMode="0" 23 | MajorVer=1 24 | MinorVer=0 25 | RevisionVer=0 26 | AutoIncrementVer=0 27 | ServerSupportFiles=0 28 | VersionCompanyName="TrickSoft" 29 | CompilationType=0 30 | OptimizationType=0 31 | FavorPentiumPro(tm)=0 32 | CodeViewDebugInfo=0 33 | NoAliasing=-1 34 | BoundsCheck=-1 35 | OverflowCheck=-1 36 | FlPointCheck=-1 37 | FDIVCheck=-1 38 | UnroundedFP=-1 39 | StartMode=0 40 | Unattended=0 41 | Retained=0 42 | ThreadPerObject=0 43 | MaxNumberOfThreads=1 44 | -------------------------------------------------------------------------------- /Demos/3DForm/clsTrickSubclass2.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/3DForm/clsTrickSubclass2.cls -------------------------------------------------------------------------------- /Demos/3DForm/frm3D.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/3DForm/frm3D.frx -------------------------------------------------------------------------------- /Demos/CornerPin/CornerPin.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.1#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.10 4 | Form=frmMain.frm 5 | Startup="frmMain" 6 | Command32="" 7 | Name="CornerPin" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | VersionCompanyName="Microsoft" 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /Demos/CornerPin/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "CornerPin" 5 | ClientHeight = 5310 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 7680 9 | FillColor = &H00000040& 10 | FillStyle = 0 'Solid 11 | ForeColor = &H00404000& 12 | MaxButton = 0 'False 13 | MinButton = 0 'False 14 | ScaleHeight = 354 15 | ScaleMode = 3 'Pixel 16 | ScaleWidth = 512 17 | StartUpPosition = 3 'Windows Default 18 | End 19 | Attribute VB_Name = "frmMain" 20 | Attribute VB_GlobalNameSpace = False 21 | Attribute VB_Creatable = False 22 | Attribute VB_PredeclaredId = True 23 | Attribute VB_Exposed = False 24 | ' // 25 | ' // Corner pin by The trick 26 | ' // 2020 27 | ' // 28 | 29 | Option Explicit 30 | 31 | Private Const PixelFormat32bppARGB As Long = &H26200A 32 | Private Const PixelFormat32bppPARGB As Long = &HE200B 33 | Private Const ImageLockModeRead As Long = &H1 34 | Private Const ImageLockModeWrite As Long = &H2 35 | Private Const ImageLockModeUserInputBuf As Long = &H4 36 | Private Const UnitPixel As Long = 2 37 | 38 | Private Type BitmapData 39 | Width As Long 40 | Height As Long 41 | stride As Long 42 | PixelFormat As Long 43 | scan0 As Long 44 | reserved As Long 45 | End Type 46 | Private Type GdiplusStartupInput 47 | GdiplusVersion As Long 48 | DebugEventCallback As Long 49 | SuppressBackgroundThread As Long 50 | SuppressExternalCodecs As Long 51 | End Type 52 | 53 | Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _ 54 | ByVal pfilename As Long, _ 55 | ByRef image As Long) As Long 56 | Private Declare Function GdiplusStartup Lib "gdiplus" ( _ 57 | ByRef token As Long, _ 58 | ByRef inputbuf As GdiplusStartupInput, _ 59 | Optional ByVal outputbuf As Long = 0) As Long 60 | Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _ 61 | ByVal token As Long) 62 | Private Declare Function GdipGetImageWidth Lib "gdiplus" ( _ 63 | ByVal image As Long, _ 64 | ByRef Width As Long) As Long 65 | Private Declare Function GdipGetImageHeight Lib "gdiplus" ( _ 66 | ByVal image As Long, _ 67 | ByRef Height As Long) As Long 68 | Private Declare Function GdipBitmapLockBits Lib "gdiplus" ( _ 69 | ByVal BITMAP As Long, _ 70 | ByRef rc As RECT, _ 71 | ByVal flags As Long, _ 72 | ByVal PixelFormat As Long, _ 73 | ByRef lockedBitmapData As BitmapData) As Long 74 | Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" ( _ 75 | ByVal BITMAP As Long, _ 76 | ByRef lockedBitmapData As BitmapData) As Long 77 | Private Declare Function GdipDisposeImage Lib "gdiplus" ( _ 78 | ByVal image As Long) As Long 79 | Private Declare Sub memcpy Lib "kernel32" _ 80 | Alias "RtlMoveMemory" ( _ 81 | ByRef Destination As Any, _ 82 | ByRef Source As Any, _ 83 | ByVal Length As Long) 84 | 85 | Private Type tVertex 86 | tPos As D3DVECTOR 87 | fRHW As Single 88 | fU As Single 89 | fV As Single 90 | End Type 91 | 92 | Private Const VERTEX_SIZE As Long = 6 * 4 93 | 94 | Private m_tCorners(3) As tVertex 95 | Private m_cD3D9 As IDirect3D9 96 | Private m_cDevice As IDirect3DDevice9 97 | Private m_cVtxBuf As IDirect3DVertexBuffer9 98 | Private m_cIndexBuf As IDirect3DIndexBuffer9 99 | Private m_cTexture As IDirect3DTexture9 100 | Private m_hGpToken As Long 101 | Private m_lSelCorner As Long 102 | Private m_bIsDrag As Boolean 103 | Private m_eFmtFlags As D3DFVF 104 | 105 | Private Sub Form_Load() 106 | Dim tPP As D3DPRESENT_PARAMETERS 107 | Dim pVtxData As Long 108 | Dim pIdxData As Long 109 | Dim tGpInput As GdiplusStartupInput 110 | Dim iIndices(5) As Integer 111 | 112 | m_lSelCorner = -1 113 | 114 | tGpInput.GdiplusVersion = 1 115 | 116 | If GdiplusStartup(m_hGpToken, tGpInput) <> 0 Then 117 | MsgBox "Unable to initialize GDI+", vbCritical 118 | Exit Sub 119 | End If 120 | 121 | Set m_cD3D9 = Direct3DCreate9() 122 | 123 | ' // Set vertex format 124 | m_eFmtFlags = D3DFVF_TEX1 Or D3DFVF_XYZRHW 125 | 126 | tPP.BackBufferCount = 1 127 | tPP.Windowed = 1 128 | tPP.BackBufferFormat = D3DFMT_A8R8G8B8 129 | tPP.SwapEffect = D3DSWAPEFFECT_DISCARD 130 | 131 | ' // Create device 132 | Set m_cDevice = m_cD3D9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, tPP) 133 | 134 | ' // Create vertex buffer which will contain corners 135 | m_cDevice.CreateVertexBuffer VERTEX_SIZE * 4, 0, m_eFmtFlags, D3DPOOL_DEFAULT, m_cVtxBuf 136 | 137 | ' // Create corners 138 | m_tCorners(0) = vtx(10, 10, 0, 1, 0, 0) 139 | m_tCorners(1) = vtx(Me.ScaleWidth - 10, 10, 0, 1, 1, 0) 140 | m_tCorners(2) = vtx(10, Me.ScaleHeight - 10, 0, 1, 0, 1) 141 | m_tCorners(3) = vtx(Me.ScaleWidth - 10, Me.ScaleHeight - 10, 0, 1, 1, 1) 142 | 143 | ' // Put corners to buffer 144 | m_cVtxBuf.Lock 0, Len(m_tCorners(0)) * (UBound(m_tCorners) + 1), pVtxData, 0 145 | memcpy ByVal pVtxData, m_tCorners(0), Len(m_tCorners(0)) * (UBound(m_tCorners) + 1) 146 | m_cVtxBuf.Unlock 147 | 148 | m_cDevice.SetStreamSource 0, m_cVtxBuf, 0, VERTEX_SIZE 149 | 150 | m_cDevice.SetFVF m_eFmtFlags 151 | 152 | ' // Create index buffer which will specify triangles corners 153 | m_cDevice.CreateIndexBuffer 6 * 2, 0, D3DFMT_INDEX16, D3DPOOL_DEFAULT, m_cIndexBuf 154 | 155 | ' // Specify corners to create 2 triangle 156 | iIndices(0) = 0: iIndices(1) = 1: iIndices(2) = 3 157 | iIndices(3) = 0: iIndices(4) = 3: iIndices(5) = 2 158 | 159 | ' // Put indices 160 | m_cIndexBuf.Lock 0, Len(iIndices(0)) * (UBound(iIndices) + 1), pIdxData, 0 161 | memcpy ByVal pIdxData, iIndices(0), Len(iIndices(0)) * (UBound(iIndices) + 1) 162 | m_cIndexBuf.Unlock 163 | 164 | m_cDevice.SetIndices m_cIndexBuf 165 | 166 | m_cDevice.SetRenderState D3DRS_LIGHTING, 0 167 | 168 | m_cDevice.SetSamplerState 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR 169 | m_cDevice.SetSamplerState 0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR 170 | 171 | Set m_cTexture = LoadTextureFromFile(App.Path & "\test.jpg") 172 | 173 | If m_cTexture Is Nothing Then 174 | Exit Sub 175 | End If 176 | 177 | m_cDevice.SetTexture 0, m_cTexture 178 | 179 | End Sub 180 | 181 | ' // Load texture from file 182 | Private Function LoadTextureFromFile( _ 183 | ByRef sFileName As String) As IDirect3DTexture9 184 | Dim hImage As Long 185 | Dim tRC As RECT 186 | Dim tLockRC As D3DLOCKED_RECT 187 | Dim tBmpData As BitmapData 188 | Dim cRet As IDirect3DTexture9 189 | 190 | On Error GoTo CleanUp 191 | 192 | If GdipLoadImageFromFile(StrPtr(sFileName), hImage) <> 0 Then 193 | MsgBox "Unable to load picture", vbCritical 194 | Exit Function 195 | End If 196 | 197 | If GdipGetImageWidth(hImage, tBmpData.Width) <> 0 Then 198 | MsgBox "Unable to get picture width", vbCritical 199 | GoTo CleanUp 200 | End If 201 | 202 | If GdipGetImageHeight(hImage, tBmpData.Height) <> 0 Then 203 | MsgBox "Unable to get picture height", vbCritical 204 | GoTo CleanUp 205 | End If 206 | 207 | m_cDevice.CreateTexture tBmpData.Width, tBmpData.Height, 1, 0, D3DFMT_A8R8G8B8, D3DPOOL_MANAGED, cRet 208 | 209 | cRet.LockRect 0, tLockRC, ByVal 0&, 0 210 | 211 | tBmpData.scan0 = tLockRC.pBits 212 | tBmpData.stride = tLockRC.Pitch 213 | tBmpData.PixelFormat = PixelFormat32bppARGB 214 | 215 | tRC.Right = tBmpData.Width 216 | tRC.bottom = tBmpData.Height 217 | 218 | If GdipBitmapLockBits(hImage, tRC, ImageLockModeRead Or ImageLockModeWrite Or ImageLockModeUserInputBuf, _ 219 | PixelFormat32bppARGB, tBmpData) <> 0 Then 220 | cRet.UnlockRect 0 221 | MsgBox "Unable to get image bits", vbCritical 222 | GoTo CleanUp 223 | End If 224 | 225 | GdipBitmapUnlockBits hImage, tBmpData 226 | 227 | cRet.UnlockRect 0 228 | 229 | Set LoadTextureFromFile = cRet 230 | 231 | CleanUp: 232 | 233 | If Err.Number Then 234 | MsgBox "An error occured 0x" & Hex$(Err.Number) 235 | End If 236 | 237 | GdipDisposeImage hImage 238 | 239 | End Function 240 | 241 | Private Function vtx( _ 242 | ByVal fX As Single, _ 243 | ByVal fY As Single, _ 244 | ByVal fZ As Single, _ 245 | ByVal fRHW As Single, _ 246 | ByVal fU As Single, _ 247 | ByVal fV As Single) As tVertex 248 | 249 | vtx.tPos.X = fX 250 | vtx.tPos.Y = fY 251 | vtx.tPos.Z = fZ 252 | vtx.fRHW = fRHW 253 | vtx.fU = fU 254 | vtx.fV = fV 255 | 256 | End Function 257 | 258 | Private Function mtxInverse3x3( _ 259 | ByRef m() As Single, _ 260 | ByRef m_ret() As Single) As Boolean 261 | Dim fDet As Single 262 | Dim fRet() As Single 263 | 264 | fDet = m(0, 0) * (m(1, 1) * m(2, 2) - m(2, 1) * m(1, 2)) - _ 265 | m(0, 1) * (m(1, 0) * m(2, 2) - m(1, 2) * m(2, 0)) + _ 266 | m(0, 2) * (m(1, 0) * m(2, 1) - m(1, 1) * m(2, 0)) 267 | 268 | If Abs(fDet) < 0.00001 Then Exit Function 269 | 270 | ReDim fRet(2, 2) 271 | 272 | fRet(0, 0) = (m(1, 1) * m(2, 2) - m(2, 1) * m(1, 2)) / fDet 273 | fRet(0, 1) = (m(0, 2) * m(2, 1) - m(0, 1) * m(2, 2)) / fDet 274 | fRet(0, 2) = (m(0, 1) * m(1, 2) - m(0, 2) * m(1, 1)) / fDet 275 | fRet(1, 0) = (m(1, 2) * m(2, 0) - m(1, 0) * m(2, 2)) / fDet 276 | fRet(1, 1) = (m(0, 0) * m(2, 2) - m(0, 2) * m(2, 0)) / fDet 277 | fRet(1, 2) = (m(1, 0) * m(0, 2) - m(0, 0) * m(1, 2)) / fDet 278 | fRet(2, 0) = (m(1, 0) * m(2, 1) - m(2, 0) * m(1, 1)) / fDet 279 | fRet(2, 1) = (m(2, 0) * m(0, 1) - m(0, 0) * m(2, 1)) / fDet 280 | fRet(2, 2) = (m(0, 0) * m(1, 1) - m(1, 0) * m(0, 1)) / fDet 281 | 282 | m_ret = fRet 283 | 284 | mtxInverse3x3 = True 285 | 286 | End Function 287 | 288 | Private Function CalcPerspective() As Boolean 289 | Dim s() As Single 290 | Dim d() As Single 291 | Dim m() As Single 292 | Dim v() As Single 293 | Dim lV As Long 294 | Dim fW As Single 295 | 296 | If Not IsConvex() Then Exit Function 297 | 298 | ReDim s(2, 2) 299 | ReDim m(2, 2) 300 | ReDim v(2) 301 | 302 | s(0, 0) = -1: s(0, 1) = -1: s(0, 2) = 1 303 | s(1, 0) = -1: s(1, 1) = 0: s(1, 2) = 0 304 | s(2, 0) = 0: s(2, 1) = -1: s(2, 2) = 0 305 | 306 | m(0, 0) = m_tCorners(0).tPos.X: m(0, 1) = m_tCorners(1).tPos.X: m(0, 2) = m_tCorners(2).tPos.X 307 | m(1, 0) = m_tCorners(0).tPos.Y: m(1, 1) = m_tCorners(1).tPos.Y: m(1, 2) = m_tCorners(2).tPos.Y 308 | m(2, 0) = 1: m(2, 1) = 1: m(2, 2) = 1 309 | 310 | If Not mtxInverse3x3(m(), m()) Then Exit Function 311 | 312 | v(0) = m(0, 0) * m_tCorners(3).tPos.X + m(0, 1) * m_tCorners(3).tPos.Y + m(0, 2) 313 | v(1) = m(1, 0) * m_tCorners(3).tPos.X + m(1, 1) * m_tCorners(3).tPos.Y + m(1, 2) 314 | v(2) = m(2, 0) * m_tCorners(3).tPos.X + m(2, 1) * m_tCorners(3).tPos.Y + m(2, 2) 315 | 316 | m(0, 0) = v(0) * m_tCorners(0).tPos.X: m(0, 1) = v(1) * m_tCorners(1).tPos.X: m(0, 2) = v(2) * m_tCorners(2).tPos.X 317 | m(1, 0) = v(0) * m_tCorners(0).tPos.Y: m(1, 1) = v(1) * m_tCorners(1).tPos.Y: m(1, 2) = v(2) * m_tCorners(2).tPos.Y 318 | m(2, 0) = v(0): m(2, 1) = v(1): m(2, 2) = v(2) 319 | 320 | m = mtxMul3x3(m, s) 321 | 322 | For lV = 0 To 3 323 | 324 | v(0) = lV And 1: v(1) = (lV And 2) \ 2: v(2) = 1 325 | fW = m(2, 0) * v(0) + m(2, 1) * v(1) + m(2, 2) * v(2) 326 | 327 | If fW = 0 Then Exit Function 328 | 329 | m_tCorners(lV).fRHW = 1 / fW 330 | 331 | Next 332 | 333 | CalcPerspective = True 334 | 335 | End Function 336 | 337 | Private Function IsConvex() As Boolean 338 | Dim lIndex As Long 339 | Dim lCW() As Long 340 | Dim fPoints() As Single 341 | Dim bIsNeg As Boolean 342 | Dim bOriginDir As Boolean 343 | 344 | ReDim lCW(3) 345 | 346 | lCW(0) = 2: lCW(1) = 0: lCW(2) = 1: lCW(3) = 3 347 | 348 | For lIndex = 0 To 3 349 | 350 | bIsNeg = PerpDot(m_tCorners(lCW((lIndex + 1) And &H3)).tPos.X - m_tCorners(lCW(lIndex)).tPos.X, _ 351 | m_tCorners(lCW((lIndex + 1) And &H3)).tPos.Y - m_tCorners(lCW(lIndex)).tPos.Y, _ 352 | m_tCorners(lCW((lIndex + 2) And &H3)).tPos.X - m_tCorners(lCW((lIndex + 1) And &H3)).tPos.X, _ 353 | m_tCorners(lCW((lIndex + 2) And &H3)).tPos.Y - m_tCorners(lCW((lIndex + 1) And &H3)).tPos.Y) < 0 354 | 355 | If lIndex Then 356 | If bOriginDir <> bIsNeg Then 357 | IsConvex = False 358 | Exit Function 359 | End If 360 | Else 361 | bOriginDir = bIsNeg 362 | End If 363 | 364 | Next 365 | 366 | IsConvex = True 367 | 368 | End Function 369 | 370 | Private Function PerpDot( _ 371 | ByVal x1 As Single, _ 372 | ByVal y1 As Single, _ 373 | ByVal x2 As Single, _ 374 | ByVal y2 As Single) As Single 375 | PerpDot = x1 * y2 - y1 * x2 376 | End Function 377 | 378 | Private Function mtxMul3x3( _ 379 | ByRef m1() As Single, _ 380 | ByRef m2() As Single) As Single() 381 | Dim lI As Long 382 | Dim lJ As Long 383 | Dim lU As Long 384 | Dim fRet() As Single 385 | 386 | ReDim fRet(2, 2) 387 | 388 | For lI = 0 To 2 389 | For lJ = 0 To 2 390 | For lU = 0 To 2 391 | fRet(lI, lJ) = fRet(lI, lJ) + m1(lI, lU) * m2(lU, lJ) 392 | Next 393 | Next 394 | Next 395 | 396 | mtxMul3x3 = fRet 397 | 398 | End Function 399 | 400 | Private Sub Form_MouseDown( _ 401 | ByRef Button As Integer, _ 402 | ByRef Shift As Integer, _ 403 | ByRef X As Single, _ 404 | ByRef Y As Single) 405 | 406 | If m_lSelCorner = -1 Then Exit Sub 407 | 408 | m_bIsDrag = True 409 | 410 | End Sub 411 | 412 | Private Sub Form_MouseMove( _ 413 | ByRef Button As Integer, _ 414 | ByRef Shift As Integer, _ 415 | ByRef X As Single, _ 416 | ByRef Y As Single) 417 | Dim lIndex As Long 418 | Dim pVtxData As Long 419 | Dim fOrigin(1) As Single 420 | 421 | If m_bIsDrag Then 422 | 423 | With m_tCorners(m_lSelCorner).tPos 424 | 425 | If X < 10 Then 426 | X = 10 427 | ElseIf X > Me.ScaleWidth - 10 Then 428 | X = Me.ScaleWidth - 10 429 | End If 430 | 431 | If Y < 10 Then 432 | Y = 10 433 | ElseIf Y > Me.ScaleHeight - 10 Then 434 | Y = Me.ScaleHeight - 10 435 | End If 436 | 437 | fOrigin(0) = .X: fOrigin(1) = .Y 438 | 439 | .X = X: .Y = Y 440 | 441 | If Not CalcPerspective() Then 442 | .X = fOrigin(0): .Y = fOrigin(1) 443 | End If 444 | 445 | m_cVtxBuf.Lock 0, Len(m_tCorners(0)) * (UBound(m_tCorners) + 1), pVtxData, 0 446 | memcpy ByVal pVtxData, m_tCorners(0), Len(m_tCorners(0)) * (UBound(m_tCorners) + 1) 447 | m_cVtxBuf.Unlock 448 | 449 | Form_Paint 450 | 451 | Exit Sub 452 | 453 | End With 454 | 455 | Else 456 | 457 | For lIndex = 0 To UBound(m_tCorners) 458 | 459 | With m_tCorners(lIndex).tPos 460 | 461 | If (.X - X) ^ 2 + (.Y - Y) ^ 2 <= 25 Then 462 | 463 | If m_lSelCorner <> lIndex Then 464 | m_lSelCorner = lIndex 465 | Form_Paint 466 | End If 467 | 468 | Exit Sub 469 | 470 | End If 471 | 472 | End With 473 | 474 | Next 475 | 476 | If m_lSelCorner <> -1 Then 477 | m_lSelCorner = -1 478 | Form_Paint 479 | End If 480 | 481 | End If 482 | 483 | End Sub 484 | 485 | Private Sub Form_MouseUp( _ 486 | ByRef Button As Integer, _ 487 | ByRef Shift As Integer, _ 488 | ByRef X As Single, _ 489 | ByRef Y As Single) 490 | 491 | m_bIsDrag = False 492 | 493 | End Sub 494 | 495 | Private Sub Form_Paint() 496 | Dim lIndex As Long 497 | 498 | m_cDevice.Clear 0, ByVal 0&, D3DCLEAR_TARGET, &H504030, 1, 0 499 | 500 | m_cDevice.BeginScene 501 | 502 | ' // Draw image 503 | m_cDevice.DrawIndexedPrimitive D3DPT_TRIANGLELIST, 0, 0, 6, 0, 2 504 | 505 | For lIndex = 0 To UBound(m_tCorners) 506 | 507 | With m_tCorners(lIndex).tPos 508 | 509 | DrawCircle .X, .Y, 5, lIndex = m_lSelCorner 510 | 511 | End With 512 | 513 | Next 514 | 515 | m_cDevice.EndScene 516 | 517 | m_cDevice.Present ByVal 0&, ByVal 0&, 0, ByVal 0& 518 | 519 | End Sub 520 | 521 | Private Sub DrawCircle( _ 522 | ByVal lX As Long, _ 523 | ByVal lY As Long, _ 524 | ByVal lRadius As Long, _ 525 | ByVal bFill As Boolean) 526 | Dim tVtx() As tVertex 527 | Dim lIndex As Long 528 | 529 | ReDim tVtx(31) 530 | 531 | m_cDevice.SetTexture 0, Nothing 532 | 533 | If bFill Then 534 | 535 | tVtx(0).tPos.X = lX: tVtx(0).tPos.Y = lY 536 | 537 | For lIndex = 0 To UBound(tVtx) - 1 538 | 539 | tVtx(lIndex + 1).tPos.X = Cos(6.2831 * lIndex / (UBound(tVtx) - 1)) * lRadius + lX 540 | tVtx(lIndex + 1).tPos.Y = Sin(6.2831 * lIndex / (UBound(tVtx) - 1)) * lRadius + lY 541 | 542 | Next 543 | 544 | m_cDevice.DrawPrimitiveUP D3DPT_TRIANGLEFAN, 31, tVtx(0), Len(tVtx(0)) 545 | 546 | Else 547 | 548 | For lIndex = 0 To UBound(tVtx) 549 | 550 | tVtx(lIndex).tPos.X = Cos(6.2831 * lIndex / (UBound(tVtx))) * lRadius + lX 551 | tVtx(lIndex).tPos.Y = Sin(6.2831 * lIndex / (UBound(tVtx))) * lRadius + lY 552 | 553 | Next 554 | 555 | m_cDevice.DrawPrimitiveUP D3DPT_LINESTRIP, 31, tVtx(0), Len(tVtx(0)) 556 | 557 | End If 558 | 559 | m_cDevice.SetStreamSource 0, m_cVtxBuf, 0, VERTEX_SIZE 560 | m_cDevice.SetTexture 0, m_cTexture 561 | 562 | End Sub 563 | 564 | Private Sub Form_Unload( _ 565 | ByRef Cancel As Integer) 566 | 567 | ' // Free resources 568 | Set m_cTexture = Nothing 569 | Set m_cVtxBuf = Nothing 570 | Set m_cDevice = Nothing 571 | Set m_cD3D9 = Nothing 572 | Set m_cIndexBuf = Nothing 573 | 574 | If m_hGpToken Then 575 | GdiplusShutdown m_hGpToken 576 | End If 577 | 578 | End Sub 579 | 580 | 581 | -------------------------------------------------------------------------------- /Demos/CornerPin/test.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/CornerPin/test.jpg -------------------------------------------------------------------------------- /Demos/CubeDemo/Texture.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/CubeDemo/Texture.jpg -------------------------------------------------------------------------------- /Demos/CubeDemo/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Cube demo by The trick." 5 | ClientHeight = 6105 6 | ClientLeft = 45 7 | ClientTop = 360 8 | ClientWidth = 5445 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 407 13 | ScaleMode = 3 'Pixel 14 | ScaleWidth = 363 15 | StartUpPosition = 3 'Windows Default 16 | Begin VB.Timer tmrFrame 17 | Interval = 1000 18 | Left = 3360 19 | Top = 4920 20 | End 21 | End 22 | Attribute VB_Name = "frmMain" 23 | Attribute VB_GlobalNameSpace = False 24 | Attribute VB_Creatable = False 25 | Attribute VB_PredeclaredId = True 26 | Attribute VB_Exposed = False 27 | Option Explicit 28 | 29 | Private Type RGBQUAD 30 | rgbBlue As Byte 31 | rgbGreen As Byte 32 | rgbRed As Byte 33 | rgbReserved As Byte 34 | End Type 35 | 36 | Private Type BITMAPINFOHEADER 37 | biSize As Long 38 | biWidth As Long 39 | biHeight As Long 40 | biPlanes As Integer 41 | biBitCount As Integer 42 | biCompression As Long 43 | biSizeImage As Long 44 | biXPelsPerMeter As Long 45 | biYPelsPerMeter As Long 46 | biClrUsed As Long 47 | biClrImportant As Long 48 | End Type 49 | 50 | Private Type BITMAPINFO 51 | bmiHeader As BITMAPINFOHEADER 52 | bmiColors As RGBQUAD 53 | End Type 54 | 55 | Private Type tVertex 56 | tPosition As D3DVECTOR 57 | tNormal As D3DVECTOR 58 | fU As Single 59 | fv As Single 60 | End Type 61 | 62 | Private Declare Function GetDIBits Lib "gdi32" ( _ 63 | ByVal aHDC As Long, _ 64 | ByVal hBitmap As Long, _ 65 | ByVal nStartScan As Long, _ 66 | ByVal nNumScans As Long, _ 67 | ByRef lpBits As Any, _ 68 | ByRef lpBI As BITMAPINFO, _ 69 | ByVal wUsage As Long) As Long 70 | 71 | Private m_lFVFFlags As D3DFVF 72 | Private m_cD3D9 As IDirect3D9 73 | Private m_cDevice As IDirect3DDevice9 74 | Private m_cCubeMesh As IDirect3DVertexBuffer9 75 | Private m_cTexture As IDirect3DTexture9 76 | Private m_bActive As Boolean 77 | Private m_lFPS As Long 78 | 79 | Private Sub Form_Load() 80 | Dim tPP As D3DPRESENT_PARAMETERS 81 | Dim tLight As D3DLIGHT9 82 | Dim tMtx As D3DMATRIX 83 | Dim tMat As D3DMATERIAL9 84 | 85 | ' // Create IDirect3D9 object 86 | Set m_cD3D9 = Direct3DCreate9() 87 | 88 | ' // Set vertex format 89 | m_lFVFFlags = D3DFVF_XYZ Or D3DFVF_TEX1 Or D3DFVF_NORMAL 90 | 91 | tPP.BackBufferCount = 1 92 | tPP.Windowed = 1 93 | tPP.BackBufferFormat = D3DFMT_A8R8G8B8 94 | tPP.SwapEffect = D3DSWAPEFFECT_DISCARD 95 | tPP.EnableAutoDepthStencil = 1 96 | tPP.AutoDepthStencilFormat = D3DFMT_D16 97 | tPP.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 98 | 99 | ' // Create device 100 | Set m_cDevice = m_cD3D9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, tPP) 101 | 102 | ' // Enable Z_buffer 103 | m_cDevice.SetRenderState D3DRS_ZENABLE, D3DZB_TRUE 104 | 105 | ' // Enable Light 106 | tLight.Type = D3DLIGHT_POINT 107 | tLight.position = vec3(0, 1, -8) 108 | tLight.Attenuation1 = 0.1 109 | tLight.Range = 100 110 | tLight.Diffuse.r = 1: tLight.Ambient.r = 1 111 | tLight.Diffuse.g = 1: tLight.Ambient.g = 1 112 | tLight.Diffuse.b = 1: tLight.Ambient.b = 1 113 | tLight.Attenuation1 = 0.1 114 | 115 | m_cDevice.SetRenderState D3DRS_LIGHTING, 1 116 | m_cDevice.SetLight 0, tLight 117 | m_cDevice.LightEnable 0, 1 118 | 119 | ' // Create cube 120 | Set m_cCubeMesh = CreateCube(2) 121 | 122 | ' // Init matrices 123 | 124 | ' // Create view matrix 125 | D3DXMatrixLookAtLH tMtx, vec3(0, 0, -5), vec3(0, 0, 0), vec3(0, 1, 0) 126 | m_cDevice.SetTransform D3DTS_VIEW, tMtx 127 | ' // Create projection matrix 128 | D3DXMatrixPerspectiveFovLH tMtx, PI / 3, ScaleWidth / ScaleHeight, 0.1, 10 129 | m_cDevice.SetTransform D3DTS_PROJECTION, tMtx 130 | ' // Select vertex buffer 131 | m_cDevice.SetStreamSource 0, m_cCubeMesh, 0, 8 * 4 132 | ' // Set format 133 | m_cDevice.SetFVF m_lFVFFlags 134 | 135 | ' // Create texture 136 | Set m_cTexture = LoadTextureFromFile(App.Path & "\Texture.jpg") 137 | 138 | m_cDevice.SetSamplerState 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR 139 | m_cDevice.SetSamplerState 0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR 140 | 141 | ' // Apply texture 142 | m_cDevice.SetTexture 0, m_cTexture 143 | 144 | ' // Create material 145 | tMat.Diffuse.r = 1: tMat.Ambient.r = 0 146 | tMat.Diffuse.g = 1: tMat.Ambient.g = 0 147 | tMat.Diffuse.b = 1: tMat.Ambient.b = 0.5 148 | 149 | m_cDevice.SetMaterial tMat 150 | 151 | Me.Show 152 | 153 | MainLoop 154 | 155 | End Sub 156 | 157 | Private Sub MainLoop() 158 | Dim tMtx As D3DMATRIX 159 | 160 | m_bActive = True 161 | 162 | Do While m_bActive 163 | 164 | ' // Create transformation for a cube 165 | D3DXMatrixRotationYawPitchRoll tMtx, Timer, Timer / 3, Timer / 7 166 | 167 | m_cDevice.SetTransform D3DTS_WORLD, tMtx 168 | 169 | ' // Clear background 170 | m_cDevice.Clear 0, ByVal 0&, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, vbRed, 1, 0 171 | 172 | m_cDevice.BeginScene 173 | 174 | m_cDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 12 175 | 176 | m_cDevice.EndScene 177 | 178 | m_cDevice.Present ByVal 0&, ByVal 0&, 0, ByVal 0& 179 | 180 | m_lFPS = m_lFPS + 1 181 | 182 | DoEvents 183 | 184 | Loop 185 | 186 | End Sub 187 | 188 | ' // Load texture from file 189 | Private Function LoadTextureFromFile( _ 190 | ByRef sFileName As String) As IDirect3DTexture9 191 | Dim cPicture As StdPicture 192 | Dim tBI As BITMAPINFO 193 | Dim tRect As D3DLOCKED_RECT 194 | 195 | Set cPicture = LoadPicture(sFileName) 196 | 197 | tBI.bmiHeader.biSize = Len(tBI.bmiHeader) 198 | 199 | GetDIBits Me.hDC, cPicture.Handle, 0, 0, ByVal 0&, tBI, 0 200 | 201 | tBI.bmiHeader.biBitCount = 32 202 | tBI.bmiHeader.biCompression = 0 203 | 204 | If tBI.bmiHeader.biHeight > 0 Then 205 | tBI.bmiHeader.biHeight = -tBI.bmiHeader.biHeight 206 | End If 207 | 208 | ' // Create texture 209 | m_cDevice.CreateTexture tBI.bmiHeader.biWidth, -tBI.bmiHeader.biHeight, 1, D3DUSAGE_DYNAMIC, _ 210 | D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, LoadTextureFromFile 211 | 212 | ' // Lock texture 213 | LoadTextureFromFile.LockRect 0, tRect, ByVal 0&, 0 214 | 215 | ' // Get picture data to texture directly 216 | GetDIBits Me.hDC, cPicture.Handle, 0, -tBI.bmiHeader.biHeight, ByVal tRect.pBits, tBI, 0 217 | 218 | ' // Update 219 | LoadTextureFromFile.UnlockRect 0 220 | 221 | End Function 222 | 223 | ' // Create a cube with specified size. 224 | Private Function CreateCube( _ 225 | ByVal fSize As Single) As IDirect3DVertexBuffer9 226 | Dim tVert() As tVertex 227 | Dim lIdx() As Long 228 | Dim fH As Single 229 | Dim lI As Long 230 | 231 | fH = fSize / 2 232 | 233 | ReDim tVert(35) 234 | 235 | nPlan vec3(-fH, fH, fH), vec3(-fH, fH, -fH), vec3(fH, fH, -fH), vec3(fH, fH, fH), vec3(0, 1, 0), lI, tVert(), 0.5, 0, 1, 0.5 236 | nPlan vec3(fH, -fH, fH), vec3(fH, -fH, -fH), vec3(-fH, -fH, -fH), vec3(-fH, -fH, fH), vec3(0, -1, 0), lI, tVert(), 0, 0, 0.5, 0.5 237 | nPlan vec3(fH, fH, fH), vec3(fH, fH, -fH), vec3(fH, -fH, -fH), vec3(fH, -fH, fH), vec3(1, 0, 0), lI, tVert(), 0, 0.5, 0.5, 1 238 | nPlan vec3(-fH, -fH, fH), vec3(-fH, -fH, -fH), vec3(-fH, fH, -fH), vec3(-fH, fH, fH), vec3(-1, 0, 0), lI, tVert(), 0, 0.5, 0.5, 1 239 | nPlan vec3(-fH, fH, -fH), vec3(-fH, -fH, -fH), vec3(fH, -fH, -fH), vec3(fH, fH, -fH), vec3(0, 0, -1), lI, tVert(), 0.5, 0.5, 1, 1 240 | nPlan vec3(fH, -fH, fH), vec3(-fH, -fH, fH), vec3(-fH, fH, fH), vec3(fH, fH, fH), vec3(0, 0, 1), lI, tVert(), 0.5, 0.5, 1, 1 241 | 242 | m_cDevice.CreateVertexBuffer Len(tVert(0)) * (UBound(tVert) + 1), D3DUSAGE_NONE, m_lFVFFlags, D3DPOOL_MANAGED, CreateCube 243 | 244 | CreateCube.Lock 0, 0, lI, 0 245 | memcpy ByVal lI, tVert(0), Len(tVert(0)) * (UBound(tVert) + 1) 246 | CreateCube.Unlock 247 | 248 | End Function 249 | 250 | ' // Add quad to buffer 251 | Private Sub nPlan( _ 252 | ByRef fP1 As D3DVECTOR, _ 253 | ByRef fP2 As D3DVECTOR, _ 254 | ByRef fP3 As D3DVECTOR, _ 255 | ByRef fP4 As D3DVECTOR, _ 256 | ByRef tN As D3DVECTOR, _ 257 | ByRef lI As Long, _ 258 | ByRef tRet() As tVertex, _ 259 | ByVal fU1 As Single, _ 260 | ByVal fV1 As Single, _ 261 | ByVal fU2 As Single, _ 262 | ByVal fV2 As Single) 263 | 264 | tRet(lI).tPosition = fP3: tRet(lI).tNormal = tN: tRet(lI).fU = fU1: tRet(lI).fv = fV2: lI = lI + 1 265 | tRet(lI).tPosition = fP2: tRet(lI).tNormal = tN: tRet(lI).fU = fU1: tRet(lI).fv = fV1: lI = lI + 1 266 | tRet(lI).tPosition = fP1: tRet(lI).tNormal = tN: tRet(lI).fU = fU2: tRet(lI).fv = fV1: lI = lI + 1 267 | tRet(lI).tPosition = fP3: tRet(lI).tNormal = tN: tRet(lI).fU = fU1: tRet(lI).fv = fV2: lI = lI + 1 268 | tRet(lI).tPosition = fP1: tRet(lI).tNormal = tN: tRet(lI).fU = fU2: tRet(lI).fv = fV1: lI = lI + 1 269 | tRet(lI).tPosition = fP4: tRet(lI).tNormal = tN: tRet(lI).fU = fU2: tRet(lI).fv = fV2: lI = lI + 1 270 | 271 | End Sub 272 | 273 | ' // Fast vector creation 274 | Private Function vec3( _ 275 | ByVal fX As Single, _ 276 | ByVal fY As Single, _ 277 | ByVal fz As Single) As D3DVECTOR 278 | vec3.X = fX: vec3.Y = fY: vec3.z = fz 279 | End Function 280 | 281 | Private Sub Form_QueryUnload( _ 282 | ByRef Cancel As Integer, _ 283 | ByRef UnloadMode As Integer) 284 | m_bActive = False 285 | End Sub 286 | 287 | Private Sub Form_Unload( _ 288 | ByRef Cancel As Integer) 289 | 290 | Set m_cCubeMesh = Nothing 291 | Set m_cTexture = Nothing 292 | Set m_cDevice = Nothing 293 | Set m_cD3D9 = Nothing 294 | 295 | End Sub 296 | 297 | Private Sub tmrFrame_Timer() 298 | Caption = "Cube demo by The trick. FPS: " & m_lFPS 299 | m_lFPS = 0 300 | End Sub 301 | -------------------------------------------------------------------------------- /Demos/CubeDemo/prjCubeDemo.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmMain.frm 5 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 6 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 7 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 8 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 9 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 10 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 11 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 12 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 13 | IconForm="frmMain" 14 | Startup="frmMain" 15 | HelpFile="" 16 | Title="prjCubeDemo" 17 | ExeName32="prjCubeDemo.exe" 18 | Command32="" 19 | Name="prjCubeDemo" 20 | HelpContextID="0" 21 | CompatibleMode="0" 22 | MajorVer=1 23 | MinorVer=0 24 | RevisionVer=0 25 | AutoIncrementVer=0 26 | ServerSupportFiles=0 27 | VersionCompanyName="TrickSoft" 28 | CompilationType=0 29 | OptimizationType=0 30 | FavorPentiumPro(tm)=0 31 | CodeViewDebugInfo=-1 32 | NoAliasing=-1 33 | BoundsCheck=-1 34 | OverflowCheck=-1 35 | FlPointCheck=-1 36 | FDIVCheck=-1 37 | UnroundedFP=-1 38 | StartMode=0 39 | Unattended=0 40 | Retained=0 41 | ThreadPerObject=0 42 | MaxNumberOfThreads=1 43 | 44 | [MS Transaction Server] 45 | AutoRefresh=1 46 | -------------------------------------------------------------------------------- /Demos/Fire/Texture.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/Fire/Texture.bmp -------------------------------------------------------------------------------- /Demos/Fire/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Fire demo by The trick" 5 | ClientHeight = 6105 6 | ClientLeft = 45 7 | ClientTop = 360 8 | ClientWidth = 5445 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 6105 13 | ScaleWidth = 5445 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.Timer tmrFrame 16 | Interval = 1000 17 | Left = 3360 18 | Top = 4920 19 | End 20 | End 21 | Attribute VB_Name = "frmMain" 22 | Attribute VB_GlobalNameSpace = False 23 | Attribute VB_Creatable = False 24 | Attribute VB_PredeclaredId = True 25 | Attribute VB_Exposed = False 26 | Option Explicit 27 | 28 | Private Type RGBQUAD 29 | rgbBlue As Byte 30 | rgbGreen As Byte 31 | rgbRed As Byte 32 | rgbReserved As Byte 33 | End Type 34 | Private Type BITMAPINFOHEADER 35 | biSize As Long 36 | biWidth As Long 37 | biHeight As Long 38 | biPlanes As Integer 39 | biBitCount As Integer 40 | biCompression As Long 41 | biSizeImage As Long 42 | biXPelsPerMeter As Long 43 | biYPelsPerMeter As Long 44 | biClrUsed As Long 45 | biClrImportant As Long 46 | End Type 47 | Private Type BITMAPINFO 48 | bmiHeader As BITMAPINFOHEADER 49 | bmiColors As RGBQUAD 50 | End Type 51 | 52 | Private Declare Function GetDIBits Lib "gdi32" ( _ 53 | ByVal aHDC As Long, _ 54 | ByVal hBitmap As Long, _ 55 | ByVal nStartScan As Long, _ 56 | ByVal nNumScans As Long, _ 57 | lpBits As Any, _ 58 | lpBI As BITMAPINFO, _ 59 | ByVal wUsage As Long) As Long 60 | 61 | Private Type Vertex 62 | position As D3DVECTOR 63 | tu As Single 64 | tv As Single 65 | End Type 66 | 67 | Private Type Particle 68 | quad(5) As Vertex 69 | birth As Single 70 | dir As D3DVECTOR 71 | transform As D3DMATRIX 72 | End Type 73 | 74 | Private Const MAX_PARTICLES As Long = 100 75 | 76 | Dim vFlag As D3DFVF 77 | Dim d3d9 As IDirect3D9 78 | Dim d3dev As IDirect3DDevice9 79 | Dim vtxBuf As IDirect3DVertexBuffer9 80 | Dim texture As IDirect3DTexture9 81 | Dim IsStop As Boolean 82 | Dim FPS As Long 83 | Dim part() As Particle 84 | Dim partCt As Long 85 | 86 | Private Sub Form_Load() 87 | ' // Create IDirect3D9 object 88 | Set d3d9 = Direct3DCreate9() 89 | 90 | Dim pP As D3DPRESENT_PARAMETERS 91 | ' // Set vertex format 92 | vFlag = D3DFVF_XYZ Or D3DFVF_TEX1 93 | 94 | pP.BackBufferCount = 1 95 | pP.Windowed = 1 96 | pP.BackBufferFormat = D3DFMT_A8R8G8B8 97 | pP.SwapEffect = D3DSWAPEFFECT_DISCARD 98 | pP.EnableAutoDepthStencil = 1 99 | pP.AutoDepthStencilFormat = D3DFMT_D16 100 | pP.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 101 | 102 | ' // Create device 103 | Set d3dev = d3d9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, pP) 104 | ' // Enable Z_buffer 105 | d3dev.SetRenderState D3DRS_ZENABLE, D3DZB_TRUE 106 | d3dev.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 107 | d3dev.SetRenderState D3DRS_LIGHTING, 0 108 | d3dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 109 | 110 | d3dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA 111 | d3dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE 112 | d3dev.SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD 113 | 114 | ' // Create vertex buffer 115 | d3dev.CreateVertexBuffer MAX_PARTICLES * 6 * 5 * 4, D3DUSAGE_DYNAMIC, vFlag, D3DPOOL_DEFAULT, vtxBuf 116 | 117 | ' // Init matrices 118 | Dim mtx As D3DMATRIX 119 | ' // Create view matrix 120 | D3DXMatrixLookAtLH mtx, vec3(0, 5, -10), vec3(0, 2, 0), vec3(0, 1, 0) 121 | d3dev.SetTransform D3DTS_VIEW, mtx 122 | ' // Create projection matrix 123 | D3DXMatrixPerspectiveFovLH mtx, PI / 3, ScaleWidth / ScaleHeight, 0.1, 100 124 | d3dev.SetTransform D3DTS_PROJECTION, mtx 125 | ' // Select vertex buffer 126 | d3dev.SetStreamSource 0, vtxBuf, 0, 5 * 4 127 | ' // Set format 128 | d3dev.SetFVF vFlag 129 | 130 | ' // Create texture 131 | Set texture = LoadTextureFromFile(App.Path & "\Texture.bmp") 132 | d3dev.SetSamplerState 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR 133 | d3dev.SetSamplerState 0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR 134 | 135 | ' // Apply texture 136 | d3dev.SetTexture 0, texture 137 | 138 | Dim index As Long 139 | Dim prev As Single 140 | 141 | ReDim part(MAX_PARTICLES - 1) 142 | 143 | Me.Show 144 | prev = Timer 145 | 146 | Do 147 | 148 | If partCt < 50 And Timer - prev > 0.03 Then 149 | prev = Timer 150 | AddParticle partCt 151 | End If 152 | 153 | ProcessParticle 154 | 155 | ' // Clear background 156 | d3dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, vbBlack, 1, 0 157 | 158 | d3dev.BeginScene 159 | 160 | d3dev.SetRenderState D3DRS_ZWRITEENABLE, 0 161 | 162 | For index = 0 To partCt - 1 163 | d3dev.SetTransform D3DTS_WORLD, part(index).transform 164 | d3dev.DrawPrimitive D3DPT_TRIANGLELIST, index * 6, 2 165 | Next 166 | 167 | d3dev.SetRenderState D3DRS_ZWRITEENABLE, 1 168 | 169 | d3dev.EndScene 170 | 171 | d3dev.Present ByVal 0, ByVal 0, 0, ByVal 0 172 | 173 | FPS = FPS + 1 174 | 175 | DoEvents 176 | 177 | Loop Until IsStop 178 | 179 | ' // Free resources 180 | Set texture = Nothing 181 | Set vtxBuf = Nothing 182 | Set d3dev = Nothing 183 | Set d3d9 = Nothing 184 | 185 | Unload Me 186 | 187 | End Sub 188 | 189 | ' // Load texture from file 190 | Private Function LoadTextureFromFile(FileName As String) As IDirect3DTexture9 191 | Dim tex As StdPicture 192 | Dim bi As BITMAPINFO 193 | Dim RECT As D3DLOCKED_RECT 194 | 195 | Set tex = LoadPicture(FileName) 196 | 197 | bi.bmiHeader.biSize = Len(bi.bmiHeader) 198 | GetDIBits Me.hDC, tex.Handle, 0, 0, ByVal 0&, bi, 0 199 | ' // Fix values 200 | bi.bmiHeader.biBitCount = 32 201 | bi.bmiHeader.biCompression = 0 202 | If bi.bmiHeader.biHeight > 0 Then bi.bmiHeader.biHeight = -bi.bmiHeader.biHeight 203 | ' // Create texture 204 | d3dev.CreateTexture bi.bmiHeader.biWidth, -bi.bmiHeader.biHeight, 1, D3DUSAGE_DYNAMIC, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, LoadTextureFromFile 205 | ' // Lock texture 206 | LoadTextureFromFile.LockRect 0, RECT, ByVal 0, 0 207 | ' // Get picture data to texture directly 208 | GetDIBits Me.hDC, tex.Handle, 0, -bi.bmiHeader.biHeight, ByVal RECT.pBits, bi, 0 209 | ' // Update 210 | LoadTextureFromFile.UnlockRect 0 211 | ' // Free 212 | Set tex = Nothing 213 | End Function 214 | 215 | ' // Add a particle into buffer 216 | Private Function AddParticle(ByVal index As Long) As Long 217 | Dim obj As Particle 218 | Dim mtx As D3DMATRIX 219 | Dim idx As Long 220 | Dim ptr As Long 221 | Dim dX As Long 222 | Dim dY As Long 223 | 224 | Randomize 225 | 226 | If index >= MAX_PARTICLES Then Stop 227 | 228 | obj.birth = Timer 229 | obj.dir = vec3(Rnd * 2 - 1, Rnd * 2 - 1, Rnd * 2 - 1) 230 | dX = Rnd * 4 231 | dY = Rnd * 4 232 | 233 | nPlan vec3(-1, 1, 0), vec3(-1, -1, 0), vec3(1, -1, 0), vec3(1, 1, 0), obj.quad(), 0.25 * dX, 0.25 * dY, 0.25 * dX + 0.25, 0.25 * dY + 0.25 234 | ' // Random rotation 235 | D3DXMatrixRotationY mtx, PI * Rnd * 2 236 | 237 | For idx = 0 To UBound(obj.quad) 238 | D3DXVec3TransformCoord obj.quad(idx).position, obj.quad(idx).position, mtx 239 | Next 240 | 241 | part(index) = obj 242 | 243 | vtxBuf.Lock index * 6 * 5 * 4, 6 * 5 * 4, ptr, 0 244 | memcpy ByVal ptr, obj.quad(0), 6 * 5 * 4 245 | vtxBuf.Unlock 246 | 247 | If index = partCt Then partCt = partCt + 1 248 | 249 | End Function 250 | 251 | ' // Process 252 | Private Sub ProcessParticle() 253 | Dim idx As Long 254 | Dim m1 As D3DMATRIX 255 | Dim m2 As D3DMATRIX 256 | Dim scl As Single 257 | Dim pos As Single 258 | Dim liv As Single 259 | 260 | For idx = 0 To partCt - 1 261 | 262 | liv = (Timer - part(idx).birth) / 1.5 263 | 264 | If liv > 1 Then 265 | AddParticle idx 266 | ElseIf liv < 0 Then 267 | liv = 0 268 | End If 269 | 270 | scl = Sin((liv * 9) ^ 0.7) * 3 271 | If scl < 0 Then scl = 0 272 | pos = (1 - Sin(Cos(liv * 4) * 1.5)) * 4 273 | 274 | D3DXMatrixTranslation m1, 0, pos, 0 275 | D3DXMatrixRotationY m2, (Timer - part(idx).birth) / 2 276 | D3DXMatrixMultiply m1, m2, m1 277 | D3DXMatrixTranslation m2, part(idx).dir.X * liv * 2, part(idx).dir.Y * liv, part(idx).dir.z * liv 278 | D3DXMatrixMultiply m1, m2, m1 279 | D3DXMatrixScaling m2, scl, scl * (liv + 1), scl 280 | D3DXMatrixMultiply m1, m2, m1 281 | 282 | part(idx).transform = m1 283 | 284 | Next 285 | 286 | End Sub 287 | 288 | ' // Add quad to buffer 289 | Private Sub nPlan(p1 As D3DVECTOR, _ 290 | p2 As D3DVECTOR, _ 291 | p3 As D3DVECTOR, _ 292 | p4 As D3DVECTOR, _ 293 | ret() As Vertex, _ 294 | ByVal u1 As Single, _ 295 | ByVal v1 As Single, _ 296 | ByVal u2 As Single, _ 297 | ByVal v2 As Single) 298 | Dim i As Long 299 | 300 | ret(i).position = p3: ret(i).tu = u2: ret(i).tv = v2: i = i + 1 301 | ret(i).position = p1: ret(i).tu = u1: ret(i).tv = v1: i = i + 1 302 | ret(i).position = p2: ret(i).tu = u1: ret(i).tv = v2: i = i + 1 303 | ret(i).position = p3: ret(i).tu = u2: ret(i).tv = v2: i = i + 1 304 | ret(i).position = p4: ret(i).tu = u2: ret(i).tv = v1: i = i + 1 305 | ret(i).position = p1: ret(i).tu = u1: ret(i).tv = v1: i = i + 1 306 | 307 | End Sub 308 | 309 | ' // Fast vector creation 310 | Private Function vec3(ByVal X As Single, ByVal Y As Single, ByVal z As Single) As D3DVECTOR 311 | vec3.X = X: vec3.Y = Y: vec3.z = z 312 | End Function 313 | 314 | Private Sub Form_Unload(Cancel As Integer) 315 | IsStop = True 316 | End Sub 317 | 318 | Private Sub tmrFrame_Timer() 319 | Caption = "Fire demo by The trick. FPS:" & FPS 320 | FPS = 0 321 | End Sub 322 | -------------------------------------------------------------------------------- /Demos/Fire/prjFireDemo.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmMain.frm 5 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 6 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 7 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 8 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 9 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 10 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 11 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 12 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 13 | IconForm="frmMain" 14 | Startup="frmMain" 15 | HelpFile="" 16 | Title="prjCubeDemo" 17 | ExeName32="prjFireDemo.exe" 18 | Command32="" 19 | Name="prFireDemo" 20 | HelpContextID="0" 21 | CompatibleMode="0" 22 | MajorVer=1 23 | MinorVer=0 24 | RevisionVer=0 25 | AutoIncrementVer=0 26 | ServerSupportFiles=0 27 | VersionCompanyName="TrickSoft" 28 | CompilationType=0 29 | OptimizationType=0 30 | FavorPentiumPro(tm)=0 31 | CodeViewDebugInfo=0 32 | NoAliasing=-1 33 | BoundsCheck=-1 34 | OverflowCheck=-1 35 | FlPointCheck=-1 36 | FDIVCheck=-1 37 | UnroundedFP=-1 38 | StartMode=0 39 | Unattended=0 40 | Retained=0 41 | ThreadPerObject=0 42 | MaxNumberOfThreads=1 43 | 44 | [MS Transaction Server] 45 | AutoRefresh=1 46 | -------------------------------------------------------------------------------- /Demos/Landscape/HeightMap.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/Landscape/HeightMap.jpg -------------------------------------------------------------------------------- /Demos/Landscape/Texture.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/Landscape/Texture.jpg -------------------------------------------------------------------------------- /Demos/Landscape/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | Caption = "Landscape by The trick" 4 | ClientHeight = 6885 5 | ClientLeft = 60 6 | ClientTop = 375 7 | ClientWidth = 7995 8 | LinkTopic = "Form1" 9 | ScaleHeight = 6885 10 | ScaleWidth = 7995 11 | StartUpPosition = 3 'Windows Default 12 | Begin VB.Timer tmrFrame 13 | Interval = 1000 14 | Left = 1560 15 | Top = 2880 16 | End 17 | End 18 | Attribute VB_Name = "frmMain" 19 | Attribute VB_GlobalNameSpace = False 20 | Attribute VB_Creatable = False 21 | Attribute VB_PredeclaredId = True 22 | Attribute VB_Exposed = False 23 | Option Explicit 24 | 25 | Private Type RGBQUAD 26 | rgbBlue As Byte 27 | rgbGreen As Byte 28 | rgbRed As Byte 29 | rgbReserved As Byte 30 | End Type 31 | Private Type BITMAPINFOHEADER 32 | biSize As Long 33 | biWidth As Long 34 | biHeight As Long 35 | biPlanes As Integer 36 | biBitCount As Integer 37 | biCompression As Long 38 | biSizeImage As Long 39 | biXPelsPerMeter As Long 40 | biYPelsPerMeter As Long 41 | biClrUsed As Long 42 | biClrImportant As Long 43 | End Type 44 | Private Type BITMAPINFO 45 | bmiHeader As BITMAPINFOHEADER 46 | bmiColors As RGBQUAD 47 | End Type 48 | 49 | Private Declare Function GetDIBits Lib "gdi32" ( _ 50 | ByVal aHDC As Long, _ 51 | ByVal hBitmap As Long, _ 52 | ByVal nStartScan As Long, _ 53 | ByVal nNumScans As Long, _ 54 | lpBits As Any, _ 55 | lpBI As BITMAPINFO, _ 56 | ByVal wUsage As Long) As Long 57 | 58 | Private Type Vertex 59 | position As D3DVECTOR 60 | normal As D3DVECTOR 61 | tu As Single 62 | tV As Single 63 | End Type 64 | 65 | Dim vFlag As D3DFVF 66 | Dim d3d9 As IDirect3D9 67 | Dim d3dev As IDirect3DDevice9 68 | Dim vtxBuf As IDirect3DVertexBuffer9 69 | Dim idxBuf As IDirect3DIndexBuffer9 70 | Dim texture As IDirect3DTexture9 71 | Dim IsStop As Boolean 72 | Dim FPS As Long 73 | Dim vtxCt As Long 74 | Dim idxCt As Long 75 | 76 | Private Sub Form_Load() 77 | ' // Create IDirect3D9 object 78 | Set d3d9 = Direct3DCreate9() 79 | 80 | Dim pP As D3DPRESENT_PARAMETERS 81 | ' // Set vertex format 82 | vFlag = D3DFVF_XYZ Or D3DFVF_TEX1 Or D3DFVF_NORMAL 83 | 84 | pP.BackBufferCount = 1 85 | pP.Windowed = 1 86 | pP.BackBufferFormat = D3DFMT_A8R8G8B8 87 | pP.SwapEffect = D3DSWAPEFFECT_DISCARD 88 | pP.EnableAutoDepthStencil = 1 89 | pP.AutoDepthStencilFormat = D3DFMT_D16 90 | pP.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 91 | 92 | ' // Create device 93 | Set d3dev = d3d9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_HARDWARE_VERTEXPROCESSING, pP) 94 | ' // Enable Z_buffer 95 | d3dev.SetRenderState D3DRS_ZENABLE, D3DZB_TRUE 96 | ' // Enable Light 97 | Dim Light As D3DLIGHT9 98 | 99 | Light.Type = D3DLIGHT_POINT 100 | Light.position = vec3(0, 10, 0) 101 | Light.Attenuation1 = 0.1 102 | Light.Range = 100 103 | Light.Diffuse.r = 1: Light.Ambient.r = 1 104 | Light.Diffuse.g = 1: Light.Ambient.g = 1 105 | Light.Diffuse.b = 1: Light.Ambient.b = 1 106 | 107 | d3dev.SetRenderState D3DRS_LIGHTING, 1 108 | d3dev.SetLight 0, Light 109 | d3dev.LightEnable 0, 1 110 | 111 | ' // Create landscape 112 | LoadLandscape App.Path & "\HeightMap.jpg", 15 113 | 114 | ' // Init matrices 115 | Dim Mtx As D3DMATRIX 116 | ' // Create view matrix 117 | D3DXMatrixLookAtLH Mtx, vec3(0, 1, -8), vec3(0, -4, 0), vec3(0, 1, 0) 118 | d3dev.SetTransform D3DTS_VIEW, Mtx 119 | ' // Create projection matrix 120 | D3DXMatrixPerspectiveFovLH Mtx, PI / 3, ScaleWidth / ScaleHeight, 0.1, 100 121 | d3dev.SetTransform D3DTS_PROJECTION, Mtx 122 | ' // Select vertex buffer 123 | d3dev.SetStreamSource 0, vtxBuf, 0, 8 * 4 124 | d3dev.SetIndices idxBuf 125 | 126 | ' // Set format 127 | d3dev.SetFVF vFlag 128 | 129 | ' // Create texture 130 | Set texture = LoadTextureFromFile(App.Path & "\Texture.jpg") 131 | 132 | d3dev.SetSamplerState 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR 133 | d3dev.SetSamplerState 0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR 134 | d3dev.SetSamplerState 0, D3DSAMP_MIPFILTER, D3DTEXF_LINEAR 135 | 136 | ' // Apply texture 137 | d3dev.SetTexture 0, texture 138 | 139 | d3dev.SetTextureStageState 0, D3DTSS_TEXTURETRANSFORMFLAGS, D3DTTFF_COUNT2 140 | 141 | ' // Resize texture 142 | D3DXMatrixScaling Mtx, 10, 10, 10 143 | d3dev.SetTransform D3DTS_TEXTURE0, Mtx 144 | 145 | ' // Create material 146 | Dim Mat As D3DMATERIAL9 147 | 148 | Mat.Diffuse.r = 1: Mat.Ambient.r = 0 149 | Mat.Diffuse.g = 1: Mat.Ambient.g = 0 150 | Mat.Diffuse.b = 1: Mat.Ambient.b = 0 151 | 152 | d3dev.SetMaterial Mat 153 | 154 | ' // Fog enable 155 | d3dev.SetRenderState D3DRS_FOGENABLE, D3D_TRUE 156 | d3dev.SetRenderState D3DRS_FOGCOLOR, vbBlack 157 | d3dev.SetRenderState D3DRS_FOGTABLEMODE, D3DFOG_LINEAR 158 | d3dev.SetRenderState D3DRS_FOGSTART, &H40A00000 159 | d3dev.SetRenderState D3DRS_FOGEND, &H41A00000 160 | 161 | ' // Main cycle 162 | Dim ph As Single 163 | 164 | Me.Show 165 | 166 | Do 167 | 168 | ' // Create transformation for a landscape 169 | D3DXMatrixRotationYawPitchRoll Mtx, Timer / 4, 0, 0 170 | d3dev.SetTransform D3DTS_WORLD, Mtx 171 | D3DXMatrixTranslation Mtx, 0, -2, 0 172 | d3dev.MultiplyTransform D3DTS_WORLD, Mtx 173 | 174 | ' // Clear background 175 | d3dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1, 0 176 | 177 | d3dev.BeginScene 178 | 179 | d3dev.DrawIndexedPrimitive D3DPT_TRIANGLELIST, 0, 0, vtxCt, 0, idxCt / 3 180 | 181 | d3dev.EndScene 182 | 183 | d3dev.Present ByVal 0, ByVal 0, 0, ByVal 0 184 | 185 | FPS = FPS + 1 186 | 187 | DoEvents 188 | 189 | Loop Until IsStop 190 | 191 | ' // Free resources 192 | Set texture = Nothing 193 | Set vtxBuf = Nothing 194 | Set idxBuf = Nothing 195 | Set d3dev = Nothing 196 | Set d3d9 = Nothing 197 | 198 | Unload Me 199 | 200 | End Sub 201 | 202 | ' // Load texture from file 203 | Private Function LoadTextureFromFile(FileName As String) As IDirect3DTexture9 204 | Dim tex As StdPicture 205 | Dim bi As BITMAPINFO 206 | Dim RECT As D3DLOCKED_RECT 207 | 208 | Set tex = LoadPicture(FileName) 209 | 210 | bi.bmiHeader.biSize = Len(bi.bmiHeader) 211 | GetDIBits Me.hDC, tex.Handle, 0, 0, ByVal 0&, bi, 0 212 | ' // Fix values 213 | bi.bmiHeader.biBitCount = 32 214 | bi.bmiHeader.biCompression = 0 215 | If bi.bmiHeader.biHeight > 0 Then bi.bmiHeader.biHeight = -bi.bmiHeader.biHeight 216 | ' // Create texture 217 | d3dev.CreateTexture bi.bmiHeader.biWidth, -bi.bmiHeader.biHeight, 1, D3DUSAGE_DYNAMIC, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, LoadTextureFromFile 218 | ' // Lock texture 219 | LoadTextureFromFile.LockRect 0, RECT, ByVal 0, 0 220 | ' // Get picture data to texture directly 221 | GetDIBits Me.hDC, tex.Handle, 0, -bi.bmiHeader.biHeight, ByVal RECT.pBits, bi, 0 222 | ' // Update 223 | LoadTextureFromFile.UnlockRect 0 224 | ' // Free 225 | Set tex = Nothing 226 | End Function 227 | 228 | ' // Create a cube with specified size. 229 | Private Function LoadLandscape(HeightMapFileName As String, ByVal ScaleFactor As Single) As Boolean 230 | Dim vert() As Vertex 231 | Dim index() As Long 232 | Dim tex As StdPicture 233 | Dim bi As BITMAPINFO 234 | Dim dat() As Long 235 | Dim X As Single 236 | Dim Y As Single 237 | 238 | Set tex = LoadPicture(HeightMapFileName) 239 | 240 | bi.bmiHeader.biSize = Len(bi.bmiHeader) 241 | GetDIBits Me.hDC, tex.Handle, 0, 0, ByVal 0&, bi, 0 242 | ' // Fix values 243 | bi.bmiHeader.biBitCount = 32 244 | bi.bmiHeader.biCompression = 0 245 | If bi.bmiHeader.biHeight > 0 Then bi.bmiHeader.biHeight = -bi.bmiHeader.biHeight 246 | ' // Alloc memory 247 | ReDim dat(bi.bmiHeader.biWidth - 1, Abs(bi.bmiHeader.biHeight) - 1) 248 | ' // Get picture data 249 | GetDIBits Me.hDC, tex.Handle, 0, Abs(bi.bmiHeader.biHeight), dat(0, 0), bi, 0 250 | ' // Alloc memory for landscape mesh 251 | ReDim vert(bi.bmiHeader.biWidth - 3, Abs(bi.bmiHeader.biHeight) - 3) 252 | ReDim index(5, (bi.bmiHeader.biWidth - 3) * (Abs(bi.bmiHeader.biHeight) - 3) - 1) 253 | 254 | Dim lr As D3DVECTOR 255 | Dim tb As D3DVECTOR 256 | Dim i1 As Long 257 | Dim i2 As Long 258 | 259 | ' // Get points (use RED channel) 260 | For Y = 1 To Abs(bi.bmiHeader.biHeight) - 2: For X = 1 To bi.bmiHeader.biWidth - 2 261 | ' // Y (height) dependent from R-value 262 | vert(X - 1, Y - 1).position = vec3(X / bi.bmiHeader.biWidth * ScaleFactor - ScaleFactor / 2, _ 263 | (dat(X, Y) And &HFF) / 255 * ScaleFactor / 8, _ 264 | Y / Abs(bi.bmiHeader.biHeight) * ScaleFactor - ScaleFactor / 2) 265 | 266 | vert(X - 1, Y - 1).tu = X / bi.bmiHeader.biWidth 267 | vert(X - 1, Y - 1).tV = Y / Abs(bi.bmiHeader.biHeight) 268 | ' // Calculae normal 269 | lr = vec3(1, ((dat(X - 1, Y) And &HFF) - (dat(X + 1, Y) And &HFF)) / 255 * ScaleFactor, 0) 270 | tb = vec3(0, ((dat(X, Y - 1) And &HFF) - (dat(X, Y + 1) And &HFF)) / 255 * ScaleFactor, -1) 271 | 272 | D3DXVec3Cross lr, lr, tb 273 | D3DXVec3Normalize vert(X - 1, Y - 1).normal, lr 274 | 275 | ' // Calculate index 276 | If Y < Abs(bi.bmiHeader.biHeight) - 2 And X < bi.bmiHeader.biWidth - 2 Then 277 | 278 | index(0, i1) = i2 279 | index(1, i1) = i2 + bi.bmiHeader.biWidth - 2 280 | index(2, i1) = i2 + 1 281 | index(3, i1) = index(1, i1) 282 | index(4, i1) = index(1, i1) + 1 283 | index(5, i1) = index(2, i1) 284 | 285 | i1 = i1 + 1 286 | 287 | End If 288 | 289 | i2 = i2 + 1 290 | 291 | Next: Next 292 | 293 | Dim ptr As Long 294 | 295 | vtxCt = (bi.bmiHeader.biWidth - 2) * (Abs(bi.bmiHeader.biHeight) - 2) 296 | 297 | d3dev.CreateVertexBuffer Len(vert(0, 0)) * vtxCt, D3DUSAGE_NONE, vFlag, D3DPOOL_DEFAULT, vtxBuf 298 | ' // Fill values to vertex buffer 299 | vtxBuf.Lock 0, 0, ptr, 0 300 | memcpy ByVal ptr, vert(0, 0), Len(vert(0, 0)) * vtxCt 301 | vtxBuf.Unlock 302 | 303 | idxCt = i1 * 6 304 | 305 | d3dev.CreateIndexBuffer idxCt * Len(index(0, 0)), D3DUSAGE_DYNAMIC, D3DFMT_INDEX32, D3DPOOL_DEFAULT, idxBuf 306 | ' // Fill values to indexes buffer 307 | idxBuf.Lock 0, 0, ptr, D3DLOCK_DISCARD 308 | memcpy ByVal ptr, index(0, 0), idxCt * Len(index(0, 0)) 309 | idxBuf.Unlock 310 | 311 | End Function 312 | 313 | ' // Fast vector creation 314 | Private Function vec3(ByVal X As Single, ByVal Y As Single, ByVal z As Single) As D3DVECTOR 315 | vec3.X = X: vec3.Y = Y: vec3.z = z 316 | End Function 317 | 318 | Private Sub Form_Unload(Cancel As Integer) 319 | IsStop = True 320 | End Sub 321 | 322 | Private Sub tmrFrame_Timer() 323 | Caption = "Landscape demo by The trick. FPS:" & FPS 324 | FPS = 0 325 | End Sub 326 | -------------------------------------------------------------------------------- /Demos/Landscape/prjLandscape.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmMain.frm 5 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 6 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 7 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 8 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 9 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 10 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 11 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 12 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 13 | IconForm="frmMain" 14 | Startup="frmMain" 15 | HelpFile="" 16 | Title="prjLandscape" 17 | ExeName32="prjLandscape.exe" 18 | Command32="" 19 | Name="prjLandscape" 20 | HelpContextID="0" 21 | CompatibleMode="0" 22 | MajorVer=1 23 | MinorVer=0 24 | RevisionVer=0 25 | AutoIncrementVer=0 26 | ServerSupportFiles=0 27 | VersionCompanyName="TrickSoft" 28 | CompilationType=0 29 | OptimizationType=0 30 | FavorPentiumPro(tm)=0 31 | CodeViewDebugInfo=0 32 | NoAliasing=-1 33 | BoundsCheck=-1 34 | OverflowCheck=-1 35 | FlPointCheck=-1 36 | FDIVCheck=-1 37 | UnroundedFP=-1 38 | StartMode=0 39 | Unattended=0 40 | Retained=0 41 | ThreadPerObject=0 42 | MaxNumberOfThreads=1 43 | 44 | [MS Transaction Server] 45 | AutoRefresh=1 46 | -------------------------------------------------------------------------------- /Demos/LaserLines/LaserLines.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmLaserLines.frm 5 | Startup="frmLaserLines" 6 | Command32="" 7 | Name="LaserLines" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | VersionCompanyName="TrickSoft" 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /Demos/LaserLines/frmLaserLines.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmLaserLines 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "LaserLines" 5 | ClientHeight = 4755 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 5160 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 317 13 | ScaleMode = 3 'Pixel 14 | ScaleWidth = 344 15 | StartUpPosition = 3 'Windows Default 16 | Begin VB.HScrollBar hsbColor 17 | Height = 315 18 | Left = 180 19 | Max = 15 20 | TabIndex = 0 21 | Top = 4020 22 | Value = 1 23 | Width = 4755 24 | End 25 | End 26 | Attribute VB_Name = "frmLaserLines" 27 | Attribute VB_GlobalNameSpace = False 28 | Attribute VB_Creatable = False 29 | Attribute VB_PredeclaredId = True 30 | Attribute VB_Exposed = False 31 | Option Explicit 32 | 33 | Private Type POINTAPI 34 | X As Long 35 | Y As Long 36 | End Type 37 | Private Type RGBQUAD 38 | rgbBlue As Byte 39 | rgbGreen As Byte 40 | rgbRed As Byte 41 | rgbReserved As Byte 42 | End Type 43 | Private Type BITMAPINFOHEADER 44 | biSize As Long 45 | biWidth As Long 46 | biHeight As Long 47 | biPlanes As Integer 48 | biBitCount As Integer 49 | biCompression As Long 50 | biSizeImage As Long 51 | biXPelsPerMeter As Long 52 | biYPelsPerMeter As Long 53 | biClrUsed As Long 54 | biClrImportant As Long 55 | End Type 56 | Private Type BITMAPINFO 57 | bmiHeader As BITMAPINFOHEADER 58 | bmiColors As RGBQUAD 59 | End Type 60 | 61 | Private Declare Function GetDIBits Lib "gdi32" ( _ 62 | ByVal aHDC As Long, _ 63 | ByVal hBitmap As Long, _ 64 | ByVal nStartScan As Long, _ 65 | ByVal nNumScans As Long, _ 66 | ByRef lpBits As Any, _ 67 | ByRef lpBI As BITMAPINFO, _ 68 | ByVal wUsage As Long) As Long 69 | Private Declare Function memcpy Lib "kernel32" _ 70 | Alias "RtlMoveMemory" ( _ 71 | ByRef Destination As Any, _ 72 | ByRef Source As Any, _ 73 | ByVal length As Long) As Long 74 | Private Declare Function GetCursorPos Lib "user32" ( _ 75 | ByRef lpPoint As POINTAPI) As Long 76 | Private Declare Function ScreenToClient Lib "user32" ( _ 77 | ByVal hwnd As Long, _ 78 | ByRef lpPoint As POINTAPI) As Long 79 | 80 | Private Const LaserWidth As Long = 20 81 | 82 | Private Type Vertex 83 | position As D3DVECTOR 84 | rhw As Single 85 | color As Long 86 | tu As Single 87 | tv As Single 88 | End Type 89 | 90 | Dim vFlag As D3DFVF 91 | Dim d3d9 As IDirect3D9 92 | Dim d3dev As IDirect3DDevice9 93 | Dim vtxBuf As IDirect3DVertexBuffer9 94 | Dim texture As IDirect3DTexture9 95 | Dim vert(29) As Vertex 96 | 97 | Private Sub Form_Load() 98 | 99 | If Not Initialize() Then 100 | MsgBox "error" 101 | Unload Me 102 | End If 103 | 104 | ' // Load background texture 105 | Set texture = LoadTextureFromFile(App.Path & "\space.jpg") 106 | 107 | ' // Create vertex buffer 108 | d3dev.CreateVertexBuffer (UBound(vert) + 1) * Len(vert(0)), D3DUSAGE_DYNAMIC, vFlag, D3DPOOL_DEFAULT, vtxBuf 109 | 110 | ' // Select vertex buffer 111 | d3dev.SetStreamSource 0, vtxBuf, 0, Len(vert(0)) 112 | 113 | CreateBackgroundSprite 114 | 115 | End Sub 116 | 117 | Private Sub Render() 118 | 119 | ' // Clear background 120 | d3dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, vbRed, 1, 0 121 | 122 | d3dev.BeginScene 123 | 124 | ' // Apply texture 125 | d3dev.SetTexture 0, texture 126 | 127 | d3dev.SetRenderState D3DRS_ALPHABLENDENABLE, 0 128 | 129 | ' // Draw background 130 | d3dev.DrawPrimitive D3DPT_TRIANGLELIST, 0, 2 131 | 132 | ' // Remove texture 133 | d3dev.SetTexture 0, Nothing 134 | 135 | CreateLasersSprites 136 | 137 | d3dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 138 | 139 | ' // Draw lasers 140 | d3dev.DrawPrimitive D3DPT_TRIANGLELIST, 6, 8 141 | 142 | d3dev.EndScene 143 | 144 | d3dev.Present ByVal 0, ByVal 0, 0, ByVal 0 145 | 146 | End Sub 147 | 148 | Private Sub CreateLasersSprites() 149 | Dim pos As POINTAPI 150 | Dim pos2 As D3DVECTOR2 151 | Dim ptr As Long 152 | Dim tmp As Single 153 | Dim length As Single 154 | Dim col As Long 155 | 156 | col = QBColor(hsbColor.Value) 157 | 158 | ' // Get cursor pos 159 | GetCursorPos pos 160 | ScreenToClient Me.hwnd, pos 161 | 162 | ' // Calculate perpendicular 163 | pos2.X = pos.X 164 | pos2.Y = pos.Y - ScaleHeight \ 2 165 | 166 | length = Sqr(pos2.X * pos2.X + pos2.Y * pos2.Y) 167 | 168 | tmp = pos2.X 169 | pos2.X = pos2.Y / length 170 | pos2.Y = -tmp / length 171 | 172 | vert(6) = vtx2D(pos2.X * LaserWidth, pos2.Y * LaserWidth + ScaleHeight \ 2, 0.5, vbBlack, 0, 0) 173 | vert(7) = vtx2D(pos2.X * LaserWidth \ 2 + pos.X, pos2.Y * LaserWidth \ 2 + pos.Y, 0.5, vbBlack, 0, 0) 174 | vert(8) = vtx2D(0, ScaleHeight \ 2, 0.5, col, 0, 0) 175 | 176 | vert(9) = vert(8) 177 | vert(10) = vert(7) 178 | vert(11) = vtx2D(pos.X, pos.Y, 0.5, col, 0, 0) 179 | 180 | vert(12) = vert(9) 181 | vert(13) = vert(11) 182 | vert(14) = vtx2D(-pos2.X * LaserWidth, -pos2.Y * LaserWidth + ScaleHeight \ 2, 0.5, vbBlack, 0, 0) 183 | 184 | vert(15) = vert(14) 185 | vert(16) = vert(13) 186 | vert(17) = vtx2D(-pos2.X * LaserWidth \ 2 + pos.X, -pos2.Y * LaserWidth \ 2 + pos.Y, 0.5, vbBlack, 0, 0) 187 | 188 | ' // Calculate perpendicular 189 | pos2.X = pos.X - ScaleWidth 190 | pos2.Y = pos.Y - ScaleHeight \ 2 191 | 192 | length = Sqr(pos2.X * pos2.X + pos2.Y * pos2.Y) 193 | 194 | tmp = pos2.X 195 | pos2.X = pos2.Y / length 196 | pos2.Y = -tmp / length 197 | 198 | vert(18) = vtx2D(pos2.X * LaserWidth + ScaleWidth, pos2.Y * LaserWidth + ScaleHeight \ 2, 0.5, vbBlack, 0, 0) 199 | vert(19) = vtx2D(pos2.X * LaserWidth \ 2 + pos.X, pos2.Y * LaserWidth \ 2 + pos.Y, 0.5, vbBlack, 0, 0) 200 | vert(20) = vtx2D(ScaleWidth, ScaleHeight \ 2, 0.5, col, 0, 0) 201 | 202 | vert(21) = vert(20) 203 | vert(22) = vert(19) 204 | vert(23) = vtx2D(pos.X, pos.Y, 0.5, col, 0, 0) 205 | 206 | vert(24) = vert(21) 207 | vert(25) = vert(23) 208 | vert(26) = vtx2D(-pos2.X * LaserWidth + ScaleWidth, -pos2.Y * LaserWidth + ScaleHeight \ 2, 0.5, vbBlack, 0, 0) 209 | 210 | vert(27) = vert(26) 211 | vert(28) = vert(25) 212 | vert(29) = vtx2D(-pos2.X * LaserWidth \ 2 + pos.X, -pos2.Y * LaserWidth \ 2 + pos.Y, 0.5, vbBlack, 0, 0) 213 | 214 | vtxBuf.Lock 6 * Len(vert(0)), 24 * Len(vert(0)), ptr, 0& 215 | memcpy ByVal ptr, vert(6), 24 * Len(vert(0)) 216 | vtxBuf.Unlock 217 | 218 | End Sub 219 | 220 | Private Sub CreateBackgroundSprite() 221 | Dim ptr As Long 222 | 223 | ' // Create background sprite 224 | vert(0) = vtx2D(0, 0, 0.1, vbWhite, 0, 0) 225 | vert(1) = vtx2D(ScaleWidth, 0, 0.1, vbWhite, 1, 0) 226 | vert(2) = vtx2D(ScaleWidth, ScaleHeight, 0.1, vbWhite, 1, 1) 227 | vert(3) = vtx2D(0, 0, 0.1, vbWhite, 0, 0) 228 | vert(4) = vtx2D(ScaleWidth, ScaleHeight, 0.1, vbWhite, 1, 1) 229 | vert(5) = vtx2D(0, ScaleHeight, 0.1, vbWhite, 0, 1) 230 | 231 | vtxBuf.Lock 0, 6 * Len(vert(0)), ptr, 0& 232 | memcpy ByVal ptr, vert(0), 6 * Len(vert(0)) 233 | vtxBuf.Unlock 234 | 235 | End Sub 236 | 237 | Private Function Initialize() As Boolean 238 | 239 | On Error GoTo error_handler 240 | 241 | ' // Create IDirect3D9 object 242 | Set d3d9 = Direct3DCreate9() 243 | 244 | Dim pP As D3DPRESENT_PARAMETERS 245 | ' // Set vertex format 246 | vFlag = D3DFVF_XYZRHW Or D3DFVF_DIFFUSE Or D3DFVF_TEX1 247 | 248 | pP.BackBufferCount = 1 249 | pP.Windowed = 1 250 | pP.BackBufferFormat = D3DFMT_A8R8G8B8 251 | pP.SwapEffect = D3DSWAPEFFECT_DISCARD 252 | pP.EnableAutoDepthStencil = 1 253 | pP.AutoDepthStencilFormat = D3DFMT_D16 254 | 255 | ' // Create device 256 | Set d3dev = d3d9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hwnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, pP) 257 | 258 | ' // Set format 259 | d3dev.SetFVF vFlag 260 | d3dev.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 261 | 262 | d3dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR 263 | d3dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_ONE 264 | d3dev.SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD 265 | 266 | Initialize = True 267 | 268 | error_handler: 269 | 270 | End Function 271 | 272 | ' // Load texture from file 273 | Private Function LoadTextureFromFile(FileName As String) As IDirect3DTexture9 274 | Dim tex As StdPicture 275 | Dim bi As BITMAPINFO 276 | Dim RECT As D3DLOCKED_RECT 277 | 278 | Set tex = LoadPicture(FileName) 279 | 280 | bi.bmiHeader.biSize = Len(bi.bmiHeader) 281 | GetDIBits Me.hDC, tex.Handle, 0, 0, ByVal 0&, bi, 0 282 | ' // Fix values 283 | bi.bmiHeader.biBitCount = 32 284 | bi.bmiHeader.biCompression = 0 285 | If bi.bmiHeader.biHeight > 0 Then bi.bmiHeader.biHeight = -bi.bmiHeader.biHeight 286 | ' // Create texture 287 | d3dev.CreateTexture bi.bmiHeader.biWidth, -bi.bmiHeader.biHeight, 1, D3DUSAGE_DYNAMIC, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, LoadTextureFromFile 288 | ' // Lock texture 289 | LoadTextureFromFile.LockRect 0, RECT, ByVal 0, 0 290 | ' // Get picture data to texture directly 291 | GetDIBits Me.hDC, tex.Handle, 0, -bi.bmiHeader.biHeight, ByVal RECT.pBits, bi, 0 292 | ' // Update 293 | LoadTextureFromFile.UnlockRect 0 294 | ' // Free 295 | Set tex = Nothing 296 | End Function 297 | 298 | ' // Fast vector creation 299 | Private Function vtx2D(ByVal X As Single, _ 300 | ByVal Y As Single, _ 301 | ByVal rhw As Single, _ 302 | ByVal col As Long, _ 303 | ByVal tu As Single, _ 304 | ByVal tv As Single) As Vertex 305 | vtx2D.position.X = X: vtx2D.position.Y = Y: vtx2D.rhw = rhw 306 | vtx2D.color = col: vtx2D.tu = tu: vtx2D.tv = tv 307 | End Function 308 | 309 | Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 310 | Render 311 | End Sub 312 | 313 | Private Sub Form_Paint() 314 | Render 315 | End Sub 316 | 317 | Private Sub Form_Unload(Cancel As Integer) 318 | 319 | Set vtxBuf = Nothing 320 | Set texture = Nothing 321 | Set d3dev = Nothing 322 | Set d3d9 = Nothing 323 | 324 | End Sub 325 | 326 | -------------------------------------------------------------------------------- /Demos/LaserLines/space.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/LaserLines/space.jpg -------------------------------------------------------------------------------- /Demos/Raymarching/Raymarching.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.1#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.10 4 | Reference=*\G{29ED3EE8-D79A-422C-95B9-85C71335D443}#1.0#0#..\..\d3dxvb.tlb#D3DX for Visual Basic 6.0 type library by The trick v1.0 5 | Form=frmMain.frm 6 | Startup="frmMain" 7 | ExeName32="Raymarching.exe" 8 | Command32="" 9 | Name="Raymarching" 10 | HelpContextID="0" 11 | CompatibleMode="0" 12 | MajorVer=1 13 | MinorVer=0 14 | RevisionVer=0 15 | AutoIncrementVer=0 16 | ServerSupportFiles=0 17 | VersionCompanyName="Microsoft" 18 | CompilationType=0 19 | OptimizationType=0 20 | FavorPentiumPro(tm)=0 21 | CodeViewDebugInfo=0 22 | NoAliasing=0 23 | BoundsCheck=0 24 | OverflowCheck=0 25 | FlPointCheck=0 26 | FDIVCheck=0 27 | UnroundedFP=0 28 | StartMode=0 29 | Unattended=0 30 | Retained=0 31 | ThreadPerObject=0 32 | MaxNumberOfThreads=1 33 | -------------------------------------------------------------------------------- /Demos/Raymarching/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Raymarching using Direct3D9 shaders" 5 | ClientHeight = 8085 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 12705 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 8085 13 | ScaleWidth = 12705 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.Timer tmrFPS 16 | Interval = 1000 17 | Left = 4320 18 | Top = 3540 19 | End 20 | End 21 | Attribute VB_Name = "frmMain" 22 | Attribute VB_GlobalNameSpace = False 23 | Attribute VB_Creatable = False 24 | Attribute VB_PredeclaredId = True 25 | Attribute VB_Exposed = False 26 | Option Explicit 27 | 28 | #Const COMPILE_SHADERS = False ' // Set to true to compile HLSL to bin. Otherwise use precompiled code 29 | 30 | ' // Input of vertex shader 31 | Private Type tVertex 32 | fX As Single 33 | fY As Single 34 | fU As Single 35 | fV As Single 36 | End Type 37 | 38 | Private Declare Function D3DXGetVertexShaderProfile Lib "d3dx9_43" ( _ 39 | ByVal pDevice As IDirect3DDevice9) As Long 40 | Private Declare Function D3DXGetPixelShaderProfile Lib "d3dx9_43" ( _ 41 | ByVal pDevice As IDirect3DDevice9) As Long 42 | Private Declare Function D3DXCreateBuffer Lib "d3dx9_43" ( _ 43 | ByVal NumBytes As Long, _ 44 | ByRef ppBuffer As ID3DXBuffer) As Long 45 | Private Declare Function D3DXCompileShaderFromFile Lib "d3dx9_43" _ 46 | Alias "D3DXCompileShaderFromFileW" ( _ 47 | ByVal pSrcFile As Long, _ 48 | ByRef pDefines As Any, _ 49 | ByVal pInclude As ID3DXInclude, _ 50 | ByVal pFunctionName As String, _ 51 | ByVal pProfile As Long, _ 52 | ByVal Flags As Long, _ 53 | ByRef ppShader As ID3DXBuffer, _ 54 | ByRef ppErrorMsgs As ID3DXBuffer, _ 55 | ByRef ppConstantTable As ID3DXConstantTable) As Long 56 | Private Declare Function D3DXGetShaderConstantTable Lib "d3dx9_43" ( _ 57 | ByRef pFunction As Any, _ 58 | ByRef ppConstantTable As ID3DXConstantTable) As Long 59 | 60 | Private Declare Sub memcpy Lib "kernel32" _ 61 | Alias "RtlMoveMemory" ( _ 62 | ByRef Destination As Any, _ 63 | ByRef Source As Any, _ 64 | ByVal Length As Long) 65 | 66 | Private m_cD3D As IDirect3D9 67 | Private m_cDevice As IDirect3DDevice9 68 | Private m_cQuad As IDirect3DVertexBuffer9 69 | Private m_lTime1Reg As Long 70 | Private m_lFPS As Long 71 | Private m_bActive As Boolean 72 | 73 | Private Sub Form_Load() 74 | Dim tPP As D3DPRESENT_PARAMETERS 75 | Dim cErrMsg As ID3DXBuffer 76 | Dim cPSCode As ID3DXBuffer 77 | Dim cVSCode As ID3DXBuffer 78 | Dim cPSConstTbl As ID3DXConstantTable 79 | Dim cVShader As IDirect3DVertexShader9 80 | Dim cPShader As IDirect3DPixelShader9 81 | Dim cVtxDecl As IDirect3DVertexDeclaration9 82 | Dim tVertex(5) As tVertex 83 | Dim tVtxDecl(2) As D3DVERTEXELEMENT9 84 | Dim pData As Long 85 | Dim hConst As Long 86 | Dim fAspect As Single 87 | Dim hr As Long 88 | 89 | Set m_cD3D = Direct3DCreate9() 90 | 91 | tPP.BackBufferCount = 1 92 | tPP.Windowed = 1 93 | tPP.BackBufferFormat = D3DFMT_A8R8G8B8 94 | tPP.SwapEffect = D3DSWAPEFFECT_DISCARD 95 | tPP.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 96 | 97 | Set m_cDevice = m_cD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_HARDWARE_VERTEXPROCESSING, tPP) 98 | 99 | #If COMPILE_SHADERS Then 100 | 101 | ' // Compile vertex shader code 102 | hr = D3DXCompileShaderFromFile(StrPtr(App.Path & "\vs.txt"), ByVal 0&, Nothing, "vs_main", _ 103 | StrPtr(StrConv("vs_1_1", vbFromUnicode)), 0, cVSCode, cErrMsg, Nothing) 104 | If hr < 0 Then 105 | ShowCompError cErrMsg 106 | Exit Sub 107 | Else 108 | Set cErrMsg = Nothing 109 | End If 110 | 111 | SaveShaderToFile cVSCode, App.Path & "\vs.bin" 112 | 113 | ' // Compile pixel shader code 114 | hr = D3DXCompileShaderFromFile(StrPtr(App.Path & "\ps.txt"), ByVal 0&, Nothing, "ps_main", _ 115 | StrPtr(StrConv("ps_3_0", vbFromUnicode)), 0, cPSCode, cErrMsg, cPSConstTbl) 116 | If hr < 0 Then 117 | ShowCompError cErrMsg 118 | Exit Sub 119 | End If 120 | 121 | SaveShaderToFile cPSCode, App.Path & "\ps.bin" 122 | 123 | #Else 124 | 125 | Set cVSCode = LoadShaderFromFile(App.Path & "\vs.bin") 126 | Set cPSCode = LoadShaderFromFile(App.Path & "\ps.bin") 127 | 128 | hr = D3DXGetShaderConstantTable(ByVal cPSCode.GetBufferPointer, cPSConstTbl) 129 | 130 | If hr < 0 Then 131 | Err.Raise hr 132 | End If 133 | 134 | #End If 135 | 136 | m_lTime1Reg = GetShaderConstantRegister(cPSConstTbl, "TIME1") 137 | 138 | ' // Create shaders 139 | Set cVShader = m_cDevice.CreateVertexShader(ByVal cVSCode.GetBufferPointer) 140 | Set cPShader = m_cDevice.CreatePixelShader(ByVal cPSCode.GetBufferPointer) 141 | 142 | ' // Create vertex declaration 143 | tVtxDecl(0) = vtx_element(0, 0, D3DDECLTYPE_FLOAT2, D3DDECLMETHOD_DEFAULT, D3DDECLUSAGE_POSITION, 0) 144 | tVtxDecl(1) = vtx_element(0, 8, D3DDECLTYPE_FLOAT2, D3DDECLMETHOD_DEFAULT, D3DDECLUSAGE_TEXCOORD, 0) 145 | tVtxDecl(2) = D3DDECL_END 146 | 147 | Set cVtxDecl = m_cDevice.CreateVertexDeclaration(tVtxDecl(0)) 148 | 149 | m_cDevice.SetVertexDeclaration cVtxDecl 150 | 151 | ' // Create full-screen quad based on screen aspect ration 152 | fAspect = Me.ScaleHeight / Me.ScaleWidth 153 | 154 | tVertex(0) = vtx(-1, 1, -1, fAspect) 155 | tVertex(1) = vtx(1, -1, 1, -fAspect) 156 | tVertex(2) = vtx(1, 1, 1, fAspect) 157 | 158 | tVertex(3) = vtx(-1, 1, -1, fAspect) 159 | tVertex(4) = vtx(1, -1, 1, -fAspect) 160 | tVertex(5) = vtx(-1, -1, -1, -fAspect) 161 | 162 | ' // Create vertex buffer with quad data 163 | m_cDevice.CreateVertexBuffer Len(tVertex(0)) * (UBound(tVertex) + 1), 0, 0, 0, m_cQuad 164 | 165 | m_cQuad.Lock 0, Len(tVertex(0)) * (UBound(tVertex) + 1), pData, 0 166 | memcpy ByVal pData, tVertex(0), Len(tVertex(0)) * (UBound(tVertex) + 1) 167 | m_cQuad.Unlock 168 | 169 | m_cDevice.SetStreamSource 0, m_cQuad, 0, Len(tVertex(0)) 170 | 171 | ' // Disable culling 172 | m_cDevice.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 173 | 174 | ' // Set shaders to device 175 | m_cDevice.SetPixelShader cPShader 176 | m_cDevice.SetVertexShader cVShader 177 | 178 | Me.Show 179 | 180 | MainLoop 181 | 182 | End Sub 183 | 184 | Private Sub MainLoop() 185 | 186 | m_bActive = True 187 | 188 | Do While m_bActive 189 | 190 | m_cDevice.SetPixelShaderConstantF m_lTime1Reg, CSng(2 * Timer * 0.6), 1 191 | 192 | m_cDevice.BeginScene 193 | 194 | ' // Draw full-scree quad 195 | m_cDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, 2 196 | 197 | m_cDevice.EndScene 198 | 199 | m_cDevice.Present ByVal 0&, ByVal 0&, 0, ByVal 0& 200 | 201 | m_lFPS = m_lFPS + 1 202 | 203 | DoEvents 204 | 205 | Loop 206 | 207 | End Sub 208 | 209 | ' // Load binary shader from file 210 | Private Function LoadShaderFromFile( _ 211 | ByRef sFileName As String) As ID3DXBuffer 212 | Dim iFile As Integer 213 | Dim bData() As Byte 214 | Dim lSize As Long 215 | Dim cRet As ID3DXBuffer 216 | Dim hr As Long 217 | 218 | iFile = FreeFile 219 | 220 | Open sFileName For Binary As iFile 221 | 222 | lSize = LOF(iFile) 223 | 224 | If lSize <= 0 Then 225 | Err.Raise 5 226 | End If 227 | 228 | ReDim bData(lSize - 1) 229 | 230 | Get iFile, , bData 231 | 232 | Close iFile 233 | 234 | hr = D3DXCreateBuffer(lSize, cRet) 235 | 236 | If hr < 0 Then 237 | Err.Raise hr 238 | End If 239 | 240 | memcpy ByVal cRet.GetBufferPointer, bData(0), UBound(bData) + 1 241 | 242 | Set LoadShaderFromFile = cRet 243 | 244 | End Function 245 | 246 | ' // Save binary shader to file 247 | Private Sub SaveShaderToFile( _ 248 | ByVal cShader As ID3DXBuffer, _ 249 | ByRef sFileName As String) 250 | Dim iFile As Integer 251 | Dim bData() As Byte 252 | 253 | If Len(Dir(sFileName)) Then 254 | Kill sFileName 255 | End If 256 | 257 | iFile = FreeFile 258 | 259 | Open sFileName For Binary As iFile 260 | 261 | If cShader.GetBufferSize > 0 Then 262 | 263 | ReDim bData(cShader.GetBufferSize - 1) 264 | memcpy bData(0), ByVal cShader.GetBufferPointer, UBound(bData) + 1 265 | 266 | Put iFile, , bData 267 | 268 | End If 269 | 270 | Close iFile 271 | 272 | End Sub 273 | 274 | ' // Get register index of shader constant 275 | Private Function GetShaderConstantRegister( _ 276 | ByVal cTable As ID3DXConstantTable, _ 277 | ByVal sName As String) As Long 278 | Dim hConst As Long 279 | Dim tDesc As D3DXCONSTANT_DESC 280 | 281 | hConst = cTable.GetConstantByName(0, sName) 282 | If hConst = 0 Then 283 | Err.Raise 5 284 | End If 285 | 286 | cTable.GetConstantDesc hConst, tDesc, 1 287 | 288 | GetShaderConstantRegister = tDesc.RegisterIndex 289 | 290 | End Function 291 | 292 | Private Function D3DDECL_END() As D3DVERTEXELEMENT9 293 | D3DDECL_END = vtx_element(255, 0, D3DDECLTYPE_UNUSED, 0, 0, 0) 294 | End Function 295 | 296 | ' // Create D3DVERTEXELEMENT9 ittem 297 | Private Function vtx_element( _ 298 | ByVal lStream As Long, _ 299 | ByVal lOffset As Long, _ 300 | ByVal eType As D3DDECLTYPE, _ 301 | ByVal eMethod As D3DDECLMETHOD, _ 302 | ByVal eUsage As D3DDECLUSAGE, _ 303 | ByVal lUsageIndex As Long) As D3DVERTEXELEMENT9 304 | 305 | With vtx_element 306 | .Stream = lStream 307 | .Offset = lOffset 308 | .Type = eType 309 | .Method = eMethod 310 | .Usage = eUsage 311 | .UsageIndex = lUsageIndex 312 | End With 313 | 314 | End Function 315 | 316 | ' // Create vertex 317 | Private Function vtx( _ 318 | ByVal fX As Single, _ 319 | ByVal fY As Single, _ 320 | ByVal fU As Single, _ 321 | ByVal fV As Single) As tVertex 322 | vtx.fX = fX 323 | vtx.fY = fY 324 | vtx.fU = fU 325 | vtx.fV = fV 326 | End Function 327 | 328 | ' // Show error message storred to ID3DXBuffer buffer 329 | Private Sub ShowCompError( _ 330 | ByVal cErrMsg As ID3DXBuffer) 331 | Dim bAnsiInfo() As Byte 332 | Dim sMsgUnicode As String 333 | 334 | If cErrMsg.GetBufferSize > 0 Then 335 | 336 | ReDim bAnsiInfo(cErrMsg.GetBufferSize - 1) 337 | 338 | memcpy bAnsiInfo(0), ByVal cErrMsg.GetBufferPointer, UBound(bAnsiInfo) + 1 339 | 340 | sMsgUnicode = StrConv(bAnsiInfo, vbUnicode) 341 | 342 | MsgBox sMsgUnicode, vbCritical 343 | 344 | Else 345 | 346 | MsgBox "Unknown error", vbCritical 347 | 348 | End If 349 | 350 | End Sub 351 | 352 | Private Sub Form_QueryUnload( _ 353 | ByRef Cancel As Integer, _ 354 | ByRef UnloadMode As Integer) 355 | m_bActive = False 356 | End Sub 357 | 358 | Private Sub Form_Unload(Cancel As Integer) 359 | 360 | Set m_cQuad = Nothing 361 | Set m_cDevice = Nothing 362 | Set m_cD3D = Nothing 363 | 364 | End Sub 365 | 366 | Private Sub tmrFPS_Timer() 367 | 368 | Me.Caption = "FPS: " & m_lFPS 369 | m_lFPS = 0 370 | 371 | End Sub 372 | -------------------------------------------------------------------------------- /Demos/Raymarching/ps.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/Raymarching/ps.bin -------------------------------------------------------------------------------- /Demos/Raymarching/ps.txt: -------------------------------------------------------------------------------- 1 | /// RAYMARCHING reference: https://youtu.be/PGtv-dBi2wE 2 | 3 | // - Roberto Mior 4 | // - reexre 5 | 6 | #define MAX_STEPS 200 7 | #define MAX_DIST 1000.0 8 | #define EPS 0.01 9 | 10 | uniform float TIME1 = 0.0; // Variabliles passed from VB6 11 | //uniform float TIME2 = 0.0; 12 | //uniform float TIME3 = 0.0; 13 | 14 | struct VS_Output { 15 | float4 pos : POSITION; 16 | float2 uv : TEXCOORD; 17 | }; 18 | 19 | ///////////////////////////////////// 20 | //// RAYMARCHING 21 | ///////////////////////////////////// 22 | 23 | ///////////////////////////////////////// SDF FUNCTIONS 24 | float sdSphere( float3 p, float s ) 25 | { 26 | return length(p)-s; 27 | } 28 | float sdBox( float3 p, float3 b ) 29 | { 30 | float3 q = abs(p) - b; 31 | return length(max(q,0.0)) + min(max(q.x,max(q.y,q.z)),0.0); 32 | } 33 | float sdTorus( float3 p, float2 t ) 34 | { 35 | float2 q = float2(length(float2(p.x,p.z))-t.x,p.y); 36 | return length(q)-t.y; 37 | } 38 | ///////////////////////////////////////// 39 | 40 | 41 | 42 | ////////////////////////////////////////// Get DISTANCE of a point 43 | float SCENE(float3 p){ 44 | 45 | float SphereDist = sdSphere(p - float3(0.0, 1.0, 5.0) , 1.0 ) ; 46 | float PlaneDist = p.y ; 47 | float BoxDist = sdBox(p - float3(3.0, .2+.08, 5.0) , float3( 0.5 ,0.2,0.5)) - 0.08; 48 | float TorusDist = sdTorus(p.xzy - float3(-3.0, 5., 1.2) , float2( 1.0,0.2)) ; 49 | float d = min(SphereDist,PlaneDist); 50 | d = min(d,BoxDist); 51 | d = min(d,TorusDist); 52 | return d; 53 | } 54 | 55 | ///////////////////////////////////////// Marching Ray 56 | float RayMarch (float3 ro, float3 rd ) 57 | { 58 | float d0 = 0.0; 59 | for (int i=0; i < MAX_STEPS; i++) { 60 | float3 p = ro + rd * d0; 61 | float DS = SCENE(p); 62 | d0 += DS; 63 | if (d0 > MAX_DIST ) i=MAX_STEPS ; 64 | if (DS < EPS) i=MAX_STEPS ; 65 | } 66 | return d0; 67 | } 68 | 69 | //////////////////////////////////////// Compute SCENE Normal 70 | float3 CalcSceneNormal(float3 p) { 71 | 72 | float3 vn1 =float3( 1., -1., -1.); 73 | float3 vn2 =float3(-1., -1., 1.); 74 | float3 vn3 =float3(-1., 1., -1.); 75 | float3 vn4 =float3( 1., 1., 1.); 76 | 77 | float3 r1 = vn1 * SCENE(p + vn1 * (EPS)); 78 | float3 r2 = vn2 * SCENE(p + vn2 * (EPS)); 79 | float3 r3 = vn3 * SCENE(p + vn3 * (EPS)); 80 | float3 r4 = vn4 * SCENE(p + vn4 * (EPS)); 81 | 82 | return normalize(r1 + r2 + r3 + r4 ); 83 | } 84 | 85 | 86 | /////////////////////////////////////////// BASIC LIGHTING 87 | 88 | float3 lighting(float3 p) { 89 | 90 | // float3 LightPos = float3(0.-3 ,1+3. *cos(AAA) ,5.-3. ); 91 | 92 | float3 LightPos = float3(-3+cos(TIME1)*2 ,4 ,4+sin(TIME1)*2 ); 93 | 94 | float3 L = normalize(LightPos-p); 95 | float3 n = CalcSceneNormal(p); 96 | 97 | float dif = clamp(dot(L,n),0.,1.); 98 | 99 | // BASIC SHADOW 100 | float d = RayMarch(p+n*EPS*2,L); 101 | if (d ATTEMPTS_COUNT Then 21 | 22 | ' // Stop the thread until main thread code (PulseEvent) has been performed 23 | ' // That logic depends on application, in current case we force to perfom the main thread 24 | 25 | ResetEvent .hEvent 26 | WaitForSingleObject .hEvent, INFINITE 27 | 28 | ' // Reset counter 29 | .lFailCounter = 0 30 | 31 | End If 32 | 33 | Sleep 0 34 | 35 | Loop Until .bEndFlag 36 | 37 | End With 38 | 39 | End Function 40 | 41 | ' // Render 42 | Public Sub RenderPass() 43 | Dim bIsInIDE As Boolean 44 | Dim bLocked As Boolean 45 | 46 | On Error GoTo error_handler 47 | 48 | Debug.Assert MakeTrue(bIsInIDE) 49 | 50 | ' // Capture resource 51 | If Not bIsInIDE Then Lock_Resources: bLocked = True 52 | 53 | ' // We can access to any fields of shared resources because only current thread has access to shared data 54 | With gtSharedResources 55 | 56 | .cDevice.Clear 0, ByVal 0&, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, vbRed, 1, 0 57 | 58 | .cDevice.BeginScene 59 | 60 | If Not .cVertexBuffer Is Nothing And .lVertexCount > 0 Then 61 | 62 | .cDevice.SetStreamSource 0, .cVertexBuffer, 0, 24 ' // sizeof(vertex) 63 | .cDevice.DrawPrimitive D3DPT_TRIANGLELIST, 0, .lVertexCount \ 3 64 | 65 | End If 66 | 67 | .cDevice.EndScene 68 | 69 | .cDevice.Present ByVal 0&, ByVal 0&, 0, ByVal 0& 70 | 71 | ' // Calculate Rendering FPS 72 | TickFPS .tRenderFPS 73 | 74 | End With 75 | 76 | error_handler: 77 | 78 | ' // Release resource ALWAYS otherwise main thread will never get access 79 | If bLocked Then Unlock_Resources 80 | 81 | End Sub 82 | 83 | ' // The "Load" of main thread. It calculates mesh and passes it to shared resource 84 | Public Sub CalcPass() 85 | Dim tVtx() As tVertexFormat 86 | Dim tPoints() As D3DVECTOR 87 | Dim bIsInIDE As Boolean 88 | Dim fX As Single 89 | Dim fY As Single 90 | Dim fZ As Single 91 | Dim lX As Long 92 | Dim lY As Long 93 | Dim lSize As Long 94 | Dim lBufferSize As Long 95 | Dim lPtIndex As Long 96 | Dim lVtxIndex As Long 97 | Dim bLocked As Boolean 98 | Dim pData As Long 99 | Dim fTheta As Single 100 | Static fPhase As Single 101 | 102 | On Error GoTo error_handler 103 | 104 | Debug.Assert MakeTrue(bIsInIDE) 105 | 106 | ' // Waves mesh 107 | 108 | lSize = 40 109 | 110 | ReDim tPoints(lSize * lSize - 1) 111 | ReDim tVtx(((lSize - 1) ^ 2) * 6 - 1) 112 | 113 | For lX = 0 To lSize - 1 114 | 115 | fX = (lX / lSize - 0.5) * 9 116 | 117 | For lY = 0 To lSize - 1 118 | 119 | fTheta = Sqr((lX / lSize - 0.5) ^ 2 + (lY / lSize - 0.5) ^ 2) 120 | fZ = Sin(fPhase + fTheta * 20) 121 | fY = (lY / lSize - 0.5) * 9 122 | tPoints(lPtIndex) = vec3(fX, fZ, fY) 123 | lPtIndex = lPtIndex + 1 124 | 125 | Next 126 | 127 | Next 128 | 129 | fPhase = fPhase + 0.01 130 | lPtIndex = lSize 131 | 132 | ' // Collect triangles by points 133 | ' // It's more optimal to make it through index buffer but for simplification it uses simple vertex buffer 134 | Do Until lPtIndex > UBound(tPoints) 135 | 136 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex - lSize + 1) 137 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 138 | 139 | lVtxIndex = lVtxIndex + 1 140 | 141 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex) 142 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 143 | lVtxIndex = lVtxIndex + 1 144 | 145 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex - lSize) 146 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 147 | lVtxIndex = lVtxIndex + 1 148 | 149 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex - lSize + 1) 150 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 151 | lVtxIndex = lVtxIndex + 1 152 | 153 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex + 1) 154 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 155 | lVtxIndex = lVtxIndex + 1 156 | 157 | tVtx(lVtxIndex).tPosition = tPoints(lPtIndex) 158 | tVtx(lVtxIndex).tNormal = vec3(0, 1, 0) 159 | lVtxIndex = lVtxIndex + 1 160 | 161 | lPtIndex = lPtIndex + 1 162 | 163 | If (lPtIndex + 1) Mod lSize = 0 Then 164 | lPtIndex = lPtIndex + 1 165 | End If 166 | 167 | Loop 168 | 169 | ' // Capture the shared vertex buffer to update vertices 170 | With gtSharedResources 171 | 172 | If Not bIsInIDE Then 173 | 174 | ' // In current implementation we try to capture the shared resource, if one is busy (the rendering thread already 175 | ' // captured the one) we increment the counter of the failed captures and end the procedure (for example, optionally 176 | ' // we can make physics or sounds calcualtion in a game or smth. like that) but don't block the main thread. 177 | ' // When the counter will have the threshold value we can block the main thread (for waiting) and wait until 178 | ' // the render thread release the resource. 179 | ' // We can just call Lock_Resources then the main thread will wait always until the resource has been released 180 | ' // in the render thread. In current case we can use the calculated data, for example, in physics calculation 181 | ' // since the data is more detailed in time. 182 | 183 | ' // Check counter of failed captures 184 | If .lFailCounter > ATTEMPTS_COUNT Then 185 | 186 | ' // Call the blocked function because the render thread anyway will be stoped and we'll get access as soon 187 | ' // as render thread call WaitForSingleObject (even maybe earlier) since the same condition is in the rendering 188 | ' // thread and it force to switch to the main thread. 189 | Call Lock_Resources 190 | bLocked = True 191 | 192 | ' // Release the rendering thread. The rendering thread ready now to reset the counter of failed captures. 193 | PulseEvent .hEvent 194 | 195 | Else 196 | 197 | ' // Try to capture resource, if failed then end the procedure (optionally make something other if need) 198 | bLocked = Lock_Resources_Unblock() 199 | 200 | If Not bLocked Then 201 | 202 | .lFailCounter = .lFailCounter + 1 203 | 204 | ' // We get out of here and all data is being lost. We can cache it in a real application (for example, 205 | ' // shadow calculation or physics). It isn't required in current example. 206 | Exit Sub 207 | 208 | End If 209 | 210 | End If 211 | 212 | End If 213 | 214 | ' // Atomic access 215 | lBufferSize = (UBound(tVtx) + 1) * Len(tVtx(0)) 216 | 217 | If .cVertexBuffer Is Nothing Then 218 | 219 | ' // Create in first time 220 | .cDevice.CreateVertexBuffer lBufferSize, D3DUSAGE_NONE, D3DFVF_XYZ Or D3DFVF_NORMAL, _ 221 | D3DPOOL_DEFAULT, .cVertexBuffer 222 | 223 | End If 224 | 225 | ' // Place data to vertex buffer 226 | .cVertexBuffer.Lock 0, lBufferSize, pData, D3DLOCK_DISCARD 227 | memcpy ByVal pData, tVtx(0), lBufferSize 228 | .cVertexBuffer.Unlock 229 | 230 | ' // Update vertex counter 231 | .lVertexCount = UBound(tVtx) + 1 232 | 233 | End With 234 | 235 | ' // Make rendering in IDE because all is preformed in the main thread 236 | If bIsInIDE Then 237 | RenderPass 238 | End If 239 | 240 | error_handler: 241 | 242 | ' // Release resource ALWAYS otherwise the rendering thread will never get access 243 | 244 | If bLocked Then 245 | Unlock_Resources 246 | End If 247 | 248 | End Sub 249 | 250 | ' // "Rough" FPS calclulation 251 | Public Sub TickFPS( _ 252 | ByRef tFPS As tFPS) 253 | 254 | With tFPS 255 | 256 | .lFPSCounter = .lFPSCounter + 1 257 | 258 | If Abs(Timer - .dPrevTime) >= 1 Then 259 | 260 | .dPrevTime = Timer 261 | .lFPS = .lFPSCounter 262 | .lFPSCounter = 0 263 | 264 | End If 265 | 266 | End With 267 | 268 | End Sub 269 | 270 | ' // DoEvents fast analog 271 | Public Sub FastDoEvents() 272 | Dim Msg(6) As Long 273 | 274 | Do While PeekMessage(Msg(0), 0, 0, 0, 1) 275 | TranslateMessage Msg(0): DispatchMessage Msg(0) 276 | Loop 277 | 278 | End Sub 279 | 280 | ' // Fast vector creation 281 | Public Function vec3( _ 282 | ByVal X As Single, _ 283 | ByVal Y As Single, _ 284 | ByVal z As Single) As D3DVECTOR 285 | vec3.X = X: vec3.Y = Y: vec3.z = z 286 | End Function 287 | 288 | Public Function MakeTrue( _ 289 | ByRef bValue As Boolean) As Boolean 290 | bValue = True 291 | MakeTrue = True 292 | End Function 293 | 294 | 295 | -------------------------------------------------------------------------------- /Demos/SharedResources/modSharedResources.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modSharedResources" 2 | ' // 3 | ' // Shared resources module 4 | ' // 5 | 6 | Option Explicit 7 | 8 | ' // Type for FPS calculation 9 | Public Type tFPS 10 | lFPS As Long 11 | lFPSCounter As Long 12 | dPrevTime As Double 13 | End Type 14 | 15 | ' // Vertex format 16 | Public Type tVertexFormat 17 | tPosition As D3DVECTOR 18 | tNormal As D3DVECTOR 19 | End Type 20 | 21 | ' // Shared resources that requires atomic access 22 | Public Type tSharedResources 23 | cDevice As IDirect3DDevice9 24 | cVertexBuffer As IDirect3DVertexBuffer9 25 | lVertexCount As Long 26 | tRenderFPS As tFPS 27 | tCalcFPS As tFPS 28 | lFailCounter As Long ' // Failed captures counter 29 | bEndFlag As Boolean ' // If True - end the rendering thread 30 | hEvent As Long ' // Event that allows stop rendering thread until the main thread get access 31 | End Type 32 | 33 | Public gtSharedResources As tSharedResources 34 | 35 | Dim mtCriticalSection As CRITICAL_SECTION ' // Critical section 36 | 37 | Public Sub Init() 38 | InitializeCriticalSection mtCriticalSection 39 | End Sub 40 | 41 | Public Sub Uninit() 42 | DeleteCriticalSection mtCriticalSection 43 | End Sub 44 | 45 | Public Function Lock_Resources() As Long 46 | EnterCriticalSection mtCriticalSection 47 | End Function 48 | 49 | Public Function Lock_Resources_Unblock() As Long 50 | Lock_Resources_Unblock = TryEnterCriticalSection(mtCriticalSection) 51 | End Function 52 | 53 | Public Function Unlock_Resources() As Long 54 | LeaveCriticalSection mtCriticalSection 55 | End Function 56 | -------------------------------------------------------------------------------- /Demos/SimpleScene/CCamera.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CCamera" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // Camera class 16 | ' // 17 | 18 | Option Explicit 19 | 20 | ' // Raised when a property has been changed 21 | Public Event Changed() 22 | 23 | Private mfDistance As Single ' // Distance from target 24 | Private mtTarget As D3DVECTOR ' // Target position 25 | Private mtOrientation As D3DQUATERNION ' // Orientation 26 | Private mfFOV As Single ' // Field of view 27 | Private mtViewMatrix As D3DMATRIX ' // View matrix 28 | 29 | Dim bUpdate As Boolean ' // If any property has been changed update view matrix 30 | 31 | ' // Field of view proerty 32 | Public Property Let FOV( _ 33 | ByVal fValue As Single) 34 | 35 | mfFOV = fValue 36 | RaiseEvent Changed 37 | 38 | End Property 39 | 40 | Public Property Get FOV() As Single 41 | FOV = mfFOV 42 | End Property 43 | 44 | ' // Camera position 45 | Public Property Let Position( _ 46 | ByRef tValue As D3DVECTOR) 47 | LookAt tValue, mtTarget, vec3(0, 1, 0) 48 | End Property 49 | 50 | Public Property Get Position() As D3DVECTOR 51 | Dim tMtx As D3DMATRIX 52 | 53 | ' // Get camera position from orientation, target and distance 54 | D3DXMatrixRotationQuaternion tMtx, mtOrientation 55 | 56 | Position = vec3(tMtx.m13, tMtx.m23, tMtx.m33) 57 | 58 | D3DXVec3Scale Position, Position, -mfDistance 59 | D3DXVec3Add Position, Position, mtTarget 60 | 61 | End Property 62 | 63 | ' // Camera target 64 | Public Property Let Target( _ 65 | ByRef tValue As D3DVECTOR) 66 | LookAt Position, tValue, vec3(0, 1, 0) 67 | End Property 68 | 69 | Public Property Get Target() As D3DVECTOR 70 | Target = mtTarget 71 | End Property 72 | 73 | ' // Get view matrix 74 | Public Property Get ViewMatrix() As D3DMATRIX 75 | 76 | If bUpdate Then 77 | Update 78 | End If 79 | 80 | ViewMatrix = mtViewMatrix 81 | 82 | End Property 83 | 84 | ' // Place camera by specified point 85 | Public Sub LookAt( _ 86 | ByRef tEye As D3DVECTOR, _ 87 | ByRef tTarget As D3DVECTOR, _ 88 | ByRef tUp As D3DVECTOR) 89 | Dim tMtx As D3DMATRIX 90 | Dim tDist As D3DVECTOR 91 | 92 | D3DXMatrixLookAtLH tMtx, tEye, tTarget, tUp 93 | D3DXQuaternionRotationMatrix mtOrientation, tMtx 94 | D3DXQuaternionNormalize mtOrientation, mtOrientation 95 | 96 | D3DXVec3Subtract tDist, tEye, tTarget 97 | 98 | mfDistance = D3DXVec3Length(tDist) 99 | mtTarget = tTarget 100 | 101 | bUpdate = True 102 | 103 | RaiseEvent Changed 104 | 105 | End Sub 106 | 107 | ' // Relative rotation 108 | Public Sub RotateRel( _ 109 | ByRef tVec As D3DVECTOR) 110 | Dim tQ As D3DQUATERNION 111 | 112 | If (tVec.Y <> 0!) Then 113 | 114 | D3DXQuaternionRotationAxis tQ, vec3(0, 1, 0), tVec.Y 115 | D3DXQuaternionMultiply mtOrientation, tQ, mtOrientation 116 | 117 | End If 118 | 119 | If (tVec.X <> 0!) Then 120 | 121 | D3DXQuaternionRotationAxis tQ, vec3(1, 0, 0), tVec.X 122 | D3DXQuaternionMultiply mtOrientation, mtOrientation, tQ 123 | 124 | End If 125 | 126 | D3DXQuaternionNormalize mtOrientation, mtOrientation 127 | 128 | bUpdate = True 129 | RaiseEvent Changed 130 | 131 | End Sub 132 | 133 | ' // Zoom 134 | Public Sub Zoom( _ 135 | ByVal fValue As Single) 136 | 137 | mfDistance = mfDistance + fValue 138 | 139 | bUpdate = True 140 | RaiseEvent Changed 141 | 142 | End Sub 143 | 144 | ' // Panning 145 | Public Sub Pan( _ 146 | ByVal fX As Single, _ 147 | ByVal fY As Single) 148 | Dim tDirX As D3DVECTOR 149 | Dim tDirY As D3DVECTOR 150 | Dim tMtx As D3DMATRIX 151 | 152 | D3DXMatrixRotationQuaternion tMtx, mtOrientation 153 | 154 | tDirX = vec3(tMtx.m11, tMtx.m21, tMtx.m31) 155 | tDirY = vec3(tMtx.m12, tMtx.m22, tMtx.m32) 156 | 157 | D3DXVec3Scale tDirX, tDirX, fX 158 | D3DXVec3Scale tDirY, tDirY, fY 159 | 160 | D3DXVec3Add mtTarget, mtTarget, tDirX 161 | D3DXVec3Add mtTarget, mtTarget, tDirY 162 | 163 | bUpdate = True 164 | RaiseEvent Changed 165 | 166 | End Sub 167 | 168 | ' // Update view matrix 169 | Private Sub Update() 170 | Dim tMtx As D3DMATRIX 171 | Dim tMtx2 As D3DMATRIX 172 | Dim tAxis(2) As D3DVECTOR 173 | Dim tDir As D3DVECTOR 174 | Dim tEye As D3DVECTOR 175 | 176 | D3DXMatrixRotationQuaternion mtViewMatrix, mtOrientation 177 | 178 | tAxis(0) = vec3(mtViewMatrix.m11, mtViewMatrix.m21, mtViewMatrix.m31) 179 | tAxis(1) = vec3(mtViewMatrix.m12, mtViewMatrix.m22, mtViewMatrix.m32) 180 | tAxis(2) = vec3(mtViewMatrix.m13, mtViewMatrix.m23, mtViewMatrix.m33) 181 | 182 | tDir = tAxis(2) 183 | 184 | D3DXVec3Scale tDir, tDir, -mfDistance 185 | D3DXVec3Add tEye, tDir, mtTarget 186 | 187 | mtViewMatrix.m41 = -D3DXVec3Dot(tAxis(0), tEye) 188 | mtViewMatrix.m42 = -D3DXVec3Dot(tAxis(1), tEye) 189 | mtViewMatrix.m43 = -D3DXVec3Dot(tAxis(2), tEye) 190 | 191 | bUpdate = False 192 | 193 | End Sub 194 | 195 | Private Sub Class_Initialize() 196 | 197 | LookAt vec3(0, 1, -1), vec3(0, 0, 0), vec3(0, 1, 0) 198 | mfFOV = PI / 180 * 60 199 | 200 | End Sub 201 | -------------------------------------------------------------------------------- /Demos/SimpleScene/CMaterial.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "CMaterial" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | ' // 15 | ' // Material class 16 | ' // 17 | 18 | Option Explicit 19 | 20 | Private mlDiffuseColor As Long 21 | Private mlSpecularColor As Long 22 | Private mlAmbientColor As Long 23 | Private mfSpecularPower As Single 24 | Private mtMaterial As D3DMATERIAL9 25 | 26 | Dim mbChanged As Boolean 27 | 28 | ' // Get material 29 | Public Property Get Material() As D3DMATERIAL9 30 | 31 | If mbChanged Then 32 | 33 | With mtMaterial.Diffuse 34 | 35 | .r = (mlDiffuseColor And &HFF) / &HFF 36 | .g = (mlDiffuseColor And &HFF00&) / &HFF00& 37 | .b = (mlDiffuseColor And &HFF0000) / &HFF0000 38 | .a = 1 39 | 40 | End With 41 | 42 | With mtMaterial.Ambient 43 | 44 | .r = (mlAmbientColor And &HFF) / &HFF 45 | .g = (mlAmbientColor And &HFF00&) / &HFF00& 46 | .b = (mlAmbientColor And &HFF0000) / &HFF0000 47 | .a = 1 48 | 49 | End With 50 | 51 | With mtMaterial.Specular 52 | 53 | .r = (mlSpecularColor And &HFF) / &HFF 54 | .g = (mlSpecularColor And &HFF00&) / &HFF00& 55 | .b = (mlSpecularColor And &HFF0000) / &HFF0000 56 | .a = 1 57 | 58 | End With 59 | 60 | mtMaterial.Power = mfSpecularPower 61 | 62 | End If 63 | 64 | Material = mtMaterial 65 | 66 | End Property 67 | 68 | Public Property Let DiffuseColor( _ 69 | ByVal lValue As Long) 70 | 71 | mlDiffuseColor = lValue 72 | mbChanged = True 73 | 74 | End Property 75 | Public Property Get DiffuseColor() As Long 76 | DiffuseColor = mlDiffuseColor 77 | End Property 78 | 79 | Public Property Let SpecularColor( _ 80 | ByVal lValue As Long) 81 | 82 | mlSpecularColor = lValue 83 | mbChanged = True 84 | 85 | End Property 86 | Public Property Get SpecularColor() As Long 87 | SpecularColor = mlSpecularColor 88 | End Property 89 | 90 | Public Property Let AmbientColor( _ 91 | ByVal lValue As Long) 92 | 93 | mlAmbientColor = lValue 94 | mbChanged = True 95 | 96 | End Property 97 | Public Property Get AmbientColor() As Long 98 | AmbientColor = mlAmbientColor 99 | End Property 100 | 101 | Public Property Let SpecularPower( _ 102 | ByVal fValue As Single) 103 | 104 | mfSpecularPower = fValue 105 | mbChanged = True 106 | 107 | End Property 108 | Public Property Get SpecularPower() As Single 109 | SpecularPower = mfSpecularPower 110 | End Property 111 | 112 | Private Sub Class_Initialize() 113 | 114 | mlDiffuseColor = vbWhite 115 | mlSpecularColor = vbWhite 116 | mlAmbientColor = &H303030 117 | mfSpecularPower = 30 118 | mbChanged = True 119 | 120 | End Sub 121 | -------------------------------------------------------------------------------- /Demos/SimpleScene/Scene.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/Scene.exe -------------------------------------------------------------------------------- /Demos/SimpleScene/SceneDemo.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.1#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.10 4 | Form=frmMain.frm 5 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 6 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 7 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 8 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 9 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 10 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 11 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 12 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 13 | Class=CScene; CScene.cls 14 | Class=CCamera; CCamera.cls 15 | Module=modMain; modMain.bas 16 | Class=CMesh; CMesh.cls 17 | Class=CMaterial; CMaterial.cls 18 | UserControl=ctlVector.ctl 19 | IconForm="frmMain" 20 | Startup="frmMain" 21 | HelpFile="" 22 | Title="SceneDemo" 23 | ExeName32="Scene.exe" 24 | Command32="" 25 | Name="SceneDemo" 26 | HelpContextID="0" 27 | CompatibleMode="0" 28 | MajorVer=1 29 | MinorVer=0 30 | RevisionVer=0 31 | AutoIncrementVer=0 32 | ServerSupportFiles=0 33 | VersionCompanyName="Microsoft" 34 | CompilationType=0 35 | OptimizationType=0 36 | FavorPentiumPro(tm)=0 37 | CodeViewDebugInfo=0 38 | NoAliasing=-1 39 | BoundsCheck=-1 40 | OverflowCheck=-1 41 | FlPointCheck=-1 42 | FDIVCheck=-1 43 | UnroundedFP=-1 44 | StartMode=0 45 | Unattended=0 46 | Retained=0 47 | ThreadPerObject=0 48 | MaxNumberOfThreads=1 49 | DebugStartupOption=0 50 | -------------------------------------------------------------------------------- /Demos/SimpleScene/ctlVector.ctl: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.UserControl ctlVector 3 | Appearance = 0 'Flat 4 | BackColor = &H00404040& 5 | ClientHeight = 1470 6 | ClientLeft = 0 7 | ClientTop = 0 8 | ClientWidth = 2745 9 | ScaleHeight = 1470 10 | ScaleWidth = 2745 11 | Begin VB.TextBox txtPos 12 | BackColor = &H00404040& 13 | ForeColor = &H00FFFFFF& 14 | Height = 375 15 | Index = 2 16 | Left = 300 17 | TabIndex = 3 18 | Text = "0" 19 | Top = 960 20 | Width = 2355 21 | End 22 | Begin VB.TextBox txtPos 23 | BackColor = &H00404040& 24 | ForeColor = &H00FFFFFF& 25 | Height = 375 26 | Index = 1 27 | Left = 300 28 | TabIndex = 2 29 | Text = "0" 30 | Top = 540 31 | Width = 2355 32 | End 33 | Begin VB.TextBox txtPos 34 | BackColor = &H00404040& 35 | ForeColor = &H00FFFFFF& 36 | Height = 375 37 | Index = 0 38 | Left = 300 39 | TabIndex = 1 40 | Text = "0" 41 | Top = 120 42 | Width = 2355 43 | End 44 | Begin VB.Label lblPos 45 | AutoSize = -1 'True 46 | BackStyle = 0 'Transparent 47 | Caption = "Z:" 48 | ForeColor = &H00FFFFFF& 49 | Height = 195 50 | Index = 2 51 | Left = 60 52 | TabIndex = 5 53 | Top = 1020 54 | Width = 150 55 | End 56 | Begin VB.Label lblPos 57 | AutoSize = -1 'True 58 | BackStyle = 0 'Transparent 59 | Caption = "Y:" 60 | ForeColor = &H00FFFFFF& 61 | Height = 195 62 | Index = 1 63 | Left = 60 64 | TabIndex = 4 65 | Top = 600 66 | Width = 150 67 | End 68 | Begin VB.Label lblPos 69 | AutoSize = -1 'True 70 | BackStyle = 0 'Transparent 71 | Caption = "X:" 72 | ForeColor = &H00FFFFFF& 73 | Height = 195 74 | Index = 0 75 | Left = 60 76 | TabIndex = 0 77 | Top = 180 78 | Width = 150 79 | End 80 | End 81 | Attribute VB_Name = "ctlVector" 82 | Attribute VB_GlobalNameSpace = False 83 | Attribute VB_Creatable = True 84 | Attribute VB_PredeclaredId = False 85 | Attribute VB_Exposed = False 86 | ' // 87 | ' // Control that represents vector in recatangular space 88 | ' // 89 | 90 | Option Explicit 91 | 92 | Private Declare Function VarR4FromStr Lib "oleaut32" ( _ 93 | ByVal lpstrValue As Long, _ 94 | ByVal lcid As Long, _ 95 | ByVal lFlags As Long, _ 96 | ByRef pF4 As Single) As Long 97 | Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long 98 | 99 | ' // Raised when user change any property in textbox 100 | Public Event Changed() 101 | 102 | ' // Internal copy 103 | Private mtVector As D3DVECTOR 104 | 105 | Public Property Get X() As Single 106 | X = mtVector.X 107 | End Property 108 | 109 | Public Property Let X( _ 110 | ByVal fValue As Single) 111 | 112 | mtVector.X = fValue 113 | txtPos(0).Text = Format$(fValue, "0.0000") 114 | 115 | End Property 116 | 117 | Public Property Get Y() As Single 118 | Y = mtVector.Y 119 | End Property 120 | 121 | Public Property Let Y( _ 122 | ByVal fValue As Single) 123 | 124 | mtVector.Y = fValue 125 | txtPos(1).Text = Format$(fValue, "0.0000") 126 | 127 | End Property 128 | 129 | Public Property Get Z() As Single 130 | Z = mtVector.Z 131 | End Property 132 | 133 | Public Property Let Z( _ 134 | ByVal fValue As Single) 135 | 136 | mtVector.Z = fValue 137 | txtPos(2).Text = Format$(fValue, "0.0000") 138 | 139 | End Property 140 | 141 | Private Sub txtPos_KeyDown( _ 142 | ByRef Index As Integer, _ 143 | ByRef KeyCode As Integer, _ 144 | ByRef Shift As Integer) 145 | 146 | If KeyCode = vbKeyReturn Then 147 | txtPos_Validate Index, False 148 | End If 149 | 150 | End Sub 151 | 152 | Private Sub txtPos_Validate( _ 153 | ByRef Index As Integer, _ 154 | ByRef Cancel As Boolean) 155 | Dim fOut As Single 156 | 157 | If VarR4FromStr(StrPtr(txtPos(Index).Text), GetUserDefaultLCID, 0, fOut) < 0 Then 158 | 159 | Select Case Index 160 | Case 0: txtPos(Index).Text = Format$(mtVector.X) 161 | Case 1: txtPos(Index).Text = Format$(mtVector.Y) 162 | Case 2: txtPos(Index).Text = Format$(mtVector.Z) 163 | End Select 164 | 165 | Else 166 | 167 | Select Case Index 168 | Case 0: mtVector.X = fOut 169 | Case 1: mtVector.Y = fOut 170 | Case 2: mtVector.Z = fOut 171 | End Select 172 | 173 | RaiseEvent Changed 174 | 175 | End If 176 | 177 | End Sub 178 | 179 | Private Sub UserControl_Initialize() 180 | X = 0: Y = 0: Z = 0 181 | End Sub 182 | 183 | Private Sub UserControl_Resize() 184 | Dim lIndex As Long 185 | 186 | For lIndex = 0 To 2 187 | txtPos(lIndex).Width = UserControl.ScaleWidth - txtPos(lIndex).Left 188 | Next 189 | 190 | End Sub 191 | -------------------------------------------------------------------------------- /Demos/SimpleScene/frmMain.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/frmMain.frx -------------------------------------------------------------------------------- /Demos/SimpleScene/icons/box.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/icons/box.jpg -------------------------------------------------------------------------------- /Demos/SimpleScene/icons/cone.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/icons/cone.jpg -------------------------------------------------------------------------------- /Demos/SimpleScene/icons/icon.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/icons/icon.bmp -------------------------------------------------------------------------------- /Demos/SimpleScene/icons/icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/icons/icon.ico -------------------------------------------------------------------------------- /Demos/SimpleScene/icons/sphere.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/SimpleScene/icons/sphere.jpg -------------------------------------------------------------------------------- /Demos/SimpleScene/modMain.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modMain" 2 | ' // 3 | ' // Common functions 4 | ' // 5 | 6 | Option Explicit 7 | 8 | ' // Fast 3D vector creation 9 | Public Function vec3( _ 10 | ByVal X As Single, _ 11 | ByVal Y As Single, _ 12 | ByVal Z As Single) As D3DVECTOR 13 | vec3.X = X: vec3.Y = Y: vec3.Z = Z 14 | End Function 15 | 16 | ' // Fast 2D vector creation 17 | Public Function vec2( _ 18 | ByVal X As Single, _ 19 | ByVal Y As Single) As D3DVECTOR2 20 | vec2.X = X: vec2.Y = Y 21 | End Function 22 | 23 | ' // Fast color creation 24 | Public Function color( _ 25 | ByVal r As Single, _ 26 | ByVal g As Single, _ 27 | ByVal b As Single, _ 28 | Optional ByVal a As Single = 1) As D3DCOLORVALUE 29 | 30 | color.r = r 31 | color.g = g 32 | color.b = b 33 | color.a = a 34 | 35 | End Function 36 | 37 | ' // Check if a ray intersects a triangle 38 | Public Function IsIntersected( _ 39 | ByRef tp1 As D3DVECTOR, _ 40 | ByRef tp2 As D3DVECTOR, _ 41 | ByRef tp3 As D3DVECTOR, _ 42 | ByRef trfrom As D3DVECTOR, _ 43 | ByRef trdir As D3DVECTOR) As Boolean 44 | Dim tEdge(1) As D3DVECTOR 45 | Dim tVec(2) As D3DVECTOR 46 | Dim fDet As Single 47 | Dim fU As Single 48 | Dim fV As Single 49 | 50 | D3DXVec3Subtract tEdge(0), tp2, tp1 51 | D3DXVec3Subtract tEdge(1), tp3, tp1 52 | D3DXVec3Cross tVec(0), trdir, tEdge(1) 53 | 54 | fDet = D3DXVec3Dot(tEdge(0), tVec(0)) 55 | 56 | If fDet < 0.00001! Then Exit Function 57 | 58 | D3DXVec3Subtract tVec(1), trfrom, tp1 59 | 60 | fU = D3DXVec3Dot(tVec(0), tVec(1)) 61 | 62 | If fU < 0 Or fU > fDet Then Exit Function 63 | 64 | D3DXVec3Cross tVec(2), tVec(1), tEdge(0) 65 | 66 | fV = D3DXVec3Dot(trdir, tVec(2)) 67 | 68 | If fV < 0 Or fV + fU > fDet Then Exit Function 69 | 70 | IsIntersected = True 71 | 72 | End Function 73 | 74 | ' // Euler angles from matrix 75 | Public Function MatrixToEuler( _ 76 | ByRef tMtx As D3DMATRIX) As D3DVECTOR 77 | Dim fCy As Single 78 | 79 | fCy = Sqr(tMtx.m33 * tMtx.m33 + tMtx.m31 * tMtx.m31) 80 | 81 | If fCy > 1.175494351E-38 * 10 Then 82 | 83 | MatrixToEuler.X = Atan2(-tMtx.m32, fCy) 84 | MatrixToEuler.Y = Atan2(tMtx.m31, tMtx.m33) 85 | MatrixToEuler.Z = Atan2(tMtx.m12, tMtx.m22) 86 | 87 | Else 88 | 89 | MatrixToEuler.X = Atan2(-tMtx.m32, fCy) 90 | MatrixToEuler.Y = 0 91 | MatrixToEuler.Z = Atan2(-tMtx.m21, tMtx.m11) 92 | 93 | End If 94 | 95 | End Function 96 | 97 | -------------------------------------------------------------------------------- /Demos/TextDraw/Font.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/Demos/TextDraw/Font.bmp -------------------------------------------------------------------------------- /Demos/TextDraw/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Draw text by The trick" 5 | ClientHeight = 5400 6 | ClientLeft = 45 7 | ClientTop = 375 8 | ClientWidth = 10530 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 5400 13 | ScaleWidth = 10530 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.PictureBox picDisp 16 | BackColor = &H00FFFFFF& 17 | Height = 4305 18 | Left = 135 19 | ScaleHeight = 283 20 | ScaleMode = 3 'Pixel 21 | ScaleWidth = 682 22 | TabIndex = 1 23 | Top = 105 24 | Width = 10290 25 | Begin VB.Timer tmrFrame 26 | Interval = 1000 27 | Left = 2880 28 | Top = 3705 29 | End 30 | End 31 | Begin VB.TextBox txtText 32 | Height = 855 33 | Left = 135 34 | MultiLine = -1 'True 35 | TabIndex = 0 36 | Top = 4440 37 | Width = 10335 38 | End 39 | End 40 | Attribute VB_Name = "frmMain" 41 | Attribute VB_GlobalNameSpace = False 42 | Attribute VB_Creatable = False 43 | Attribute VB_PredeclaredId = True 44 | Attribute VB_Exposed = False 45 | Option Explicit 46 | 47 | Private Type RGBQUAD 48 | rgbBlue As Byte 49 | rgbGreen As Byte 50 | rgbRed As Byte 51 | rgbReserved As Byte 52 | End Type 53 | Private Type BITMAPINFOHEADER 54 | biSize As Long 55 | biWidth As Long 56 | biHeight As Long 57 | biPlanes As Integer 58 | biBitCount As Integer 59 | biCompression As Long 60 | biSizeImage As Long 61 | biXPelsPerMeter As Long 62 | biYPelsPerMeter As Long 63 | biClrUsed As Long 64 | biClrImportant As Long 65 | End Type 66 | Private Type BITMAPINFO 67 | bmiHeader As BITMAPINFOHEADER 68 | bmiColors As RGBQUAD 69 | End Type 70 | 71 | Private Declare Function GetDIBits Lib "gdi32" ( _ 72 | ByVal aHDC As Long, _ 73 | ByVal hBitmap As Long, _ 74 | ByVal nStartScan As Long, _ 75 | ByVal nNumScans As Long, _ 76 | lpBits As Any, _ 77 | lpBI As BITMAPINFO, _ 78 | ByVal wUsage As Long) As Long 79 | 80 | Private Type Vertex 81 | position As D3DVECTOR 82 | tu As Single 83 | tv As Single 84 | End Type 85 | 86 | Dim vFlag As D3DFVF 87 | Dim d3d9 As IDirect3D9 88 | Dim d3dev As IDirect3DDevice9 89 | Dim vtxBuf As IDirect3DVertexBuffer9 90 | Dim texture As IDirect3DTexture9 91 | Dim IsStop As Boolean 92 | Dim FPS As Long 93 | Dim triCount As Long 94 | Dim maxLine As Single 95 | Dim ctLine As Long 96 | 97 | Private Sub Form_Load() 98 | ' // Create IDirect3D9 object 99 | Set d3d9 = Direct3DCreate9() 100 | 101 | Dim pP As D3DPRESENT_PARAMETERS 102 | ' // Set vertex format 103 | vFlag = D3DFVF_XYZ Or D3DFVF_TEX1 104 | 105 | pP.BackBufferCount = 1 106 | pP.Windowed = 1 107 | pP.BackBufferFormat = D3DFMT_A8R8G8B8 108 | pP.SwapEffect = D3DSWAPEFFECT_DISCARD 109 | pP.EnableAutoDepthStencil = 1 110 | pP.AutoDepthStencilFormat = D3DFMT_D16 111 | pP.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 112 | 113 | ' // Create device 114 | Set d3dev = d3d9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, picDisp.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, pP) 115 | ' // Set states 116 | d3dev.SetRenderState D3DRS_ZENABLE, D3DZB_TRUE 117 | d3dev.SetRenderState D3DRS_LIGHTING, 0 118 | d3dev.SetRenderState D3DRS_CULLMODE, D3DCULL_NONE 119 | ' // Alpha blending 120 | d3dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1 121 | d3dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA 122 | d3dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA 123 | d3dev.SetRenderState D3DRS_BLENDOP, D3DBLENDOP_ADD 124 | ' // Set format 125 | d3dev.SetFVF vFlag 126 | ' // Init matrices 127 | Dim Mtx As D3DMATRIX 128 | ' // Create view matrix 129 | D3DXMatrixLookAtLH Mtx, vec3(0, 0, -5), vec3(0, 0, 0), vec3(0, 1, 0) 130 | d3dev.SetTransform D3DTS_VIEW, Mtx 131 | ' // Create projection matrix 132 | D3DXMatrixPerspectiveFovLH Mtx, PI / 3, picDisp.ScaleWidth / picDisp.ScaleHeight, 0.1, 100 133 | d3dev.SetTransform D3DTS_PROJECTION, Mtx 134 | ' // Create texture 135 | Set texture = LoadTextureFromFile(App.Path & "\Font.bmp") 136 | d3dev.SetSamplerState 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR 137 | d3dev.SetSamplerState 0, D3DSAMP_MINFILTER, D3DTEXF_LINEAR 138 | ' // Apply texture 139 | d3dev.SetTexture 0, texture 140 | ' // Create text 141 | txtText.Text = "directx9 text" & vbNewLine & "demonstration" & vbNewLine & "visual basic6" & vbNewLine & "by the trick" & vbNewLine & " 2015" 142 | 143 | Me.Show 144 | 145 | Do 146 | 147 | ' // Create transformation for a text (center) 148 | D3DXMatrixTranslation Mtx, -maxLine / 2, ctLine / 2 - 1, 0 149 | 150 | d3dev.SetTransform D3DTS_WORLD, Mtx 151 | ' // Clear background 152 | d3dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, vbWhite, 1, 0 153 | 154 | d3dev.BeginScene 155 | 156 | d3dev.DrawPrimitive D3DPT_TRIANGLELIST, 0, triCount 157 | 158 | d3dev.EndScene 159 | 160 | d3dev.Present ByVal 0, ByVal 0, 0, ByVal 0 161 | 162 | FPS = FPS + 1 163 | 164 | DoEvents 165 | 166 | Loop Until IsStop 167 | 168 | ' // Free resources 169 | Set texture = Nothing 170 | Set vtxBuf = Nothing 171 | Set d3dev = Nothing 172 | Set d3d9 = Nothing 173 | 174 | Unload Me 175 | 176 | End Sub 177 | 178 | ' // Create quads from text 179 | Private Function CreateTextSurface(Text As String) As IDirect3DVertexBuffer9 180 | Dim tmpStr As String 181 | Dim dx As Single 182 | Dim dy As Single 183 | Dim fx As Single 184 | Dim fy As Single 185 | Dim index As Long 186 | Dim texIdx As Long 187 | Dim vtxIdx As Long 188 | Dim vert() As Vertex 189 | Dim curLine As Single 190 | 191 | ' // Because we have only upper case symbols on texture 192 | tmpStr = UCase(Text) 193 | maxLine = 0 194 | triCount = 0 195 | ctLine = 0 196 | 197 | If Len(tmpStr) = 0 Then Exit Function 198 | 199 | ReDim vert(6 * Len(tmpStr) - 1) 200 | 201 | ctLine = 1 202 | 203 | For index = 1 To Len(tmpStr) 204 | 205 | texIdx = Asc(Mid$(tmpStr, index, 1)) 206 | 207 | Select Case texIdx 208 | Case &HD 209 | ' // New line 210 | dy = dy - 1: dx = -1: texIdx = -1 211 | index = index + 1 212 | If curLine > maxLine Then maxLine = curLine 213 | curLine = -1 214 | ctLine = ctLine + 1 215 | Case &H30 To &H39 216 | ' // Digits 217 | texIdx = texIdx - 48 218 | Case &H41 To &H5A 219 | ' // Letters 220 | texIdx = texIdx - 55 221 | Case Else 222 | ' // Skip 223 | texIdx = -1 224 | End Select 225 | 226 | If texIdx >= 0 And texIdx < 36 Then 227 | ' // Get texture coordinates 228 | fx = (texIdx Mod 6) / 6 229 | fy = (texIdx \ 6) / 6 230 | ' // Create quad 231 | nPlan vec3(dx, dy, 0), vec3(dx + 1, dy, 0), vec3(dx + 1, dy + 1, 0), vec3(dx, dy + 1, 0), vtxIdx, vert(), fx, fy, fx + 1 / 6, fy + 1 / 6 232 | 233 | triCount = triCount + 2 234 | 235 | End If 236 | 237 | dx = dx + 1 238 | curLine = curLine + 1 239 | 240 | Next 241 | 242 | If curLine > maxLine Then maxLine = curLine 243 | 244 | ReDim Preserve vert(vtxIdx - 1) 245 | 246 | d3dev.CreateVertexBuffer Len(vert(0)) * (UBound(vert) + 1), D3DUSAGE_NONE, vFlag, D3DPOOL_DEFAULT, CreateTextSurface 247 | 248 | CreateTextSurface.Lock 0, 0, index, 0 249 | memcpy ByVal index, vert(0), LenB(vert(0)) * (UBound(vert) + 1) 250 | CreateTextSurface.Unlock 251 | 252 | End Function 253 | 254 | ' // Load texture from file 255 | Private Function LoadTextureFromFile(FileName As String) As IDirect3DTexture9 256 | Dim tex As StdPicture 257 | Dim bi As BITMAPINFO 258 | Dim RECT As D3DLOCKED_RECT 259 | 260 | Set tex = LoadPicture(FileName) 261 | 262 | bi.bmiHeader.biSize = Len(bi.bmiHeader) 263 | GetDIBits Me.hDC, tex.Handle, 0, 0, ByVal 0&, bi, 0 264 | ' // Fix values 265 | bi.bmiHeader.biBitCount = 32 266 | bi.bmiHeader.biCompression = 0 267 | If bi.bmiHeader.biHeight > 0 Then bi.bmiHeader.biHeight = -bi.bmiHeader.biHeight 268 | ' // Create texture 269 | d3dev.CreateTexture bi.bmiHeader.biWidth, -bi.bmiHeader.biHeight, 1, D3DUSAGE_DYNAMIC, D3DFMT_A8R8G8B8, D3DPOOL_DEFAULT, LoadTextureFromFile 270 | ' // Lock texture 271 | LoadTextureFromFile.LockRect 0, RECT, ByVal 0, 0 272 | ' // Get picture data to texture directly 273 | GetDIBits Me.hDC, tex.Handle, 0, -bi.bmiHeader.biHeight, ByVal RECT.pBits, bi, 0 274 | ' // Update 275 | LoadTextureFromFile.UnlockRect 0 276 | ' // Free 277 | Set tex = Nothing 278 | End Function 279 | 280 | ' // Add quad to buffer 281 | Private Sub nPlan(p1 As D3DVECTOR, _ 282 | p2 As D3DVECTOR, _ 283 | p3 As D3DVECTOR, _ 284 | p4 As D3DVECTOR, _ 285 | i As Long, _ 286 | ret() As Vertex, _ 287 | ByVal u1 As Single, _ 288 | ByVal v1 As Single, _ 289 | ByVal u2 As Single, _ 290 | ByVal v2 As Single) 291 | 292 | ret(i).position = p3: ret(i).tu = u2: ret(i).tv = v1: i = i + 1 293 | ret(i).position = p2: ret(i).tu = u2: ret(i).tv = v2: i = i + 1 294 | ret(i).position = p1: ret(i).tu = u1: ret(i).tv = v2: i = i + 1 295 | ret(i).position = p4: ret(i).tu = u1: ret(i).tv = v1: i = i + 1 296 | ret(i).position = p3: ret(i).tu = u2: ret(i).tv = v1: i = i + 1 297 | ret(i).position = p1: ret(i).tu = u1: ret(i).tv = v2: i = i + 1 298 | 299 | End Sub 300 | 301 | ' // Fast vector creation 302 | Private Function vec3(ByVal X As Single, ByVal Y As Single, ByVal z As Single) As D3DVECTOR 303 | vec3.X = X: vec3.Y = Y: vec3.z = z 304 | End Function 305 | 306 | Private Sub Form_Unload(Cancel As Integer) 307 | IsStop = True 308 | End Sub 309 | 310 | Private Sub tmrFrame_Timer() 311 | Caption = "Draw text demo by The trick. FPS:" & FPS 312 | FPS = 0 313 | End Sub 314 | 315 | Private Sub txtText_Change() 316 | 317 | ' // Create cube 318 | Set vtxBuf = CreateTextSurface(txtText) 319 | ' // Select vertex buffer 320 | If Not vtxBuf Is Nothing Then d3dev.SetStreamSource 0, vtxBuf, 0, 5 * 4 321 | 322 | End Sub 323 | -------------------------------------------------------------------------------- /Demos/TextDraw/prjDrawText.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmMain.frm 5 | Module=D3DX_COLOR; ..\..\Math\D3DX_COLOR.bas 6 | Module=D3DX_MATRICES; ..\..\Math\D3DX_MATRICES.bas 7 | Module=D3DX_MISC; ..\..\Math\D3DX_MISC.bas 8 | Module=D3DX_PLANE; ..\..\Math\D3DX_PLANE.bas 9 | Module=D3DX_QUATERNION; ..\..\Math\D3DX_QUATERNION.bas 10 | Module=D3DX_VECTOR2; ..\..\Math\D3DX_VECTOR2.bas 11 | Module=D3DX_VECTOR3; ..\..\Math\D3DX_VECTOR3.bas 12 | Module=D3DX_VECTOR4; ..\..\Math\D3DX_VECTOR4.bas 13 | IconForm="frmMain" 14 | Startup="frmMain" 15 | HelpFile="" 16 | Title="prjDrawText" 17 | ExeName32="prjDrawText.exe" 18 | Command32="" 19 | Name="prjDrawText" 20 | HelpContextID="0" 21 | CompatibleMode="0" 22 | MajorVer=1 23 | MinorVer=0 24 | RevisionVer=0 25 | AutoIncrementVer=0 26 | ServerSupportFiles=0 27 | VersionCompanyName="TrickSoft" 28 | CompilationType=0 29 | OptimizationType=0 30 | FavorPentiumPro(tm)=0 31 | CodeViewDebugInfo=0 32 | NoAliasing=-1 33 | BoundsCheck=-1 34 | OverflowCheck=-1 35 | FlPointCheck=-1 36 | FDIVCheck=-1 37 | UnroundedFP=-1 38 | StartMode=0 39 | Unattended=0 40 | Retained=0 41 | ThreadPerObject=0 42 | MaxNumberOfThreads=1 43 | -------------------------------------------------------------------------------- /Demos/TriangleRotation/frmMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form frmMain 3 | BorderStyle = 1 'Fixed Single 4 | Caption = "Triangle demo by The trick" 5 | ClientHeight = 5475 6 | ClientLeft = 105 7 | ClientTop = 435 8 | ClientWidth = 5745 9 | LinkTopic = "Form1" 10 | MaxButton = 0 'False 11 | MinButton = 0 'False 12 | ScaleHeight = 5475 13 | ScaleWidth = 5745 14 | StartUpPosition = 3 'Windows Default 15 | Begin VB.Timer tmrFrame 16 | Interval = 1000 17 | Left = 1680 18 | Top = 3165 19 | End 20 | End 21 | Attribute VB_Name = "frmMain" 22 | Attribute VB_GlobalNameSpace = False 23 | Attribute VB_Creatable = False 24 | Attribute VB_PredeclaredId = True 25 | Attribute VB_Exposed = False 26 | Option Explicit 27 | 28 | Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 29 | 30 | Private Type Vertex 31 | position As D3DVECTOR 32 | rhw As Single 33 | color As Long 34 | End Type 35 | 36 | Dim vFlag As D3DFVF 37 | Dim d3d9 As IDirect3D9 38 | Dim d3dev As IDirect3DDevice9 39 | Dim vtxBuf As IDirect3DVertexBuffer9 40 | Dim IsStop As Boolean 41 | Dim FPS As Long 42 | 43 | Private Sub Form_Load() 44 | 45 | Set d3d9 = Direct3DCreate9() 46 | 47 | Dim pp As D3DPRESENT_PARAMETERS 48 | ' // Set vertex format 49 | vFlag = D3DFVF_DIFFUSE Or D3DFVF_XYZRHW 50 | 51 | pp.BackBufferCount = 1 52 | pp.Windowed = 1 53 | pp.BackBufferFormat = D3DFMT_A8R8G8B8 54 | pp.SwapEffect = D3DSWAPEFFECT_DISCARD 55 | pp.PresentationInterval = D3DPRESENT_INTERVAL_IMMEDIATE 56 | 57 | ' // Create device 58 | Set d3dev = d3d9.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_HARDWARE_VERTEXPROCESSING, pp) 59 | ' // Create vertex buffer 60 | d3dev.CreateVertexBuffer 5 * 4 * 3, 0, vFlag, D3DPOOL_DEFAULT, vtxBuf 61 | 62 | Dim alpha As Single 63 | Dim vtx(2) As Vertex 64 | Dim ptr As Long 65 | Dim ca As Single 66 | Dim sa As Single 67 | 68 | ' // Main cycle 69 | 70 | Me.Show 71 | 72 | Do 73 | 74 | alpha = Timer 75 | 76 | ca = Cos(alpha): sa = Sin(alpha) 77 | 78 | vtx(0).position = vec3(0 * ca + 100 * sa + 200, -100 * ca + 0 * sa + 200, 0): vtx(0).color = vbCyan: vtx(0).rhw = 10 79 | vtx(1).position = vec3(100 * ca - 100 * sa + 200, 100 * ca + 100 * sa + 200, 0): vtx(1).color = vbGreen: vtx(1).rhw = 10 80 | vtx(2).position = vec3(-100 * ca - 100 * sa + 200, 100 * ca - 100 * sa + 200, 0): vtx(2).color = vbBlue: vtx(2).rhw = 10 81 | 82 | vtxBuf.Lock 0, Len(vtx(0)) * (UBound(vtx) + 1), ptr, 0 83 | memcpy ByVal ptr, vtx(0), Len(vtx(0)) * (UBound(vtx) + 1) 84 | vtxBuf.Unlock 85 | 86 | d3dev.SetStreamSource 0, vtxBuf, 0, (5) * 4 87 | d3dev.SetFVF vFlag 88 | d3dev.Clear 0, ByVal 0, D3DCLEAR_TARGET, vbRed, 1, 0 89 | 90 | d3dev.BeginScene 91 | 92 | d3dev.DrawPrimitive D3DPT_TRIANGLELIST, 0, 1 93 | 94 | d3dev.EndScene 95 | 96 | d3dev.Present ByVal 0, ByVal 0, 0, ByVal 0 97 | 98 | FPS = FPS + 1 99 | 100 | DoEvents 101 | 102 | Loop Until IsStop 103 | 104 | ' // Free resources 105 | Set vtxBuf = Nothing 106 | Set d3dev = Nothing 107 | Set d3d9 = Nothing 108 | 109 | Unload Me 110 | 111 | End Sub 112 | 113 | Private Function vec3(ByVal x As Single, ByVal y As Single, ByVal z As Single) As D3DVECTOR 114 | vec3.x = x: vec3.y = y: vec3.z = z 115 | End Function 116 | 117 | Private Sub Form_Unload(Cancel As Integer) 118 | IsStop = True 119 | End Sub 120 | 121 | Private Sub tmrFrame_Timer() 122 | Caption = "Triangle demo by The trick. FPS:" & FPS 123 | FPS = 0 124 | End Sub 125 | -------------------------------------------------------------------------------- /Demos/TriangleRotation/prjTriangleDemo.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Reference=*\G{93E767C8-1E6B-46CC-B452-3531146574ED}#1.0#0#..\..\dx9vb.tlb#DirectX 9 for Visual Basic 6.0 type library by The trick v1.00 4 | Form=frmMain.frm 5 | IconForm="frmMain" 6 | Startup="frmMain" 7 | HelpFile="" 8 | Title="prjTest1" 9 | ExeName32="prjTriangleDemo.exe" 10 | Command32="" 11 | Name="prjTriangleDemo" 12 | HelpContextID="0" 13 | CompatibleMode="0" 14 | MajorVer=1 15 | MinorVer=0 16 | RevisionVer=0 17 | AutoIncrementVer=0 18 | ServerSupportFiles=0 19 | VersionCompanyName="TrickSoft" 20 | CompilationType=0 21 | OptimizationType=0 22 | FavorPentiumPro(tm)=0 23 | CodeViewDebugInfo=0 24 | NoAliasing=-1 25 | BoundsCheck=-1 26 | OverflowCheck=-1 27 | FlPointCheck=-1 28 | FDIVCheck=-1 29 | UnroundedFP=-1 30 | StartMode=0 31 | Unattended=0 32 | Retained=0 33 | ThreadPerObject=0 34 | MaxNumberOfThreads=1 35 | 36 | [MS Transaction Server] 37 | AutoRefresh=1 38 | -------------------------------------------------------------------------------- /Math/D3DX_COLOR.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_COLOR" 2 | Option Explicit 3 | 4 | ' // Adds two color values together to create a new color value. 5 | Public Sub D3DXColorAdd(pOut As D3DCOLORVALUE, _ 6 | pC1 As D3DCOLORVALUE, _ 7 | pC2 As D3DCOLORVALUE) 8 | pOut.r = pC1.r + pC2.r 9 | pOut.g = pC1.g + pC2.g 10 | pOut.B = pC1.B + pC2.B 11 | pOut.a = pC1.a + pC2.a 12 | End Sub 13 | 14 | ' // Adjusts the contrast value of a color. 15 | Public Sub D3DXColorAdjustContrast(pOut As D3DCOLORVALUE, _ 16 | pC As D3DCOLORVALUE, _ 17 | ByVal c As Single) 18 | pOut.r = 0.5! + c * (pC.r - 0.5!) 19 | pOut.g = 0.5! + c * (pC.g - 0.5!) 20 | pOut.B = 0.5! + c * (pC.B - 0.5!) 21 | pOut.a = pC.a 22 | End Sub 23 | 24 | ' // Adjusts the saturation value of a color. 25 | Public Sub D3DXColorAdjustSaturation(pOut As D3DCOLORVALUE, _ 26 | pC As D3DCOLORVALUE, _ 27 | ByVal s As Single) 28 | Dim grey As Single 29 | 30 | grey = pC.r * 0.2125! + pC.g * 0.7154! + pC.B * 0.0721! 31 | pOut.r = grey + s * (pC.r - grey) 32 | pOut.g = grey + s * (pC.g - grey) 33 | pOut.B = grey + s * (pC.B - grey) 34 | pOut.a = grey + s * (pC.a - grey) 35 | End Sub 36 | 37 | ' // Uses linear interpolation to create a color value. 38 | Public Sub D3DXColorLerp(pOut As D3DCOLORVALUE, _ 39 | pC1 As D3DCOLORVALUE, _ 40 | pC2 As D3DCOLORVALUE, _ 41 | ByVal s As Single) 42 | pOut.r = pC1.r + s * (pC2.r - pC1.r) 43 | pOut.g = pC1.g + s * (pC2.g - pC1.g) 44 | pOut.B = pC1.B + s * (pC2.B - pC1.B) 45 | pOut.a = pC1.a + s * (pC2.a - pC1.a) 46 | End Sub 47 | 48 | ' // Blends two colors. 49 | Public Sub D3DXColorModulate(pOut As D3DCOLORVALUE, _ 50 | pC1 As D3DCOLORVALUE, _ 51 | pC2 As D3DCOLORVALUE) 52 | pOut.r = pC1.r * pC2.r 53 | pOut.g = pC1.g * pC2.g 54 | pOut.B = pC1.B * pC2.B 55 | pOut.a = pC1.a * pC2.a 56 | End Sub 57 | 58 | ' // Creates the negative color value of a color value. 59 | Public Sub D3DXColorNegative(pOut As D3DCOLORVALUE, _ 60 | pC As D3DCOLORVALUE) 61 | pOut.r = 1! - pC.r 62 | pOut.g = 1! - pC.g 63 | pOut.B = 1! - pC.B 64 | pOut.a = pC.a 65 | End Sub 66 | 67 | ' // Scales a color value. 68 | Public Sub D3DXColorScale(pOut As D3DCOLORVALUE, _ 69 | pC As D3DCOLORVALUE, ByVal s As Single) 70 | pOut.r = pC.r * s 71 | pOut.g = pC.g * s 72 | pOut.B = pC.B * s 73 | pOut.a = pC.a * s 74 | End Sub 75 | 76 | ' // Subtracts two color values to create a new color value. 77 | Public Sub D3DXColorSubtract(pOut As D3DCOLORVALUE, _ 78 | pC1 As D3DCOLORVALUE, _ 79 | pC2 As D3DCOLORVALUE) 80 | pOut.r = pC1.r - pC2.r 81 | pOut.g = pC1.g - pC2.g 82 | pOut.B = pC1.B - pC2.B 83 | pOut.a = pC1.a - pC2.a 84 | End Sub 85 | 86 | 87 | -------------------------------------------------------------------------------- /Math/D3DX_MISC.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_MISC" 2 | Option Explicit 3 | 4 | Public Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 5 | Public Declare Sub GetMem4 Lib "MSVBVM60" (Src As Any, Dst As Any) 6 | 7 | Public Const PI As Single = 3.14159265358979 8 | 9 | ' // Determines whether a value is an illegal number. 10 | Public Function sngIsNaN(ByVal Value As Single) As Boolean 11 | Dim dat As Long 12 | 13 | GetMem4 Value, dat 14 | sngIsNaN = (dat And &H7F800000) = &H7F800000 And (dat And &H7FFFFF) > 0 15 | 16 | End Function 17 | 18 | ' // Determines whether a value is an infinite. 19 | Public Function sngIsInf(ByVal Value As Single) As Boolean 20 | Dim dat As Long 21 | 22 | GetMem4 Value, dat 23 | sngIsInf = (dat And &H7F800000) = &H7F800000 And (dat And &H7FFFFF) = 0 24 | 25 | End Function 26 | 27 | ' // Converts an array of 16-bit floats to 32-bit floats. 28 | Public Sub D3DXFloat16To32Array(pOut() As Single, _ 29 | pIn() As Integer, _ 30 | ByVal n As Long) 31 | Dim s As Long 32 | Dim e As Long 33 | Dim m As Long 34 | Dim sn As Long 35 | Dim v As Integer 36 | Dim i As Long 37 | 38 | For i = 0 To n - 1 39 | 40 | v = pIn(i): s = v And &H8000&: e = (v And &H7C00&) \ 1024: m = v And &H3FF 41 | sn = IIf(s, -1, 1) 42 | 43 | If e = 0 Then 44 | If m = 0 Then 45 | pOut(i) = 0! 46 | Else 47 | pOut(i) = sn * 6.103516E-05! * (m / 1024!) 48 | End If 49 | Else 50 | pOut(i) = sn * (2 ^ (e - 15)) * (1! + m / 1024!) 51 | End If 52 | Next 53 | 54 | End Sub 55 | 56 | ' // Converts an array of 32-bit floats to 16-bit floats. 57 | Public Sub D3DXFloat32To16Array(pOut() As Integer, _ 58 | pIn() As Single, _ 59 | ByVal n As Long) 60 | Dim exp_ As Long 61 | Dim origexp As Long 62 | Dim tmp As Single 63 | Dim mantissa As Long 64 | Dim sign As Long 65 | Dim ret As Integer 66 | Dim i As Long 67 | Dim v As Single 68 | 69 | For i = 0 To n - 1 70 | 71 | v = pIn(i) 72 | tmp = Abs(v): sign = IIf(v >= 0, 0, 1) 73 | If sngIsInf(v) Or sngIsNaN(v) Then 74 | pOut(i) = IIf(sign, &HFFFF, &H7FFF) 75 | ElseIf v = 0! Then 76 | pOut(i) = IIf(sign, &H8000, &H0) 77 | Else 78 | If tmp < 1024! Then 79 | Do 80 | tmp = tmp * 2! 81 | exp_ = exp_ - 1 82 | Loop While tmp < 1024! 83 | ElseIf tmp >= 2048 Then 84 | Do 85 | tmp = tmp / 2 86 | exp_ = exp_ + 1 87 | Loop While tmp >= 2048! 88 | End If 89 | 90 | exp_ = exp_ + 10 + 15 91 | origexp = exp_ 92 | 93 | If (tmp = 2018.5! Or tmp = 2016.5! Or tmp = 2014.5! Or tmp = 2012.5! Or _ 94 | tmp = 1954.5! Or tmp = 1952.5! Or tmp = 1950.5! Or tmp = 1948.5!) Then 95 | mantissa = tmp 96 | ElseIf (tmp = 2019.5! Or tmp = 2017.5! Or tmp = 2015.5! Or tmp = 2013.5! Or _ 97 | tmp = 1955.5! Or tmp = 1953.5! Or tmp = 1951.5! Or tmp = 1949.5!) Then 98 | mantissa = tmp + 1 99 | Else 100 | mantissa = tmp 101 | If tmp - mantissa >= 0.5! Then mantissa = mantissa + 1 102 | End If 103 | If mantissa = 2048 Then 104 | mantissa = 1024 105 | exp_ = exp_ + 1 106 | End If 107 | 108 | If exp_ > 31 Then 109 | ret = &H7FFF 110 | ElseIf exp_ <= 0 Then 111 | Dim rounding As Long 112 | 113 | exp_ = origexp 114 | mantissa = tmp 115 | mantissa = mantissa And &H3FF Or &H400 116 | 117 | Do While exp_ <= 0 118 | rounding = mantissa And 1 119 | mantissa = mantissa \ 2 120 | exp_ = exp_ + 1 121 | Loop 122 | 123 | ret = mantissa + rounding 124 | 125 | Else 126 | ret = (exp_ * 1024) Or (mantissa And &H3FF) 127 | End If 128 | 129 | If sign Then 130 | ret = ret Or &H8000 131 | End If 132 | 133 | pOut(i) = ret 134 | End If 135 | 136 | Next 137 | 138 | End Sub 139 | 140 | ' // Calculate the Fresnel term. 141 | Public Function D3DXFresnelTerm(ByVal CosTheta As Single, _ 142 | ByVal RefractionIndex As Single) As Single 143 | Dim a As Single 144 | Dim d As Single 145 | Dim g As Single 146 | Dim ret As Single 147 | 148 | If CosTheta < 1.175494E-38! Then D3DXFresnelTerm = 1! 149 | 150 | g = Sqr(Abs(RefractionIndex * RefractionIndex + CosTheta * CosTheta - 1!)) 151 | a = g + CosTheta 152 | d = g - CosTheta 153 | ret = (CosTheta * a - 1!) * (CosTheta * a - 1!) / ((CosTheta * d + 1!) * (CosTheta * d + 1!)) + 1! 154 | D3DXFresnelTerm = ret * 0.5! * d * d / (a * a) 155 | 156 | End Function 157 | 158 | ' // Returns the angle whose tangent is the ratio of the two numbers 159 | Public Function Atan2(ByVal Y As Double, ByVal X As Double) As Double 160 | If Y > 0 Then 161 | If X >= Y Then 162 | Atan2 = Atn(Y / X) 163 | ElseIf X <= -Y Then 164 | Atan2 = Atn(Y / X) + PI 165 | Else 166 | Atan2 = PI / 2 - Atn(X / Y) 167 | End If 168 | Else 169 | If X >= -Y Then 170 | Atan2 = Atn(Y / X) 171 | ElseIf X <= Y Then 172 | Atan2 = Atn(Y / X) - PI 173 | Else 174 | Atan2 = -Atn(X / Y) - PI / 2 175 | End If 176 | End If 177 | End Function 178 | 179 | -------------------------------------------------------------------------------- /Math/D3DX_PLANE.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_PLANE" 2 | Option Explicit 3 | 4 | ' // Normalizes the plane coefficients so that the plane normal has unit length. 5 | Public Sub D3DXPlaneNormalize(pOut As D3DPLANE, _ 6 | pP As D3DPLANE) 7 | Dim norm As Single 8 | 9 | norm = Sqr(pP.a * pP.a + pP.b * pP.b + pP.c * pP.c) 10 | 11 | If norm = 0! Then 12 | 13 | pOut.a = 0! 14 | pOut.b = 0! 15 | pOut.c = 0! 16 | pOut.d = 0! 17 | 18 | Else 19 | 20 | pOut.a = pP.a / norm 21 | pOut.b = pP.b / norm 22 | pOut.c = pP.c / norm 23 | pOut.d = pP.d / norm 24 | 25 | End If 26 | 27 | End Sub 28 | 29 | ' // Computes the dot product of a plane and a 4D vector. 30 | Public Function D3DXPlaneDot(pP As D3DPLANE, _ 31 | pV As D3DVECTOR4) As Single 32 | 33 | D3DXPlaneDot = pP.a * pV.X + pP.b * pV.Y + pP.c * pV.z + pP.d * pV.w 34 | 35 | End Function 36 | 37 | ' // Computes the dot product of a plane and a 3D vector. The w parameter of the vector is assumed to be 1. 38 | Public Function D3DXPlaneDotCoord(pP As D3DPLANE, _ 39 | pV As D3DVECTOR) As Single 40 | 41 | D3DXPlaneDotCoord = pP.a * pV.X + pP.b * pV.Y + pP.c * pV.z + pP.d 42 | 43 | End Function 44 | 45 | ' // Computes the dot product of a plane and a 3D vector. The w parameter of the vector is assumed to be 0. 46 | Public Function D3DXPlaneDotNormal(pP As D3DPLANE, _ 47 | pV As D3DVECTOR) As Single 48 | 49 | D3DXPlaneDotNormal = pP.a * pV.X + pP.b * pV.Y + pP.c * pV.z 50 | 51 | End Function 52 | 53 | ' // Constructs a plane from a point and a normal. 54 | Public Sub D3DXPlaneFromPointNormal(pOut As D3DPLANE, _ 55 | pPoint As D3DVECTOR, _ 56 | pNormal As D3DVECTOR) 57 | 58 | pOut.a = pNormal.X 59 | pOut.b = pNormal.Y 60 | pOut.c = pNormal.z 61 | pOut.d = -D3DXVec3Dot(pPoint, pNormal) 62 | 63 | End Sub 64 | 65 | ' // Constructs a plane from three points. 66 | Public Sub D3DXPlaneFromPoints(pOut As D3DPLANE, _ 67 | pV1 As D3DVECTOR, _ 68 | pV2 As D3DVECTOR, _ 69 | pV3 As D3DVECTOR) 70 | Dim edge1 As D3DVECTOR 71 | Dim edge2 As D3DVECTOR 72 | Dim normal As D3DVECTOR 73 | Dim Nnormal As D3DVECTOR 74 | 75 | D3DXVec3Subtract edge1, pV2, pV1 76 | D3DXVec3Subtract edge2, pV3, pV1 77 | D3DXVec3Cross normal, edge1, edge2 78 | D3DXVec3Normalize Nnormal, normal 79 | D3DXPlaneFromPointNormal pOut, pV1, Nnormal 80 | 81 | End Sub 82 | 83 | ' // Finds the intersection between a plane and a line. 84 | Public Function D3DXPlaneIntersectLine(pOut As D3DVECTOR, _ 85 | pP As D3DPLANE, _ 86 | pV1 As D3DVECTOR, _ 87 | pV2 As D3DVECTOR) As Boolean 88 | Dim direction As D3DVECTOR 89 | Dim normal As D3DVECTOR 90 | Dim dot As Single 91 | Dim temp As Single 92 | 93 | normal.X = pP.a 94 | normal.Y = pP.b 95 | normal.z = pP.c 96 | 97 | direction.X = pV2.X - pV1.X 98 | direction.Y = pV2.Y - pV1.Y 99 | direction.z = pV2.z - pV1.z 100 | 101 | dot = D3DXVec3Dot(normal, direction) 102 | 103 | If dot = 0 Then Exit Function 104 | 105 | temp = (pP.d + D3DXVec3Dot(normal, pV1)) / dot 106 | 107 | pOut.X = pV1.X - temp * direction.X 108 | pOut.Y = pV1.Y - temp * direction.Y 109 | pOut.z = pV1.z - temp * direction.z 110 | 111 | D3DXPlaneIntersectLine = True 112 | 113 | End Function 114 | 115 | ' // Scale the plane with the given scaling factor. 116 | Public Sub D3DXPlaneScale(pOut As D3DPLANE, _ 117 | pP As D3DPLANE, _ 118 | ByVal s As Single) 119 | 120 | pOut.a = pP.a * s 121 | pOut.b = pP.b * s 122 | pOut.c = pP.c * s 123 | pOut.d = pP.d * s 124 | 125 | End Sub 126 | 127 | ' // Transforms a plane by a matrix. The input matrix is the inverse transpose of the actual transformation. 128 | Public Sub D3DXPlaneTransform(pOut As D3DPLANE, _ 129 | pP As D3DPLANE, _ 130 | pM As D3DMATRIX) 131 | Dim plane As D3DPLANE 132 | 133 | plane = pP 134 | 135 | pOut.a = pM.m11 * plane.a + pM.m21 * plane.b + pM.m31 * plane.c + pM.m41 * plane.d 136 | pOut.b = pM.m12 * plane.a + pM.m22 * plane.b + pM.m32 * plane.c + pM.m42 * plane.d 137 | pOut.c = pM.m13 * plane.a + pM.m23 * plane.b + pM.m33 * plane.c + pM.m43 * plane.d 138 | pOut.d = pM.m14 * plane.a + pM.m24 * plane.b + pM.m34 * plane.c + pM.m44 * plane.d 139 | 140 | End Sub 141 | 142 | -------------------------------------------------------------------------------- /Math/D3DX_QUATERNION.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_QUATERNION" 2 | Option Explicit 3 | 4 | ' // Returns a quaternion in barycentric coordinates. 5 | Public Sub D3DXQuaternionBaryCentric(pOut As D3DQUATERNION, _ 6 | pQ1 As D3DQUATERNION, _ 7 | pQ2 As D3DQUATERNION, _ 8 | pQ3 As D3DQUATERNION, _ 9 | ByVal f As Single, _ 10 | ByVal g As Single) 11 | Dim temp1 As D3DQUATERNION 12 | Dim temp2 As D3DQUATERNION 13 | 14 | D3DXQuaternionSlerp temp1, pQ1, pQ2, f + g 15 | D3DXQuaternionSlerp temp2, pQ1, pQ3, f + g 16 | 17 | D3DXQuaternionSlerp pOut, temp1, temp2, g / (f + g) 18 | 19 | End Sub 20 | 21 | ' // Calculates the exponential. 22 | Public Sub D3DXQuaternionExp(pOut As D3DQUATERNION, _ 23 | pQ As D3DQUATERNION) 24 | Dim norm As Single 25 | 26 | norm = Sqr(pQ.X * pQ.X + pQ.Y * pQ.Y + pQ.z * pQ.z) 27 | 28 | If (norm <> 0) Then 29 | 30 | pOut.X = Sin(norm) * pQ.X / norm 31 | pOut.Y = Sin(norm) * pQ.Y / norm 32 | pOut.z = Sin(norm) * pQ.z / norm 33 | pOut.w = Cos(norm) 34 | 35 | Else 36 | 37 | pOut.X = 0! 38 | pOut.Y = 0! 39 | pOut.z = 0! 40 | pOut.w = 1! 41 | 42 | End If 43 | 44 | End Sub 45 | 46 | ' // Conjugates and renormalizes a quaternion. 47 | Public Sub D3DXQuaternionInverse(pOut As D3DQUATERNION, _ 48 | pQ As D3DQUATERNION) 49 | Dim norm As Single 50 | 51 | norm = D3DXQuaternionLengthSq(pQ) 52 | 53 | pOut.X = -pQ.X / norm 54 | pOut.Y = -pQ.Y / norm 55 | pOut.z = -pQ.z / norm 56 | pOut.w = pQ.w / norm 57 | 58 | End Sub 59 | 60 | ' // Returns the dot product of two quaternions. 61 | Public Function D3DXQuaternionDot(pQ1 As D3DQUATERNION, _ 62 | pQ2 As D3DQUATERNION) As Single 63 | 64 | D3DXQuaternionDot = pQ1.X * pQ2.X + pQ1.Y * pQ2.Y + pQ1.z * pQ2.z + pQ1.w * pQ2.w 65 | 66 | End Function 67 | 68 | ' // Determines if a quaternion is an identity quaternion. 69 | Public Function D3DXQuaternionIsIdentity(pQ As D3DQUATERNION) As Single 70 | 71 | D3DXQuaternionIsIdentity = pQ.X = 0 And pQ.Y = 0 And pQ.z = 0 And pQ.w = 1! 72 | 73 | End Function 74 | 75 | ' // Returns the length of a quaternion. 76 | Public Function D3DXQuaternionLength(pQ As D3DQUATERNION) As Single 77 | 78 | D3DXQuaternionLength = Sqr(pQ.X * pQ.X + pQ.Y * pQ.Y + pQ.z * pQ.z + pQ.w * pQ.w) 79 | 80 | End Function 81 | 82 | ' // Returns the square of the length of a quaternion. 83 | Public Function D3DXQuaternionLengthSq(pQ As D3DQUATERNION) As Single 84 | 85 | D3DXQuaternionLengthSq = pQ.X * pQ.X + pQ.Y * pQ.Y + pQ.z * pQ.z + pQ.w * pQ.w 86 | 87 | End Function 88 | 89 | ' // Calculates the natural logarithm. 90 | Public Sub D3DXQuaternionLn(pOut As D3DQUATERNION, _ 91 | pQ As D3DQUATERNION) 92 | Dim v3 As Single 93 | Dim v8 As Single 94 | Dim v5 As Boolean 95 | Dim v7 As Single 96 | 97 | If pQ.w < 1! Then 98 | v3 = acos(pQ.w) 99 | v8 = Sin(v3) 100 | 101 | v5 = Not (v8 >= -0.00000011920929 And v8 <= 0.00000011920929) 102 | End If 103 | 104 | If Not v5 Then 105 | pOut.X = pQ.X 106 | pOut.Y = pQ.Y 107 | pOut.z = pQ.z 108 | Else 109 | v7 = v3 / v8 110 | pOut.X = v7 * pQ.X 111 | pOut.Y = v7 * pQ.Y 112 | pOut.z = v7 * pQ.z 113 | End If 114 | 115 | pOut.w = 0 116 | 117 | End Sub 118 | 119 | ' // Multiplies two quaternions. 120 | Public Sub D3DXQuaternionMultiply(pOut As D3DQUATERNION, _ 121 | pQ1 As D3DQUATERNION, _ 122 | pQ2 As D3DQUATERNION) 123 | 124 | Dim out As D3DQUATERNION 125 | 126 | out.X = pQ2.w * pQ1.X + pQ2.X * pQ1.w + pQ2.Y * pQ1.z - pQ2.z * pQ1.Y 127 | out.Y = pQ2.w * pQ1.Y - pQ2.X * pQ1.z + pQ2.Y * pQ1.w + pQ2.z * pQ1.X 128 | out.z = pQ2.w * pQ1.z + pQ2.X * pQ1.Y - pQ2.Y * pQ1.X + pQ2.z * pQ1.w 129 | out.w = pQ2.w * pQ1.w - pQ2.X * pQ1.X - pQ2.Y * pQ1.Y - pQ2.z * pQ1.z 130 | 131 | pOut = out 132 | 133 | End Sub 134 | 135 | ' // Computes a unit length quaternion. 136 | Public Sub D3DXQuaternionNormalize(pOut As D3DQUATERNION, _ 137 | pQ As D3DQUATERNION) 138 | 139 | Dim norm As Single 140 | 141 | norm = D3DXQuaternionLength(pQ) 142 | 143 | pOut.X = pQ.X / norm 144 | pOut.Y = pQ.Y / norm 145 | pOut.z = pQ.z / norm 146 | pOut.w = pQ.w / norm 147 | 148 | End Sub 149 | 150 | ' // Rotates a quaternion about an arbitrary axis. 151 | Public Sub D3DXQuaternionRotationAxis(pOut As D3DQUATERNION, _ 152 | pV As D3DVECTOR, _ 153 | ByVal angle As Single) 154 | Dim temp As D3DVECTOR 155 | 156 | D3DXVec3Normalize temp, pV 157 | 158 | pOut.X = Sin(angle / 2!) * temp.X 159 | pOut.Y = Sin(angle / 2!) * temp.Y 160 | pOut.z = Sin(angle / 2!) * temp.z 161 | pOut.w = Cos(angle / 2!) 162 | 163 | End Sub 164 | 165 | ' // Builds a quaternion from a rotation matrix. 166 | Public Sub D3DXQuaternionRotationMatrix(pOut As D3DQUATERNION, _ 167 | pM As D3DMATRIX) 168 | Dim i As Long 169 | Dim maxi As Long 170 | Dim maxdiag As Single 171 | Dim s As Single 172 | Dim trace As Single 173 | Dim sqrt As Single 174 | 175 | trace = pM.m11 + pM.m22 + pM.m33 + 1! 176 | 177 | If trace > 1! Then 178 | sqrt = Sqr(trace) 179 | pOut.X = (pM.m23 - pM.m32) / (2! * sqrt) 180 | pOut.Y = (pM.m31 - pM.m13) / (2! * sqrt) 181 | pOut.z = (pM.m12 - pM.m21) / (2! * sqrt) 182 | pOut.w = sqrt / 2 183 | Exit Sub 184 | End If 185 | 186 | maxi = 0: maxdiag = pM.m11 187 | 188 | If pM.m22 > maxdiag Then 189 | maxi = 1 190 | maxdiag = pM.m22 191 | End If 192 | 193 | If pM.m33 > maxdiag Then 194 | maxi = 2 195 | maxdiag = pM.m33 196 | End If 197 | 198 | Select Case maxi 199 | Case 0 200 | s = 2! * Sqr(1! + pM.m11 - pM.m22 - pM.m33) 201 | pOut.X = 0.25! * s 202 | pOut.Y = (pM.m12 + pM.m21) / s 203 | pOut.z = (pM.m13 + pM.m31) / s 204 | pOut.w = (pM.m23 + pM.m32) / s 205 | Case 1 206 | s = 2! * Sqr(1! + pM.m22 - pM.m11 - pM.m33) 207 | pOut.X = (pM.m12 + pM.m21) / s 208 | pOut.Y = 0.25! * s 209 | pOut.z = (pM.m23 + pM.m32) / s 210 | pOut.w = (pM.m31 + pM.m13) / s 211 | Case 2 212 | s = 2! * Sqr(1! + pM.m33 - pM.m11 - pM.m22) 213 | pOut.X = (pM.m13 + pM.m31) / s 214 | pOut.Y = (pM.m23 + pM.m32) / s 215 | pOut.z = 0.25! * s 216 | pOut.w = (pM.m12 + pM.m21) / s 217 | End Select 218 | 219 | End Sub 220 | 221 | ' // Builds a quaternion with the given yaw, pitch, and roll. 222 | Public Sub D3DXQuaternionRotationYawPitchRoll(pOut As D3DQUATERNION, _ 223 | ByVal yaw As Single, _ 224 | ByVal pitch As Single, _ 225 | ByVal roll As Single) 226 | 227 | pOut.X = Sin(yaw / 2!) * Cos(pitch / 2!) * Sin(roll / 2!) + Cos(yaw / 2!) * Sin(pitch / 2!) * Cos(roll / 2!) 228 | pOut.Y = Sin(yaw / 2!) * Cos(pitch / 2!) * Cos(roll / 2!) - Cos(yaw / 2!) * Sin(pitch / 2!) * Sin(roll / 2!) 229 | pOut.z = Cos(yaw / 2!) * Cos(pitch / 2!) * Sin(roll / 2!) - Sin(yaw / 2!) * Sin(pitch / 2!) * Cos(roll / 2!) 230 | pOut.w = Cos(yaw / 2!) * Cos(pitch / 2!) * Cos(roll / 2!) + Sin(yaw / 2!) * Sin(pitch / 2!) * Sin(roll / 2!) 231 | 232 | End Sub 233 | 234 | ' // Interpolates between two quaternions, using spherical linear interpolation. 235 | Public Sub D3DXQuaternionSlerp(pOut As D3DQUATERNION, _ 236 | pQ1 As D3DQUATERNION, _ 237 | pQ2 As D3DQUATERNION, _ 238 | ByVal t As Single) 239 | Dim dot As Single 240 | Dim epsilon As Single 241 | Dim temp As Single 242 | Dim theta As Single 243 | Dim u As Single 244 | 245 | epsilon = 1! 246 | temp = 1! - t 247 | u = t 248 | 249 | dot = D3DXQuaternionDot(pQ1, pQ2) 250 | 251 | If (dot < 0!) Then 252 | 253 | epsilon = -1! 254 | dot = -dot 255 | 256 | End If 257 | 258 | If 1! - dot > 0.001! Then 259 | 260 | theta = acos(dot) 261 | temp = Sin(theta * temp) / Sin(theta) 262 | u = Sin(theta * u) / Sin(theta) 263 | 264 | End If 265 | 266 | pOut.X = temp * pQ1.X + epsilon * u * pQ2.X 267 | pOut.Y = temp * pQ1.Y + epsilon * u * pQ2.Y 268 | pOut.z = temp * pQ1.z + epsilon * u * pQ2.z 269 | pOut.w = temp * pQ1.w + epsilon * u * pQ2.w 270 | 271 | End Sub 272 | 273 | ' // Interpolates between quaternions, using spherical quadrangle interpolation. 274 | Public Sub D3DXQuaternionSquad(pOut As D3DQUATERNION, _ 275 | pQ1 As D3DQUATERNION, _ 276 | pA As D3DQUATERNION, _ 277 | pB As D3DQUATERNION, _ 278 | pC As D3DQUATERNION, _ 279 | ByVal t As Single) 280 | 281 | Dim temp1 As D3DQUATERNION 282 | Dim temp2 As D3DQUATERNION 283 | 284 | D3DXQuaternionSlerp temp1, pQ1, pC, t 285 | D3DXQuaternionSlerp temp2, pA, pB, t 286 | 287 | D3DXQuaternionSlerp pOut, temp1, temp2, 2! * t * (1! - t) 288 | 289 | End Sub 290 | 291 | ' // Sets up control points for spherical quadrangle interpolation. 292 | Public Sub D3DXQuaternionSquadSetup(pAOut As D3DQUATERNION, _ 293 | pBOut As D3DQUATERNION, _ 294 | pCOut As D3DQUATERNION, _ 295 | pQ0 As D3DQUATERNION, _ 296 | pQ1 As D3DQUATERNION, _ 297 | pQ2 As D3DQUATERNION, _ 298 | pQ3 As D3DQUATERNION) 299 | Dim q As D3DQUATERNION 300 | Dim temp1 As D3DQUATERNION 301 | Dim temp2 As D3DQUATERNION 302 | Dim temp3 As D3DQUATERNION 303 | Dim zero As D3DQUATERNION 304 | 305 | If (D3DXQuaternionDot(pQ0, pQ1) < 0!) Then 306 | 307 | temp2.X = -pQ0.X 308 | temp2.Y = -pQ0.Y 309 | temp2.z = -pQ0.z 310 | temp2.w = -pQ0.w 311 | 312 | Else: temp2 = pQ0 313 | End If 314 | 315 | If (D3DXQuaternionDot(pQ1, pQ2) < 0!) Then 316 | 317 | pCOut.X = -pQ2.X 318 | pCOut.Y = -pQ2.Y 319 | pCOut.z = -pQ2.z 320 | pCOut.w = -pQ2.w 321 | 322 | Else: pCOut = pQ2 323 | End If 324 | 325 | If (D3DXQuaternionDot(pCOut, pQ3) < 0!) Then 326 | 327 | temp3.X = -pQ3.X 328 | temp3.Y = -pQ3.Y 329 | temp3.z = -pQ3.z 330 | temp3.w = -pQ3.w 331 | 332 | Else: temp3 = pQ3 333 | End If 334 | 335 | D3DXQuaternionInverse temp1, pQ1 336 | D3DXQuaternionMultiply temp2, temp1, temp2 337 | D3DXQuaternionLn temp2, temp2 338 | D3DXQuaternionMultiply q, temp1, pCOut 339 | D3DXQuaternionLn q, q 340 | 341 | temp1.X = temp2.X + q.X 342 | temp1.Y = temp2.Y + q.Y 343 | temp1.z = temp2.z + q.z 344 | temp1.w = temp2.w + q.w 345 | 346 | temp1.X = temp1.X * -0.25! 347 | temp1.Y = temp1.Y * -0.25! 348 | temp1.z = temp1.z * -0.25! 349 | temp1.w = temp1.w * -0.25! 350 | 351 | D3DXQuaternionExp temp1, temp1 352 | D3DXQuaternionMultiply pAOut, pQ1, temp1 353 | D3DXQuaternionInverse temp1, pCOut 354 | D3DXQuaternionMultiply temp2, temp1, pQ1 355 | D3DXQuaternionLn temp2, temp2 356 | D3DXQuaternionMultiply q, temp1, temp3 357 | D3DXQuaternionLn q, q 358 | 359 | temp1.X = temp2.X + q.X 360 | temp1.Y = temp2.Y + q.Y 361 | temp1.z = temp2.z + q.z 362 | temp1.w = temp2.w + q.w 363 | 364 | temp1.X = temp1.X * -0.25! 365 | temp1.Y = temp1.Y * -0.25! 366 | temp1.z = temp1.z * -0.25! 367 | temp1.w = temp1.w * -0.25! 368 | 369 | D3DXQuaternionExp temp1, temp1 370 | D3DXQuaternionMultiply pBOut, pCOut, temp1 371 | 372 | End Sub 373 | 374 | ' // Computes a quaternion's axis and angle of rotation. 375 | Public Sub D3DXQuaternionToAxisAngle(pQ As D3DQUATERNION, _ 376 | pAxis As D3DVECTOR, _ 377 | pAngle As Single) 378 | Dim fNorm As Single 379 | 380 | fNorm = D3DXQuaternionLength(pQ) 381 | 382 | pAngle = 0 383 | 384 | If fNorm <> 0! Then 385 | 386 | pAxis.X = pQ.X / fNorm 387 | pAxis.Y = pQ.Y / fNorm 388 | pAxis.z = pQ.z / fNorm 389 | 390 | If Abs(pQ.w <= 1!) Then 391 | pAngle = 2! * acos(pQ.w) 392 | End If 393 | 394 | Else 395 | 396 | pAxis.X = 1! 397 | pAxis.Y = 0! 398 | pAxis.z = 0! 399 | 400 | End If 401 | 402 | End Sub 403 | 404 | Private Function acos(ByVal Value As Single) As Single 405 | 406 | If Value = -1! Then acos = PI: Exit Function 407 | If Value = 1! Then acos = 0: Exit Function 408 | acos = Atn(-Value / Sqr(-Value * Value + 1)) + 2 * Atn(1) 409 | 410 | End Function 411 | -------------------------------------------------------------------------------- /Math/D3DX_VECTOR2.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_VECTOR2" 2 | Option Explicit 3 | 4 | ' // Adds two 2D vectors. 5 | Public Sub D3DXVec2Add(pOut As D3DVECTOR2, _ 6 | pV1 As D3DVECTOR2, _ 7 | pV2 As D3DVECTOR2) 8 | 9 | pOut.X = pV1.X + pV2.X 10 | pOut.Y = pV1.Y + pV2.Y 11 | 12 | End Sub 13 | 14 | ' // Returns a point in Barycentric coordinates, using the specified 2D vectors. 15 | Public Sub D3DXVec2BaryCentric(pOut As D3DVECTOR2, _ 16 | pV1 As D3DVECTOR2, _ 17 | pV2 As D3DVECTOR2, _ 18 | pV3 As D3DVECTOR2, _ 19 | ByVal f As Single, _ 20 | ByVal g As Single) 21 | Dim tmp As Single 22 | 23 | tmp = (1! - f - g) 24 | 25 | pOut.X = tmp * (pV1.X) + f * (pV2.X) + g * (pV3.X) 26 | pOut.Y = tmp * (pV1.Y) + f * (pV2.Y) + g * (pV3.Y) 27 | 28 | End Sub 29 | 30 | ' // Returns the z-component by taking the cross product of two 2D vectors. 31 | Public Function D3DXVec2CCW(pV1 As D3DVECTOR2, _ 32 | pV2 As D3DVECTOR2) As Single 33 | 34 | D3DXVec2CCW = pV1.X * pV2.Y - pV1.Y * pV2.X 35 | 36 | End Function 37 | 38 | ' // Determines the dot product of two 2D vectors. 39 | Public Function D3DXVecDot(pV1 As D3DVECTOR2, _ 40 | pV2 As D3DVECTOR2) As Single 41 | 42 | D3DXVecDot = pV1.X * pV2.X + pV1.Y * pV2.Y 43 | 44 | End Function 45 | 46 | ' // Performs a Catmull-Rom interpolation, using the specified 2D vectors. 47 | Public Sub D3DXVec2CatmullRom(pOut As D3DVECTOR2, _ 48 | pV0 As D3DVECTOR2, _ 49 | pV1 As D3DVECTOR2, _ 50 | pV2 As D3DVECTOR2, _ 51 | pV3 As D3DVECTOR2, _ 52 | ByVal s As Single) 53 | 54 | pOut.X = 0.5! * (2! * pV1.X + (pV2.X - pV0.X) * s + _ 55 | (2! * pV0.X - 5! * pV1.X + 4! * pV2.X - pV3.X) * s * s + _ 56 | (pV3.X - 3! * pV2.X + 3! * pV1.X - pV0.X) * s * s * s) 57 | pOut.Y = 0.5! * (2! * pV1.Y + (pV2.Y - pV0.Y) * s + _ 58 | (2! * pV0.Y - 5! * pV1.Y + 4! * pV2.Y - pV3.Y) * s * s + _ 59 | (pV3.Y - 3! * pV2.Y + 3! * pV1.Y - pV0.Y) * s * s * s) 60 | 61 | End Sub 62 | 63 | ' // Performs a Hermite spline interpolation, using the specified 2D vectors. 64 | Public Sub D3DXVec2Hermite(pOut As D3DVECTOR2, _ 65 | pV1 As D3DVECTOR2, _ 66 | pT1 As D3DVECTOR2, _ 67 | pV2 As D3DVECTOR2, _ 68 | pT2 As D3DVECTOR2, _ 69 | ByVal s As Single) 70 | 71 | Dim h1 As Single 72 | Dim h2 As Single 73 | Dim h3 As Single 74 | Dim h4 As Single 75 | 76 | h1 = 2! * s * s * s - 3! * s * s + 1! 77 | h2 = s * s * s - 2! * s * s + s 78 | h3 = -2! * s * s * s + 3! * s * s 79 | h4 = s * s * s - s * s 80 | 81 | pOut.X = h1 * pV1.X + h2 * pT1.X + h3 * pV2.X + h4 * pT2.X 82 | pOut.Y = h1 * pV1.Y + h2 * pT1.Y + h3 * pV2.Y + h4 * pT2.Y 83 | 84 | End Sub 85 | 86 | ' // Returns the length of a 2D vector. 87 | Public Function D3DXVec2Length(pV As D3DVECTOR2) As Single 88 | 89 | D3DXVec2Length = Sqr(pV.X * pV.X + pV.Y * pV.Y) 90 | 91 | End Function 92 | 93 | ' // Returns the square of the length of a 2D vector. 94 | Public Function D3DXVec2LengthSq(pV As D3DVECTOR2) As Single 95 | 96 | D3DXVec2LengthSq = pV.X * pV.X + pV.Y + pV.Y 97 | 98 | End Function 99 | 100 | ' // Performs a linear interpolation between two 2D vectors. 101 | Public Sub D3DXVec2Lerp(pOut As D3DVECTOR2, _ 102 | pV1 As D3DVECTOR2, _ 103 | pV2 As D3DVECTOR2, _ 104 | ByVal s As Single) 105 | Dim s1 As Single 106 | 107 | s1 = 1 - s 108 | pOut.X = s1 * pV1.X + s * pV2.X 109 | pOut.Y = s1 * pV1.Y + s * pV2.Y 110 | 111 | End Sub 112 | 113 | ' // Returns a 2D vector that is made up of the largest components of two 2D vectors. 114 | Public Sub D3DXVec2Maximize(pOut As D3DVECTOR2, _ 115 | pV1 As D3DVECTOR2, _ 116 | pV2 As D3DVECTOR2) 117 | 118 | If pV1.X > pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 119 | If pV1.Y > pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 120 | 121 | End Sub 122 | 123 | ' // Returns a 2D vector that is made up of the smallest components of two 2D vectors. 124 | Public Sub D3DXVec2Minimize(pOut As D3DVECTOR2, _ 125 | pV1 As D3DVECTOR2, _ 126 | pV2 As D3DVECTOR2) 127 | 128 | If pV1.X < pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 129 | If pV1.Y < pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 130 | 131 | End Sub 132 | 133 | 134 | ' // Returns the normalized version of a 2D vector. 135 | Public Sub D3DXVec2Normalize(pOut As D3DVECTOR2, _ 136 | pV As D3DVECTOR2) 137 | 138 | Dim norm As Single 139 | 140 | norm = D3DXVec2Length(pV) 141 | 142 | If norm = 0! Then 143 | pOut.X = 0! 144 | pOut.Y = 0! 145 | Else 146 | pOut.X = pV.X / norm 147 | pOut.Y = pV.Y / norm 148 | End If 149 | 150 | End Sub 151 | 152 | ' // Scales a 2D vector. 153 | Public Sub D3DXVec2Scale(pOut As D3DVECTOR2, _ 154 | pV As D3DVECTOR2, _ 155 | ByVal s As Single) 156 | 157 | pOut.X = pV.X * s 158 | pOut.Y = pV.Y * s 159 | 160 | End Sub 161 | 162 | ' // Subtracts two 2D vectors. 163 | Public Sub D3DXVec2Subtract(pOut As D3DVECTOR2, _ 164 | pV1 As D3DVECTOR2, _ 165 | pV2 As D3DVECTOR2) 166 | 167 | pOut.X = pV1.X - pV2.X 168 | pOut.Y = pV1.Y - pV2.Y 169 | 170 | End Sub 171 | 172 | ' // Transforms a 2D vector by a given matrix. 173 | Public Sub D3DXVec2Transform(pOut As D3DVECTOR4, _ 174 | pV As D3DVECTOR2, _ 175 | pM As D3DMATRIX) 176 | 177 | pOut.X = pM.m11 * pV.X + pM.m21 * pV.Y + pM.m41 178 | pOut.Y = pM.m12 * pV.X + pM.m22 * pV.Y + pM.m42 179 | pOut.z = pM.m13 * pV.X + pM.m23 * pV.Y + pM.m43 180 | pOut.w = pM.m14 * pV.X + pM.m24 * pV.Y + pM.m44 181 | 182 | End Sub 183 | 184 | ' // Transforms a 2D vector by a given matrix, projecting the result back into w = 1. 185 | Public Sub D3DXVec2TransformCoord(pOut As D3DVECTOR2, _ 186 | pV As D3DVECTOR2, _ 187 | pM As D3DMATRIX) 188 | 189 | Dim v As D3DVECTOR2 190 | Dim norm As Single 191 | 192 | v = pV 193 | norm = pM.m14 * pV.X + pM.m24 * pV.Y + pM.m44 194 | 195 | pOut.X = (pM.m11 * v.X + pM.m21 * v.Y + pM.m41) / norm 196 | pOut.Y = (pM.m12 * v.X + pM.m22 * v.Y + pM.m42) / norm 197 | 198 | End Sub 199 | 200 | ' // Transforms the 2D vector normal by the given matrix. 201 | Public Sub D3DXVec2TransformNormal(pOut As D3DVECTOR2, _ 202 | pV As D3DVECTOR2, _ 203 | pM As D3DMATRIX) 204 | 205 | Dim v As D3DVECTOR2 206 | 207 | v = pV 208 | pOut.X = pM.m11 * v.X + pM.m21 * v.Y 209 | pOut.Y = pM.m12 * v.X + pM.m22 * v.Y 210 | 211 | End Sub 212 | 213 | 214 | -------------------------------------------------------------------------------- /Math/D3DX_VECTOR3.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_VECTOR3" 2 | Option Explicit 3 | 4 | ' // Adds two 3D vectors. 5 | Public Sub D3DXVec3Add(pOut As D3DVECTOR, _ 6 | pV1 As D3DVECTOR, _ 7 | pV2 As D3DVECTOR) 8 | 9 | pOut.X = pV1.X + pV2.X 10 | pOut.Y = pV1.Y + pV2.Y 11 | pOut.z = pV1.z + pV2.z 12 | 13 | End Sub 14 | 15 | ' // Returns a point in Barycentric coordinates, using the specified 3D vectors. 16 | Public Sub D3DXVec3BaryCentric(pOut As D3DVECTOR, _ 17 | pV1 As D3DVECTOR, _ 18 | pV2 As D3DVECTOR, _ 19 | pV3 As D3DVECTOR, _ 20 | ByVal f As Single, _ 21 | ByVal g As Single) 22 | Dim tmp As Single 23 | 24 | tmp = (1! - f - g) 25 | 26 | pOut.X = tmp * (pV1.X) + f * (pV2.X) + g * (pV3.X) 27 | pOut.Y = tmp * (pV1.Y) + f * (pV2.Y) + g * (pV3.Y) 28 | pOut.z = tmp * (pV1.z) + f * (pV2.z) + g * (pV3.z) 29 | 30 | End Sub 31 | 32 | ' // Performs a Catmull-Rom interpolation, using the specified 3D vectors. 33 | Public Sub D3DXVec3CatmullRom(pOut As D3DVECTOR, _ 34 | pV0 As D3DVECTOR, _ 35 | pV1 As D3DVECTOR, _ 36 | pV2 As D3DVECTOR, _ 37 | pV3 As D3DVECTOR, _ 38 | ByVal s As Single) 39 | 40 | pOut.X = 0.5! * (2! * pV1.X + (pV2.X - pV0.X) * s + _ 41 | (2! * pV0.X - 5! * pV1.X + 4! * pV2.X - pV3.X) * s * s + _ 42 | (pV3.X - 3! * pV2.X + 3! * pV1.X - pV0.X) * s * s * s) 43 | pOut.Y = 0.5! * (2! * pV1.Y + (pV2.Y - pV0.Y) * s + _ 44 | (2! * pV0.Y - 5! * pV1.Y + 4! * pV2.Y - pV3.Y) * s * s + _ 45 | (pV3.Y - 3! * pV2.Y + 3! * pV1.Y - pV0.Y) * s * s * s) 46 | pOut.z = 0.5! * (2! * pV1.z + (pV2.z - pV0.z) * s + _ 47 | (2! * pV0.z - 5! * pV1.z + 4! * pV2.z - pV3.z) * s * s + _ 48 | (pV3.z - 3! * pV2.z + 3! * pV1.z - pV0.z) * s * s * s) 49 | 50 | End Sub 51 | 52 | ' // Determines the cross-product of two 3D vectors. 53 | Public Sub D3DXVec3Cross(pOut As D3DVECTOR, _ 54 | pV1 As D3DVECTOR, _ 55 | pV2 As D3DVECTOR) 56 | Dim v As D3DVECTOR 57 | 58 | v.X = pV1.Y * pV2.z - pV1.z * pV2.Y 59 | v.Y = pV1.z * pV2.X - pV1.X * pV2.z 60 | v.z = pV1.X * pV2.Y - pV1.Y * pV2.X 61 | 62 | pOut = v 63 | 64 | End Sub 65 | 66 | ' // Determines the dot product of two 3D vectors. 67 | Public Function D3DXVec3Dot(pV1 As D3DVECTOR, _ 68 | pV2 As D3DVECTOR) As Single 69 | 70 | D3DXVec3Dot = pV1.X * pV2.X + pV1.Y * pV2.Y + pV1.z * pV2.z 71 | 72 | End Function 73 | 74 | ' // Performs a Hermite spline interpolation, using the specified 3D vectors. 75 | Public Sub D3DXVec3Hermite(pOut As D3DVECTOR, _ 76 | pV1 As D3DVECTOR, _ 77 | pT1 As D3DVECTOR, _ 78 | pV2 As D3DVECTOR, _ 79 | pT2 As D3DVECTOR, _ 80 | ByVal s As Single) 81 | 82 | Dim h1 As Single 83 | Dim h2 As Single 84 | Dim h3 As Single 85 | Dim h4 As Single 86 | 87 | h1 = 2! * s * s * s - 3! * s * s + 1! 88 | h2 = s * s * s - 2! * s * s + s 89 | h3 = -2! * s * s * s + 3! * s * s 90 | h4 = s * s * s - s * s 91 | 92 | pOut.X = h1 * pV1.X + h2 * pT1.X + h3 * pV2.X + h4 * pT2.X 93 | pOut.Y = h1 * pV1.Y + h2 * pT1.Y + h3 * pV2.Y + h4 * pT2.Y 94 | pOut.z = h1 * pV1.z + h2 * pT1.z + h3 * pV2.z + h4 * pT2.z 95 | 96 | End Sub 97 | 98 | ' // Returns the length of a 3D vector. 99 | Public Function D3DXVec3Length(pV As D3DVECTOR) As Single 100 | 101 | D3DXVec3Length = Sqr(pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z) 102 | 103 | End Function 104 | 105 | ' // Returns the square of the length of a 3D vector. 106 | Public Function D3DXVec3LengthSq(pV As D3DVECTOR) As Single 107 | 108 | D3DXVec3LengthSq = pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z 109 | 110 | End Function 111 | 112 | ' // Performs a linear interpolation between two 3D vectors. 113 | Public Sub D3DXVec3Lerp(pOut As D3DVECTOR, _ 114 | pV1 As D3DVECTOR, _ 115 | pV2 As D3DVECTOR, _ 116 | ByVal s As Single) 117 | Dim s1 As Single 118 | 119 | s1 = 1 - s 120 | pOut.X = s1 * pV1.X + s * pV2.X 121 | pOut.Y = s1 * pV1.Y + s * pV2.Y 122 | pOut.z = s1 * pV1.z + s * pV2.z 123 | 124 | End Sub 125 | 126 | ' // Returns a 3D vector that is made up of the largest components of two 3D vectors. 127 | Public Sub D3DXVec3Maximize(pOut As D3DVECTOR, _ 128 | pV1 As D3DVECTOR, _ 129 | pV2 As D3DVECTOR) 130 | 131 | If pV1.X > pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 132 | If pV1.Y > pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 133 | If pV1.z > pV2.z Then pOut.z = pV1.z Else pOut.z = pV2.z 134 | 135 | End Sub 136 | 137 | ' // Returns a 3D vector that is made up of the smallest components of two 3D vectors. 138 | Public Sub D3DXVec3Minimize(pOut As D3DVECTOR, _ 139 | pV1 As D3DVECTOR, _ 140 | pV2 As D3DVECTOR) 141 | 142 | If pV1.X < pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 143 | If pV1.Y < pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 144 | If pV1.z < pV2.z Then pOut.z = pV1.z Else pOut.z = pV2.z 145 | 146 | End Sub 147 | 148 | ' // Returns the normalized version of a 3D vector. 149 | Public Sub D3DXVec3Normalize(pOut As D3DVECTOR, _ 150 | pV As D3DVECTOR) 151 | Dim norm As Single 152 | 153 | norm = Sqr(pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z) 154 | 155 | If norm = 0! Then 156 | pOut.X = 0!: pOut.Y = 0!: pOut.z = 0! 157 | Else 158 | pOut.X = pV.X / norm 159 | pOut.Y = pV.Y / norm 160 | pOut.z = pV.z / norm 161 | End If 162 | 163 | End Sub 164 | 165 | ' // Projects a 3D vector from object space into screen space. 166 | Public Sub D3DXVec3Project(pOut As D3DVECTOR, _ 167 | pV As D3DVECTOR, _ 168 | pViewport As D3DVIEWPORT9, _ 169 | pProjection As D3DMATRIX, _ 170 | pView As D3DMATRIX, _ 171 | pWorld As D3DMATRIX) 172 | 173 | Dim m As D3DMATRIX 174 | Dim out As D3DVECTOR 175 | 176 | D3DXMatrixMultiply m, pWorld, pView 177 | D3DXMatrixMultiply m, m, pProjection 178 | D3DXVec3TransformCoord out, pV, m 179 | out.X = pViewport.X + (1! + out.X) * pViewport.Width / 2! 180 | out.Y = pViewport.Y + (1! - out.Y) * pViewport.Height / 2! 181 | out.z = pViewport.MinZ + out.z * (pViewport.MaxZ - pViewport.MinZ) 182 | 183 | pOut = out 184 | 185 | End Sub 186 | 187 | ' // Scales a 3D vector. 188 | Public Sub D3DXVec3Scale(pOut As D3DVECTOR, _ 189 | pV As D3DVECTOR, _ 190 | ByVal s As Single) 191 | 192 | pOut.X = pV.X * s 193 | pOut.Y = pV.Y * s 194 | pOut.z = pV.z * s 195 | 196 | End Sub 197 | 198 | ' // Subtracts two 3D vectors. 199 | Public Sub D3DXVec3Subtract(pOut As D3DVECTOR, _ 200 | pV1 As D3DVECTOR, _ 201 | pV2 As D3DVECTOR) 202 | 203 | pOut.X = pV1.X - pV2.X 204 | pOut.Y = pV1.Y - pV2.Y 205 | pOut.z = pV1.z - pV2.z 206 | 207 | End Sub 208 | 209 | ' // Transforms vector (x, y, z, 1) by a given matrix. 210 | Public Sub D3DXVec3Transform(pOut As D3DVECTOR4, _ 211 | pV As D3DVECTOR, _ 212 | pM As D3DMATRIX) 213 | 214 | pOut.X = pM.m11 * pV.X + pM.m21 * pV.Y + pM.m31 * pV.z + pM.m41 215 | pOut.Y = pM.m12 * pV.X + pM.m22 * pV.Y + pM.m32 * pV.z + pM.m42 216 | pOut.z = pM.m13 * pV.X + pM.m23 * pV.Y + pM.m33 * pV.z + pM.m43 217 | pOut.w = pM.m14 * pV.X + pM.m24 * pV.Y + pM.m34 * pV.z + pM.m44 218 | 219 | End Sub 220 | 221 | ' // Transforms a 3D vector by a given matrix, projecting the result back into w = 1. 222 | Public Sub D3DXVec3TransformCoord(pOut As D3DVECTOR, _ 223 | pV As D3DVECTOR, _ 224 | pM As D3DMATRIX) 225 | 226 | Dim out As D3DVECTOR 227 | Dim norm As Single 228 | 229 | norm = pM.m14 * pV.X + pM.m24 * pV.Y + pM.m34 * pV.z + pM.m44 230 | 231 | out.X = (pM.m11 * pV.X + pM.m21 * pV.Y + pM.m31 * pV.z + pM.m41) / norm 232 | out.Y = (pM.m12 * pV.X + pM.m22 * pV.Y + pM.m32 * pV.z + pM.m42) / norm 233 | out.z = (pM.m13 * pV.X + pM.m23 * pV.Y + pM.m33 * pV.z + pM.m43) / norm 234 | 235 | pOut = out 236 | 237 | End Sub 238 | 239 | ' // Transforms the 3D vector normal by the given matrix. 240 | Public Sub D3DXVec3TransformNormal(pOut As D3DVECTOR, _ 241 | pV As D3DVECTOR, _ 242 | pM As D3DMATRIX) 243 | 244 | Dim v As D3DVECTOR 245 | 246 | v = pV 247 | 248 | pOut.X = pM.m11 * v.X + pM.m21 * v.Y + pM.m31 * v.z 249 | pOut.Y = pM.m12 * v.X + pM.m22 * v.Y + pM.m32 * v.z 250 | pOut.z = pM.m13 * v.X + pM.m23 * v.Y + pM.m33 * v.z 251 | 252 | End Sub 253 | 254 | ' // Projects a vector from screen space into object space. 255 | Public Sub D3DXVec3Unproject(pOut As D3DVECTOR, _ 256 | pV As D3DVECTOR, _ 257 | pViewport As D3DVIEWPORT9, _ 258 | pProjection As D3DMATRIX, _ 259 | pView As D3DMATRIX, _ 260 | pWorld As D3DMATRIX) 261 | 262 | Dim m As D3DMATRIX 263 | Dim out As D3DVECTOR 264 | 265 | D3DXMatrixMultiply m, pWorld, pView 266 | D3DXMatrixMultiply m, m, pProjection 267 | D3DXMatrixInverse m, 0!, m 268 | 269 | out.X = 2! * (pV.X - pViewport.X) / pViewport.Width - 1! 270 | out.Y = 1! - 2! * (pV.Y - pViewport.Y) / pViewport.Height 271 | out.z = (pV.z - pViewport.MinZ) / (pViewport.MaxZ - pViewport.MinZ) 272 | 273 | D3DXVec3TransformCoord out, out, m 274 | pOut = out 275 | 276 | End Sub 277 | 278 | 279 | 280 | -------------------------------------------------------------------------------- /Math/D3DX_VECTOR4.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "D3DX_VECTOR4" 2 | Option Explicit 3 | 4 | ' // Adds two 4D vectors. 5 | Public Sub D3DXVec4Add(pOut As D3DVECTOR4, _ 6 | pV1 As D3DVECTOR4, _ 7 | pV2 As D3DVECTOR4) 8 | 9 | pOut.X = pV1.X + pV2.X 10 | pOut.Y = pV1.Y + pV2.Y 11 | pOut.z = pV1.z + pV2.z 12 | pOut.w = pV1.w + pV2.w 13 | 14 | End Sub 15 | 16 | ' // Returns a point in Barycentric coordinates, using the specified 4D vectors. 17 | Public Sub D3DXVec4BaryCentric(pOut As D3DVECTOR4, _ 18 | pV1 As D3DVECTOR4, _ 19 | pV2 As D3DVECTOR4, _ 20 | pV3 As D3DVECTOR4, _ 21 | ByVal f As Single, _ 22 | ByVal g As Single) 23 | Dim tmp As Single 24 | 25 | tmp = (1! - f - g) 26 | pOut.X = tmp * (pV1.X) + f * (pV2.X) + g * (pV3.X) 27 | pOut.Y = tmp * (pV1.Y) + f * (pV2.Y) + g * (pV3.Y) 28 | pOut.z = tmp * (pV1.z) + f * (pV2.z) + g * (pV3.z) 29 | pOut.w = tmp * (pV1.w) + f * (pV2.w) + g * (pV3.w) 30 | 31 | End Sub 32 | 33 | ' // Performs a Catmull-Rom interpolation, using the specified 4D vectors. 34 | Public Sub D3DXVec4CatmullRom(pOut As D3DVECTOR4, _ 35 | pV0 As D3DVECTOR4, _ 36 | pV1 As D3DVECTOR4, _ 37 | pV2 As D3DVECTOR4, _ 38 | pV3 As D3DVECTOR4, _ 39 | ByVal s As Single) 40 | 41 | pOut.X = 0.5! * (2! * pV1.X + (pV2.X - pV0.X) * s + _ 42 | (2! * pV0.X - 5! * pV1.X + 4! * pV2.X - pV3.X) * s * s + _ 43 | (pV3.X - 3! * pV2.X + 3! * pV1.X - pV0.X) * s * s * s) 44 | pOut.Y = 0.5! * (2! * pV1.Y + (pV2.Y - pV0.Y) * s + _ 45 | (2! * pV0.Y - 5! * pV1.Y + 4! * pV2.Y - pV3.Y) * s * s + _ 46 | (pV3.Y - 3! * pV2.Y + 3! * pV1.Y - pV0.Y) * s * s * s) 47 | pOut.z = 0.5! * (2! * pV1.z + (pV2.z - pV0.z) * s + _ 48 | (2! * pV0.z - 5! * pV1.z + 4! * pV2.z - pV3.z) * s * s + _ 49 | (pV3.z - 3! * pV2.z + 3! * pV1.z - pV0.z) * s * s * s) 50 | pOut.w = 0.5! * (2! * pV1.w + (pV2.w - pV0.w) * s + _ 51 | (2! * pV0.w - 5! * pV1.w + 4! * pV2.w - pV3.w) * s * s + _ 52 | (pV3.w - 3! * pV2.w + 3! * pV1.w - pV0.w) * s * s * s) 53 | 54 | End Sub 55 | 56 | ' // Determines the cross-product in four dimensions. 57 | Public Sub D3DXVec4Cross(pOut As D3DVECTOR4, _ 58 | pV1 As D3DVECTOR4, _ 59 | pV2 As D3DVECTOR4, _ 60 | pV3 As D3DVECTOR4) 61 | 62 | Dim out As D3DVECTOR4 63 | 64 | 65 | out.X = pV1.Y * (pV2.z * pV3.w - pV3.z * pV2.w) - pV1.z * (pV2.Y * pV3.w - pV3.Y * pV2.w) + pV1.w * (pV2.Y * pV3.z - pV2.z * pV3.Y) 66 | out.Y = -(pV1.X * (pV2.z * pV3.w - pV3.z * pV2.w) - pV1.z * (pV2.X * pV3.w - pV3.X * pV2.w) + pV1.w * (pV2.X * pV3.z - pV3.X * pV2.z)) 67 | out.z = pV1.X * (pV2.Y * pV3.w - pV3.Y * pV2.w) - pV1.Y * (pV2.X * pV3.w - pV3.X * pV2.w) + pV1.w * (pV2.X * pV3.Y - pV3.X * pV2.Y) 68 | out.w = -(pV1.X * (pV2.Y * pV3.z - pV3.Y * pV2.z) - pV1.Y * (pV2.X * pV3.z - pV3.X * pV2.z) + pV1.z * (pV2.X * pV3.Y - pV3.X * pV2.Y)) 69 | 70 | pOut = out 71 | End Sub 72 | 73 | ' // Determines the dot product of two 4D vectors. 74 | Public Function D3DXVec4Dot(pV1 As D3DVECTOR4, _ 75 | pV2 As D3DVECTOR4) As Single 76 | 77 | D3DXVec4Dot = pV1.X * pV2.X + pV1.Y * pV2.Y + pV1.z * pV2.z + pV1.w * pV2.w 78 | 79 | End Function 80 | 81 | ' // Performs a Hermite spline interpolation, using the specified 4D vectors. 82 | Public Sub D3DXVec4Hermite(pOut As D3DVECTOR4, _ 83 | pV1 As D3DVECTOR4, _ 84 | pT1 As D3DVECTOR4, _ 85 | pV2 As D3DVECTOR4, _ 86 | pT2 As D3DVECTOR4, _ 87 | ByVal s As Single) 88 | 89 | Dim h1 As Single 90 | Dim h2 As Single 91 | Dim h3 As Single 92 | Dim h4 As Single 93 | 94 | h1 = 2! * s * s * s - 3! * s * s + 1! 95 | h2 = s * s * s - 2! * s * s + s 96 | h3 = -2! * s * s * s + 3! * s * s 97 | h4 = s * s * s - s * s 98 | 99 | pOut.X = h1 * (pV1.X) + h2 * (pT1.X) + h3 * (pV2.X) + h4 * (pT2.X) 100 | pOut.Y = h1 * (pV1.Y) + h2 * (pT1.Y) + h3 * (pV2.Y) + h4 * (pT2.Y) 101 | pOut.z = h1 * (pV1.z) + h2 * (pT1.z) + h3 * (pV2.z) + h4 * (pT2.z) 102 | pOut.w = h1 * (pV1.w) + h2 * (pT1.w) + h3 * (pV2.w) + h4 * (pT2.w) 103 | 104 | End Sub 105 | 106 | 107 | ' // Returns the length of a 4D vector. 108 | Public Function D3DXVec4Length(pV As D3DVECTOR4) As Single 109 | 110 | D3DXVec4Length = Sqr(pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z + pV.w * pV.w) 111 | 112 | End Function 113 | 114 | ' // Returns the square of the length of a 4D vector. 115 | Public Function D3DXVec4LengthSq(pV As D3DVECTOR4) As Single 116 | 117 | D3DXVec4LengthSq = pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z + pV.w * pV.w 118 | 119 | End Function 120 | 121 | ' // Performs a linear interpolation between two 4D vectors. 122 | Public Sub D3DXVec4Lerp(pOut As D3DVECTOR4, _ 123 | pV1 As D3DVECTOR4, _ 124 | pV2 As D3DVECTOR4, _ 125 | ByVal s As Single) 126 | Dim s1 As Single 127 | 128 | s1 = 1 - s 129 | pOut.X = s1 * pV1.X + s * pV2.X 130 | pOut.Y = s1 * pV1.Y + s * pV2.Y 131 | pOut.z = s1 * pV1.z + s * pV2.z 132 | pOut.w = s1 * pV1.w + s * pV2.w 133 | 134 | End Sub 135 | 136 | ' // Returns a 4D vector that is made up of the largest components of two 4D vectors. 137 | Public Sub D3DXVec4Maximize(pOut As D3DVECTOR4, _ 138 | pV1 As D3DVECTOR4, _ 139 | pV2 As D3DVECTOR4) 140 | 141 | If pV1.X > pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 142 | If pV1.Y > pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 143 | If pV1.z > pV2.z Then pOut.z = pV1.z Else pOut.z = pV2.z 144 | If pV1.w > pV2.w Then pOut.w = pV1.w Else pOut.w = pV2.w 145 | 146 | End Sub 147 | 148 | ' // Returns a 4D vector that is made up of the smallest components of two 4D vectors. 149 | Public Sub D3DXVec4Minimize(pOut As D3DVECTOR4, _ 150 | pV1 As D3DVECTOR4, _ 151 | pV2 As D3DVECTOR4) 152 | 153 | If pV1.X < pV2.X Then pOut.X = pV1.X Else pOut.X = pV2.X 154 | If pV1.Y < pV2.Y Then pOut.Y = pV1.Y Else pOut.Y = pV2.Y 155 | If pV1.z < pV2.z Then pOut.z = pV1.z Else pOut.z = pV2.z 156 | If pV1.w < pV2.w Then pOut.w = pV1.w Else pOut.w = pV2.w 157 | 158 | End Sub 159 | 160 | ' // Returns the normalized version of a 4D vector. 161 | Public Sub D3DXVec4Normalize(pOut As D3DVECTOR4, _ 162 | pV As D3DVECTOR4) 163 | Dim norm As Single 164 | 165 | norm = Sqr(pV.X * pV.X + pV.Y * pV.Y + pV.z * pV.z + pV.w * pV.w) 166 | 167 | If norm = 0! Then 168 | pOut.X = 0!: pOut.Y = 0!: pOut.z = 0!: pOut.w = 0 169 | Else 170 | pOut.X = pV.X / norm 171 | pOut.Y = pV.Y / norm 172 | pOut.z = pV.z / norm 173 | pOut.w = pV.w / norm 174 | End If 175 | 176 | End Sub 177 | 178 | ' // Scales a 4D vector. 179 | Public Sub D3DXVec4Scale(pOut As D3DVECTOR4, _ 180 | pV As D3DVECTOR4, _ 181 | ByVal s As Single) 182 | 183 | pOut.X = pV.X * s 184 | pOut.Y = pV.Y * s 185 | pOut.z = pV.z * s 186 | pOut.w = pV.w * s 187 | 188 | End Sub 189 | 190 | ' // Subtracts two 4D vectors. 191 | Public Sub D3DXVec4Subtract(pOut As D3DVECTOR4, _ 192 | pV1 As D3DVECTOR4, _ 193 | pV2 As D3DVECTOR4) 194 | 195 | pOut.X = pV1.X - pV2.X 196 | pOut.Y = pV1.Y - pV2.Y 197 | pOut.z = pV1.z - pV2.z 198 | pOut.w = pV1.w - pV2.w 199 | 200 | End Sub 201 | 202 | ' // Transforms a 4D vector by a given matrix. 203 | Public Sub D3DXVec4Transform(pOut As D3DVECTOR4, _ 204 | pV As D3DVECTOR4, _ 205 | pM As D3DMATRIX) 206 | 207 | pOut.X = pM.m11 * pV.X + pM.m21 * pV.Y + pM.m31 * pV.z + pM.m41 * pV.w 208 | pOut.Y = pM.m12 * pV.X + pM.m22 * pV.Y + pM.m32 * pV.z + pM.m42 * pV.w 209 | pOut.z = pM.m13 * pV.X + pM.m23 * pV.Y + pM.m33 * pV.z + pM.m43 * pV.w 210 | pOut.w = pM.m14 * pV.X + pM.m24 * pV.Y + pM.m34 * pV.z + pM.m44 * pV.w 211 | 212 | End Sub 213 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DX9VB 2 | ## Direct3D9 for Visual Basic 6 3 | 4 | The repository contains type library "DirectX 9 for Visual Basic 6.0 type library by The trick" (**dx9vb.tlb**) which describes the following interfaces: 5 | 6 | * IDirect3D9; 7 | * IDirect3DDevice9; 8 | * IDirect3DSurface9; 9 | * IDirect3DResource9; 10 | * IDirect3DSwapChain9; 11 | * IDirect3DTexture9; 12 | * IDirect3DBaseTexture9; 13 | * IDirect3DVolumeTexture9; 14 | * IDirect3DVolume9; 15 | * IDirect3DCubeTexture9; 16 | * IDirect3DVertexBuffer9; 17 | * IDirect3DIndexBuffer9; 18 | * IDirect3DStateBlock9; 19 | * IDirect3DVertexDeclaration9; 20 | * IDirect3DVertexShader9; 21 | * IDirect3DPixelShader9; 22 | * IDirect3DQuery9. 23 | 24 | The library declared many types, constants and enumerations as well. 25 | 26 | Repository includes several modules written in VB6: 27 | 28 | * D3DX_COLOR.bas - working with colors; 29 | * D3DX_MATRICES.bas - working with matrices; 30 | * D3DX_QUATERNION.bas - working with quaternions; 31 | * D3DX_VECTOR2.bas, D3DX_VECTOR3.bas, D3DX_VECTOR4.bas - working with vectors; 32 | * D3DX_MISC.bas - the miscellaneous functions. 33 | 34 | These modules include the analogs of the corresponding D3DX functions. 35 | 36 | --- 37 | 38 | The type library **d3dxvb.tlb** (D3DX for Visual Basic 6.0 type library by The trick) contains the several D3DX interfaces: 39 | 40 | * ID3DXBuffer; 41 | * ID3DXConstantTable; 42 | * ID3DXInclude. 43 | 44 | Those interfaces with the some declared structures/enums/constatns allow to compile shaders using a **d3dx9_XX.dll** libary. 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /d3dxvb.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/d3dxvb.tlb -------------------------------------------------------------------------------- /dx9vb.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thetrik/DX9VB/9e2868e77ce6b61807e6e86c5b23dd499d8ee61f/dx9vb.tlb --------------------------------------------------------------------------------