i'm trying learning directx with vb6.
i have these code for work with fullscreen:
these code works fine. well except when we close the programCode:Public Function Initialise() As Boolean On Error GoTo ErrHandler: Dim DispMode As D3DDISPLAYMODE '//Describes our Display Mode Dim D3DWindow As D3DPRESENT_PARAMETERS '//Describes our Viewport Set Dx = New DirectX8 '//Create our Master Object Set D3D = Dx.Direct3DCreate() '//Make our Master Object create the Direct3D Interface DispMode.Format = D3DFMT_X8R8G8B8 DispMode.Width = 640 DispMode.Height = 480 D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP D3DWindow.BackBufferCount = 1 '//1 backbuffer only D3DWindow.BackBufferFormat = DispMode.Format 'What we specified earlier D3DWindow.BackBufferHeight = 480 D3DWindow.BackBufferWidth = 640 D3DWindow.hDeviceWindow = Form1.hWnd Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Form1.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DWindow) Initialise = True '//We succeeded Exit Function ErrHandler: '//We failed; for now we wont worry about why. Initialise = False End Function
heres the rest of code:
why, when we close the program, the vb6 IDE and other programs change their window(and some controls) size?Code:Option Explicit '//The variables Required Dim Dx As DirectX8 'The master Object, everything comes from here Dim D3D As Direct3D8 'This controls all things 3D Dim D3DDevice As Direct3DDevice8 'This actually represents the hardware doing the rendering Dim bRunning As Boolean 'Controls whether the program is running or not... '//These aren't really required - they'll just show us what the frame rate is... Private Declare Function GetTickCount Lib "kernel32" () As Long '//This is used to get the frame rate. Dim LastTimeCheckFPS As Long '//When did we last check the frame rate? Dim FramesDrawn As Long '//How many frames have been drawn Dim FrameRate As Long '//What the current frame rate is..... Public Sub Render() '//1. We need to clear the render device before we can draw anything 'This must always happen before you start rendering stuff... D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 255, 255), 1#, 0 '1. the D3DColorRGBA() is for give us a color. in these case i use the blue color. i don't use 'the alpha value, that's why i put 255. '//2. Next we would render everything. This lesson doesn't do this, but if it did it'd look something 'like this: D3DDevice.BeginScene 'All rendering calls go between these two lines D3DDevice.EndScene '//3. Update the frame to the screen... 'This is the same as the Primary.Flip method as used in DirectX 7 'These values below should work for almost all cases... D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0 End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then bRunning = False End Sub Private Sub Form_Load() Me.Show '//Make sure our window is visible bRunning = Initialise() Debug.Print "Device Creation Return Code : ", bRunning 'So you can see what happens... Do While bRunning Render '//Update the frame... DoEvents '//Allow windows time to think; otherwise you'll get into a really tight (and bad) loop... 'Calculate the frame rate; how this is done isn't greatly important 'So dont worry about understanding it yet... If GetTickCount - LastTimeCheckFPS >= 1000 Then LastTimeCheckFPS = GetTickCount FrameRate = FramesDrawn '//Store the frame count FramesDrawn = 0 '//Reset the counter Me.Caption = "DirectX-Graphics: Lesson 01 {" & FrameRate & "fps}" '//Display it on screen End If FramesDrawn = FramesDrawn + 1 Loop '//If we've gotten to this point the loop must have been terminated 'So we need to clean up after ourselves. This isn't essential, but it' 'good coding practise. On Error Resume Next 'If the objects were never created; '(the initialisation failed) we might get an 'error when freeing them... which we need to 'handle, but as we're closing anyway... Set D3DDevice = Nothing Set D3D = Nothing Set Dx = Nothing Debug.Print "All Objects Destroyed" '//Final termination: Unload Me End End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) bRunning = False End Sub






Reply With Quote