moddirectx.bas

一个RPG游戏源代码

Attribute VB_Name = "modDirectX"
'Started November 2 2001
'DirectX Declarations
Public DirectX As DirectX7
Public DirectDraw As DirectDraw7

'DirectDraw Surfaces
Public Primary As DirectDrawSurface7 'Primary Surface
Public Backbuffer As DirectDrawSurface7 'Backbuffer

'Surface descriptions
Public Ddsd1 As DDSURFACEDESC2
Public Ddsd2 As DDSURFACEDESC2

'Game Font
Public GameFont As IFont

Public Function InitDirectDraw(ByRef MyForm As Form, ByVal ResX As Long, ByVal ResY As Long, ByVal bpp As Integer, Optional Fullscreen As Boolean = True)
On Error Resume Next
'Create Main DirectX
Set DirectX = New DirectX7

'Create Main DirectDraw
Set DirectDraw = DirectX.DirectDrawCreate("")
If Fullscreen = True Then
'Coop Level/Display Mode
 DirectDraw.SetCooperativeLevel MyForm.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE Or DDSCL_ALLOWMODEX
DirectDraw.SetDisplayMode ResX, ResY, bpp, 0, DDSDM_DEFAULT

'create primary surface
Ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
Ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
Ddsd1.lBackBufferCount = 1

Set Primary = DirectDraw.CreateSurface(Ddsd1)

'create backbuffer
Dim caps As DDSCAPS2
caps.lCaps = DDSCAPS_BACKBUFFER

Set Backbuffer = Primary.GetAttachedSurface(caps)

Backbuffer.GetSurfaceDesc Ddsd2
Else

DirectDraw.SetCooperativeLevel MyForm.hWnd, DDSCL_NORMAL

Ddsd1.lFlags = DDSD_CAPS
'This surface is the primary surface (what is visible to the user)
Ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
'You're now creating the primary surface with the surface description you just set
Set Primary = DirectDraw.CreateSurface(Ddsd1)

Set Clipper = DirectDraw.CreateClipper(0)
Clipper.SetHWnd MyForm.hWnd
Primary.SetClipper Clipper

MyForm.BorderStyle = 2
End If
Dim DDCK As DDCOLORKEY
DDCK.high = 0
DDCK.low = 0

Backbuffer.SetColorKey DDCKEY_SRCBLT, DDCK
End Function

Public Sub DDSColorFill(surface As DirectDrawSurface7, Color As Long)
Dim tmpRect As RECT

With tmpRect
    .Bottom = Ddsd2.lHeight
    .Right = Ddsd2.lWidth
    .Top = 0: .Left = 0
End With

surface.BltColorFill tmpRect, Color

End Sub

Public Sub DDSSetFont(surface As DirectDrawSurface7, FontName As String, FontSize As String, Color As Long)
GWAFont.Name = FontName
GWAFont.Size = FontSize
surface.SetForeColor Color
surface.SetFont GWAFont
End Sub
Public Sub CleanUpDX()
Set DirectX = Nothing
Set DirectDraw = Nothing
Set Primary = Nothing
Set Backbuffer = Nothing
End Sub

Public Sub DDSCreateSurface(surface As DirectDrawSurface7, BmpPath As String, RECTvar As RECT, Optional transCol As Long = 0, Optional UseSystemMemory As Boolean = True)
    'This sub will load a bitmap from a file
    'into a specified dd surface. Transparent
    'colour is black (0) by default.
    Dim tmpDD As DDSURFACEDESC2
    Set surface = Nothing
    tmpDD.lFlags = DDSD_CAPS
    tmpDD.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    Set surface = DirectDraw.CreateSurfaceFromFile(BmpPath, tmpDD)
    
    Dim DDCK As DDCOLORKEY
    DDCK.high = 0
    DDCK.low = 0
    surface.SetColorKey DDCKEY_SRCBLT, DDCK
End Sub