form1.frm

石器客端图形补丁编译环境RH9,GCC

    Label31.Caption = str(AdrnIndex(Index).datalen)
    '偏移量X
    Label33.Caption = str(AdrnIndex(Index).X)
    '偏移量Y
    Label35.Caption = str(AdrnIndex(Index).Y)
    '图片宽度
    Label37.Caption = str(AdrnIndex(Index).width)
    '图片高度
    Label39.Caption = str(AdrnIndex(Index).height)
    '占地面积-东
    Label41.Caption = str(AdrnIndex(Index).EastCover)
    '占地面积-南
    Label43.Caption = str(AdrnIndex(Index).SouthCover)
    '障碍标志
    Label45.Caption = str(AdrnIndex(Index).ObstacleFlags)
    '地图编号

    Label48.Caption = str(AdrnIndex(Index).MapNum)


    Text5.Text = ""
    For A = 1 To 45
    Text5.Text = Text5.Text & str(AdrnIndex(Index).AdrnNotKnow(A)) & ","
    Next
    ShowReal AdrnIndex(Index).addr, AdrnIndex(Index).datalen
    If MyBmp_Info.bmiHeader.biSizeImage <> 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
    If Check1.Value = 1 Then SaveBmpFile "\" & AdrnIndex(Index).Num & ".bmp"
End Sub

Private Sub ShowReal(addr As Long, datalen As Long)
    MyBmp_Info.bmiHeader.biSizeImage = 0
    Dim FileName As String
    Dim TempStr As String
    Dim MyReal As Real
    Dim buff() As Byte
    FileName = Text1.Text & "\real_*.bin"
    TempStr = ManhuntFile(FileName)
    
    If TempStr = "0" Then
        TempStr = "real.bin"
    End If
    Close #3
    Open Text1.Text & "\" & TempStr For Binary Access Read As #3
    If datalen = 0 Then
        Close #3
        Exit Sub
    End If
    'If DataLen < 17 Then
    '    Close #3
    '    Exit Sub
    'End If
    ReDim buff(1 To datalen) As Byte
    Get #3, addr + 1, MyReal
    'Get #3, , Buff
    '检查数据头
    If MyReal.hwnd(1) = 82 And MyReal.hwnd(2) = 68 Then
        '数据正确
        
        Label59.Caption = Chr(MyReal.hwnd(1)) + Chr(MyReal.hwnd(2))
        Label50.Caption = MyReal.Compress
        Label52.Caption = MyReal.RealNotKnow
        Label56.Caption = MyReal.width
        Label57.Caption = MyReal.height
        Adrn_BMP_Decrypt MyReal.datalen - 16, 3, addr + 16, MyReal.width, MyReal.height, MyReal.Compress
        
        Label58.Caption = MyReal.datalen
    Else
        MsgBox "数据错误！"
    End If
    Close #3
End Sub

Sub ShowSpr(Index As Long)
    Dim FileName As String
    Dim TempStr As String
    Dim Current_ActionNum As Long
    Current_ActionNum = Val(Text23.Text)
    
    Label9.Caption = str(SpradrnIndex(Index).AnimationNum)
    Label12.Caption = str(SpradrnIndex(Index).addr)
    Label14.Caption = str(SpradrnIndex(Index).ActionNum)
    Label16.Caption = str(SpradrnIndex(Index).SpradrnNotKnow)
    
    FileName = Text1.Text & "\spr_*.bin"
    TempStr = ManhuntFile(FileName)
    
    If TempStr = "0" Then
        TempStr = "spr.bin"
    End If
    
    Dim MySpr As Spr
    Dim addr As Long
    addr = SpradrnIndex(Index).addr + 1
    '打开文件
    Open Text1.Text & "\" & TempStr For Binary Access Read As #4
    '读指定动作
    For A = 0 To SpradrnIndex(Index).ActionNum - 1
        Get #4, addr, MySpr
        addr = addr + Len(MySpr) + (MySpr.Number * 10)
        If Current_ActionNum = A Then Exit For
    Next
    
    Label19.Caption = str(MySpr.Direction)
    Label20.Caption = str(MySpr.ActionFlags)
    Label22.Caption = str(MySpr.Time)
    Label24.Caption = str(MySpr.Number)
    List1.Clear
    If MySpr.Number > 0 Then
        ReDim buff(1 To 10) As Byte
        ReDim MySequence(1 To MySpr.Number) As Sequence
    
        For A = 1 To MySpr.Number
            Get #4, , buff
            CopyMemory MySequence(A), buff(1), 10
            List1.AddItem MySequence(A).PictureNum
            Text4.Text = MySequence(A).SequenceNotKnow(1) & MySequence(A).SequenceNotKnow(2) & _
            MySequence(A).SequenceNotKnow(3) & MySequence(A).SequenceNotKnow(4) _
            & MySequence(A).SequenceNotKnow(5) & MySequence(A).SequenceNotKnow(6)
        Next
    End If
    Close #4
