[ALL]Sistema de Emcriptação de Graficos

Código:

modDirectX

Código:


Sub InitDirectX()

    ' Initialize direct draw
If GetVar(App.Path & "\config.ini", "CONFIG", "FullScreen") = "" Then
Set DD = DX.DirectDrawCreate("")
frmMirage.WindowState = 0
mclsStyle.Titlebar = True
Else
Set DD = DX.DirectDrawCreate("")
DD.SetDisplayMode 800, 600, 16, 0, DDSDM_DEFAULT
mclsStyle.Titlebar = False
End If
frmMirage.Show
   
    ' Indicate windows mode application
    Call DD.SetCooperativeLevel(frmMirage.hwnd, DDSCL_NORMAL)
   
    ' Init type and get the primary surface
    DDSD_Primary.lFlags = DDSD_CAPS
    DDSD_Primary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
    Set DD_PrimarySurf = DD.CreateSurface(DDSD_Primary)
   
    ' Create the clipper
    Set DD_Clip = DD.CreateClipper(0)
   
    ' Associate the picture hwnd with the clipper
    DD_Clip.SetHWnd frmMirage.picScreen.hwnd
       
    ' Have the blits to the screen clipped to the picture box
    DD_PrimarySurf.SetClipper DD_Clip
       
    ' Initialize all surfaces
    Call InitSurfaces
End Sub


Código:


Sub InitDirectX(Optional mmStart As Boolean = False)
    ' Initialize direct draw
    Set DD = DX.DirectDrawCreate("")
 
    ' Indicate windows mode application
    Call DD.SetCooperativeLevel(frmMirage.hwnd, DDSCL_NORMAL)
       
    If mmStart = False Then

       
        frmMirage.Show
        frmMirage.SetFocus
       
        ' Init type and get the primary surface
        DDSD_Primary.lFlags = DDSD_CAPS
        DDSD_Primary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
        Set DD_PrimarySurf = DD.CreateSurface(DDSD_Primary)
       
        ' Create the clipper
        Set DD_Clip = DD.CreateClipper(0)
       
        ' Associate the picture hwnd with the clipper
        DD_Clip.SetHWnd frmMirage.picScreen.hwnd
           
        ' Have the blits to the screen clipped to the picture box
        DD_PrimarySurf.SetClipper DD_Clip
    End If
    ' Initialize all surfaces
    Call InitSurfaces(mmStart)
End Sub


Código:

