DirextX编程

开发平台：
Visual Basic

脚本模块.bas：源码内容
							Attribute VB_Name = "脚本模块"
Option Explicit
Public Type ScriptType  '脚本属性
    ScriptName As String
    ScriptStr As String
End Type
Public Type NpcType 'NPC属性
    X As Integer
    Y As Integer
    Name_名称 As String
    Image As Integer
    Pic As Integer
    PicSpeed As Integer
    PTime As Long
'    ScriptCount As Integer
'    Script() As ScriptType
'    ScriptFileName As String
End Type
Public SelNpcNum As Integer
Public NpcCount As Integer
Public NPCInfo() As NpcType
Public mScript As String
'Public Function ActScript(ByVal mNpc As Long, ByVal mScript As String, Optional ByVal inValue As String) As String
'    Dim IFstr, ACTstr, ELSEstr, ELSESAYstr As String
'    Dim IFvalue As Boolean
'    Dim mWord, mData, mVal As Variant
'    Dim i, j, k As Long
'    Dim tmpStr, mStr As String
'    Dim tmpNum, MonID As Long
'    Dim N1 As Integer, N2 As Integer
'    Dim S1 As String, S2 As String
'    Dim mSay As String
'    '系统变量
'    mScript = SysVariable(mNpc, mScript, inValue)
'    IFvalue = True
'
'    '去掉TAB字符
'    mScript = Replace(mScript, vbTab & vbTab, " ")
'    mScript = Replace(mScript, vbTab, " ")
'    '去掉多余的空格
'    For i = 9 To 2 Step -1
'        mScript = Replace(mScript, String(i, " "), " ")
'    Next i
'    mScript = Replace(mScript, " " & vbCrLf, vbCrLf)
'    IFstr = TakeStr(mScript, "#IF" & vbCrLf, vbCrLf & "#ACT")
'    If IFstr = "" Then IFstr = TakeStr(mScript, "#if" & vbCrLf, vbCrLf & "#act")
'    If IFstr = "" Then IFstr = TakeStr(mScript, "#IF" & vbCrLf, vbCrLf & "#SAY")
'    If IFstr = "" Then IFstr = TakeStr(mScript, "#if" & vbCrLf, vbCrLf & "#say")
'    '#ACT后面可能是#ELSE也可能是#ELSESAY
'    ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, vbCrLf & "#ELSE")
'    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#act" & vbCrLf, vbCrLf & "#else")
'    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, vbCrLf & "")
'    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#act" & vbCrLf, vbCrLf & "")
'
'    '如果没有ELSE语句
'    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, "")
'    ELSEstr = TakeStr(mScript, "#ELSE" & vbCrLf, "")
'    If ELSEstr = "" Then ELSEstr = TakeStr(mScript, "#else" & vbCrLf, "")
'    ELSESAYstr = TakeStr(mScript, "#ELSESAY" & vbCrLf, "")
'    If ELSESAYstr = "" Then ELSESAYstr = TakeStr(mScript, "#elsesay" & vbCrLf, "")
'    If ELSESAYstr = "" Then ELSESAYstr = TakeStr(mScript, "#SAY" & vbCrLf, "")
'
'    '如果脚本中不含有IF ACT成分，那么呈现整个脚本给客户端
'    If (IFstr = "") And (ACTstr = "") And (ELSESAYstr = "") Then IFvalue = False: ELSESAYstr = mScript
'
'    '如果只包含ACT语句，则执行
'    If (IFstr = "") And (ACTstr <> "") Then IFvalue = True
'    '执行判断语句
'    mWord = Split(IFstr, vbCrLf)
'    For i = 0 To UBound(mWord)
'        mData = Split(mWord(i), " ")
'        If UBound(mData) >= 0 Then
'            Select Case UCase(mData(0))
'                Case "CHECKLEVEL"
'                    IFvalue = IFvalue And Hero.Level_等级 >= mData(1)
'                Case "CHECKPK"
'                    IFvalue = IFvalue And Hero.PK值 >= mData(1)
'                Case "CHECKJOB"
'                    IFvalue = IFvalue And (Hero.Job_职业 = mData(1))
'                Case "CHECKSEX"
'                    IFvalue = IFvalue And (Hero.Sex_性别 = mData(1))
'                Case "CHECKGOLD"
'                    IFvalue = IFvalue And (Hero.Gold_金币 >= mData(1))
'                Case "CHECKITEM"
'                    Dim AA As String
'                    AA = mData(1)
'                    tmpNum = GetItemCount(AA)
'                    If UBound(mData) >= 2 Then
'                        N1 = mData(2)
'                        IFvalue = IFvalue And (tmpNum) >= N1
'                    Else
'                        IFvalue = IFvalue And 1
'                    End If
'
'            End Select
'        End If
'    Next i
'    '根据上面的判断，生成相应的字符串
'    If Not IFvalue Then ACTstr = ELSEstr
'    If ACTstr <> "" Then
'        mWord = Split(Replace(ACTstr, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
'        For i = 0 To UBound(mWord)
'            If mWord(i) <> "" Then
'                tmpStr = ""
'                mData = Split(mWord(i), " ")
'                Select Case UCase(mData(0))
'                    Case "MSG"
'                        MsgBox Hero.PK值, , "PK"
'                    Case "SAY"
'                        mSay = TakeStr(mWord(i), "say ", "")
'                        If mSay = "" Then mSay = TakeStr(mWord(i), "Say ", "")
'                        If mSay = "" Then mSay = TakeStr(mWord(i), "SAY ", "")
'                        tmpStr = NPCInfo(mNpc).Name_名称 & "/" & mSay
'                    Case "ADDFAME" '声望
'                        Hero.Fame_声望值 = Hero.Fame_声望值 + mData(1)
'                    Case "TAKE" '拿走包裹装备
'                        S1 = mData(1)
'
'                        If mData(1) = "金币" Then
'                            If UBound(mData) >= 2 Then
'                                N1 = mData(2)
'                                Hero.Gold_金币 = Hero.Gold_金币 - N1
'                                ReDim Preserve SystemInfo(UBound(SystemInfo) + 1)
'                                SystemInfo(UBound(SystemInfo)).Enabled = True
'                                SystemInfo(UBound(SystemInfo)).mStr = "金币" & "    已被收取"
'                                SystemInfo(UBound(SystemInfo)).LTime = GetTickCount
'                            End If
'                        Else
'                            If UBound(mData) >= 2 Then
'                                N1 = mData(2)
'                            Else
'                                N1 = 1
'                            End If
'                            ShouItemCount S1, N1
'
'                        End If
'                    Case "FAMEUP"
'                        Hero.Fame_声望值 = Hero.Fame_声望值 + mData(1)
'                    Case "MAPMOVE"
'                        Hero.Map_地图 = mData(1)
'                    Case "GIVE" '给物品
'                        If mData(1) = "金币" Then
'                            Hero.Gold_金币 = Hero.Gold_金币 + mData(2)
'                            ReDim Preserve SystemInfo(UBound(SystemInfo) + 1)
'                            SystemInfo(UBound(SystemInfo)).Enabled = True
'                            SystemInfo(UBound(SystemInfo)).mStr = "金币" & "    被发现"
'                            SystemInfo(UBound(SystemInfo)).LTime = GetTickCount
'                        Else
'                            S1 = mData(1)
'                            If UBound(mData) >= 2 Then
'                                N1 = mData(2)
'                            Else
'                                N1 = 1
'                            End If
'                            tmpNum = GetItemNum(S1)
'                            If tmpNum > 0 Then
'                                GiveItem Items(tmpNum), N1
'
'                            End If
'                        End If
'
'                    Case "LEVELUP"  '升级
'                        Hero.Level_等级 = Hero.Level_等级 + mData(1)
'                    Case "LEVELDOWN"  '降级
'                        Hero.Level_等级 = Hero.Level_等级 - mData(1)
'
'                End Select
'            End If
'        Next i
'    Else
'        tmpStr = ELSESAYstr
'
'    End If
'
'    '字符串变量
'    tmpStr = SysVariable(mNpc, tmpStr, inValue)
''    tmpStr = JiaMiC(tmpStr)
'
'    '要向客户端发送的字符串
'    ActScript = tmpStr '执行结果已加密
'End Function
'
'
'Public Function SysVariable(ByVal mNpc As Long, ByVal mScript As String, Optional ByVal inValue As String) As String
'    Dim mStr As String
'    Dim i As Long
'    '系统变量
'    mScript = Replace(mScript, "<$NPCNAME>", NPCInfo(mNpc).Name_名称)
'    mScript = Replace(mScript, "<$USERNAME>", Hero.Name_名称)
'    mScript = Replace(mScript, "<$USERLEVEL>", Hero.Level_等级)
''    mScript = Replace(mScript, "<$USERLUCKY>", Hero.Lucky)
'    mScript = Replace(mScript, "<$USERPK>", Hero.PK值)
''    mScript = Replace(mScript, "<$USERIP>", P7200.sckPost(hero.SocksID).RemoteHostIP)
'    mScript = Replace(mScript, "<$USERFAME>", Hero.Fame_声望值)
''    mScript = Replace(mScript, "<$USEGUILD>", Hero.Guild)
''    mScript = Replace(mScript, "<$USERSUBHUMAN>", Hero.SubHuman)
'    mScript = Replace(mScript, "<$USERMAP>", Hero.Map_地图)
'    mScript = Replace(mScript, "<$USERX>", Hero.X)
'    mScript = Replace(mScript, "<$USERY>", Hero.Y)
'    mScript = Replace(mScript, "<$USERHOMEMAP>", Hero.HomeMap)
'    mScript = Replace(mScript, "<$USERHOMEX>", Hero.HomeX)
'    mScript = Replace(mScript, "<$USERHOMEY>", Hero.HomeY)
'
'
'    mScript = Replace(mScript, "<$YEAR>", Year(Now))
'    mScript = Replace(mScript, "<$DATE>", Date)
'    mScript = Replace(mScript, "<$TIME>", Time)
'    mScript = Replace(mScript, "<$LOGINLONG>", Hero.LoginTime)
''    mScript = Replace(mScript, "<$RUNTIME>", Sec2Min(timeGetTime  1000))
'
''    mScript = Replace(mScript, "<$SABUKGUILD>", SABUK.OwnerGuild)
''    mScript = Replace(mScript, "<$SABUKGUILDBOSS>", SABUK.OwnerBoss)
''    mScript = Replace(mScript, "<$SABUKGOLD>", SABUK.Gold)
'    mScript = Replace(mScript, "<$INPUTVAL>", inValue)
'    SysVariable = mScript
'End Function
'
'Function TakeStr(Str As Variant, StartStr As String, EndStr As String) As String
'    Dim Len1 As Integer
'    Dim Len2 As Integer
'    Dim SS As String
'    Len1 = InStr(Str, StartStr)
'    If Len1 = 0 Then Exit Function
'    Len2 = InStr(Len1, Str, EndStr)
'    If Len2 > Len1 + Len(StartStr) Then
'        SS = Mid(Str, Len1 + Len(StartStr), Len2 - Len1 - Len(StartStr))
'    Else
'        SS = Mid(Str, Len1 + Len(StartStr), Len(Str) - Len1 - Len(StartStr))
'    End If
'    TakeStr = SS
'
'End Function
'Public Sub LoadScriptFile(mNpc As Integer, FileName As String)
'    Dim i As Integer
'    Dim Str As String
'    Dim Work1 As Boolean
'    open FileName For Input As #1
'        Do While Not EOF(1)
'            Line Input #1, Str
'            If Left(Str, 1) = "[" Then
'                NPCInfo(mNpc).ScriptCount = NPCInfo(mNpc).ScriptCount + 1
'                ReDim Preserve NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount)
'                NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptName = Mid(Str, 2, Len(Str) - 2)
'            Else
'                NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptStr = NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptStr & Str & vbCrLf
'            End If
'            DoEvents
'        Loop
'    close #1
'End Sub

						