End Sub

Private Sub List3_Click()

End Sub

Private Sub Timer1_Timer()
    If List1.ListIndex + 1 = List1.ListCount Then
        If Check2.Value = 0 Then
            Timer1.Enabled = False
            Exit Sub
        Else
            List1.ListIndex = 0
        End If
    Else
        List1.ListIndex = List1.ListIndex + 1
    End If
    ShowAdrn Val(List1.List(List1.ListIndex))
End Sub

Private Sub UpDown1_DownClick()
    If Command6.Enabled = False Then Exit Sub
    If Val(Text3.Text) - 1 < 0 Then Exit Sub
    Text3.Text = Trim(str(Val(Text3.Text) - 1))
    Command6_Click
End Sub

Private Sub UpDown1_UpClick()
    If Command6.Enabled = False Then Exit Sub
    If Val(Text3.Text) + 1 > Val(Label6.Caption) Then Exit Sub
    Text3.Text = Trim(str(Val(Text3.Text) + 1))
    Command6_Click
End Sub

Private Sub UpDown2_DownClick()
    If Command7.Enabled = False Then Exit Sub
    If Val(Text6.Text) - 1 < 0 Then Exit Sub
    Dim Temp1 As Long
    Temp1 = Val(Text6.Text) - 1
    For A = Temp1 To 0 Step -1
        If MapIndex(A) > 0 Then
            Text6.Text = Trim(str(A))
            Exit For
        End If
    Next
    Command7_Click
End Sub

Private Sub UpDown2_UpClick()
    If Command7.Enabled = False Then Exit Sub
    If Val(Text6.Text) + 1 > Val(Label63.Caption) Then Exit Sub
    Dim Temp1 As Long
    Temp1 = Val(Text6.Text) + 1
    For A = Temp1 To UBound(MapIndex) Step 1
        If MapIndex(A) > 0 Then
            Text6.Text = Trim(str(A))
            Exit For
        End If
    Next
    Text6.Text = Trim(str(A))
    Command7_Click
End Sub


Private Sub UpDown3_DownClick()
    On Error GoTo Error
    List2.ListIndex = List2.ListIndex + 1
    List2_DblClick
Error:
End Sub

Private Sub UpDown3_UpClick()
    On Error GoTo Error
    List2.ListIndex = List2.ListIndex - 1
    List2_DblClick
Error:
End Sub

Private Sub UpDown5_DownClick()
    Dim A As Long
    If Command2.Enabled = False Then Exit Sub
    If Val(Text23.Text) - 1 < 0 Then Exit Sub
    Text23.Text = Trim(str(Val(Text23.Text) - 1))
    For A = 0 To List2.ListCount
        If List2.List(A) = Trim(Label9.Caption) Then
            ShowSpr A
            Exit For
        End If
    Next
    List1.ListIndex = 0
    ShowAdrn Val(List1.List(List1.ListIndex))
End Sub

Private Sub UpDown5_UpClick()
    Dim A As Long
    If Command2.Enabled = False Then Exit Sub
    If Val(Text23.Text) + 1 > Val(Label14.Caption) - 1 Then Exit Sub
    Text23.Text = Trim(str(Val(Text23.Text) + 1))
    For A = 0 To List2.ListCount
        If List2.List(A) = Trim(Label9.Caption) Then
            ShowSpr A
            Exit For
        End If
    Next
    List1.ListIndex = 0
    ShowAdrn Val(List1.List(List1.ListIndex))
End Sub

Function Perfor_DiagramShow_Function1(A As Long) As Long
Text3.Text = str(A)
Command6_Click
Perfor_DiagramShow_Function1 = MsgBox("按确定继续查找", vbOKCancel)
End Function

