English
载入数据.bas
资源名称：vbmcrisrc.rar [点击查看]
上传用户：pcw2004
上传日期：2022-02-02
资源大小：743k
文件大小：12k
源码类别：
DirextX编程
开发平台：
Visual Basic
- Attribute VB_Name = "载入数据"
- Option Explicit
- ' Download by http://www.codefans.net
- Public Sub LoadChrSelTexData(FileName As String)
- Dim i As Long, TexCount As Long
- On Error GoTo Err
- Close #1
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim ChrSelTex(TexCount)
- Get #1, 49, ChrSelTex(i).StartPos
- Get #1, , ChrSelTex(i).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , ChrSelTex(i).StartPos
- Get #1, , ChrSelTex(i).EndPos
- ChrSelTex(i - 1).StartPos = ChrSelTex(i - 2).EndPos
- ChrSelTex(i - 1).EndPos = ChrSelTex(i).StartPos
- Next
- Close #1
- Exit Sub
- Err:
- MsgBox "载入文件失败" & FileName, , "载入失败"
- End Sub
- Public Sub LoadNpcTexData(FileName As String)
- Dim i As Long, TexCount As Long
- On Error GoTo Err
- Close #1
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim NpcTex(TexCount)
- Get #1, 49, NpcTex(0).StartPos
- Get #1, , NpcTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , NpcTex(i).StartPos
- Get #1, , NpcTex(i).EndPos
- NpcTex(i - 1).StartPos = NpcTex(i - 2).EndPos
- NpcTex(i - 1).EndPos = NpcTex(i).StartPos
- Next
- Close #1
- Exit Sub
- Err:
- MsgBox "载入文件失败" & FileName, , "载入失败"
- End Sub
- Public Sub LoadMonTexData()
- Dim i As Integer, j As Long
- Dim MonTexNum As Integer, TexCount As Long
- MonTexNum = 23
- ReDim MonPic(MonTexNum)
- For i = 1 To MonTexNum
- Open ResPath & "DataMon" & i & ".wix" For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim MonPic(i).MonTex(TexCount)
- Get #1, 49, MonPic(i).MonTex(0).StartPos
- Get #1, , MonPic(i).MonTex(0).EndPos
- For j = 2 To TexCount Step 2
- Get #1, , MonPic(i).MonTex(j).StartPos
- Get #1, , MonPic(i).MonTex(j).EndPos
- MonPic(i).MonTex(j - 1).StartPos = MonPic(i).MonTex(j - 2).EndPos
- MonPic(i).MonTex(j - 1).EndPos = MonPic(i).MonTex(j).StartPos
- Next
- Close #1
- Next
- End Sub
- Public Sub LoadMonDBData()
- Dim i As Integer
- Open App.Path & "DBMonDB.DB" For Input As #1
- Input #1, MonDBCount
- ReDim MonDB(MonDBCount)
- For i = 1 To MonDBCount
- Input #1, MonDB(i).Name_名称
- Input #1, MonDB(i).Race_种族
- Input #1, MonDB(i).RaceImage_种族图像
- Input #1, MonDB(i).Appr_形象代码
- Input #1, MonDB(i).Level_等级
- Input #1, MonDB(i).UnDead_不死系
- Input #1, MonDB(i).CoolEye_视觉范围
- Input #1, MonDB(i).Exp_经验值
- Input #1, MonDB(i).HP
- Input #1, MonDB(i).MP
- Input #1, MonDB(i).AC
- Input #1, MonDB(i).MAC
- Input #1, MonDB(i).DC_攻击力
- Input #1, MonDB(i).DCMax_最大攻击力
- Input #1, MonDB(i).MC_魔法力
- Input #1, MonDB(i).SC_道术力
- Input #1, MonDB(i).Speed_速度
- Input #1, MonDB(i).Hit_命中率
- Input #1, MonDB(i).WalkSpeed_行走速度
- Input #1, MonDB(i).WalkStep_行走步伐
- Input #1, MonDB(i).WalkWait_行走等待
- Input #1, MonDB(i).AttactSpeed_攻击速度
- Next
- Close #1
- End Sub
- Public Function GetMonDBNum(MonName As String) As Integer
- Dim i As Integer
- For i = 1 To MonDBCount
- If MonName = MonDB(i).Name_名称 Then
- GetMonDBNum = i
- Exit For
- End If
- Next
- End Function
- Public Function GetMagicDBNum(MagicName As String) As Integer
- Dim i As Integer
- For i = 1 To MagicDBCount
- If MagicDB(i).MagName_名称 = MagicName Then
- GetMagicDBNum = i
- Exit For
- End If
- Next
- End Function
- '/////// 载入物品数据
- Public Sub LoadItemDBData()
- Dim i As Integer
- Open App.Path & "DBStdItemDB.DB" For Input As #1
- Input #1, ItemDBCount
- ReDim ItemDB(ItemDBCount)
- If ItemDBCount > 0 Then
- For i = 1 To ItemDBCount
- Input #1, ItemDB(i).Idx
- Input #1, ItemDB(i).Name
- Input #1, ItemDB(i).StdMode
- Input #1, ItemDB(i).Shape
- Input #1, ItemDB(i).Weight
- Input #1, ItemDB(i).Anicount
- Input #1, ItemDB(i).Source
- Input #1, ItemDB(i).Reserved
- Input #1, ItemDB(i).Looks
- Input #1, ItemDB(i).DuraMax
- Input #1, ItemDB(i).AC
- Input #1, ItemDB(i).AC2
- Input #1, ItemDB(i).MAC
- Input #1, ItemDB(i).MAC2
- Input #1, ItemDB(i).Dc
- Input #1, ItemDB(i).DC2
- Input #1, ItemDB(i).MC
- Input #1, ItemDB(i).MC2
- Input #1, ItemDB(i).sc
- Input #1, ItemDB(i).SC2
- Input #1, ItemDB(i).Need
- Input #1, ItemDB(i).NeedLevel
- Input #1, ItemDB(i).Price
- Next
- End If
- Close #1
- End Sub
- '/////// 载入魔法数据
- Public Sub LoadMagicDBData()
- Dim i As Integer
- Open App.Path & "DBMagicDB.DB" For Input As #1
- Input #1, MagicDBCount
- ReDim MagicDB(MagicDBCount)
- If MagicDBCount > 0 Then
- For i = 1 To MagicDBCount
- Input #1, MagicDB(i).MagID_序号
- Input #1, MagicDB(i).MagName_名称
- Input #1, MagicDB(i).EffectType_动作效果
- Input #1, MagicDB(i).Effect_魔法效果
- Input #1, MagicDB(i).Spell_魔法消耗
- Input #1, MagicDB(i).Power_基本威力
- Input #1, MagicDB(i).MaxPower_最大威力
- Input #1, MagicDB(i).DefSpell_升级魔法
- Input #1, MagicDB(i).DefPower_升级威力
- Input #1, MagicDB(i).DefMaxPower_升最大威力
- Input #1, MagicDB(i).Job_职业
- Input #1, MagicDB(i).NeedL1_1级等级
- Input #1, MagicDB(i).L1Train_1级经验
- Input #1, MagicDB(i).NeedL2_2级等级
- Input #1, MagicDB(i).L2Train_2级经验
- Input #1, MagicDB(i).NeedL3_3级等级
- Input #1, MagicDB(i).L3Train_3级经验
- Input #1, MagicDB(i).Delay_技能延时
- Next
- End If
- Close #1
- End Sub
- '////////// 载入其它贴图数据
- Public Sub LoadPrguseTexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim PrguseTex(TexCount)
- Get #1, 49, PrguseTex(0).StartPos
- Get #1, , PrguseTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , PrguseTex(i).StartPos
- Get #1, , PrguseTex(i).EndPos
- PrguseTex(i - 1).StartPos = PrguseTex(i - 2).EndPos
- PrguseTex(i - 1).EndPos = PrguseTex(i).StartPos
- Next
- Close #1
- End Sub
- Public Sub LoadPrguse2TexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim Prguse2Tex(TexCount)
- Get #1, 49, Prguse2Tex(0).StartPos
- Get #1, , Prguse2Tex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , Prguse2Tex(i).StartPos
- Get #1, , Prguse2Tex(i).EndPos
- Prguse2Tex(i - 1).StartPos = Prguse2Tex(i - 2).EndPos
- Prguse2Tex(i - 1).EndPos = Prguse2Tex(i).StartPos
- Next
- Close #1
- End Sub
- Public Sub LoadPrguse3TexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim Prguse3Tex(TexCount)
- Get #1, 49, Prguse3Tex(0).StartPos
- Get #1, , Prguse3Tex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , Prguse3Tex(i).StartPos
- Get #1, , Prguse3Tex(i).EndPos
- Prguse3Tex(i - 1).StartPos = Prguse3Tex(i - 2).EndPos
- Prguse3Tex(i - 1).EndPos = Prguse3Tex(i).StartPos
- Next
- Close #1
- End Sub
- '////////// 载入魔法贴图数据
- Public Sub LoadMagicTexData()
- Dim i As Long, j As Long, TexCount As Long, mFileNum As String
- ReDim MagicPic(6)
- For j = 1 To 2
- mFileNum = j
- If j = 1 Then mFileNum = ""
- Open ResPath & "DataMagic" & mFileNum & ".wix" For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim MagicPic(j).MagicTex(TexCount)
- Get #1, 49, MagicPic(j).MagicTex(0).StartPos
- Get #1, , MagicPic(j).MagicTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , MagicPic(j).MagicTex(i).StartPos
- Get #1, , MagicPic(j).MagicTex(i).EndPos
- MagicPic(j).MagicTex(i - 1).StartPos = MagicPic(j).MagicTex(i - 2).EndPos
- MagicPic(j).MagicTex(i - 1).EndPos = MagicPic(j).MagicTex(i).StartPos
- Next
- Close #1
- Next
- End Sub
- '////////// 载入衣服贴图数据
- Public Sub LoadHumTexData(FileName As String)
- Dim i As Long, TexCount As Long
- On Error GoTo Err
- Close #1
- Open FileName For Binary As #1
- Get #1, 45, TexCount
- TexCount = TexCount - 1
- ReDim HumTex(TexCount)
- Get #1, 49, HumTex(0).StartPos
- Get #1, , HumTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , HumTex(i).StartPos
- Get #1, , HumTex(i).EndPos
- HumTex(i - 1).StartPos = HumTex(i - 2).EndPos
- HumTex(i - 1).EndPos = HumTex(i).StartPos
- Next
- Close #1
- Exit Sub
- Err:
- MsgBox "载入文件失败" & FileName, , "载入失败"
- End Sub
- '///////// 载入武器贴图数据
- Public Sub LoadWeaponTexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount '##
- TexCount = TexCount - 1 '##
- ReDim WeaponTex(TexCount) '##
- '############### 载入图片数量结束 ####################
- Get #1, 49, WeaponTex(0).StartPos
- Get #1, , WeaponTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , WeaponTex(i).StartPos
- Get #1, , WeaponTex(i).EndPos
- WeaponTex(i - 1).StartPos = WeaponTex(i - 2).EndPos
- WeaponTex(i - 1).EndPos = WeaponTex(i).StartPos
- Next
- Close #1
- End Sub
- '///////// 载入物品贴图数据
- Public Sub LoadItemsTexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount '##
- TexCount = TexCount - 1 '##
- ReDim ItemsTex(TexCount) '##
- '############### 载入图片数量结束 ####################
- Get #1, 49, ItemsTex(0).StartPos
- Get #1, , ItemsTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , ItemsTex(i).StartPos
- Get #1, , ItemsTex(i).EndPos
- ItemsTex(i - 1).StartPos = ItemsTex(i - 2).EndPos
- ItemsTex(i - 1).EndPos = ItemsTex(i).StartPos
- Next
- Close #1
- End Sub
- '///////// 载入装备物品贴图数据
- Public Sub LoadStateItemTexData(FileName As String)
- Dim i As Long, TexCount As Long
- Open FileName For Binary As #1
- Get #1, 45, TexCount '##
- TexCount = TexCount - 1 '##
- ReDim StateItemTex(TexCount) '##
- '############### 载入图片数量结束 ####################
- Get #1, 49, StateItemTex(0).StartPos
- Get #1, , StateItemTex(0).EndPos
- For i = 2 To TexCount Step 2
- Get #1, , StateItemTex(i).StartPos
- Get #1, , StateItemTex(i).EndPos
- StateItemTex(i - 1).StartPos = StateItemTex(i - 2).EndPos
- StateItemTex(i - 1).EndPos = StateItemTex(i).StartPos
- Next
- Close #1
- End Sub
