form1.frm

石器时代的客户端用 图片修改工具 源码VB下开发

            AdrnLine = AdrnLine + 1
            Label1.Caption = "读adrn"
        End If
    Loop
    Close #1
    DoEvents
    Label2.Caption = AdrnNumMax
    Label5.Caption = AdrnLine
    Label4.Caption = MapIndexMax
    '===============================================================================
    '读Spradrn数据头文件

    SrpAdrnFileSize = FileLen(Text1.Text & "\spradrn.bin")
    
    Open Text1.Text & "\spradrn.bin" For Binary Access Read As #2
    SpradrnIndexNum = 0
    ReDim Buffer(1 To 12) As Byte
    '读文件
    Label1.Caption = "读Spradrn"
    DoEvents
    Do While Not EOF(2)
        Get #2, , Buffer
        If Not EOF(2) Then
            '申请内存
            ReDim Preserve SpradrnIndex(SpradrnIndexNum) As Spradrn
        
            CopyMemory SpradrnIndex(SpradrnIndexNum), Buffer(1), 12
        
            If SpradrnNumMax < SpradrnIndex(SpradrnIndexNum).AnimationNum Then SpradrnNumMax = SpradrnIndex(SpradrnIndexNum).AnimationNum
            Label1.Caption = "读Spradrn"
            SpradrnIndexNum = SpradrnIndexNum + 1
            DoEvents
        End If
    Loop
    Close #2
    Label3.Caption = SpradrnNumMax
    Label6.Caption = SpradrnIndexNum
    DoEvents

    For A = 0 To UBound(SpradrnIndex)
        If SpradrnIndex(A).AnimationNum > 0 Then
            List2.AddItem SpradrnIndex(A).AnimationNum
        End If
        DoEvents
    Next

    SprFileSize = FileLen(Text1.Text & "\spr.bin")

    RealFileSize = FileLen(Text1.Text & "\real.bin")
    
    Label12.Caption = AdrnFileSize & " B"
    Label14.Caption = RealFileSize & " B"
    Label16.Caption = SrpAdrnFileSize & " B"
    Label19.Caption = SprFileSize & " B"
    
    ShowAdrn 0
    
    Command3.Enabled = True
    Command4.Enabled = True
    Command8.Enabled = True
    Command9.Enabled = True
    
    If AdrnLine > 0 Then
        Label20.Enabled = True
    End If
    If SpradrnIndexNum > 0 Then
        Label22.Enabled = True
    End If
    
    Label1.Caption = "加载完毕"
    MsgBox "加载数据完毕"
End Sub


Private Sub ShowAdrn(Index As Long)
    MyBmp_Info.bmiHeader.biImage = 0
    Picture1.Cls

    If UBound(AdrnIndex) < Index Then Exit Sub
    
    Text2(0).Text = AdrnIndex(Index).Num
    Text2(1).Text = AdrnIndex(Index).Addr
    Text2(2).Text = AdrnIndex(Index).datalen
    Text2(3).Text = AdrnIndex(Index).X
    Text2(4).Text = AdrnIndex(Index).Y
    Text2(5).Text = AdrnIndex(Index).width
    Text2(6).Text = AdrnIndex(Index).height
    Text2(7).Text = AdrnIndex(Index).EastCover
    Text2(8).Text = AdrnIndex(Index).SouthCover
    Text2(10).Text = AdrnIndex(Index).ObstacleFlags
    Text2(9).Text = AdrnIndex(Index).MapNum

    Text2(11).Text = ""

    For A = 1 To 45
        Text2(11).Text = Text2(11).Text & Hex(AdrnIndex(Index).AdrnNotKnow(A)) & ","
    Next
    ShowReal AdrnIndex(Index).Addr, Index
    If MyBmp_Info.bmiHeader.biImage <> 0 Then
        Dim ErrLong As Long
        ErrLong = StretchDIBits(Picture1.hdc, ((Picture1.width / 15) - MyBmp_Info.bmiHeader.biWidth) / 2 _
        , ((Picture1.height / 15) - MyBmp_Info.bmiHeader.biHeight) / 2, MyBmp_Info.bmiHeader.biWidth, _
        MyBmp_Info.bmiHeader.biHeight, 0, 0, MyBmp_Info.bmiHeader.biWidth, MyBmp_Info.bmiHeader.biHeight, _
        BmpData_Byte(0), MyBmp_Info, DIB_RGB_COLORSn, SRCCOPY)
        SendMessageBynum& Picture1.hwnd, WM_PAINT, 0, 0
    End If
