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 + -
显示快捷键?