Initial commit: ROW Client source code
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,131 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form DDTut1
|
||||
Caption = "DirectDraw Tutorial 1"
|
||||
ClientHeight = 4485
|
||||
ClientLeft = 570
|
||||
ClientTop = 690
|
||||
ClientWidth = 5670
|
||||
Icon = "DDTut1.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 299
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 378
|
||||
Begin VB.PictureBox Picture1
|
||||
ClipControls = 0 'False
|
||||
Height = 4452
|
||||
Left = 0
|
||||
ScaleHeight = 4395
|
||||
ScaleWidth = 5595
|
||||
TabIndex = 0
|
||||
Top = 0
|
||||
Width = 5652
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "DDTut1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
Option Compare Text
|
||||
|
||||
'Module level variables
|
||||
Dim objDX As New DirectX7
|
||||
Dim objDD As DirectDraw7
|
||||
Dim objDDSurf As DirectDrawSurface7
|
||||
Dim objDDPrimSurf As DirectDrawSurface7
|
||||
Dim ddsd1 As DDSURFACEDESC2
|
||||
Dim ddsd2 As DDSURFACEDESC2
|
||||
Dim ddClipper As DirectDrawClipper
|
||||
|
||||
Dim bInit As Boolean
|
||||
|
||||
Private Sub Form_Load()
|
||||
init
|
||||
End Sub
|
||||
|
||||
Sub init()
|
||||
|
||||
Dim sMedia As String
|
||||
'Initialization procedure
|
||||
|
||||
'The empty string parameter means to use the active display driver
|
||||
Set objDD = objDX.DirectDrawCreate("")
|
||||
'Notice that the show event calls Form_Resize
|
||||
|
||||
'Indicate this app will be a normal windowed app
|
||||
'with the same display depth as the current display
|
||||
Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
|
||||
|
||||
'Indicate that the ddsCaps member is valid in this type
|
||||
ddsd1.lFlags = DDSD_CAPS
|
||||
'This surface is the primary surface (what is visible to the user)
|
||||
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
|
||||
'Your creating the primary surface now with the surface description you just set
|
||||
Set objDDPrimSurf = objDD.CreateSurface(ddsd1)
|
||||
|
||||
'Call the FindMediaDir procedure
|
||||
sMedia = FindMediaDir("lake.bmp")
|
||||
If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
|
||||
|
||||
'Now let's set the second surface description
|
||||
ddsd2.lFlags = DDSD_CAPS
|
||||
'This is going to be a plain off-screen surface
|
||||
ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
'Now we create the off-screen surface
|
||||
Set objDDSurf = objDD.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
|
||||
|
||||
Set ddClipper = objDD.CreateClipper(0)
|
||||
ddClipper.SetHWnd Picture1.hWnd
|
||||
objDDPrimSurf.SetClipper ddClipper
|
||||
'Yes it has been initialized and is ready to blit
|
||||
bInit = True
|
||||
|
||||
'Ok now were ready to blit this thing, call the blt procedure
|
||||
blt
|
||||
|
||||
End Sub
|
||||
Private Sub Form_Resize()
|
||||
|
||||
'This procedure is called by the me.show event or when
|
||||
'The form is resized during runtime.
|
||||
'Since DX uses pixels and VB uses twips this procedure
|
||||
'Syncs up the two scales
|
||||
'Remember to change the ScaleMode property on the
|
||||
'Form to Pixels. Notice the Width and Height of the form
|
||||
'Stay in twips even after you change the ScaleMode, but
|
||||
'The ScaleWidth and the ScaleHeight are now in pixels.
|
||||
Picture1.Width = Me.ScaleWidth
|
||||
Picture1.Height = Me.ScaleHeight
|
||||
blt
|
||||
End Sub
|
||||
Sub blt()
|
||||
|
||||
'Has it been initialized? If not let's get out of this procedure
|
||||
If bInit = False Then Exit Sub
|
||||
|
||||
'Some local variables
|
||||
Dim ddrval As Long
|
||||
Dim r1 As RECT
|
||||
Dim r2 As RECT
|
||||
|
||||
'Gets the bounding rect for the entire window handle, stores in r1
|
||||
objDX.GetWindowRect Picture1.hWnd, r1
|
||||
|
||||
r2.Bottom = ddsd2.lHeight
|
||||
r2.Right = ddsd2.lWidth
|
||||
|
||||
ddrval = objDDPrimSurf.blt(r1, objDDSurf, r2, DDBLT_WAIT)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Picture1_Paint()
|
||||
'This procedure is called during runtime when the form
|
||||
'is moved or resized.
|
||||
Do While objDD.TestCooperativeLevel <> DD_OK
|
||||
DoEvents
|
||||
Loop
|
||||
objDD.RestoreAllSurfaces
|
||||
init
|
||||
blt
|
||||
End Sub
|
||||
Binary file not shown.
@@ -0,0 +1,31 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=DDTut1.frm
|
||||
Module=MediaDir; ..\..\..\common\media.bas
|
||||
Startup="DDTut1"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="MSFT"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,345 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form DDTransparentBlt
|
||||
BorderStyle = 3 'Fixed Dialog
|
||||
Caption = "DD Transparency"
|
||||
ClientHeight = 5070
|
||||
ClientLeft = 630
|
||||
ClientTop = 630
|
||||
ClientWidth = 6495
|
||||
BeginProperty Font
|
||||
Name = "Courier New"
|
||||
Size = 72
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = -1 'True
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Icon = "DDtut2.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
MaxButton = 0 'False
|
||||
MinButton = 0 'False
|
||||
ScaleHeight = 338
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 433
|
||||
Begin VB.PictureBox Picture1
|
||||
FillStyle = 7 'Diagonal Cross
|
||||
BeginProperty Font
|
||||
Name = "MS Sans Serif"
|
||||
Size = 18
|
||||
Charset = 0
|
||||
Weight = 400
|
||||
Underline = 0 'False
|
||||
Italic = 0 'False
|
||||
Strikethrough = 0 'False
|
||||
EndProperty
|
||||
Height = 5055
|
||||
Left = 0
|
||||
ScaleHeight = 4995
|
||||
ScaleWidth = 6435
|
||||
TabIndex = 0
|
||||
Top = 0
|
||||
Width = 6495
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "DDTransparentBlt"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'NOTE THIS SAMPLES SHOWS HOW TO BLIT TO AREAS OF THE SCREEN
|
||||
Dim objDX As New DirectX7
|
||||
Dim objDD As DirectDraw7
|
||||
Dim objDDLakeSurf As DirectDrawSurface7
|
||||
Dim objDDSpriteSurf As DirectDrawSurface7
|
||||
Dim objDDScreen As DirectDrawSurface7
|
||||
Dim objDDBackBuffer As DirectDrawSurface7
|
||||
Dim objDDClip As DirectDrawClipper
|
||||
|
||||
Dim ddsdLake As DDSURFACEDESC2
|
||||
Dim ddsdSprite As DDSURFACEDESC2
|
||||
Dim ddsdScreen As DDSURFACEDESC2
|
||||
Dim ddsdBackBuffer As DDSURFACEDESC2
|
||||
Dim rBackBuffer As RECT
|
||||
Dim rLake As RECT
|
||||
Dim rSprite As RECT
|
||||
Dim lastX As Long
|
||||
Dim lastY As Long
|
||||
Dim fps As Single
|
||||
Dim running As Boolean
|
||||
Private sMedia As String
|
||||
|
||||
Sub Init()
|
||||
|
||||
Dim file As String
|
||||
|
||||
'The empty string parameter means use the active display
|
||||
Set objDD = objDX.DirectDrawCreate("")
|
||||
Me.Show
|
||||
|
||||
'Indicate the application will be a normal windowed application
|
||||
'with the same display depth as the current display
|
||||
Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
|
||||
|
||||
'----- getting a surface that represents the screen
|
||||
|
||||
'Indicate that the ddsCaps member is valid
|
||||
ddsdScreen.lFlags = DDSD_CAPS
|
||||
|
||||
'Ask for the primary surface (one that is visible on the screen)
|
||||
ddsdScreen.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
|
||||
|
||||
'Get the primary surface object
|
||||
Set objDDScreen = objDD.CreateSurface(ddsdScreen)
|
||||
|
||||
'Create a clipper object
|
||||
'Clippers are used to set the writable region of the screen
|
||||
Set objDDClip = objDD.CreateClipper(0)
|
||||
|
||||
'Assoiciate the picture hwnd with the clipper
|
||||
objDDClip.SetHWnd Picture1.hWnd
|
||||
|
||||
'Have the blts to the screen clipped to the Picture box
|
||||
objDDScreen.SetClipper objDDClip
|
||||
|
||||
|
||||
|
||||
'----- creating an invisible surface to draw to
|
||||
' use it as a compositing surface in system memory
|
||||
|
||||
'Indicate that we want to specify the ddscaps height and width
|
||||
'The format of the surface (bits per pixel) will be the same
|
||||
'as the primary
|
||||
ddsdBackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
|
||||
'Indicate that we want a surface that is not visible and that
|
||||
'we want it in system memory wich is plentiful as opposed to
|
||||
'video memory
|
||||
ddsdBackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
|
||||
|
||||
'Specify the height and width of the surface to be the same
|
||||
'as the picture box (note unit are in pixels)
|
||||
ddsdBackBuffer.lWidth = Picture1.Width
|
||||
ddsdBackBuffer.lHeight = Picture1.Height
|
||||
|
||||
'Create the requested surface
|
||||
Set objDDBackBuffer = objDD.CreateSurface(ddsdBackBuffer)
|
||||
|
||||
|
||||
'Change the current directory to be the media directory
|
||||
sMedia = FindMediaDir("lake.bmp")
|
||||
If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
|
||||
|
||||
InitSurfaces
|
||||
|
||||
rBackBuffer.Bottom = ddsdBackBuffer.lHeight
|
||||
rBackBuffer.Right = ddsdBackBuffer.lWidth
|
||||
|
||||
|
||||
|
||||
'get the area of the bitmap we want ot blt
|
||||
rLake.Bottom = ddsdLake.lHeight
|
||||
rLake.Right = ddsdLake.lWidth
|
||||
|
||||
rSprite.Bottom = ddsdSprite.lHeight
|
||||
rSprite.Right = ddsdSprite.lWidth
|
||||
|
||||
RepaintEntireBackground
|
||||
|
||||
running = True
|
||||
Do While running
|
||||
DoFrame
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
'copy the backround bitmap to the background surface
|
||||
Sub RepaintEntireBackground()
|
||||
|
||||
Call objDDBackBuffer.BltFast(0, 0, objDDLakeSurf, rLake, DDBLTFAST_WAIT)
|
||||
|
||||
End Sub
|
||||
Sub InitSurfaces()
|
||||
'----- loading a background image of the lake
|
||||
|
||||
'Indicate that we want to create an offscreen surface
|
||||
'An offscreen surface is one that is available in memory
|
||||
'(video or system memory) but is not visible to the user
|
||||
ddsdLake.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
|
||||
ddsdLake.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
ddsdLake.lWidth = Picture1.Width
|
||||
ddsdLake.lHeight = Picture1.Height
|
||||
|
||||
'create the surface and load lake.bmp onto the surface
|
||||
Set objDDLakeSurf = objDD.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsdLake)
|
||||
|
||||
'copy the background to the compositing surface
|
||||
RepaintEntireBackground
|
||||
|
||||
'----- loading a sprit image (face)
|
||||
|
||||
'load the bitmap into the second surface
|
||||
|
||||
'specify that the ddsCaps field is valid
|
||||
ddsdSprite.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
|
||||
ddsdSprite.lWidth = 64
|
||||
ddsdSprite.lHeight = 64
|
||||
'indicate we want an offscreen surface
|
||||
ddsdSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
|
||||
'create the surface
|
||||
'since we are not specifying the height and width
|
||||
'the bitmap will be the same size as the bitmap
|
||||
Set objDDSpriteSurf = objDD.CreateSurfaceFromFile(sMedia & "disk1.bmp", ddsdSprite)
|
||||
|
||||
|
||||
'----- setting the transparent color of the sprite
|
||||
|
||||
|
||||
Dim key As DDCOLORKEY
|
||||
|
||||
'You can set a range of colors to be the
|
||||
'here we set it to white
|
||||
'CreateColor take 3 singles representing ranging from 0 to 1
|
||||
'for red green and blue components of the color
|
||||
key.low = 0
|
||||
key.high = 0
|
||||
|
||||
'Assign the transparent color to the sprite object
|
||||
'DDCKEY_SRCBLT specifies that when a blt is done the
|
||||
'transparent color is associated with the surface being
|
||||
'blitted and not the one being blitted to
|
||||
objDDSpriteSurf.SetColorKey DDCKEY_SRCBLT, key
|
||||
|
||||
|
||||
End Sub
|
||||
Sub DoFrame()
|
||||
|
||||
|
||||
Dim ddrval As Long
|
||||
Dim rPrim As RECT
|
||||
Dim x As Single
|
||||
Dim y As Single
|
||||
|
||||
Static a As Single
|
||||
Static t1 As Single
|
||||
Static t2 As Single
|
||||
Static i As Integer
|
||||
Static tLast As Single
|
||||
Static tNow As Single
|
||||
|
||||
|
||||
'calculate the angle of where we place the sprite
|
||||
t2 = Timer
|
||||
If t1 <> 0 Then
|
||||
|
||||
a = a + (t2 - t1) * 100
|
||||
If a > 360 Then a = a - 360
|
||||
End If
|
||||
t1 = t2
|
||||
|
||||
|
||||
Dim bRestore As Boolean
|
||||
' this will keep us from trying to blt in case we lose the surfaces (another fullscreen app takes over)
|
||||
bRestore = False
|
||||
Do Until ExModeActive
|
||||
DoEvents
|
||||
bRestore = True
|
||||
Loop
|
||||
|
||||
' if we lost and got back the surfaces, then restore them
|
||||
DoEvents
|
||||
If bRestore Then
|
||||
bRestore = False
|
||||
objDD.RestoreAllSurfaces
|
||||
InitSurfaces ' must init the surfaces again if they we're lost
|
||||
End If
|
||||
|
||||
'calculate FPS
|
||||
i = i + 1
|
||||
If i = 30 Then
|
||||
tNow = Timer
|
||||
If tNow <> tLast Then
|
||||
fps = 30 / (Timer - tLast)
|
||||
tLast = Timer
|
||||
i = 0
|
||||
Me.Caption = "DD Transparency Frames per Second =" + Format$(fps, "#.0")
|
||||
End If
|
||||
End If
|
||||
|
||||
'calculate the x y coordinate of where we place the sprite
|
||||
x = Cos((a / 360) * 2 * 3.141) * Picture1.Width / 8
|
||||
y = Sin((a / 360) * 2 * 3.141) * Picture1.Height / 8
|
||||
x = x + Picture1.Width / 2
|
||||
y = y + Picture1.Height / 2
|
||||
|
||||
'clean up background from last frame
|
||||
'by only reparing the background where it needs to
|
||||
'be you wont need to reblit the whole thing
|
||||
Dim rClean As RECT
|
||||
If lastX <> 0 Then
|
||||
rClean.Left = lastX
|
||||
rClean.Top = lastY
|
||||
rClean.Right = lastX + ddsdSprite.lWidth
|
||||
rClean.Bottom = lastY + ddsdSprite.lHeight
|
||||
Call objDDBackBuffer.BltFast(lastX, lastY, objDDLakeSurf, rClean, DDBLTFAST_WAIT)
|
||||
End If
|
||||
|
||||
lastX = x
|
||||
lastY = y
|
||||
'blt to the backbuffer from our sprite
|
||||
'use the color key on the source - (our sprite)
|
||||
'wait for the blt to finish before moving one
|
||||
Dim rtemp As RECT
|
||||
rtemp.Left = x
|
||||
rtemp.Top = y
|
||||
rtemp.Right = x + ddsdSprite.lWidth
|
||||
rtemp.Bottom = y + ddsdSprite.lHeight
|
||||
|
||||
objDDBackBuffer.Blt rtemp, objDDSpriteSurf, rSprite, DDBLT_KEYSRC Or DDBLT_WAIT
|
||||
|
||||
'Get the position of our picture box in screen coordinates
|
||||
objDX.GetWindowRect Picture1.hWnd, rPrim
|
||||
|
||||
'blt our back buffer to the screen
|
||||
Call objDDScreen.Blt(rPrim, objDDBackBuffer, rBackBuffer, DDBLT_WAIT)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Private Sub Form_Load()
|
||||
Init
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Resize()
|
||||
'This tutorial does not handle resize
|
||||
'To resize we would need to recreate the backbuffer
|
||||
'The lake bitmap would have to be larger as well
|
||||
'for the dirty rectangle clean up to be correct.
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Unload(Cancel As Integer)
|
||||
running = False
|
||||
End Sub
|
||||
|
||||
Private Sub Picture1_Paint()
|
||||
DoFrame
|
||||
End Sub
|
||||
|
||||
Function ExModeActive() As Boolean
|
||||
Dim TestCoopRes As Long
|
||||
|
||||
TestCoopRes = objDD.TestCooperativeLevel
|
||||
|
||||
If (TestCoopRes = DD_OK) Then
|
||||
ExModeActive = True
|
||||
Else
|
||||
ExModeActive = False
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,33 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=DDtut2.frm
|
||||
Module=MediaDir; ..\..\..\common\media.bas
|
||||
Startup="DDTransparentBlt"
|
||||
HelpFile=""
|
||||
Title="ddtut2"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,237 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form DDFullScreen
|
||||
BorderStyle = 0 'None
|
||||
Caption = "Form1"
|
||||
ClientHeight = 5625
|
||||
ClientLeft = 885
|
||||
ClientTop = 585
|
||||
ClientWidth = 7065
|
||||
Icon = "DDtut3.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 375
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 471
|
||||
End
|
||||
Attribute VB_Name = "DDFullScreen"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
'NOTE THIS SAMPLES SHOWS HOW TO USE FULL SCREEN FEATURES
|
||||
|
||||
Dim dx As New DirectX7
|
||||
Dim dd As DirectDraw7
|
||||
Dim lakesurf As DirectDrawSurface7
|
||||
Dim spritesurf As DirectDrawSurface7
|
||||
Dim primary As DirectDrawSurface7
|
||||
Dim backbuffer As DirectDrawSurface7
|
||||
Dim ddsd1 As DDSURFACEDESC2
|
||||
Dim ddsd2 As DDSURFACEDESC2
|
||||
Dim ddsd3 As DDSURFACEDESC2
|
||||
Dim ddsd4 As DDSURFACEDESC2
|
||||
Dim brunning As Boolean
|
||||
Dim binit As Boolean
|
||||
Dim CurModeActiveStatus As Boolean
|
||||
Dim bRestore As Boolean
|
||||
Dim sMedia As String
|
||||
|
||||
Sub Init()
|
||||
On Local Error GoTo errOut
|
||||
|
||||
Dim file As String
|
||||
|
||||
Set dd = dx.DirectDrawCreate("")
|
||||
Me.Show
|
||||
|
||||
'indicate that we dont need to change display depth
|
||||
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
|
||||
|
||||
dd.SetDisplayMode 640, 480, 16, 0, DDSDM_DEFAULT
|
||||
|
||||
|
||||
|
||||
'get the screen surface and create a back buffer too
|
||||
ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
|
||||
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
|
||||
ddsd1.lBackBufferCount = 1
|
||||
|
||||
Set primary = dd.CreateSurface(ddsd1)
|
||||
|
||||
|
||||
|
||||
Dim caps As DDSCAPS2
|
||||
caps.lCaps = DDSCAPS_BACKBUFFER
|
||||
Set backbuffer = primary.GetAttachedSurface(caps)
|
||||
|
||||
backbuffer.GetSurfaceDesc ddsd4
|
||||
|
||||
|
||||
|
||||
'We create a DrawableSurface class from our backbuffer
|
||||
'that makes it easy to draw text
|
||||
backbuffer.SetForeColor vbGreen
|
||||
backbuffer.SetFontTransparency True
|
||||
|
||||
' init the surfaces
|
||||
InitSurfaces
|
||||
|
||||
binit = True
|
||||
brunning = True
|
||||
Do While brunning
|
||||
blt
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
|
||||
errOut:
|
||||
|
||||
EndIT
|
||||
|
||||
End Sub
|
||||
|
||||
Sub InitSurfaces()
|
||||
|
||||
Set lakesurf = Nothing
|
||||
Set spritesurf = Nothing
|
||||
|
||||
sMedia = FindMediaDir("lake.bmp")
|
||||
If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
|
||||
|
||||
'load the bitmap into the second surface same size
|
||||
'as our back buffer
|
||||
ddsd2.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
ddsd2.lWidth = ddsd4.lWidth
|
||||
ddsd2.lHeight = ddsd4.lHeight
|
||||
Set lakesurf = dd.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
|
||||
|
||||
'load the bitmap into the second surface
|
||||
ddsd3.lFlags = DDSD_CAPS
|
||||
ddsd3.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
Set spritesurf = dd.CreateSurfaceFromFile(sMedia & "disk1.bmp", ddsd3)
|
||||
|
||||
'use black for transparent color key
|
||||
Dim key As DDCOLORKEY
|
||||
key.low = 0
|
||||
key.high = 0
|
||||
spritesurf.SetColorKey DDCKEY_SRCBLT, key
|
||||
End Sub
|
||||
|
||||
|
||||
Sub blt()
|
||||
On Local Error GoTo errOut
|
||||
If binit = False Then Exit Sub
|
||||
|
||||
Dim rSprite As RECT
|
||||
Dim rSprite2 As RECT
|
||||
Dim rPrim As RECT
|
||||
|
||||
Static i As Integer
|
||||
Static a As Single
|
||||
Static x As Single
|
||||
Static y As Single
|
||||
Static t As Single
|
||||
Static t2 As Single
|
||||
Static tLast As Single
|
||||
Static fps As Single
|
||||
|
||||
|
||||
' this will keep us from trying to blt in case we lose the surfaces (alt-tab)
|
||||
bRestore = False
|
||||
Do Until ExModeActive
|
||||
DoEvents
|
||||
bRestore = True
|
||||
Loop
|
||||
|
||||
' if we lost and got back the surfaces, then restore them
|
||||
DoEvents
|
||||
If bRestore Then
|
||||
bRestore = False
|
||||
dd.RestoreAllSurfaces
|
||||
InitSurfaces ' must init the surfaces again if they we're lost
|
||||
End If
|
||||
|
||||
'get the rectangle for our source sprite
|
||||
rSprite.Bottom = ddsd3.lHeight
|
||||
rSprite.Right = ddsd3.lWidth
|
||||
|
||||
|
||||
|
||||
'calculate an angle to place the sprite
|
||||
t2 = Timer
|
||||
If t <> 0 Then
|
||||
a = a + (t - t2) * 80
|
||||
If a > 360 Then a = a - 360
|
||||
End If
|
||||
t = t2
|
||||
|
||||
'caculate the center x y position
|
||||
x = Cos((a / 360) * 2 * 3.141) * 100
|
||||
y = Sin((a / 360) * 2 * 3.141) * 100
|
||||
|
||||
'where on the screen do you want the sprite
|
||||
rSprite2.Top = y + Me.ScaleHeight / 2
|
||||
rSprite2.Left = x + Me.ScaleWidth / 2
|
||||
|
||||
|
||||
'paint the background onto our back buffer
|
||||
Dim rLake As RECT, rback As RECT
|
||||
rLake.Bottom = ddsd2.lHeight
|
||||
rLake.Right = ddsd2.lWidth
|
||||
rback.Bottom = ddsd4.lHeight
|
||||
rback.Right = ddsd4.lWidth
|
||||
Call backbuffer.BltFast(0, 0, lakesurf, rLake, DDBLTFAST_WAIT)
|
||||
|
||||
'Calculate the frame rate
|
||||
If i = 30 Then
|
||||
If tLast <> 0 Then fps = 30 / (Timer - tLast)
|
||||
tLast = Timer
|
||||
i = 0
|
||||
End If
|
||||
i = i + 1
|
||||
Call backbuffer.DrawText(10, 10, "640x480x16 Frames per Second " + Format$(fps, "#.0"), False)
|
||||
Call backbuffer.DrawText(10, 30, "Click Screen to Exit", False)
|
||||
|
||||
'blt to the backbuffer from our surface
|
||||
Call backbuffer.BltFast(rSprite2.Left, rSprite2.Top, spritesurf, rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
|
||||
|
||||
'flip the backbuffer to the screen
|
||||
primary.Flip Nothing, DDFLIP_WAIT
|
||||
|
||||
errOut:
|
||||
|
||||
End Sub
|
||||
|
||||
Sub EndIT()
|
||||
Call dd.RestoreDisplayMode
|
||||
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Click()
|
||||
EndIT
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Init
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Paint()
|
||||
blt
|
||||
End Sub
|
||||
|
||||
Function ExModeActive() As Boolean
|
||||
Dim TestCoopRes As Long
|
||||
|
||||
TestCoopRes = dd.TestCooperativeLevel
|
||||
|
||||
If (TestCoopRes = DD_OK) Then
|
||||
ExModeActive = True
|
||||
Else
|
||||
ExModeActive = False
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,31 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=DDtut3.frm
|
||||
Module=MediaDir; ..\..\..\common\media.bas
|
||||
Startup="DDFullScreen"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,258 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form Form1
|
||||
BorderStyle = 0 'None
|
||||
Caption = "DD Animation"
|
||||
ClientHeight = 5625
|
||||
ClientLeft = 2355
|
||||
ClientTop = 1620
|
||||
ClientWidth = 7065
|
||||
Icon = "DDtut4.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 375
|
||||
ScaleMode = 3 'Pixel
|
||||
ScaleWidth = 471
|
||||
End
|
||||
Attribute VB_Name = "Form1"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
'NOTE THIS SAMPLES SHOWS HOW TO BLIT TO AREAS OF THE SCREEN
|
||||
Dim binit As Boolean
|
||||
Dim dx As New DirectX7
|
||||
Dim dd As DirectDraw7
|
||||
Dim lakesurf As DirectDrawSurface7
|
||||
Dim spritesurf As DirectDrawSurface7
|
||||
Dim primary As DirectDrawSurface7
|
||||
Dim backbuffer As DirectDrawSurface7
|
||||
Dim ddsd1 As DDSURFACEDESC2
|
||||
Dim ddsd2 As DDSURFACEDESC2
|
||||
Dim ddsd3 As DDSURFACEDESC2
|
||||
Dim ddsd4 As DDSURFACEDESC2
|
||||
Dim spriteWidth As Integer
|
||||
Dim spriteHeight As Integer
|
||||
Dim cols As Integer
|
||||
Dim rows As Integer
|
||||
Dim row As Integer
|
||||
Dim col As Integer
|
||||
Dim currentFrame As Integer
|
||||
Dim brunning As Boolean
|
||||
Dim CurModeActiveStatus As Boolean
|
||||
Dim bRestore As Boolean
|
||||
Dim sMedia As String
|
||||
|
||||
Sub Init()
|
||||
On Local Error GoTo errOut
|
||||
|
||||
Dim file As String
|
||||
|
||||
Set dd = dx.DirectDrawCreate("")
|
||||
Me.Show
|
||||
|
||||
'indicate that we dont need to change display depth
|
||||
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_FULLSCREEN Or DDSCL_ALLOWMODEX Or DDSCL_EXCLUSIVE)
|
||||
Call dd.SetDisplayMode(640, 480, 16, 0, DDSDM_DEFAULT)
|
||||
|
||||
'get the screen surface and create a back buffer too
|
||||
ddsd1.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
|
||||
ddsd1.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
|
||||
ddsd1.lBackBufferCount = 1
|
||||
Set primary = dd.CreateSurface(ddsd1)
|
||||
|
||||
'Get the backbuffer
|
||||
Dim caps As DDSCAPS2
|
||||
caps.lCaps = DDSCAPS_BACKBUFFER
|
||||
Set backbuffer = primary.GetAttachedSurface(caps)
|
||||
backbuffer.GetSurfaceDesc ddsd4
|
||||
|
||||
'Create DrawableSurface class form backbuffer
|
||||
|
||||
backbuffer.SetFontTransparency True
|
||||
backbuffer.SetForeColor vbGreen
|
||||
|
||||
' init the surfaces
|
||||
InitSurfaces
|
||||
|
||||
binit = True
|
||||
brunning = True
|
||||
Do While brunning
|
||||
blt
|
||||
DoEvents
|
||||
Loop
|
||||
|
||||
errOut:
|
||||
EndIt
|
||||
End Sub
|
||||
|
||||
Sub InitSurfaces()
|
||||
|
||||
|
||||
Set lakesurf = Nothing
|
||||
Set spritesurf = Nothing
|
||||
|
||||
sMedia = FindMediaDir("lake.bmp")
|
||||
If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
|
||||
|
||||
'load the bitmap into a surface - lake
|
||||
ddsd2.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
|
||||
ddsd2.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
ddsd2.lWidth = ddsd4.lWidth
|
||||
ddsd2.lHeight = ddsd4.lHeight
|
||||
Set lakesurf = dd.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsd2)
|
||||
|
||||
'load the bitmap into a surface
|
||||
'this bitmap has many frames of animation
|
||||
'each is 32 by 32 in layed out in cols x rows
|
||||
ddsd3.lFlags = DDSD_CAPS
|
||||
ddsd3.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
|
||||
Set spritesurf = dd.CreateSurfaceFromFile(sMedia & "animate.bmp", ddsd3)
|
||||
spriteWidth = 32
|
||||
spriteHeight = 32
|
||||
cols = ddsd3.lWidth / spriteWidth
|
||||
rows = ddsd3.lHeight / spriteHeight
|
||||
|
||||
'use black for transparent color key which is on
|
||||
'the source bitmap -> use src keying
|
||||
Dim key As DDCOLORKEY
|
||||
key.low = 0
|
||||
key.high = 0
|
||||
spritesurf.SetColorKey DDCKEY_SRCBLT, key
|
||||
End Sub
|
||||
|
||||
|
||||
Sub blt()
|
||||
On Local Error GoTo errOut
|
||||
If binit = False Then Exit Sub
|
||||
|
||||
Dim ddrval As Long
|
||||
Static i As Integer
|
||||
|
||||
Dim rBack As RECT
|
||||
Dim rLake As RECT
|
||||
Dim rSprite As RECT
|
||||
Dim rSprite2 As RECT
|
||||
Dim rPrim As RECT
|
||||
|
||||
Static a As Single
|
||||
Static x As Single
|
||||
Static y As Single
|
||||
Static t As Single
|
||||
Static t2 As Single
|
||||
Static tLast As Single
|
||||
Static fps As Single
|
||||
|
||||
|
||||
' this will keep us from trying to blt in case we lose the surfaces (alt-tab)
|
||||
bRestore = False
|
||||
Do Until ExModeActive
|
||||
DoEvents
|
||||
bRestore = True
|
||||
Loop
|
||||
|
||||
' if we lost and got back the surfaces, then restore them
|
||||
DoEvents
|
||||
If bRestore Then
|
||||
bRestore = False
|
||||
dd.RestoreAllSurfaces
|
||||
InitSurfaces ' must init the surfaces again if they we're lost
|
||||
End If
|
||||
|
||||
'get the area of the screen where our window is
|
||||
|
||||
rBack.Bottom = ddsd4.lHeight
|
||||
rBack.Right = ddsd4.lWidth
|
||||
|
||||
'get the area of the bitmap we want ot blt
|
||||
rLake.Bottom = ddsd2.lHeight
|
||||
rLake.Right = ddsd2.lWidth
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
'blt to the backbuffer from our surface to
|
||||
'the screen surface such that our bitmap
|
||||
'appears over the window
|
||||
ddrval = backbuffer.BltFast(0, 0, lakesurf, rLake, DDBLTFAST_WAIT)
|
||||
|
||||
|
||||
'Calculate the frame rate
|
||||
If i = 30 Then
|
||||
If tLast <> 0 Then fps = 30 / (Timer - tLast)
|
||||
tLast = Timer
|
||||
i = 0
|
||||
End If
|
||||
i = i + 1
|
||||
Call backbuffer.DrawText(10, 10, "640x480x16 Frames per Second " + Format$(fps, "#.0"), False)
|
||||
Call backbuffer.DrawText(10, 30, "Click Screen to Exit", False)
|
||||
|
||||
'calculate the angle from the center
|
||||
'at witch to place the sprite
|
||||
'calcultate wich frame# we are on in the sprite bitmap
|
||||
t2 = Timer
|
||||
If t <> 0 Then
|
||||
a = a + (t2 - t) * 40
|
||||
If a > 360 Then a = a - 360
|
||||
currentFrame = currentFrame + (t2 - t) * 40
|
||||
If currentFrame > rows * cols - 1 Then currentFrame = 0
|
||||
End If
|
||||
t = t2
|
||||
|
||||
'calculat the x and y position of the sprite
|
||||
x = Cos((a / 360) * 2 * 3.141) * 100
|
||||
y = Sin((a / 360) * 2 * 3.141) * 100
|
||||
rSprite2.Top = y + Me.ScaleHeight / 2
|
||||
rSprite2.Left = x + Me.ScaleWidth / 2
|
||||
rSprite2.Right = rSprite2.Left + spriteWidth
|
||||
rSprite2.Bottom = rSprite2.Top + spriteHeight
|
||||
|
||||
'from the current frame select the bitmap we want
|
||||
col = currentFrame Mod cols
|
||||
row = Int(currentFrame / cols)
|
||||
rSprite.Left = col * spriteWidth
|
||||
rSprite.Top = row * spriteHeight
|
||||
rSprite.Right = rSprite.Left + spriteWidth
|
||||
rSprite.Bottom = rSprite.Top + spriteHeight
|
||||
|
||||
|
||||
'blt to the backbuffer our animated sprite
|
||||
ddrval = backbuffer.BltFast(rSprite2.Left, rSprite2.Top, spritesurf, rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT)
|
||||
|
||||
'flip the back buffer to the screen
|
||||
primary.Flip Nothing, DDFLIP_WAIT
|
||||
|
||||
errOut:
|
||||
|
||||
End Sub
|
||||
|
||||
Sub EndIt()
|
||||
Call dd.RestoreDisplayMode
|
||||
Call dd.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Click()
|
||||
EndIt
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Load()
|
||||
Init
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Paint()
|
||||
blt
|
||||
End Sub
|
||||
|
||||
Function ExModeActive() As Boolean
|
||||
Dim TestCoopRes As Long
|
||||
|
||||
TestCoopRes = dd.TestCooperativeLevel
|
||||
|
||||
If (TestCoopRes = DD_OK) Then
|
||||
ExModeActive = True
|
||||
Else
|
||||
ExModeActive = False
|
||||
End If
|
||||
|
||||
End Function
|
||||
Binary file not shown.
@@ -0,0 +1,31 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=DDtut4.frm
|
||||
Module=MediaDir; ..\..\..\common\media.bas
|
||||
Startup="Form1"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
@@ -0,0 +1,274 @@
|
||||
VERSION 5.00
|
||||
Begin VB.Form DDDisplayCardInfo
|
||||
Caption = "DD Display Card Information"
|
||||
ClientHeight = 6570
|
||||
ClientLeft = 60
|
||||
ClientTop = 345
|
||||
ClientWidth = 4785
|
||||
Icon = "ddtut5.frx":0000
|
||||
LinkTopic = "Form1"
|
||||
ScaleHeight = 6570
|
||||
ScaleWidth = 4785
|
||||
StartUpPosition = 3 'Windows Default
|
||||
Begin VB.ListBox OutList
|
||||
Height = 6495
|
||||
Left = 0
|
||||
TabIndex = 0
|
||||
Top = 0
|
||||
Width = 4815
|
||||
End
|
||||
End
|
||||
Attribute VB_Name = "DDDisplayCardInfo"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Dim m_dx As New DirectX7
|
||||
|
||||
Private Sub Form_Load()
|
||||
Me.Show
|
||||
GetDisplayCards
|
||||
End Sub
|
||||
|
||||
Sub GetDisplayModes(sGuid As String)
|
||||
'If you want to switch display modes
|
||||
'to a certain resolution
|
||||
'this is how you figure out what resoultions
|
||||
'are supported.
|
||||
'note some cards will report zero for
|
||||
'the refresh rate.
|
||||
|
||||
Dim DisplayModesEnum As DirectDrawEnumModes
|
||||
Dim ddsd2 As DDSURFACEDESC2
|
||||
Dim dd As DirectDraw7
|
||||
Set dd = m_dx.DirectDrawCreate(sGuid)
|
||||
dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
|
||||
Set DisplayModesEnum = dd.GetDisplayModesEnum(0, ddsd2)
|
||||
OutList.AddItem " Display Modes"
|
||||
For i = 1 To DisplayModesEnum.GetCount()
|
||||
DisplayModesEnum.GetItem i, ddsd2
|
||||
OutList.AddItem " Index " + Str(i)
|
||||
OutList.AddItem " Width " + Str(ddsd2.lWidth)
|
||||
OutList.AddItem " Height " + Str(ddsd2.lHeight)
|
||||
OutList.AddItem " Bits Per Pixel" + Str(ddsd2.ddpfPixelFormat.lRGBBitCount)
|
||||
OutList.AddItem " Refresh Rate " + Str(ddsd2.lRefreshRate)
|
||||
OutList.AddItem ""
|
||||
Next
|
||||
|
||||
Set dd = Nothing
|
||||
|
||||
End Sub
|
||||
|
||||
Sub GetDisplayCards()
|
||||
'Some systems will have multiple display cards
|
||||
'or have daughter cards for 3d support.
|
||||
'if you want to draw to more than just the
|
||||
'primary display or search for 3d hardware not
|
||||
'on the primary display card you can
|
||||
'use this code to search for such devices
|
||||
'Note that windows 98 supports multiple monitors.
|
||||
'Note the GUID is what identifies the device
|
||||
'and that on the primary display this will return
|
||||
'an empty string
|
||||
|
||||
Dim ddEnum As DirectDrawEnum
|
||||
Dim strGuid As String
|
||||
|
||||
Set ddEnum = m_dx.GetDDEnum()
|
||||
OutList.AddItem "Display Cards"
|
||||
For i = 1 To ddEnum.GetCount()
|
||||
|
||||
|
||||
OutList.AddItem " Index " + Str(i)
|
||||
OutList.AddItem " Description " + ddEnum.GetDescription(i)
|
||||
OutList.AddItem " Name " + ddEnum.GetName(i)
|
||||
OutList.AddItem " GUID " + ddEnum.GetGuid(i)
|
||||
OutList.AddItem ""
|
||||
|
||||
strGuid = ddEnum.GetGuid(i)
|
||||
GetDDCaps strGuid
|
||||
GetD3DDevices strGuid
|
||||
GetDisplayModes strGuid
|
||||
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetDDCaps(sGuid As String)
|
||||
Dim dd As DirectDraw7
|
||||
Dim hwCaps As DDCAPS 'HARDWARE
|
||||
Dim helCaps As DDCAPS 'SOFTWARE EMULATION
|
||||
|
||||
Set dd = m_dx.DirectDrawCreate(sGuid)
|
||||
dd.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL
|
||||
|
||||
'Its always a good idea to figure out if the HW
|
||||
'supports a feature
|
||||
'may un supported features however are emulated via
|
||||
'software but are much slower
|
||||
'This code provide an example of querying the hw.
|
||||
'Note there is a seperate caps call for determining
|
||||
'3d capabilities
|
||||
|
||||
dd.GetCaps hwCaps, helCaps
|
||||
|
||||
'how much video memory is available
|
||||
OutList.AddItem " HW CAPS"
|
||||
OutList.AddItem " total video memory " + Str(hwCaps.lVidMemTotal)
|
||||
OutList.AddItem " free video memory " + Str(hwCaps.lVidMemFree)
|
||||
|
||||
|
||||
'Palette Support
|
||||
'Most apps dont use palettes since
|
||||
'all cards support 16bpp
|
||||
'Some apps use 8bpp for speed
|
||||
|
||||
lVal = hwCaps.lPalCaps
|
||||
If (lVal = 0) Then
|
||||
OutList.AddItem " no hw palette support"
|
||||
End If
|
||||
If (lVal And DDPCAPS_1BIT) Then
|
||||
OutList.AddItem " palette support 1bpp "
|
||||
End If
|
||||
If (lVal And DDPCAPS_2BIT) Then
|
||||
OutList.AddItem " palette support 2bit "
|
||||
End If
|
||||
If (lVal And DDPCAPS_8BIT) Then
|
||||
OutList.AddItem " palette support 8bit "
|
||||
End If
|
||||
If (lVal And DDPCAPS_8BITENTRIES) Then
|
||||
OutList.AddItem " palette support 8bit entries "
|
||||
End If
|
||||
If (lVal And DDPCAPS_ALLOW256) Then
|
||||
OutList.AddItem " palette support setting all 256 colors"
|
||||
End If
|
||||
|
||||
'do we support the gamma ramp interface?
|
||||
lVal = hwCaps.ddsCaps.lCaps2
|
||||
If lVal And DDCAPS2_CANCALIBRATEGAMMA Then
|
||||
OutList.AddItem " supports gamma correction"
|
||||
Else
|
||||
OutList.AddItem " no support for gamma correction"
|
||||
End If
|
||||
|
||||
Set dd = Nothing
|
||||
End Sub
|
||||
|
||||
Sub GetD3DDevices(sGuid As String)
|
||||
Dim d3denum As Direct3DEnumDevices
|
||||
|
||||
Dim helDesc As D3DDEVICEDESC7
|
||||
Dim hwDesc As D3DDEVICEDESC7
|
||||
Dim dd As DirectDraw7
|
||||
Dim ddSurf As DirectDrawSurface7
|
||||
Dim d3d As Direct3D7
|
||||
Set dd = m_dx.DirectDrawCreate(sGuid)
|
||||
Set d3d = dd.GetDirect3D()
|
||||
|
||||
OutList.AddItem " D3D devices"
|
||||
|
||||
'NOTE its important not to get to bogged down
|
||||
'in understand the caps bits. particularly
|
||||
'if using the retained mode api.
|
||||
|
||||
'things become more important if you want to run
|
||||
'use specialized features such as blending and
|
||||
'multiple texture stages
|
||||
|
||||
'there are cards that dont have a zbuffer
|
||||
'that may need there triangles sorted..
|
||||
'most cards however have zbuffers
|
||||
|
||||
'The color model is the most important aspect in
|
||||
'determining speed. software rasterizers provide
|
||||
'MONOchormatic lighting for more speed.
|
||||
'The sort flags are only important of IM applications
|
||||
'that need to work on HW that doesnt support z buffers
|
||||
|
||||
Set d3denum = d3d.GetDevicesEnum()
|
||||
|
||||
OutList.AddItem ""
|
||||
|
||||
For i = 1 To d3denum.GetCount()
|
||||
|
||||
d3denum.GetDesc i, hwDesc
|
||||
|
||||
|
||||
|
||||
OutList.AddItem " Guid " + d3denum.GetGuid(i)
|
||||
OutList.AddItem " Description " + d3denum.GetDescription(i)
|
||||
OutList.AddItem " Name " + d3denum.GetName(i)
|
||||
|
||||
' you can make
|
||||
|
||||
OutList.AddItem " Device "
|
||||
With hwDesc
|
||||
OutList.AddItem " Max Texture Height " + Str(.lMaxTextureHeight)
|
||||
OutList.AddItem " Max Texture Width " + Str(.lMaxTextureWidth)
|
||||
|
||||
|
||||
If (.lDeviceRenderBitDepth And DDBD_8) Then
|
||||
OutList.AddItem " Supports rendering to 8 bit"
|
||||
End If
|
||||
If (.lDeviceRenderBitDepth And DDBD_16) Then
|
||||
OutList.AddItem " Supports rendering to 16 bit"
|
||||
End If
|
||||
If (.lDeviceRenderBitDepth And DDBD_24) Then
|
||||
OutList.AddItem " Supports rendering to 24 bit"
|
||||
End If
|
||||
If (.lDeviceRenderBitDepth And DDBD_32) Then
|
||||
OutList.AddItem " Supports rendering to 32 bit"
|
||||
End If
|
||||
|
||||
|
||||
If (.lDeviceZBufferBitDepth And DDBD_8) Then
|
||||
OutList.AddItem " Supports 8 bit z buffer"
|
||||
End If
|
||||
If (.lDeviceZBufferBitDepth And DDBD_16) Then
|
||||
OutList.AddItem " Supports 16 bit z buffer"
|
||||
End If
|
||||
If (.lDeviceZBufferBitDepth And DDBD_24) Then
|
||||
OutList.AddItem " Supports 24 bit z buffer"
|
||||
End If
|
||||
If (.lDeviceZBufferBitDepth And DDBD_32) Then
|
||||
OutList.AddItem " Supports 32 bit z buffer"
|
||||
End If
|
||||
If (.lDeviceZBufferBitDepth = 0) Then
|
||||
OutList.AddItem " no z buffer support"
|
||||
End If
|
||||
|
||||
|
||||
If (.lDevCaps And D3DDEVCAPS_TEXTURENONLOCALVIDMEM) Then
|
||||
OutList.AddItem " Supports AGP textures"
|
||||
End If
|
||||
If (.lDevCaps And D3DDEVCAPS_SORTDECREASINGZ) Then
|
||||
OutList.AddItem " IM triangles must be sorted by decreasing depth"
|
||||
End If
|
||||
If (.lDevCaps And D3DDEVCAPS_SORTDECREASINGZ) Then
|
||||
OutList.AddItem " IM triangles must be sorted exactly"
|
||||
End If
|
||||
If (.lDevCaps And D3DDEVCAPS_SORTINCREASINGZ) Then
|
||||
OutList.AddItem " IM triangles must be sorted by increasing depth"
|
||||
End If
|
||||
|
||||
If (.lDevCaps And D3DDEVCAPS_TEXTUREVIDEOMEMORY) Then
|
||||
OutList.AddItem " IM can uses video memory to store textures"
|
||||
End If
|
||||
|
||||
End With
|
||||
|
||||
|
||||
OutList.AddItem ""
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Resize()
|
||||
If Me.Width > 100 Then
|
||||
OutList.Width = Me.Width - 100
|
||||
End If
|
||||
If Me.Height > 400 Then
|
||||
OutList.Height = Me.Height - 400
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,30 @@
|
||||
Type=Exe
|
||||
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
|
||||
Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
|
||||
Form=ddtut5.frm
|
||||
Startup="DDDisplayCardInfo"
|
||||
Command32=""
|
||||
Name="Project1"
|
||||
HelpContextID="0"
|
||||
CompatibleMode="0"
|
||||
MajorVer=1
|
||||
MinorVer=0
|
||||
RevisionVer=0
|
||||
AutoIncrementVer=0
|
||||
ServerSupportFiles=0
|
||||
VersionCompanyName="Microsoft Corp"
|
||||
CompilationType=0
|
||||
OptimizationType=0
|
||||
FavorPentiumPro(tm)=0
|
||||
CodeViewDebugInfo=0
|
||||
NoAliasing=0
|
||||
BoundsCheck=0
|
||||
OverflowCheck=0
|
||||
FlPointCheck=0
|
||||
FDIVCheck=0
|
||||
UnroundedFP=0
|
||||
StartMode=0
|
||||
Unattended=0
|
||||
Retained=0
|
||||
ThreadPerObject=0
|
||||
MaxNumberOfThreads=1
|
||||
Reference in New Issue
Block a user