End Sub


Private Sub Command10_Click()
    Dim i As Long
    For i = 0 To Label5.Caption - 1
        If AdrnIndex(i).MapNum >= 9680 And AdrnIndex(i).MapNum <= 9725 Then
            AdrnIndex(i).ObstacleFlags = 0
        End If
    Next i
    Open Text1.Text & "\adrn_136.bin" For Binary Access Write As #1
        Put #1, , AdrnIndex
    Close #1
End Sub

Private Sub Command3_Click()
    Dim i As Long

    Check1.Value = 1

    KillBack

    For i = 0 To List2.ListCount - 1
        DoEvents
        SaveSprData i
    Next i
    For i = 0 To Label5.Caption - 1
        If i Mod 200 = 0 Then DoEvents
        AdrnIndex(i).Num = i + 1
        SaveData i
    Next i
    
    KillBin
    
    ReNameBack
    
    MsgBox "制作补丁完成"
End Sub

Private Sub Command4_Click()
    Dim i As Long

    Check1.Value = 0

    KillBack

    For i = 0 To List2.ListCount - 1
        SaveSprData i
    Next i
    For i = 0 To Label5.Caption - 1
        SaveData i
    Next i

    KillBin
    
    ReNameBack
    
    MsgBox "保存数据完成"
End Sub

Private Sub Command2_Click()
    Dim lpIDList     As Long
    Dim sBuffer     As String
    Dim tBrowseInfo     As BrowseInfo
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        Text1.Text = sBuffer
    End If
End Sub

Private Sub Command27_Click()
    SaveBmpFile "\" & AdrnIndex(Text3.Text - 1).Num & ".bmp"
End Sub

Private Sub Command5_Click()
    Timer1.Enabled = False
    List1.ListIndex = 0
    List1_DblClick
    Command5.Enabled = False
    Command6.Enabled = False
    Command7.Enabled = True
End Sub

Private Sub Command6_Click()
    Timer1.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
    Command7.Enabled = True
End Sub

Private Sub Command7_Click()
    If List1.ListCount = 0 Then Exit Sub
    If List1.ListIndex = List1.ListCount - 1 Then List1.ListIndex = 0
    Timer1.Enabled = True
    Command5.Enabled = True
    Command6.Enabled = True
    Command7.Enabled = False
End Sub

Private Sub Command8_Click()
    Form2.Text3.Text = 1
    Form2.Show
End Sub

