|
|
发表于 2016-7-7 14:27:15
|
显示全部楼层
Private Sub UserForm_Initialize()
Dim d '定义字典转换数组用 '
Dim i%
'-------------获取武将所有数据---------------
arr = Sheet3.[a1].Resize(Sheet3.[a1].End(xlDown).Row, Sheet3.[a1].End(xlToRight).Column)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr, 1)
d(arr(i, 2)) = ""
Next i
brr = d.keys
'-------------选择武将库初始化---------------
M1.List = brr
M2.List = brr
M3.List = brr
M4.List = brr
M5.List = brr
M6.List = brr
Y1.List = brr
Y2.List = brr
Y3.List = brr
Y4.List = brr
Y5.List = brr
Y6.List = brr
End Sub
Private Sub get_hero(ByRef newhero As hero)
'-----------------------------------------武将属性数据-------------------------------------------
'武将攻击状态
newhero.hero_act = False
newhero.hero_dead = False
'武将ID
newhero.hero_id = arr(newhero.hero_pos + 1, 1)
'武将名称
newhero.hero_name = arr(newhero.hero_pos + 1, 2)
'武将名称
newhero.hero_indro = arr(newhero.hero_pos + 1, 3)
'攻击成长
newhero.hero_atk_up = arr(newhero.hero_pos + 1, 4)
'防御成长
newhero.hero_def_up = arr(newhero.hero_pos + 1, 5)
'血量成长
newhero.hero_hp_up = arr(newhero.hero_pos + 1, 6)
'初始攻击
newhero.hero_ini_atk = arr(newhero.hero_pos + 1, 7)
'初始防御
newhero.hero_ini_def = arr(newhero.hero_pos + 1, 8)
'初始血量
newhero.hero_ini_hp = arr(newhero.hero_pos + 1, 9)
'武将类型
newhero.hero_type = arr(newhero.hero_pos + 1, 10)
'怒气上限
newhero.hero_power_limit = arr(newhero.hero_pos + 1, 11)
'技能ID
newhero.hero_skill = arr(newhero.hero_pos + 1, 12)
'-----------------------------------------武将属性数据-------------------------------------------
'-----------------------------------------武将类型数据-------------------------------------------
Dim e '字典e武将类型数据
Dim j%
'-----------------------------------------武将类型数据-------------------------------------------
crr = Sheet4.[a1].Resize(Sheet4.[a1].End(xlDown).Row, Sheet4.[a1].End(xlToRight).Column)
Set e = CreateObject("scripting.dictionary")
For j = 2 To UBound(crr, 1)
e(crr(j, 1)) = ""
Next j
drr = e.keys
'根据类型获取等级提升值
newhero.hero_atk_lv = crr(Application.WorksheetFunction.Match(newhero.hero_type, drr, 0) + 1, 2)
newhero.hero_def_lv = crr(Application.WorksheetFunction.Match(newhero.hero_type, drr, 0) + 1, 3)
newhero.hero_hp_lv = crr(Application.WorksheetFunction.Match(newhero.hero_type, drr, 0) + 1, 4)
'-----------------------------------------武将类型数据-------------------------------------------
End Sub
Private Sub set_hero(ByRef newlist As ComboBox)
Dim hero_select As hero
Dim hero_newlv As Object
Dim battle_atk As Object
Dim battle_def As Object
Dim battle_hp As Object
'-----------------------------------------NEWLIST------------------------------------------------
Select Case control
'>>>>>>>>>>>>>>>>>>我方阵营<<<<<<<<<<<<<<<<<<
Case 1
Set hero_select = Hero_M1
Set battle_atk = m1_atk
Set battle_def = m1_def
Set battle_hp = m1_hp
Set hero_newlv = m1_lv
Case 2
Set hero_select = Hero_M2
Set battle_atk = m2_atk
Set battle_def = m2_def
Set battle_hp = m2_hp
Set hero_newlv = m2_lv
Case 3
Set hero_select = Hero_M3
Set battle_atk = m3_atk
Set battle_def = m3_def
Set battle_hp = m3_hp
Set hero_newlv = m3_lv
Case 4
Set hero_select = Hero_M4
Set battle_atk = m4_atk
Set battle_def = m4_def
Set battle_hp = m4_hp
Set hero_newlv = m4_lv
Case 5
Set hero_select = Hero_M5
Set battle_atk = m5_atk
Set battle_def = m5_def
Set battle_hp = m5_hp
Set hero_newlv = m5_lv
Case 6
Set hero_select = Hero_M6
Set battle_atk = m6_atk
Set battle_def = m6_def
Set battle_hp = m6_hp
Set hero_newlv = m6_lv
'>>>>>>>>>>>>>>>>>>敌方阵营<<<<<<<<<<<<<<<<<<
Case 7
Set hero_select = Hero_Y1
Set battle_atk = y1_atk
Set battle_def = y1_def
Set battle_hp = y1_hp
Set hero_newlv = y1_lv
Case 8
Set hero_select = Hero_Y2
Set battle_atk = y2_atk
Set battle_def = y2_def
Set battle_hp = y2_hp
Set hero_newlv = y2_lv
Case 9
Set hero_select = Hero_Y3
Set battle_atk = y3_atk
Set battle_def = y3_def
Set battle_hp = y3_hp
Set hero_newlv = y3_lv
Case 10
Set hero_select = Hero_Y4
Set battle_atk = y4_atk
Set battle_def = y4_def
Set battle_hp = y4_hp
Set hero_newlv = y4_lv
Case 11
Set hero_select = Hero_Y5
Set battle_atk = y5_atk
Set battle_def = y5_def
Set battle_hp = y5_hp
Set hero_newlv = y5_lv
Case 12
Set hero_select = Hero_Y6
Set battle_atk = y6_atk
Set battle_def = y6_def
Set battle_hp = y6_hp
Set hero_newlv = y6_lv
End Select
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>武将数据位置<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
If newlist.Value <> "" Then
'-------------------------------------根据武将选择获取数据--------------------------------------
hero_select.hero_name = newlist.Value
hero_select.hero_pos = Application.WorksheetFunction.Match(newlist.Value, brr, 0)
get_hero hero_select '<====调用get_hero====>
hero_indro.text = hero_select.hero_indro
'-----------------------------------------------------------------------------------------------
'武将等级
With hero_select
'=========================武将等级========================
If hero_newlv.Value <> "" Then
.hero_lv = hero_newlv.Value
Else
.hero_lv = 1
End If
'=========================================================
'----------------------------------------武将攻防血---------------------------------------------
On Error GoTo err
.hero_atk = .hero_ini_atk + .hero_atk_lv * (.hero_lv - 1) * .hero_atk_up
.hero_def = .hero_ini_def + .hero_def_lv * (.hero_lv - 1) * .hero_def_up
.hero_hp = .hero_ini_hp + .hero_hp_lv * (.hero_lv - 1) * .hero_hp_up
'=================prop================
battle_atk.Caption = .hero_atk
battle_def.Caption = .hero_def
battle_hp.Caption = .hero_hp
End With
'-----------------------------------------------------------------------------------------------
Else
MsgBox "请选择武将后再设定等级参数！"
End If
err: MsgBox "请填写正确的武将数据!"
End Sub
|
|
楼主