Mim Ajude com erro

por Bluezac Qua 13 Mar 2013, 20:44

Galera sera que vcs poderia mim ajudar nesse erro aqui que eo esto passando por favor se alguem mim ajudar so aradesso e se alguem pude mim add ai nos contatos valeu ai vo mostra uma imagem em foto e outra vo mostra como ta o codigo la com isso ele da ru time erro 91 valeu ai

Código:: Public DDS_Primary As DirectDrawSurface7 Public DDSD_Primary As DDSURFACEDESC2 ' back buffer Public DDS_BackBuffer As DirectDrawSurface7 Public DDSD_BackBuffer As DDSURFACEDESC2 ' Used for pre-rendering Public DDS_Map As DirectDrawSurface7 Public DDSD_Map As DDSURFACEDESC2 ' gfx buffers Public DDS_Item() As DirectDrawSurface7 ' arrays Public DDS_Character() As DirectDrawSurface7 Public DDS_Paperdoll() As DirectDrawSurface7 Public DDS_Tileset() As DirectDrawSurface7 Public DDS_Resource() As DirectDrawSurface7 Public DDS_Animation() As DirectDrawSurface7 Public DDS_SpellIcon() As DirectDrawSurface7 Public DDS_Face() As DirectDrawSurface7 Public DDS_Door As DirectDrawSurface7 ' singes Public DDS_Blood As DirectDrawSurface7 Public DDS_Misc As DirectDrawSurface7 Public DDS_Direction As DirectDrawSurface7 Public DDS_Target As DirectDrawSurface7 Public DDS_Bars As DirectDrawSurface7 Public DDS_MiniMap As DirectDrawSurface7 Public DDS_Snow As DirectDrawSurface7 Public DDS_Bird As DirectDrawSurface7 Public DDS_Sand As DirectDrawSurface7 Public DDS_Projectile() As DirectDrawSurface7 ' descriptions Public DDSD_Temp As DDSURFACEDESC2 ' arrays Public DDSD_Item() As DDSURFACEDESC2 Public DDSD_Character() As DDSURFACEDESC2 Public DDSD_Paperdoll() As DDSURFACEDESC2 Public DDSD_Tileset() As DDSURFACEDESC2 Public DDSD_Resource() As DDSURFACEDESC2 Public DDSD_Animation() As DDSURFACEDESC2 Public DDSD_SpellIcon() As DDSURFACEDESC2 Public DDSD_Face() As DDSURFACEDESC2 Public DDSD_Door As DDSURFACEDESC2 ' singles Public DDSD_Blood As DDSURFACEDESC2 Public DDSD_Misc As DDSURFACEDESC2 Public DDSD_Direction As DDSURFACEDESC2 Public DDSD_Target As DDSURFACEDESC2 Public DDSD_Bars As DDSURFACEDESC2 Public DDSD_MiniMap As DDSURFACEDESC2 Public DDSD_Snow As DDSURFACEDESC2 Public DDSD_Bird As DDSURFACEDESC2 Public DDSD_Sand As DDSURFACEDESC2 Public DDSD_Projectile() As DDSURFACEDESC2 ' timers Public Const SurfaceTimerMax As Long = 10000 Public CharacterTimer() As Long Public PaperdollTimer() As Long Public ItemTimer() As Long Public ResourceTimer() As Long Public AnimationTimer() As Long Public SpellIconTimer() As Long Public FaceTimer() As Long ' Number of graphic files Public NumTileSets As Long Public NumCharacters As Long Public NumPaperdolls As Long Public NumItems As Long Public NumResources As Long Public NumAnimations As Long Public NumSpellIcons As Long Public NumProjectiles As Long Public NumFaces As Long ' ******************** ' ** Initialization ** ' ******************** Public Function InitDirectDraw() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Clear DD7 Call DestroyDirectDraw ' Init Direct Draw Set DD = DX7.DirectDrawCreate(vbNullString) ' Windowed DD.SetCooperativeLevel frmMain.hWnd, DDSCL_NORMAL ' Init type and set the primary surface With DDSD_Primary .lFlags = DDSD_CAPS .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE .lBackBufferCount = 1 End With Set DDS_Primary = DD.CreateSurface(DDSD_Primary) ' Create the clipper Set DD_Clip = DD.CreateClipper(0) ' Associate the picture hwnd with the clipper DD_Clip.SetHWnd frmMain.picScreen.hWnd ' Have the blits to the screen clipped to the picture box DDS_Primary.SetClipper DD_Clip ' Initialise the surfaces InitSurfaces ' We're done InitDirectDraw = True ' Error handler Exit Function errorhandler: HandleError "InitDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Private Sub InitSurfaces() Dim Rec As DxVBLib.RECT ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' DirectDraw Surface memory management setting DDSD_Temp.lFlags = DDSD_CAPS DDSD_Temp.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY ' clear out everything for re-init Set DDS_BackBuffer = Nothing ' Initialize back buffer With DDSD_BackBuffer .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT .ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps .lWidth = (MAX_MAPX + 3) * PIC_X .lHeight = (MAX_MAPY + 3) * PIC_Y End With Set DDS_BackBuffer = DD.CreateSurface(DDSD_BackBuffer) ' load persistent surfaces If FileExist(App.Path & "\data files\graphics\door.png", True) Then Call InitDDSurf("door", DDSD_Door, DDS_Door) If FileExist(App.Path & "\data files\graphics\direction.png", True) Then Call InitDDSurf("direction", DDSD_Direction, DDS_Direction) If FileExist(App.Path & "\data files\graphics\target.png", True) Then Call InitDDSurf("target", DDSD_Target, DDS_Target) If FileExist(App.Path & "\data files\graphics\misc.png", True) Then Call InitDDSurf("misc", DDSD_Misc, DDS_Misc) If FileExist(App.Path & "\data files\graphics\blood.png", True) Then Call InitDDSurf("blood", DDSD_Blood, DDS_Blood) If FileExist(App.Path & "\data files\graphics\bars.png", True) Then Call InitDDSurf("bars", DDSD_Bars, DDS_Bars) If FileExist(App.Path & "\data files\graphics\minimap.png", True) Then Call InitDDSurf("minimap", DDSD_MiniMap, DDS_MiniMap) If FileExist(App.Path & "\data files\graphics\snow.png", True) Then Call InitDDSurf("snow", DDSD_Snow, DDS_Snow) If FileExist(App.Path & "\data files\graphics\bird.png", True) Then Call InitDDSurf("bird", DDSD_Bird, DDS_Bird) If FileExist(App.Path & "\data files\graphics\sand.png", True) Then Call InitDDSurf("sand", DDSD_Sand, DDS_Sand) ' count the blood sprites BloodCount = DDSD_Blood.lWidth / 32 ' Error handler Exit Sub errorhandler: HandleError "InitSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ' This sub gets the mask color from the surface loaded from a bitmap image Public Sub SetMaskColorFromPixel(ByRef TheSurface As DirectDrawSurface7, ByVal X As Long, ByVal Y As Long) Dim TmpR As RECT Dim TmpDDSD As DDSURFACEDESC2 Dim TmpColorKey As DDCOLORKEY ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler With TmpR .Left = X .top = Y .Right = X .Bottom = Y End With TheSurface.Lock TmpR, TmpDDSD, DDLOCK_WAIT Or DDLOCK_READONLY, 0 With TmpColorKey .Low = TheSurface.GetLockedPixel(X, Y) .High = .Low End With TheSurface.SetColorKey DDCKEY_SRCBLT, TmpColorKey TheSurface.Unlock TmpR ' Error handler Exit Sub errorhandler: HandleError "SetMaskColorFromPixel", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ' Initializing a surface, using a bitmap Public Sub InitDDSurf(fileName As String, ByRef SurfDesc As DDSURFACEDESC2, ByRef Surf As DirectDrawSurface7) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Set path fileName = App.Path & GFX_PATH & fileName & GFX_EXT ' Destroy surface if it exist If Not Surf Is Nothing Then Set Surf = Nothing Call ZeroMemory(ByVal VarPtr(SurfDesc), LenB(SurfDesc)) End If ' set flags SurfDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH SurfDesc.ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps ' init object Set Surf = LoadImage(fileName, DD, SurfDesc) ' Set mask Call SetMaskColorFromPixel(Surf, 0, 0) ' Error handler Exit Sub errorhandler: HandleError "InitDDSurf", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Function CheckSurfaces() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Check if we need to restore surfaces If Not DD.TestCooperativeLevel = DD_OK Then CheckSurfaces = False Else CheckSurfaces = True End If ' Error handler Exit Function errorhandler: HandleError "CheckSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Private Function NeedToRestoreSurfaces() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Not DD.TestCooperativeLevel = DD_OK Then NeedToRestoreSurfaces = True End If ' Error handler Exit Function errorhandler: HandleError "NeedToRestoreSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Public Sub ReInitDD() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Call InitDirectDraw LoadTilesets ' Error handler Exit Sub errorhandler: HandleError "ReInitDD", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub DestroyDirectDraw() Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Unload DirectDraw Set DDS_Misc = Nothing For i = 1 To NumTileSets Set DDS_Tileset(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Tileset(i)), LenB(DDSD_Tileset(i)) Next For i = 1 To NumItems Set DDS_Item(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Item(i)), LenB(DDSD_Item(i)) Next For i = 1 To NumCharacters Set DDS_Character(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Character(i)), LenB(DDSD_Character(i)) Next For i = 1 To NumPaperdolls Set DDS_Paperdoll(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Paperdoll(i)), LenB(DDSD_Paperdoll(i)) Next For i = 1 To NumResources Set DDS_Resource(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Resource(i)), LenB(DDSD_Resource(i)) Next For i = 1 To NumAnimations Set DDS_Animation(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Animation(i)), LenB(DDSD_Animation(i)) Next For i = 1 To NumSpellIcons Set DDS_SpellIcon(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_SpellIcon(i)), LenB(DDSD_SpellIcon(i)) Next For i = 1 To NumFaces Set DDS_Face(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i)) Next For i = 1 To NumProjectiles Set DDS_Projectile(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Projectile(i)), LenB(DDSD_Projectile(i)) Next Set DDS_Blood = Nothing ZeroMemory ByVal VarPtr(DDSD_Blood), LenB(DDSD_Blood) Set DDS_Door = Nothing ZeroMemory ByVal VarPtr(DDSD_Door), LenB(DDSD_Door) Set DDS_Direction = Nothing ZeroMemory ByVal VarPtr(DDSD_Direction), LenB(DDSD_Direction) Set DDS_Target = Nothing ZeroMemory ByVal VarPtr(DDSD_Target), LenB(DDSD_Target) Set DDS_MiniMap = Nothing ZeroMemory ByVal VarPtr(DDSD_MiniMap), LenB(DDSD_MiniMap) Set DDS_Snow = Nothing 'neve ZeroMemory ByVal VarPtr(DDSD_Snow), LenB(DDSD_Snow) Set DDS_Bird = Nothing ZeroMemory ByVal VarPtr(DDSD_Bird), LenB(DDSD_Bird) Set DDS_Sand = Nothing ZeroMemory ByVal VarPtr(DDSD_Sand), LenB(DDSD_Sand) Set DDS_BackBuffer = Nothing Set DDS_Primary = Nothing Set DD_Clip = Nothing Set DD = Nothing ' Error handler Exit Sub errorhandler: HandleError "DestroyDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Function LoadPNG(fileName As String, Optional Errore As Boolean) As StdPicture On Error GoTo er: Dim PictureDecoder As New PAINTXLib.PictureDecoder Set LoadPNG = PictureDecoder.LoadPicture(fileName) Exit Function er: If Errore Then MsgBox "Erreur de chargement de " & fileName & vbCrLf & "Verifiez qu'il soit présent." End Function Public Function LoadImage(fileName As String, DDraw As DirectDraw7, SDesc As DDSURFACEDESC2) As DirectDrawSurface7 Dim TPict As StdPicture Set TPict = LoadPNG(fileName, True) SDesc.lHeight = CLng((TPict.Height * 0.001) * 567 / Screen.TwipsPerPixelY) SDesc.lWidth = CLng((TPict.Width * 0.001) * 567 / Screen.TwipsPerPixelX) Set LoadImage = DDraw.CreateSurface(SDesc) Dim SDC As Long, TDC As Long SDC = LoadImage.GetDC TDC = CreateCompatibleDC(0) SelectObject TDC, TPict.Handle BitBlt SDC, 0, 0, SDesc.lWidth, SDesc.lHeight, TDC, 0, 0, vbSrcCopy LoadImage.ReleaseDC SDC DeleteDC TDC Set TPict = Nothing End Function Public DDS_Primary As DirectDrawSurface7 Public DDSD_Primary As DDSURFACEDESC2 ' back buffer Public DDS_BackBuffer As DirectDrawSurface7 Public DDSD_BackBuffer As DDSURFACEDESC2 ' Used for pre-rendering Public DDS_Map As DirectDrawSurface7 Public DDSD_Map As DDSURFACEDESC2 ' gfx buffers Public DDS_Item() As DirectDrawSurface7 ' arrays Public DDS_Character() As DirectDrawSurface7 Public DDS_Paperdoll() As DirectDrawSurface7 Public DDS_Tileset() As DirectDrawSurface7 Public DDS_Resource() As DirectDrawSurface7 Public DDS_Animation() As DirectDrawSurface7 Public DDS_SpellIcon() As DirectDrawSurface7 Public DDS_Face() As DirectDrawSurface7 Public DDS_Door As DirectDrawSurface7 ' singes Public DDS_Blood As DirectDrawSurface7 Public DDS_Misc As DirectDrawSurface7 Public DDS_Direction As DirectDrawSurface7 Public DDS_Target As DirectDrawSurface7 Public DDS_Bars As DirectDrawSurface7 Public DDS_MiniMap As DirectDrawSurface7 Public DDS_Snow As DirectDrawSurface7 Public DDS_Bird As DirectDrawSurface7 Public DDS_Sand As DirectDrawSurface7 Public DDS_Projectile() As DirectDrawSurface7 ' descriptions Public DDSD_Temp As DDSURFACEDESC2 ' arrays Public DDSD_Item() As DDSURFACEDESC2 Public DDSD_Character() As DDSURFACEDESC2 Public DDSD_Paperdoll() As DDSURFACEDESC2 Public DDSD_Tileset() As DDSURFACEDESC2 Public DDSD_Resource() As DDSURFACEDESC2 Public DDSD_Animation() As DDSURFACEDESC2 Public DDSD_SpellIcon() As DDSURFACEDESC2 Public DDSD_Face() As DDSURFACEDESC2 Public DDSD_Door As DDSURFACEDESC2 ' singles Public DDSD_Blood As DDSURFACEDESC2 Public DDSD_Misc As DDSURFACEDESC2 Public DDSD_Direction As DDSURFACEDESC2 Public DDSD_Target As DDSURFACEDESC2 Public DDSD_Bars As DDSURFACEDESC2 Public DDSD_MiniMap As DDSURFACEDESC2 Public DDSD_Snow As DDSURFACEDESC2 Public DDSD_Bird As DDSURFACEDESC2 Public DDSD_Sand As DDSURFACEDESC2 Public DDSD_Projectile() As DDSURFACEDESC2 ' timers Public Const SurfaceTimerMax As Long = 10000 Public CharacterTimer() As Long Public PaperdollTimer() As Long Public ItemTimer() As Long Public ResourceTimer() As Long Public AnimationTimer() As Long Public SpellIconTimer() As Long Public FaceTimer() As Long ' Number of graphic files Public NumTileSets As Long Public NumCharacters As Long Public NumPaperdolls As Long Public NumItems As Long Public NumResources As Long Public NumAnimations As Long Public NumSpellIcons As Long Public NumProjectiles As Long Public NumFaces As Long ' ******************** ' ** Initialization ** ' ******************** Public Function InitDirectDraw() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Clear DD7 Call DestroyDirectDraw ' Init Direct Draw Set DD = DX7.DirectDrawCreate(vbNullString) ' Windowed DD.SetCooperativeLevel frmMain.hWnd, DDSCL_NORMAL ' Init type and set the primary surface With DDSD_Primary .lFlags = DDSD_CAPS .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE .lBackBufferCount = 1 End With Set DDS_Primary = DD.CreateSurface(DDSD_Primary) ' Create the clipper Set DD_Clip = DD.CreateClipper(0) ' Associate the picture hwnd with the clipper DD_Clip.SetHWnd frmMain.picScreen.hWnd ' Have the blits to the screen clipped to the picture box DDS_Primary.SetClipper DD_Clip ' Initialise the surfaces InitSurfaces ' We're done InitDirectDraw = True ' Error handler Exit Function errorhandler: HandleError "InitDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Private Sub InitSurfaces() Dim Rec As DxVBLib.RECT ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' DirectDraw Surface memory management setting DDSD_Temp.lFlags = DDSD_CAPS DDSD_Temp.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY ' clear out everything for re-init Set DDS_BackBuffer = Nothing ' Initialize back buffer With DDSD_BackBuffer .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT .ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps .lWidth = (MAX_MAPX + 3) * PIC_X .lHeight = (MAX_MAPY + 3) * PIC_Y End With Set DDS_BackBuffer = DD.CreateSurface(DDSD_BackBuffer) ' load persistent surfaces If FileExist(App.Path & "\data files\graphics\door.png", True) Then Call InitDDSurf("door", DDSD_Door, DDS_Door) If FileExist(App.Path & "\data files\graphics\direction.png", True) Then Call InitDDSurf("direction", DDSD_Direction, DDS_Direction) If FileExist(App.Path & "\data files\graphics\target.png", True) Then Call InitDDSurf("target", DDSD_Target, DDS_Target) If FileExist(App.Path & "\data files\graphics\misc.png", True) Then Call InitDDSurf("misc", DDSD_Misc, DDS_Misc) If FileExist(App.Path & "\data files\graphics\blood.png", True) Then Call InitDDSurf("blood", DDSD_Blood, DDS_Blood) If FileExist(App.Path & "\data files\graphics\bars.png", True) Then Call InitDDSurf("bars", DDSD_Bars, DDS_Bars) If FileExist(App.Path & "\data files\graphics\minimap.png", True) Then Call InitDDSurf("minimap", DDSD_MiniMap, DDS_MiniMap) If FileExist(App.Path & "\data files\graphics\snow.png", True) Then Call InitDDSurf("snow", DDSD_Snow, DDS_Snow) If FileExist(App.Path & "\data files\graphics\bird.png", True) Then Call InitDDSurf("bird", DDSD_Bird, DDS_Bird) If FileExist(App.Path & "\data files\graphics\sand.png", True) Then Call InitDDSurf("sand", DDSD_Sand, DDS_Sand) ' count the blood sprites BloodCount = DDSD_Blood.lWidth / 32 ' Error handler Exit Sub errorhandler: HandleError "InitSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ' This sub gets the mask color from the surface loaded from a bitmap image Public Sub SetMaskColorFromPixel(ByRef TheSurface As DirectDrawSurface7, ByVal X As Long, ByVal Y As Long) Dim TmpR As RECT Dim TmpDDSD As DDSURFACEDESC2 Dim TmpColorKey As DDCOLORKEY ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler With TmpR .Left = X .top = Y .Right = X .Bottom = Y End With TheSurface.Lock TmpR, TmpDDSD, DDLOCK_WAIT Or DDLOCK_READONLY, 0 With TmpColorKey .Low = TheSurface.GetLockedPixel(X, Y) .High = .Low End With TheSurface.SetColorKey DDCKEY_SRCBLT, TmpColorKey TheSurface.Unlock TmpR ' Error handler Exit Sub errorhandler: HandleError "SetMaskColorFromPixel", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub ' Initializing a surface, using a bitmap Public Sub InitDDSurf(fileName As String, ByRef SurfDesc As DDSURFACEDESC2, ByRef Surf As DirectDrawSurface7) ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Set path fileName = App.Path & GFX_PATH & fileName & GFX_EXT ' Destroy surface if it exist If Not Surf Is Nothing Then Set Surf = Nothing Call ZeroMemory(ByVal VarPtr(SurfDesc), LenB(SurfDesc)) End If ' set flags SurfDesc.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH SurfDesc.ddsCaps.lCaps = DDSD_Temp.ddsCaps.lCaps ' init object Set Surf = LoadImage(fileName, DD, SurfDesc) ' Set mask Call SetMaskColorFromPixel(Surf, 0, 0) ' Error handler Exit Sub errorhandler: HandleError "InitDDSurf", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Function CheckSurfaces() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Check if we need to restore surfaces If Not DD.TestCooperativeLevel = DD_OK Then CheckSurfaces = False Else CheckSurfaces = True End If ' Error handler Exit Function errorhandler: HandleError "CheckSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Private Function NeedToRestoreSurfaces() As Boolean ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler If Not DD.TestCooperativeLevel = DD_OK Then NeedToRestoreSurfaces = True End If ' Error handler Exit Function errorhandler: HandleError "NeedToRestoreSurfaces", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Function End Function Public Sub ReInitDD() ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler Call InitDirectDraw LoadTilesets ' Error handler Exit Sub errorhandler: HandleError "ReInitDD", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Sub DestroyDirectDraw() Dim i As Long ' If debug mode, handle error then exit out If Options.Debug = 1 Then On Error GoTo errorhandler ' Unload DirectDraw Set DDS_Misc = Nothing For i = 1 To NumTileSets Set DDS_Tileset(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Tileset(i)), LenB(DDSD_Tileset(i)) Next For i = 1 To NumItems Set DDS_Item(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Item(i)), LenB(DDSD_Item(i)) Next For i = 1 To NumCharacters Set DDS_Character(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Character(i)), LenB(DDSD_Character(i)) Next For i = 1 To NumPaperdolls Set DDS_Paperdoll(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Paperdoll(i)), LenB(DDSD_Paperdoll(i)) Next For i = 1 To NumResources Set DDS_Resource(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Resource(i)), LenB(DDSD_Resource(i)) Next For i = 1 To NumAnimations Set DDS_Animation(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Animation(i)), LenB(DDSD_Animation(i)) Next For i = 1 To NumSpellIcons Set DDS_SpellIcon(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_SpellIcon(i)), LenB(DDSD_SpellIcon(i)) Next For i = 1 To NumFaces Set DDS_Face(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Face(i)), LenB(DDSD_Face(i)) Next For i = 1 To NumProjectiles Set DDS_Projectile(i) = Nothing ZeroMemory ByVal VarPtr(DDSD_Projectile(i)), LenB(DDSD_Projectile(i)) Next Set DDS_Blood = Nothing ZeroMemory ByVal VarPtr(DDSD_Blood), LenB(DDSD_Blood) Set DDS_Door = Nothing ZeroMemory ByVal VarPtr(DDSD_Door), LenB(DDSD_Door) Set DDS_Direction = Nothing ZeroMemory ByVal VarPtr(DDSD_Direction), LenB(DDSD_Direction) Set DDS_Target = Nothing ZeroMemory ByVal VarPtr(DDSD_Target), LenB(DDSD_Target) Set DDS_MiniMap = Nothing ZeroMemory ByVal VarPtr(DDSD_MiniMap), LenB(DDSD_MiniMap) Set DDS_Snow = Nothing 'neve ZeroMemory ByVal VarPtr(DDSD_Snow), LenB(DDSD_Snow) Set DDS_Bird = Nothing ZeroMemory ByVal VarPtr(DDSD_Bird), LenB(DDSD_Bird) Set DDS_Sand = Nothing ZeroMemory ByVal VarPtr(DDSD_Sand), LenB(DDSD_Sand) Set DDS_BackBuffer = Nothing Set DDS_Primary = Nothing Set DD_Clip = Nothing Set DD = Nothing ' Error handler Exit Sub errorhandler: HandleError "DestroyDirectDraw", "modDirectDraw7", Err.Number, Err.Description, Err.Source, Err.HelpContext Err.Clear Exit Sub End Sub Public Function LoadPNG(fileName As String, Optional Errore As Boolean) As StdPicture On Error GoTo er: Dim PictureDecoder As New PAINTXLib.PictureDecoder Set LoadPNG = PictureDecoder.LoadPicture(fileName) Exit Function er: If Errore Then MsgBox "Erreur de chargement de " & fileName & vbCrLf & "Verifiez qu'il soit présent." End Function Public Function LoadImage(fileName As String, DDraw As DirectDraw7, SDesc As DDSURFACEDESC2) As DirectDrawSurface7 Dim TPict As StdPicture Set TPict = LoadPNG(fileName, True) [color=yellow] SDesc.lHeight = CLng((TPict.Height * 0.001) * 567 / Screen.TwipsPerPixelY)[/color] SDesc.lWidth = CLng((TPict.Width * 0.001) * 567 / Screen.TwipsPerPixelX) Set LoadImage = DDraw.CreateSurface(SDesc) Dim SDC As Long, TDC As Long SDC = LoadImage.GetDC TDC = CreateCompatibleDC(0) SelectObject TDC, TPict.Handle BitBlt SDC, 0, 0, SDesc.lWidth, SDesc.lHeight, TDC, 0, 0, vbSrcCopy LoadImage.ReleaseDC SDC DeleteDC TDC Set TPict = Nothing End Function