Private Sub Command9_Click()
    Dim AdrnFilePath As String
    Dim RealFilePath As String
    Dim SrpAdrnFilePath As String
    Dim SrpFilePath As String

    Dim lpIDList    As Long
    Dim sBuffer     As String
    Dim tBrowseInfo As BrowseInfo
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    End If
    
    '检查adrn文件路径
    AdrnFilePath = sBuffer & "\adrn.bin"
    
    '检查real文件路径
    RealFilePath = sBuffer & "\real.bin"
    
    Dim AdrnFileNum, RealFileNum, CAdrnFileNum, CRealFileNum As Long            '定义文件号
    
    Dim AdrnFileSize As Long
    
    Dim AdrnData As adrn                                      '定义一个Adrn数据块
    
    Dim buff() As Byte
    
    Dim AdrnLine As Long
    
    '抽取出Adrn数据
    AdrnFileNum = FreeFile
    Open AdrnFilePath For Binary As AdrnFileNum
    RealFileNum = FreeFile
    Open RealFilePath For Binary As RealFileNum
    CAdrnFileNum = FreeFile
    Open Text1.Text & "\adrn.bin" For Binary As CAdrnFileNum
    CRealFileNum = FreeFile
    Open Text1.Text & "\real.bin" For Binary As CRealFileNum
    AdrnFileSize = FileLen(AdrnFilePath)
    Do While AdrnLine * 80 < AdrnFileSize
        Get AdrnFileNum, AdrnLine * 80 + 1, AdrnData
        
        ReDim buff(1 To AdrnData.datalen) As Byte
    
        Get RealFileNum, AdrnData.Addr + 1, buff
        
        AdrnData.Num = AdrnData.Num + Val(Label5.Caption) + 1
        
        AdrnData.Addr = LOF(CRealFileNum)
        
        If LOF(CRealFileNum) = 0 Then
            Put CRealFileNum, , buff
        Else
            Put CRealFileNum, LOF(CRealFileNum) + 1, buff
        End If
        
        If LOF(CAdrnFileNum) = 0 Then
            Put CAdrnFileNum, , AdrnData
        Else
            Put CAdrnFileNum, LOF(CAdrnFileNum) + 1, AdrnData
        End If
        
        AdrnLine = AdrnLine + 1
    Loop

    Close AdrnFileNum
    Close RealFileNum
    Close CAdrnFileNum
    Close CRealFileNum
    
    Dim SprFileNum, SprAdrnFileNum, CSprFileNum, CSprAdrnFileNum As Integer
    
    Dim SprAdrnData As Spradrn                                   '定义一个Spr数据块
    
    Dim SprAdrnFileSize As Long
    
    Dim SprAdrnLine As Long
    
    Dim MySpr As Spr
    Dim Addr As Long
    
    '检查spradrn文件路径
    SrpAdrnFilePath = sBuffer & "\spradrn.bin"
    
    '检查spr文件路径
    SrpFilePath = sBuffer & "\spr.bin"
    
    SprAdrnFileNum = FreeFile
    Open SrpAdrnFilePath For Binary As SprAdrnFileNum
    SprFileNum = FreeFile
    Open SrpFilePath For Binary As SprFileNum
    CSprAdrnFileNum = FreeFile
    Open Text1.Text & "\spradrn.bin" For Binary As CSprAdrnFileNum
    CSprFileNum = FreeFile
    Open Text1.Text & "\spr.bin" For Binary As CSprFileNum
    
    SprAdrnFileSize = FileLen(SrpAdrnFilePath)
    
    Do While SprAdrnLine * 12 < SprAdrnFileSize
        Get SprAdrnFileNum, SprAdrnLine * 12 + 1, SprAdrnData

        Addr = SprAdrnData.Addr + 1
        
        SprAdrnData.Addr = LOF(CSprFileNum)
        If LOF(CSprAdrnFileNum) = 0 Then
            Put CSprAdrnFileNum, , SprAdrnData
        Else
            Put CSprAdrnFileNum, LOF(CSprAdrnFileNum) + 1, SprAdrnData
        End If
        
        Dim i As Long
        Dim j As Long
        Dim ActionNum As Long
        Dim PictureNo() As Long
        Dim PictureNum As Long
        ReDim Preserve PictureNo(0 To PictureNum)
        For ActionNum = 0 To SprAdrnData.ActionNum - 1
            '读指定动作
            Get SprFileNum, Addr, MySpr
            Addr = Addr + Len(MySpr)
    
            
            If LOF(CSprFileNum) = 0 Then
                Put CSprFileNum, , MySpr
            Else
                Put CSprFileNum, LOF(CSprFileNum) + 1, MySpr
            End If
            
            If MySpr.Number > 0 Then
                ReDim buff(1 To 10) As Byte
                ReDim MySequence(1 To MySpr.Number) As Sequence
    
                For i = 1 To MySpr.Number
                    Get SprFileNum, , buff
                    CopyMemory MySequence(i), buff(1), 10
                    
                    MySequence(i).PictureNum = MySequence(i).PictureNum + Val(Label5.Caption) + 1
                    
                    Put CSprFileNum, LOF(CSprFileNum) + 1, MySequence(i)
                    Addr = Addr + Len(MySequence(i))
                Next i
                
            End If
        Next
        SprAdrnLine = SprAdrnLine + 1
    Loop

    Close SprAdrnFileNum
    Close SprFileNum
    Close CSprAdrnFileNum
    Close CSprFileNum
    
    MsgBox "追加完成"
End Sub

Private Sub FlatScrollBar1_Change()

End Sub

Private Sub Form_Load()
    SetBkMode Picture1.hdc, TRANSPARENT
    
    '默认调色板
    MyPals_Num = "1"
End Sub

Private Sub ShowReal(Addr As Long, Index As Long)
    MyBmp_Info.bmiHeader.biImage = 0
    Dim FileName As String
    Dim TempStr As String
    Dim MyReal As Real
    Dim buff() As Byte

    Dim FileNum As Long
    FileNum = FreeFile
    Open Text1.Text & "\real.bin" For Binary Access Read As FileNum

    Get FileNum, Addr + 1, MyReal
    
    '检查数据头
    If MyReal.hwnd(1) = 82 And MyReal.hwnd(2) = 68 Then
        '数据正确
        
        If MyReal.Compress >= 254 Then