wemadeimagelibtexture.vb.svn-base

来自「MirUnleashed vb.net Module modMain」· SVN-BASE 代码 · 共 1,781 行 · 第 1/5 页

SVN-BASE
1,781
字号
        ReDim WIL_TilesImage.ImageHeight(WIL_TilesImage.ImageCount - 1)
        ReDim WIL_TilesImage.ImageWidth(WIL_TilesImage.ImageCount - 1)
        ReDim WIL_TilesImage.ImageX(WIL_TilesImage.ImageCount - 1)
        ReDim WIL_TilesImage.ImageY(WIL_TilesImage.ImageCount - 1)
        ReDim WIL_TilesImage.ImageTexture(WIL_TilesImage.ImageCount - 1)
        ReDim WIL_TilesImage.ImageLoaded(WIL_TilesImage.ImageCount - 1)


        Dim I As Integer


        For I = 0 To WIL_TilesImage.ImageCount - 1

            WIL_TilesImage.ImageIndex(I) = MakeInt32(MakeInt16(DataArray(8 + (I * 4)), DataArray(9 + (I * 4))), MakeInt16(DataArray(10 + (I * 4)), DataArray(11 + (I * 4))))
            'WIL_TilesImage.ImageIndex(I) = MakeInt16(DataArray(8 + (I * 4)), DataArray(9 + (I * 4)))

        Next I

        DataStream.Close()

    End Sub

#End Region