Sub InitSurfaces()
Dim key As DDCOLORKEY
Dim i As Long

    ' Check for files existing
    If FileExist("\GFX\sprites.bmp") = False Or FileExist("\GFX\Itens.bmp") = False Or FileExist("\GFX\bigsprites.bmp") = False Or FileExist("\GFX\emoticons.bmp") = False Or FileExist("\GFX\Flechas.bmp") = False Then
        Call MsgBox("Alguns arquivos gráficos estão faltando!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If
 
    ' Set the key for masks
    key.low = 0
    key.high = 0
 
    ' Initialize back buffer
    DDSD_BackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    DDSD_BackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    DDSD_BackBuffer.lWidth = (MAX_MAPX + 1) * PIC_X
    DDSD_BackBuffer.lHeight = (MAX_MAPY + 1) * PIC_Y
    Set DD_BackBuffer = DD.CreateSurface(DDSD_BackBuffer)
 
    ' Init sprite ddsd type and load the bitmap
    DDSD_Sprite.lFlags = DDSD_CAPS
    DDSD_Sprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\sprites.bmp", DDSD_Sprite)
    SetMaskColorFromPixel DD_SpriteSurf, 0, 0
 
    ' Init tiles ddsd type and load the bitmap
    For i = 0 To ExtraSheets
        If Dir(App.Path & "\GFX\tiles" & i & ".bmp") <> vbNullString Then
            DDSD_Tile(i).lFlags = DDSD_CAPS
            DDSD_Tile(i).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
            Set DD_TileSurf(i) = DD.CreateSurfaceFromFile(App.Path & "\GFX\tiles" & i & ".bmp", DDSD_Tile(i))
            SetMaskColorFromPixel DD_TileSurf(i), 0, 0
            TileFile(i) = 1
        Else
            TileFile(i) = 0
        End If
    Next i
 
    ' Init items ddsd type and load the bitmap
    DDSD_Item.lFlags = DDSD_CAPS
    DDSD_Item.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ItemSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\Itens.bmp", DDSD_Item)
    SetMaskColorFromPixel DD_ItemSurf, 0, 0
 
    ' Init big sprites ddsd type and load the bitmap
    DDSD_BigSprite.lFlags = DDSD_CAPS
    DDSD_BigSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_BigSpriteSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\bigsprites.bmp", DDSD_BigSprite)
    SetMaskColorFromPixel DD_BigSpriteSurf, 0, 0
 
    ' Init emoticons ddsd type and load the bitmap
    DDSD_Emoticon.lFlags = DDSD_CAPS
    DDSD_Emoticon.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_EmoticonSurf = DD.CreateSurfaceFromFile(App.Path & "\GFX\emoticons.bmp", DDSD_Emoticon)
    SetMaskColorFromPixel DD_EmoticonSurf, 0, 0
 
    ' Init spells ddsd type and load the bitmap
    DDSD_SpellAnim.lFlags = DDSD_CAPS
    DDSD_SpellAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_SpellAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\Magias.bmp", DDSD_SpellAnim)
    SetMaskColorFromPixel DD_SpellAnim, 0, 0
 
    ' Init arrows ddsd type and load the bitmap
    DDSD_ArrowAnim.lFlags = DDSD_CAPS
    DDSD_ArrowAnim.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    Set DD_ArrowAnim = DD.CreateSurfaceFromFile(App.Path & "\GFX\Flechas.bmp", DDSD_ArrowAnim)
    SetMaskColorFromPixel DD_ArrowAnim, 0, 0
End Sub

Código:


Sub InitSurfaces(Optional mmStart As Boolean = False)
Dim Key As DDCOLORKEY
Dim I As Long
Dim StrPW As String

    ' Our password is going to be 'test'.. We set it with Chr$(num)
    ' t = 116, e = 101, s = 115, t = 116
    ' Doing it this way keeps someone from hex editing your password easily.
    ' You can also just do: StrPW = "test" The result would be the same.
    StrPW = "SUASENHAAQUI"
 
    ' Check for files existing
    If FileExist("\GFX\sprites.gfx") = False Or FileExist("\GFX\items.gfx") = False Or FileExist("\GFX\bigsprites.gfx") = False Or FileExist("\GFX\emoticons.gfx") = False Or FileExist("\GFX\arrows.gfx") = False Then
        Call MsgBox("Your missing some graphic files!", vbOKOnly, GAME_NAME)
        Call GameDestroy
    End If
 
    ' Set the key for masks
    Key.low = 0
    Key.high = 0
 
    If Not mmStart Then
        ' Initialize back buffer
        DDSD_BackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
        DDSD_BackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
        DDSD_BackBuffer.lWidth = (MAX_MAPX + 1) * PIC_X
        DDSD_BackBuffer.lHeight = (MAX_MAPY + 1) * PIC_Y
        Set DD_BackBuffer = DD.CreateSurface(DDSD_BackBuffer)
 
      ' Init tiles ddsd type and load the bitmap
      For I = 0 To ExtraSheets
          If Dir(App.Path & "\GFX\tiles" & I & ".gfx") <> "" Then
              Call InitSurface(App.Path & "\GFX\tiles" & I & ".gfx", StrPW, DDSD_Tile(I), DD_TileSurf(I))
              TileFile(I) = 1
          Else
              TileFile(I) = 0
          End If
      Next I
 
      ' Init big sprites ddsd type and load the bitmap
      Call InitSurface(App.Path & "\GFX\bigsprites.gfx", StrPW, DDSD_BigSprite, DD_BigSpriteSurf)
   
      ' Init emoticons ddsd type and load the bitmap
      Call InitSurface(App.Path & "\GFX\emoticons.gfx", StrPW, DDSD_Emoticon, DD_EmoticonSurf)
   
      ' Init spells ddsd type and load the bitmap
      Call InitSurface(App.Path & "\GFX\spells.gfx", StrPW, DDSD_SpellAnim, DD_SpellAnim)
   
      ' Init arrows ddsd type and load the bitmap
      Call InitSurface(App.Path & "\GFX\arrows.gfx", StrPW, DDSD_ArrowAnim, DD_ArrowAnim)
    End If
 
    ' Init sprite ddsd type and load the bitmap
    Call InitSurface(App.Path & "\GFX\sprites.gfx", StrPW, DDSD_Sprite, DD_SpriteSurf)
 
    ' Init items ddsd type and load the bitmap
    Call InitSurface(App.Path & "\GFX\items.gfx", StrPW, DDSD_Item, DD_ItemSurf)

    '' Init items ddsd type and load the bitmap
    '  Call InitSurface(App.Path & "\GFX\minimap.gfx", StrPW, DDSD_MiniMap, DD_MiniMap)
End Sub


Código:

Private Sub InitSurface(ByVal FileName As String, ByVal StrPW As String, ByRef DDSD As DDSURFACEDESC2, ByRef DDSurf As DirectDrawSurface7)
Dim sDc As Long
Dim BMU As BitmapUtils

    Set BMU = New BitmapUtils
 
    With BMU
        Call .LoadByteData(FileName)
        Call .DecryptByteData(StrPW)
        Call .DecompressByteData      'If you want to use zlib, you can change this to .DecompressByteData_ZLib
    End With
 
    DDSD.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    DDSD.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    DDSD.lWidth = BMU.ImageWidth
    DDSD.lHeight = BMU.ImageHeight
 
    Set DDSurf = DD.CreateSurface(DDSD)
 
    sDc = DDSurf.GetDC
    Call BMU.Blt(sDc)
    Call DDSurf.ReleaseDC(sDc)
    Call SetMaskColorFromPixel(DDSurf, 0, 0)
 
    Set BMU = Nothing
End Sub

Código:

ModGameLogic

Código:

Sub GameLoop()
Dim Tick As Long
Dim TickFPS As Long
Dim FPS As Long
Dim x As Long
Dim y As Long
Dim I As Long
Dim rec_back As RECT


Código:


Sub GameLoop()
Dim Tick As Long
Dim TickFPS As Long
Dim FPS As Long
Dim x As Long
Dim y As Long
Dim I As Long
Dim rec_back As RECT
Dim sDc As Long


Código:

 sub gameloop

Código:


' Visual Inventory
Dim Q As Long
Dim Qq As Long
Dim IT As Long

If GetTickCount > IT + 500 And frmMirage.picInv3.Visible = True Then
For Q = 0 To MAX_INV - 1
Qq = Player(MyIndex).Inv(Q + 1).Num

If frmMirage.picInv(Q).Picture <> LoadPicture() Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else
If Qq = 0 Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else

Call BitBlt(frmMirage.picInv(Q).hdc, 0, 0, PIC_X, PIC_Y,
frmMirage.picItems.hdc, (Item(Qq).Pic - Int(Item(Qq).Pic / 6) * 6) *
PIC_X, Int(Item(Qq).Pic / 6) * PIC_Y, SRCCOPY)
End If
End If
Next Q
End If


Código:


' Visual Inventory
Dim Q As Long
Dim Qq As Long
Dim IT As Long

If GetTickCount > IT + 500 And frmMirage.picInv3.Visible = True Then
For Q = 0 To MAX_INV - 1
Qq = Player(MyIndex).Inv(Q + 1).Num

If frmMirage.picInv(Q).Picture <> LoadPicture() Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else
If Qq = 0 Then
frmMirage.picInv(Q).Picture = LoadPicture()
Else
sDc = DD_ItemSurf.GetDC

Call BitBlt(frmMirage.picInv(Q).hDC, 0, 0, PIC_X, PIC_Y,
frmMirage.picItems.hDC, (Item(Qq).Pic - Int(Item(Qq).Pic / 6) * 6) *
PIC_X, Int(Item(Qq).Pic / 6) * PIC_Y, SRCCOPY)
DD_ItemSurf.ReleaseDC (sDc)
End If
End If
Next Q
End If


Código:


Public Sub EditorInit()
Dim I As Long

InEditor = True
InSpawnEditor = False
frmMapEditor.Show vbModeless, frmMirage

frmMapEditor.picBackSelect.Picture = LoadPicture(App.Path & "\GFX\Tiles" & EditorSet & ".bmp")

frmMapEditor.scrlPicture.Max = Int((frmMapEditor.picBackSelect.Height - frmMapEditor.picBack.Height) / PIC_Y)
frmMapEditor.picBack.Width = 448

If GameTime = TIME_NIGHT Then frmMapEditor.chkDayNight.Value = 1
If GameTime = TIME_DAY Then frmMapEditor.chkDayNight.Value = 0
End Sub


Código:


Public Sub EditorInit()
Dim I As Long
Dim sDc As Long

InEditor = True
InSpawnEditor = False
frmMapEditor.Show vbModeless, frmMirage

sDc = DD_TileSurf(EditorSet).GetDC
With frmMapEditor.picBackSelect
.Width = DDSD_Tile(EditorSet).lWidth
.Height = DDSD_Tile(EditorSet).lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_TileSurf(EditorSet).ReleaseDC(sDc)

frmMapEditor.scrlPicture.Max = Int((frmMapEditor.picBackSelect.Height - frmMapEditor.picBack.Height) / PIC_Y)
frmMapEditor.picBack.Width = 448

If GameTime = TIME_NIGHT Then frmMapEditor.chkDayNight.Value = 1
If GameTime = TIME_DAY Then frmMapEditor.chkDayNight.Value = 0
End Sub


Código:


Public Sub EmoticonEditorInit()
frmEmoticonEditor.scrlEmoticon.Max = MAX_EMOTICONS
frmEmoticonEditor.scrlEmoticon.Value = Emoticons(EditorIndex - 1).Pic
frmEmoticonEditor.txtCommand.Text = Trim(Emoticons(EditorIndex - 1).Command)
frmEmoticonEditor.picEmoticons.Picture = LoadPicture(App.Path & "\GFX\emoticons.bmp")
If Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_BOTH Or Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_IMAGE Then frmEmoticonEditor.chkPic.Value = 1
If Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_BOTH Or Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_SOUND Then frmEmoticonEditor.chkSound.Value = 1

frmEmoticonEditor.Show vbModal
End Sub


Código:


Public Sub EmoticonEditorInit()
Dim sDc As Long

frmEmoticonEditor.scrlEmoticon.Max = MAX_EMOTICONS
frmEmoticonEditor.scrlEmoticon.Value = Emoticons(EditorIndex - 1).Pic
frmEmoticonEditor.txtCommand.Text = Trim(Emoticons(EditorIndex - 1).Command)
'frmEmoticonEditor.picEmoticons.Picture = LoadPicture(App.Path & "\GFX\emoticons.bmp")

sDc = DD_EmoticonSurf.GetDC
With frmEmoticonEditor.picEmoticons
.Width = DDSD_Emoticon.lWidth
.Height = DDSD_Emoticon.lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_EmoticonSurf.ReleaseDC(sDc)

If Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_BOTH Or Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_IMAGE Then frmEmoticonEditor.chkPic.Value = 1
If Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_BOTH Or Emoticons(EditorIndex - 1).Type = EMOTICON_TYPE_SOUND Then frmEmoticonEditor.chkSound.Value = 1

frmEmoticonEditor.Show vbModal
End Sub


Código:


Public Sub ArrowEditorInit()
frmEditArrows.scrlArrow.Max = MAX_ARROWS
If Arrows(EditorIndex).Pic = 0 Then Arrows(EditorIndex).Pic = 1
frmEditArrows.scrlArrow.Value = Arrows(EditorIndex).Pic
frmEditArrows.txtName.Text = Arrows(EditorIndex).Name
If Arrows(EditorIndex).Range = 0 Then Arrows(EditorIndex).Range = 1
frmEditArrows.scrlRange.Value = Arrows(EditorIndex).Range
frmEditArrows.picArrows.Picture = LoadPicture(App.Path & "\GFX\Flechas.bmp")
frmEditArrows.Show vbModal
End Sub


Código:


Public Sub ArrowEditorInit()
Dim sDc As Long
frmEditArrows.scrlArrow.Max = MAX_ARROWS
If Arrows(EditorIndex).Pic = 0 Then Arrows(EditorIndex).Pic = 1
frmEditArrows.scrlArrow.Value = Arrows(EditorIndex).Pic
frmEditArrows.txtName.Text = Arrows(EditorIndex).Name
If Arrows(EditorIndex).range = 0 Then Arrows(EditorIndex).range = 1
frmEditArrows.scrlRange.Value = Arrows(EditorIndex).range
'frmEditArrows.picArrows.Picture = LoadPicture(App.Path & "\GFX\arrows.bmp")

sDc = DD_ArrowAnim.GetDC
With frmEditArrows.picArrows
.Width = DDSD_ArrowAnim.lWidth
.Height = DDSD_ArrowAnim.lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_ArrowAnim.ReleaseDC(sDc)

frmEditArrows.Show vbModal
End Sub


Código:


Public Sub ItemEditorInit()
Dim I As Long
EditorItemY = Int(Item(EditorIndex).Pic / 6)
EditorItemX = (Item(EditorIndex).Pic - Int(Item(EditorIndex).Pic / 6) * 6)

frmItemEditor.scrlClassReq.Max = Max_Classes

frmItemEditor.picItems.Picture = LoadPicture(App.Path & "\GFX\Itens.bmp")


Código:


Public Sub ItemEditorInit()
Dim I As Long
Dim sDc As Long

EditorItemY = Int(Item(EditorIndex).Pic / 6)
EditorItemX = (Item(EditorIndex).Pic - Int(Item(EditorIndex).Pic / 6) * 6)

frmItemEditor.scrlClassReq.Max = Max_Classes

sDc = DD_ItemSurf.GetDC
With frmItemEditor.picItems
.Cls
.Width = DDSD_Item.lWidth
.Height = DDSD_Item.lHeight
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_ItemSurf.ReleaseDC(sDc)

'frmItemEditor.picItems.Picture = LoadPicture(App.Path & "\GFX\items.bmp")


Código:


Public Sub NpcEditorBltSprite()
If frmNpcEditor.BigNpc.Value = Checked Then
Call BitBlt(frmNpcEditor.picSprite.hdc, 0, 0, 64, 64, frmNpcEditor.picSprites.hdc, 3 * 64, frmNpcEditor.scrlSprite.Value * 64, SRCCOPY)
Else
Call BitBlt(frmNpcEditor.picSprite.hdc, 0, 0, SIZE_X, SIZE_Y, frmNpcEditor.picSprites.hdc, 3 * SIZE_X, frmNpcEditor.scrlSprite.Value * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
End If
End Sub


Código:


Public Sub NpcEditorBltSprite()
Dim sDc As Long

With frmNpcEditor
If .BigNpc.Value = Checked Then
sDc = DD_BigSpriteSurf.GetDC
.picSprite.Cls
Call BitBlt(.picSprite.hDC, 0, 0, 64, 64, sDc, 3 * 64, .scrlSprite.Value * 64, SRCCOPY)
Call DD_BigSpriteSurf.ReleaseDC(sDc)
Else
sDc = DD_SpriteSurf.GetDC
.picSprite.Cls
Call BitBlt(.picSprite.hDC, 0, 0, SIZE_X, SIZE_Y, sDc, 3 * SIZE_X, .scrlSprite.Value * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
Call DD_SpriteSurf.ReleaseDC(sDc)
End If
End With
End Sub


Código:

Public Sub UpdateVisInv()
Dim Index As Long
Dim d As Long


Código:


Public Sub UpdateVisInv()
Dim Index As Long
Dim d As Long
Dim sDc As Long


Código:


Sub Main()
Dim I As Long
Dim Ending As String


Código:


Sub Main()
Dim I As Long
Dim Ending As String
Dim sDc As Long


Código:


' Check if the maps directory is there, if its not make it
If LCase(Dir(App.Path & "\mapas", vbDirectory)) <> "mapas" Then
Call MkDir(App.Path & "\Mapas")
End If
If UCase(Dir(App.Path & "\GFX", vbDirectory)) <> "GFX" Then
Call MkDir(App.Path & "\GFX")
End If
If UCase(Dir(App.Path & "\GUI", vbDirectory)) <> "GUI" Then
Call MkDir(App.Path & "\GUI")
End If
If LCase(Dir(App.Path & "\músicas", vbDirectory)) <> "músicas" Then
Call MkDir(App.Path & "\Músicas")
End If
If UCase(Dir(App.Path & "\SFX", vbDirectory)) <> "SFX" Then
Call MkDir(App.Path & "\SFX")
End If
If LCase(Dir(App.Path & "\flashs", vbDirectory)) <> "flashs" Then
Call MkDir(App.Path & "\Flashs")


Código:


'Load the DX Surfaces here..
Call InitDirectX(True)


Código:


frmMirage.picItems.Picture = LoadPicture(App.Path & "\GFX\Itens.bmp")
frmSpriteChange.picSprites.Picture = LoadPicture(App.Path & "\GFX\Sprites.bmp")


Código:


sDc = DD_ItemSurf.GetDC
With frmMirage.picItems
.Width = DDSD_Item.lWidth
.Height = DDSD_Item.lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_ItemSurf.ReleaseDC(sDc)

'frmMirage.picItems.Picture = LoadPicture(App.Path & "\GFX\items.bmp")

sDc = DD_SpriteSurf.GetDC
With frmSpriteChange.picSprite
.Width = 480
.Height = 480
.Cls
Call BitBlt(frmSpriteChange.picSprite.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_SpriteSurf.ReleaseDC(sDc)

'frmSpriteChange.Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")


Código:

FrmItemeditor

Código:


Private Sub Form_Load()
picItems.Height = 320 * PIC_Y
Call BitBlt(picSelect.hdc, 0, 0, PIC_X, PIC_Y, picItems.hdc, EditorItemX * PIC_X, EditorItemY * PIC_Y, SRCCOPY)
picBow.Picture = LoadPicture(App.Path & "\GFX\Flechas.bmp")
End Sub


Código:


Private Sub Form_Load()
Dim sDc As Long

picItems.Height = 320 * PIC_Y
Call BitBlt(picSelect.hDC, 0, 0, PIC_X, PIC_Y, picItems.hDC, EditorItemX * PIC_X, EditorItemY * PIC_Y, SRCCOPY)

sDc = DD_ArrowAnim.GetDC
With picBow
.Cls
.Width = DDSD_ArrowAnim.lWidth
.Height = DDSD_ArrowAnim.lHeight
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_ArrowAnim.ReleaseDC(sDc)

End Sub


Código:

frmMapEditor

Código:


Private Sub sclTileset_Change()
picBackSelect.Picture = LoadPicture(App.Path & "\GFX\Tiles" & sclTileset.Value & ".bmp")
EditorSet = sclTileset.Value
scrlPicture.Max = ((picBackSelect.Height - picBack.Height) / PIC_Y)
lblTileset = sclTileset.Value
End Sub


Código:


Private Sub sclTileset_Change()
Dim sDc As Long

sDc = DD_TileSurf(sclTileset.Value).GetDC
With picBackSelect
.Width = DDSD_Tile(sclTileset.Value).lWidth
.Height = DDSD_Tile(sclTileset.Value).lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_TileSurf(sclTileset.Value).ReleaseDC(sDc)

EditorSet = sclTileset.Value
scrlPicture.Max = ((picBackSelect.Height - picBack.Height) / PIC_Y)
' frmMapEditor.picBack.Width = frmMapEditor.picBackSelect.Width
' If frmMapEditor.Width > picBack.Width + scrlPicture.Width Then frmMapEditor.Width = (picBack.Width + scrlPicture.Width + 8) * Screen.TwipsPerPixelX
' If frmMapEditor.Height > (picBackSelect.Height * Screen.TwipsPerPixelX) + 800 Then frmMapEditor.Height = (picBackSelect.Height * Screen.TwipsPerPixelX) + 800
lblTileset = sclTileset.Value
End Sub


Código:


Private Sub optlight_Click()
fraLayers.Visible = False
fraAttribs.Visible = False
sclTileset.Value = 6

frmMapEditor.picBackSelect.Picture = LoadPicture(App.Path & "\GFX\Tiles" & 6 & ".bmp")
EditorSet = 6

scrlPicture.Max = ((picBackSelect.Height - picBack.Height) / PIC_Y)
sclTileset.Enabled = False
End Sub


Código:


Private Sub optlight_Click()
Dim sDc As Long

fraLayers.Visible = False
fraAttribs.Visible = False
sclTileset.Value = 6

sDc = DD_TileSurf(sclTileset.Value).GetDC
With frmMapEditor.picBackSelect
.Width = DDSD_Tile(sclTileset.Value).lWidth
.Height = DDSD_Tile(sclTileset.Value).lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_TileSurf(sclTileset.Value).ReleaseDC(sDc)
EditorSet = 6

scrlPicture.Max = ((picBackSelect.Height - picBack.Height) / PIC_Y)
'picBack.Width = picBackSelect.Width
'If frmMapEditor.Width > picBack.Width + scrlPicture.Width Then frmMapEditor.Width = (picBack.Width + scrlPicture.Width + 8) * Screen.TwipsPerPixelX
'If frmMapEditor.Height > (picBackSelect.Height * Screen.TwipsPerPixelX) + 800 Then frmMapEditor.Height = (picBackSelect.Height * Screen.TwipsPerPixelX) + 800
sclTileset.Enabled = False
End Sub


Código:

 frmNewChar

Código:


Private Sub Timer1_Timer()
If cmbClass.ListIndex < 0 Then Exit Sub

Picpic.Width = SIZE_X
Picpic.Height = SIZE_Y
Picture4.Width = SIZE_X + 4
Picture4.Height = SIZE_Y + 4

If optMale.Value = True Then
Call BitBlt(Picpic.hdc, 0, 0, SIZE_X, SIZE_Y, Picsprites.hdc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).MaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
Else
Call BitBlt(Picpic.hdc, 0, 0, SIZE_X, SIZE_Y, Picsprites.hdc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).FemaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
End If
frmNewChar.txtDescri.Text = Class(cmbClass.ListIndex + 1).Descri
End Sub

Private Sub Form_Load()
Dim I As Long
Dim Ending As String
For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\medium" & Ending) Then frmNewChar.Picture = LoadPicture(App.Path & "\GUI\medium" & Ending)
Next I
Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
End Sub


Código:


Private Sub Timer1_Timer()
Dim sDc As Long

If cmbClass.ListIndex < 0 Then Exit Sub

Picpic.Width = SIZE_X
Picpic.Height = SIZE_Y
Picture4.Width = SIZE_X + 4
Picture4.Height = SIZE_Y + 4

sDc = DD_SpriteSurf.GetDC
If optMale.Value = True Then
Call BitBlt(Picpic.hDC, 0, 0, SIZE_X, SIZE_Y, sDc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).MaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
Else
Call BitBlt(Picpic.hDC, 0, 0, SIZE_X, SIZE_Y, sDc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).FemaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
End If
Call DD_SpriteSurf.ReleaseDC(sDc)
End Sub

Private Sub Form_Load()
Dim I As Long
Dim Ending As String
Dim sDc As Long

For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\medium2" & Ending) Then frmNewChar.Picture = LoadPicture(App.Path & "\GUI\medium2" & Ending)
Next I



sDc = DD_SpriteSurf.GetDC
With Picsprites
.Width = DDSD_Sprite.lWidth
.Height = DDSD_Sprite.lHeight
.Cls

End With
Call DD_SpriteSurf.ReleaseDC(sDc)

' Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
End Sub


Código:

 FrmNpcEditor

Código:


Private Sub BigNpc_Click()
frmNpcEditor.ScaleMode = 3
If BigNpc.Value = Checked Then
frmNpcEditor.picSprites.Picture = LoadPicture(App.Path & "\GFX\bigsprites.bmp")
picSprite.Width = 64
picSprite.Height = 64
picSprite.Left = (73 - 64) / 2 ' "73" is the scale width/height of Picture 1
picSprite.Top = (73 - 64) / 2
Else
frmNpcEditor.picSprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
picSprite.Width = SIZE_X
picSprite.Height = SIZE_Y
picSprite.Left = (73 - SIZE_X) / 2
picSprite.Top = (73 - SIZE_Y) / 2
End If
End Sub


Código:


Private Sub BigNpc_Click()
Dim sDc As Long

frmNpcEditor.ScaleMode = 3
If BigNpc.Value = Checked Then
sDc = DD_BigSpriteSurf.GetDC
With picSprite
.Width = 64
.Height = 64
.Left = (73 - 64) / 2 ' "73" is the scale width/height of Picture 1
.Top = (73 - 64) / 2
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_BigSpriteSurf.ReleaseDC(sDc)

' frmNpcEditor.Picsprites.Picture = LoadPicture(App.Path & "\GFX\bigsprites.bmp")
Else
sDc = DD_SpriteSurf.GetDC
With picSprite
.Width = 32
.Height = 32
.Left = (73 - SIZE_X) / 2
.Top = (73 - SIZE_Y) / 2
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_SpriteSurf.ReleaseDC(sDc)

' frmNpcEditor.Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
End If
End Sub


Código:

 frmSign

Código:


Private Sub Timer1_Timer()
Dim sDc As Long

If cmbClass.ListIndex < 0 Then Exit Sub

Picpic.Width = SIZE_X
Picpic.Height = SIZE_Y
Picture4.Width = SIZE_X + 4
Picture4.Height = SIZE_Y + 4

sDc = DD_SpriteSurf.GetDC
If optMale.Value = True Then
Call BitBlt(Picpic.hDC, 0, 0, SIZE_X, SIZE_Y, sDc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).MaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
Else
Call BitBlt(Picpic.hDC, 0, 0, SIZE_X, SIZE_Y, sDc, animi * SIZE_X, Int(Class(cmbClass.ListIndex + 1).FemaleSprite) * SIZE_Y - (SIZE_Y - PIC_Y), SRCCOPY)
End If
Call DD_SpriteSurf.ReleaseDC(sDc)
End Sub


Código:

 frmTalk

Código:

Private Sub Form_Load()
Dim I As Long
Dim Ending As String
For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\content" & Ending) Then frmNewChar.Picture = LoadPicture(App.Path & "\GUI\content" & Ending)
Next I

picSprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
End Sub


Código:


Private Sub Form_Load()
Dim I As Long
Dim Ending As String
Dim sDc As Long

For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\content" & Ending) Then frmNewChar.Picture = LoadPicture(App.Path & "\GUI\content" & Ending)
Next I

sDc = DD_SpriteSurf.GetDC
With Picsprites
.Width = DDSD_Sprite.lWidth
.Height = DDSD_Sprite.lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_SpriteSurf.ReleaseDC(sDc)

' Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")
End Sub


Código:

 frmTrade

Código:


Private Sub Form_Load()
Dim I As Long
Dim Ending As String
For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\shop" & Ending) Then frmTrade.Picture = LoadPicture(App.Path & "\GUI\shop" & Ending)
Next I

picItems.Picture = LoadPicture(App.Path & "\GFX\Itens.bmp")
End Sub


Código:


Private Sub Form_Load()
Dim I As Long
Dim Ending As String
Dim sDc As Long

For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"

If FileExist("GUI\shop" & Ending) Then frmTrade.Picture = LoadPicture(App.Path & "\GUI\shop" & Ending)
Next I

sDc = DD_ItemSurf.GetDC
With picItems
.Width = DDSD_Item.lWidth
.Height = DDSD_Item.lHeight
.Cls
Call BitBlt(.hDC, 0, 0, .Width, .Height, sDc, 0, 0, SRCCOPY)
End With
Call DD_ItemSurf.ReleaseDC(sDc)

' picItems.Picture = LoadPicture(App.Path & "\GFX\items.bmp")
End Sub


Código:

 MODGAMELOGIC

Código:


Public Sub NpcEditorInit()


Código:


frmNpcEditor.Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")


Código:

 frmnpceditor

Código:

Private Sub Form_Load()

Código:

Picsprites.Picture = LoadPicture(App.Path & "\GFX\sprites.bmp")

matheusinc escreveu:Easy!