https://2img.net/r/ihimg/photo/my-images/248/erro91.jpg/https://2img.net/r/ihimg/photo/my-images/248/erro91.jpg/

por Pablo Qua 13 Mar 2013, 21:15

o Tópico foi Editado, lembre-se de postar com o elemento "code" nas linhas de código.

Atenciosamente,
Pablo

por Bluezac Qua 13 Mar 2013, 21:32

valeu pablo pela ajuda men tem como vc mim ajuda com uma coisa eu consegir ajeita mais ou menos mais agora a engine não ver nenhuma das partes do graphics a não ser a gui como fasso pra ela agora passar a ver os cha e mapas no caso tilits animação vo tira print aquui

https://2img.net/r/ihimg/photo/my-images/33/dbzpreto.jpg/

VALEU AI SE ALGUEM PUDER MIM AJUDAR

MAIS UM ERRO QUE ACHEI A RESPEITO DA IMAGEM DAI DE CIMA

https://2img.net/r/ihimg/photo/my-images/5/erro291.jpg/

por Bluezac Sex 15 Mar 2013, 09:01

como já se passaram mais de 24h acredito que já possa postar galera da uma força aqui com esses último erro pq não ta aparecendo nada do graphic quem ajuda só agraddeso

por GuiinhoLP Sex 15 Mar 2013, 14:26

Cuidado Duble Post. Bluezac

por Bluezac Sex 15 Mar 2013, 15:46

segundo as regras depois de 24h não é caracterizado duplos post mais presizo de pessoas que mim ajude

por RenanR Sex 15 Mar 2013, 16:04

Olá, que engine está usando?

por Bluezac Sex 15 Mar 2013, 17:05

eclypse advance

por Conteúdo patrocinado

Mim Ajude com erro

Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro

Re: Mim Ajude com erro