#Region "Load SmTile WIL and WIX"

    Public Sub LoadWILSmTilesImage(ByVal Index As Integer)

        Dim FileName As String
        Dim DataStream As System.IO.FileStream


        FileName = My.Application.Info.DirectoryPath & "\Data\smtiles.wil"

        DataStream = New System.IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)

        Dim DataArray(14) As Byte



        DataStream.Seek(WIL_SmTilesImage.ImageIndex(Index), IO.SeekOrigin.Begin)
        DataStream.Read(DataArray, 0, 8)


        WIL_SmTilesImage.ImageWidth(Index) = MakeInt16(DataArray(0), DataArray(1))
        WIL_SmTilesImage.ImageHeight(Index) = MakeInt16(DataArray(2), DataArray(3))

        If (MakeInt16(DataArray(4), DataArray(5))) >= 32768 Then
            WIL_SmTilesImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5)) - 65536
        Else
            WIL_SmTilesImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5))
        End If

        If (MakeInt16(DataArray(6), DataArray(7))) >= 32768 Then
            WIL_SmTilesImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7)) - 65536
        Else
            WIL_SmTilesImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7))
        End If



        Dim Bytes As Integer

        Bytes = WIL_SmTilesImage.ImageWidth(Index) * WIL_SmTilesImage.ImageHeight(Index)


        ReDim DataArray(Bytes)

        DataStream.Seek(WIL_SmTilesImage.ImageIndex(Index) + 8, IO.SeekOrigin.Begin)

        DataStream.Read(DataArray, 0, Bytes)

        DataStream.Close()

        WIL_SmTilesImage.ImageTexture(Index) = New Microsoft.DirectX.Direct3D.Texture(D3D, WIL_SmTilesImage.ImageWidth(Index), WIL_SmTilesImage.ImageHeight(Index), 1, Usage.None, Format.A8R8G8B8, Pool.Managed)


        Dim Stream As GraphicsStream = WIL_SmTilesImage.ImageTexture(Index).LockRectangle(0, LockFlags.None)

        Dim S As Integer = 0
        Dim B As Integer = 1
        Dim D As Integer

        While S < Bytes
            'start from left to right of top line
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_SmTilesImage.ImageWidth(Index) * B))).Blue)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_SmTilesImage.ImageWidth(Index) * B))).Green)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_SmTilesImage.ImageWidth(Index) * B))).Red)
            Stream.WriteByte(255)
            S = S + 1
            D = D + 1

            If S >= (WIL_SmTilesImage.ImageWidth(Index) * B) Then
                B = B + 1
                D = 0
            End If

        End While

        WIL_SmTilesImage.ImageTexture(Index).UnlockRectangle(0)

    End Sub

    Public Sub LoadWIXSmTilesFile()

        Dim FileName As String
        Dim DataStream As System.IO.FileStream


        FileName = My.Application.Info.DirectoryPath & "\Data\smtiles.WIX"

        DataStream = New System.IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)

        Dim DataArray(DataStream.Length) As Byte

        DataStream.Seek(44, IO.SeekOrigin.Begin)
        DataStream.Read(DataArray, 0, DataStream.Length)

        WIL_SmTilesImage.ImageCount = MakeInt32(MakeInt16(DataArray(0), DataArray(1)), MakeInt16(DataArray(2), DataArray(3)))

        ReDim WIL_SmTilesImage.ImageIndex(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageHeight(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageWidth(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageX(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageY(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageTexture(WIL_SmTilesImage.ImageCount - 1)
        ReDim WIL_SmTilesImage.ImageLoaded(WIL_SmTilesImage.ImageCount - 1)


        Dim I As Integer


        For I = 0 To WIL_SmTilesImage.ImageCount - 1

            WIL_SmTilesImage.ImageIndex(I) = MakeInt32(MakeInt16(DataArray(8 + (I * 4)), DataArray(9 + (I * 4))), MakeInt16(DataArray(10 + (I * 4)), DataArray(11 + (I * 4))))
            'WIL_smtilesImage.ImageIndex(I) = MakeInt16(DataArray(8 + (I * 4)), DataArray(9 + (I * 4)))

        Next I

        DataStream.Close()

    End Sub

#End Region

#Region "Load NPC WIL and WIX"

    Public Sub LoadWILNPCImage(ByVal Index As Integer)

        Dim FileName As String
        Dim DataStream As System.IO.FileStream


        FileName = My.Application.Info.DirectoryPath & "\Data\NPC.wil"

        DataStream = New System.IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)

        Dim DataArray(14) As Byte

        DataStream.Seek(WIL_NPCImage.ImageIndex(Index), IO.SeekOrigin.Begin)
        DataStream.Read(DataArray, 0, 12)


        WIL_NPCImage.ImageWidth(Index) = MakeInt16(DataArray(0), DataArray(1))
        WIL_NPCImage.ImageHeight(Index) = MakeInt16(DataArray(2), DataArray(3))

        If (MakeInt16(DataArray(4), DataArray(5))) >= 32768 Then
            WIL_NPCImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5)) - 65536
        Else
            WIL_NPCImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5))
        End If

        If (MakeInt16(DataArray(6), DataArray(7))) >= 32768 Then
            WIL_NPCImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7)) - 65536
        Else
            WIL_NPCImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7))
        End If


        Dim Bytes As Integer

        Bytes = Val(WIL_NPCImage.ImageWidth(Index)) * Val(WIL_NPCImage.ImageHeight(Index))


        ReDim DataArray(Bytes)

        DataStream.Seek(WIL_NPCImage.ImageIndex(Index) + 12, IO.SeekOrigin.Begin)

        DataStream.Read(DataArray, 0, Bytes)

        DataStream.Close()

        WIL_NPCImage.ImageTexture(Index) = New Microsoft.DirectX.Direct3D.Texture(D3D, WIL_NPCImage.ImageWidth(Index), WIL_NPCImage.ImageHeight(Index), 1, Usage.None, Format.A8R8G8B8, Pool.Managed)

        Dim Stream As GraphicsStream = WIL_NPCImage.ImageTexture(Index).LockRectangle(0, LockFlags.None)

        Dim S As Integer = 0
        Dim B As Integer = 1
        Dim D As Integer


        While S < Bytes
            'start from left to right of top line
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Blue)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Green)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Red)

            If CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Blue = 0 And CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Red = 0 And CustomPal(DataArray(Bytes + D - (WIL_NPCImage.ImageWidth(Index) * B))).Green = 0 Then
                Stream.WriteByte(0)
            Else
                Stream.WriteByte(255)
            End If

            S = S + 1
            D = D + 1

            If S >= (WIL_NPCImage.ImageWidth(Index) * B) Then
                B = B + 1
                D = 0
            End If

        End While

        WIL_NPCImage.ImageTexture(Index).UnlockRectangle(0)


    End Sub

    Public Sub LoadWIXNPCFile()

        Dim FileName As String
        Dim DataStream As System.IO.FileStream


        FileName = My.Application.Info.DirectoryPath & "\Data\NPC.WIX"

        DataStream = New System.IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)

        Dim DataArray(DataStream.Length) As Byte

        DataStream.Seek(44, IO.SeekOrigin.Begin)
        DataStream.Read(DataArray, 0, DataStream.Length)

        WIL_NPCImage.ImageCount = MakeInt32(MakeInt16(DataArray(0), DataArray(1)), MakeInt16(DataArray(2), DataArray(3)))

        ReDim WIL_NPCImage.ImageIndex(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageHeight(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageWidth(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageX(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageY(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageTexture(WIL_NPCImage.ImageCount - 1)
        ReDim WIL_NPCImage.ImageLoaded(WIL_NPCImage.ImageCount - 1)


        Dim I As Integer


        For I = 0 To WIL_NPCImage.ImageCount - 1

            WIL_NPCImage.ImageIndex(I) = MakeInt32(MakeInt16(DataArray(8 + (I * 4)), DataArray(9 + (I * 4))), MakeInt16(DataArray(10 + (I * 4)), DataArray(11 + (I * 4))))

        Next I

        DataStream.Close()

    End Sub

#End Region

#Region "Load Hair WIL and WIX"

    Public Sub LoadWILHairImage(ByVal Index As Integer)

        Dim FileName As String
        Dim DataStream As System.IO.FileStream


        FileName = My.Application.Info.DirectoryPath & "\Data\hair.wil"

        DataStream = New System.IO.FileStream(FileName, IO.FileMode.Open, IO.FileAccess.Read)

        Dim DataArray(14) As Byte

        DataStream.Seek(WIL_HairImage.ImageIndex(Index), IO.SeekOrigin.Begin)
        DataStream.Read(DataArray, 0, 12)


        WIL_HairImage.ImageWidth(Index) = MakeInt16(DataArray(0), DataArray(1))
        WIL_HairImage.ImageHeight(Index) = MakeInt16(DataArray(2), DataArray(3))

        If (MakeInt16(DataArray(4), DataArray(5))) >= 32768 Then
            WIL_HairImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5)) - 65536
        Else
            WIL_HairImage.ImageX(Index) = MakeInt16(DataArray(4), DataArray(5))
        End If

        If (MakeInt16(DataArray(6), DataArray(7))) >= 32768 Then
            WIL_HairImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7)) - 65536
        Else
            WIL_HairImage.ImageY(Index) = MakeInt16(DataArray(6), DataArray(7))
        End If


        Dim Bytes As Integer

        Bytes = WIL_HairImage.ImageWidth(Index) * WIL_HairImage.ImageHeight(Index)


        ReDim DataArray(Bytes)

        DataStream.Seek(WIL_HairImage.ImageIndex(Index) + 8, IO.SeekOrigin.Begin)

        DataStream.Read(DataArray, 0, Bytes)

        DataStream.Close()

        WIL_HairImage.ImageTexture(Index) = New Microsoft.DirectX.Direct3D.Texture(D3D, WIL_HairImage.ImageWidth(Index), WIL_HairImage.ImageHeight(Index), 1, Usage.None, Format.A8R8G8B8, Pool.Managed)

        Dim Stream As GraphicsStream = WIL_HairImage.ImageTexture(Index).LockRectangle(0, LockFlags.None)

        Dim S As Integer = 0
        Dim B As Integer = 1
        Dim D As Integer


        While S < Bytes
            'start from left to right of top line
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Blue)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Green)
            Stream.WriteByte(CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Red)

            If CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Blue = 0 And CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Red = 0 And CustomPal(DataArray(Bytes + D - (WIL_HairImage.ImageWidth(Index) * B))).Green = 0 Then
                Stream.WriteByte(0)
            Else
                Stream.WriteByte(255)
            End If

            S = S + 1
            D = D + 1

            If S >= (WIL_HairImage.ImageWidth(Index) * B) Then
                B = B + 1
                D = 0
            End If

        End While

        WIL_HairImage.ImageTexture(Index).UnlockRectangle(0)
        'WIL_hairImage.ImageTexture(Index).

    End Sub

    Public Sub LoadWIXHairFile()

        Dim FileName As String
        Dim DataStream As System.IO.FileStream

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?