Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

VB6 .hFont Error


Recommended Posts

Hello folks!
I have a big problem with this code. It works just fine but I want to use it in EO and when i copy/paste it I'm getting an error here (with this "hFont"):
```
Set MainFont = Direct3DX.CreateFont(Direct3D_Device, MainFontDesc.hFont)
```
I should have those options:
![](http://i.imgur.com/Ad72Ifz.png)

But when I paste it to the EO I have only those:
![](http://i.imgur.com/K7hIWPv.png)

```
Sub Main()
   frmMain.Show
   bRunning = InitDX8()

   Do While bRunning
       Render_Text "Test 123", 0, 0, &HFFFF0000, DT_CENTER
       DoEvents
   Loop

On Error Resume Next
Destroy
End Sub
```
```
Sub Destroy()
   Set Direct3DX = Nothing
   Set Direct3D_Device = Nothing
   Set Direct3D = Nothing
   Set DirectX8 = Nothing
   Unload frmMain
   End
End Sub
```
```
Private DirectX8 As DirectX8
Private Direct3D As Direct3D8
Private Direct3D_Device As Direct3DDevice8
Private Direct3DX As D3DX8

Public bRunning As Boolean

Private MainFont As D3DXFont
Private MainFontDesc As IFont
Private TextRect As RECT
Private fnt As New StdFont

Private ScreenWidth As Long
Private ScreenHeight As Long
Private Direct3D_Window As D3DPRESENT_PARAMETERS
Private Display_Mode As D3DDISPLAYMODE
```
```
Function TryCreateDirectX8Device() As Boolean
Dim I As Long

On Error GoTo nexti
   For I = 1 To 4
       Select Case I
           Case 1
               Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_HARDWARE_VERTEXPROCESSING, Direct3D_Window)
               TryCreateDirectX8Device = True
               Exit Function
           Case 2
               Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_MIXED_VERTEXPROCESSING, Direct3D_Window)
               TryCreateDirectX8Device = True
               Exit Function
           Case 2
               Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Direct3D_Window)
               TryCreateDirectX8Device = True
               Exit Function
           Case 3
               TryCreateDirectX8Device = False
               Exit Function
       End Select
nexti:
   Next
End Function
```
```
Public Function InitDX8() As Boolean
   On Error GoTo errorhandler

   Set DirectX8 = New DirectX8
   Set Direct3D = DirectX8.Direct3DCreate()
   Set Direct3DX = New D3DX8

   ScreenWidth = 800
   ScreenHeight = 600

   Direct3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, Display_Mode

   With Direct3D_Window
       .Windowed = True

       .SwapEffect = D3DSWAPEFFECT_DISCARD
       .BackBufferFormat = Display_Mode.Format
       .SwapEffect = D3DSWAPEFFECT_COPY
       .BackBufferCount = 1
       .BackBufferWidth = ScreenWidth
       .BackBufferHeight = ScreenHeight
       .hDeviceWindow = frmMain.hWnd
   End With

   If TryCreateDirectX8Device = False Then
       MsgBox "Unable to initialize DirectX8\. You may be missing dx8vb.dll or have incompatible hardware to use DirectX8."
       Destroy
   End If

   With Direct3D_Device
       .SetVertexShader D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE

       .SetRenderState D3DRS_LIGHTING, False
       .SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
       .SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
       .SetRenderState D3DRS_ALPHABLENDENABLE, True
       .SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
       .SetRenderState D3DRS_CULLMODE, D3DCULL_NONE
       .SetRenderState D3DRS_ZENABLE, False
       .SetRenderState D3DRS_ZWRITEENABLE, False

       .SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE

       .SetRenderState D3DRS_POINTSPRITE_ENABLE, 1
       .SetRenderState D3DRS_POINTSCALE_ENABLE, 0

       .SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_POINT
       .SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_POINT
       .SetTextureStageState 0, D3DTSS_MIPFILTER, D3DTEXF_NONE
   End With

   With fnt
       .Name = "Verdana"
       .Size = 25
       .Bold = False
   End With

   Set MainFontDesc = fnt
   Set MainFont = Direct3DX.CreateFont(Direct3D_Device, MainFontDesc.hFont)

   InitDX8 = True

   Exit Function
errorhandler:
End Function
```
```
Public Sub Render_Text(ByVal Text As String, ByVal X As Long, ByVal Y As Long, ByVal Color As Long, ByVal Alignment As Long, Optional ByVal Alpha As Long = 0)
   If LenB(Text) = 0 Then Exit Sub

   With Direct3D_Device
       .Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0
       .BeginScene
   End With

   With TextRect
       .Top = Y
       .Left = X
       .bottom = 600
       .Right = 800
   End With

   Direct3DX.DrawText MainFont, Color, Text, TextRect, Alignment

   With Direct3D_Device
       .EndScene
       .Present ByVal 0, ByVal 0, 0, ByVal 0
   End With
End Sub
```
Compiled program in **Attachment.**

Please help me :)
Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...