-
Notifications
You must be signed in to change notification settings - Fork 8
/
Module2.bas
156 lines (146 loc) · 4.64 KB
/
Module2.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
Attribute VB_Name = "Module2"
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
'dss
Public Const HTLEFT = 10
Public Const HTRight = 11
Public Const HTUP = 12
Public Const HTDown = 13
Type SkillName
Name As String
raw As String
Sp As String
maxsp As Integer
End Type
Public SkillIDName() As SkillName
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Function GetSkillIDbyName(tstr As String) As Integer
Dim i As Integer
If UBound(SkillIDName) > 0 Then
For i = 0 To UBound(SkillIDName)
If SkillIDName(i).raw = tstr Then
GetSkillIDbyName = i + 1
Exit Function
End If
Next
End If
GetSkillIDbyName = 0
End Function
Public Function CanUseSkill(ByVal Name As String, level As Byte, ByVal Sp As Integer) As Boolean
Dim requiresp As Integer
requiresp = Get_UseSPbyName(Name, level)
If Sp >= requiresp And requiresp <> 0 Then
'Stat "Can use " & name & vbCrLf
CanUseSkill = True
Else
'Stat sp & " Can't use " & CStr(level) & " " & name & " " & CStr(requiresp) & vbCrLf
CanUseSkill = False
End If
End Function
Public Function Get_UseSPbyName(ByVal Name As String, ByVal level As Byte) As Integer
On Error GoTo errie
Dim i As Integer
For i = 0 To UBound(SkillIDName)
If SkillIDName(i).raw = Name Then
If SkillIDName(i).Sp <> "" Then
Index = 1
If level > 1 Then Index = (level * 3) - 2
Get_UseSPbyName = Val(Mid(SkillIDName(i).Sp, Index, 3))
Else
Get_UseSPbyName = SkillIDName(i).maxsp
End If
Exit Function
End If
Next
errie:
Get_UseSPbyName = 0
End Function
Public Function Get_UseSPbyID(ByVal ID As Integer, ByVal level As Byte) As Integer
On Error GoTo errie
Dim Index As Integer
If UBound(SkillIDName) >= ID - 1 Then
If SkillIDName(ID - 1).Sp <> "" Then
If SkillIDName(i).Sp <> "" Then
Index = 1
If level > 1 Then Index = (level * 3) - 2
Get_UseSPbyID = Val(Mid(SkillIDName(i).Sp, Index, 3))
Else
Get_UseSPbyID = SkillIDName(i).maxsp
End If
Exit Function
End If
End If
errie:
Get_UseSPbyID = 0
End Function
Public Sub Load_SkillName()
On Error GoTo Out
Dim tstr As String
ReDim SkillIDName(0)
'Close 1
Open App.Path & "\table\Skillname.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, tstr
Index = InStr(tstr, "#")
If Index > 0 Then
SkillIDName(UBound(SkillIDName)).raw = Left(tstr, Index - 1)
tstr = Trim(Right(tstr, Len(tstr) - Index))
SkillIDName(UBound(SkillIDName)).Name = Left(tstr, Len(tstr))
SkillIDName(UBound(SkillIDName)).Sp = Get_SkillUseSp(SkillIDName(UBound(SkillIDName)).raw)
ReDim Preserve SkillIDName(UBound(SkillIDName) + 1)
End If
Loop
If (UBound(SkillIDName) > 0) Then ReDim Preserve SkillIDName(UBound(SkillIDName) - 1)
Close 1
Exit Sub
Out:
Close 1
MsgBox "Error!!! on loading 'table\skillname.txt' : " & Err.Description, vbCritical
End Sub
Public Function Get_SkillName(rawname As String) As String
Open App.Path & "\table\Skillname.txt" For Input As #1
Dim tstr As String
Dim text As String
Dim Index As Integer
text = "#"
Do While Not EOF(1)
Input #1, tstr
Index = InStr(1, tstr, text, vbTextCompare)
If Index > 0 Then
If Left(tstr, Index - 1) = rawname Then
Get_SkillName = Mid(tstr, Index + 1, Len(tstr) - Index)
Close 1
Exit Function
End If
End If
Loop
Get_SkillName = rawname
Close 1
End Function
Public Function Get_SkillD(rawname As String) As String
Dim tstr As String
Dim text As String
Dim Index As Integer
text = "#"
Open App.Path & "\table\SkillD.txt" For Input As #1
Do While Not EOF(1)
Input #1, tstr
Index = InStr(1, tstr, text, vbTextCompare)
If Index > 0 Then
If Left(tstr, Index - 1) = rawname Then
Input #1, tstr
Input #1, tstr
Do
Get_SkillD = Get_SkillD & tstr
Input #1, tstr
If (tstr <> "#") Then Get_SkillD = Get_SkillD & vbCrLf
Loop While (tstr <> "#")
Close 1
Exit Function
End If
End If
Loop
Get_SkillD = "Nothing"
Close 1
End Function