Private Sub SaveData(Index As Long)
    Dim AdrnFileNum, RealFileNum As Integer                   '定义文件号
    
    Dim AdrnData As adrn                                      '定义一个Adrn数据块

    '抽取出Adrn数据
    AdrnFileNum = FreeFile                                    '申请Adrn文件号
    Open App.Path & "\data\adrn.bin" For Binary As AdrnFileNum
    RealFileNum = FreeFile                                    '申请Real文件号
    Open App.Path & "\data\real.bin" For Binary As RealFileNum
    AdrnData = AdrnIndex(Index)
    AdrnData.addr = LOF(RealFileNum)
    If LOF(AdrnFileNum) = 0 Then
        Put AdrnFileNum, , AdrnData
    Else
        Put AdrnFileNum, LOF(AdrnFileNum) + 1, AdrnData
    End If
    Close AdrnFileNum
    
    '抽取出Real数据
    Dim FileName As String
    Dim TempStr As String
    Dim MyReal As Real
    Dim buff() As Byte
    FileName = Text1.Text & "\real_*.bin"
    TempStr = ManhuntFile(FileName)
    
    If TempStr = "0" Then
        TempStr = "real.bin"
    End If
    
    FileName = FreeFile
    Open Text1.Text & "\" & TempStr For Binary Access Read As FileName
    
    ReDim buff(1 To AdrnIndex(Index).datalen) As Byte
    
    Get FileName, AdrnIndex(Index).addr + 1, buff
    
    CopyMemory MyReal, buff(1), 16
    
    Close FileName
    
    If LOF(RealFileNum) = 0 Then
        Put RealFileNum, , buff
    Else
        Put RealFileNum, LOF(RealFileNum) + 1, buff
    End If
    Close RealFileNum
End Sub

Private Sub SaveSprData(Index As Long)
    Dim SprFileNum, SprAdrnFileNum As Integer                    '定义文件号
    Dim SprAdrnData As Spradrn                                   '定义一个Spr数据块
    
    SprAdrnData = SpradrnIndex(Index)
    

    '抽取出Spr数据
    SprFileNum = FreeFile                                        '申请Spr文件号
    Open App.Path & "\data\spr.bin" For Binary As SprFileNum
    '抽取出SprAdrn数据
    SprAdrnFileNum = FreeFile                                    '申请SprAdrn文件号
    Open App.Path & "\data\spradrn.bin" For Binary As SprAdrnFileNum
    
    SprAdrnData.addr = LOF(SprFileNum)
    
    If LOF(SprAdrnFileNum) = 0 Then
        Put SprAdrnFileNum, , SprAdrnData
    Else
        Put SprAdrnFileNum, LOF(SprAdrnFileNum) + 1, SprAdrnData
    End If
    Close SprAdrnFileNum
    
    '抽取出Spr数据
    Dim FileName As String
    Dim TempStr As String
    Dim Current_ActionNum As Long
    Current_ActionNum = Val(Text23.Text)
    
    FileName = Text1.Text & "\spr_*.bin"
    TempStr = ManhuntFile(FileName)
    
    If TempStr = "0" Then
        TempStr = "spr.bin"
    End If
    
    Dim MySpr As Spr
    Dim addr As Long
    addr = SpradrnIndex(Index).addr + 1
    
    FileName = FreeFile
    '打开文件
    Open Text1.Text & "\" & TempStr For Binary Access Read As FileName
    
    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
        '读指定动作
        For i = 0 To SpradrnIndex(Index).ActionNum - 1
            Get FileName, addr, MySpr
            addr = addr + Len(MySpr) + (MySpr.Number * 10)
            If Current_ActionNum = i Then Exit For
        Next
        
        If LOF(SprFileNum) = 0 Then
            Put SprFileNum, , MySpr
        Else
            Put SprFileNum, LOF(SprFileNum) + 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 FileName, , buff
                CopyMemory MySequence(i), buff(1), 10
                
                For j = 0 To PictureNum
                    If PictureNo(j) = MySequence(i).PictureNum Then
                        Exit For
                    End If
                    If j = PictureNum Then
                        PictureNo(j) = MySequence(i).PictureNum
                        PictureNum = PictureNum + 1
                        ReDim Preserve PictureNo(0 To PictureNum)
                        SaveData MySequence(i).PictureNum
                    End If
                Next j
                
                If LOF(SprFileNum) = 0 Then
                    Put SprFileNum, , MySequence(i)
                Else
                    Put SprFileNum, LOF(SprFileNum) + 1, MySequence(i)
                End If
            Next i
        End If
    Next
    
    Close FileName
    Close SprFileNum
    
End Sub