All pastes #115083 Raw Edit

Untitled

public text v1 · immutable
·published 2006-08-04 10:55 UTC
rendered paste body
Widget frmParty(Container)
    Widget cmdAddMember(Button)
        Set .Rectangle = F2Rect(10, 10, 100, 20, False)
        .Text = "Add"
    End Widget
    Widget cmdRemoveMember(Button)
        Set .Rectangle = F2Rect(120, 10, 100, 20, False)
        .Text = "Remove"
    End Widget
    Widget lstMembers(ListBox)
    End Widget
    Widget fraMember(Window)
        .Text = "Selected Member"
        ' This block generates a textbox for all of the editable variables a party member has
        ' You can add/remove/modify the variables by changing the list of names in the ()
        Widgets $var(Name Level HP MP Strength Agility Intelligence Sprite)
            Widget txtMember$var(TextField)
                .Label = "$var:"
            End Widget
        End Widgets
        Widget lstActions(ListBox)
            .Label = "Actions:"
        End Widget
        Widget cmdAddAction(Button)
            .Text = "Add"
        End Widget
        Widget cmdRemoveAction(Button)
            .Text = "Remove"
        End Widget
    End Widget
End Widget

Public Party
Public Editor

Public Sub Form_Initialize()
    Refresh
End Sub

Public Sub Editor_Initialize()
On Error Resume Next
    Editor.SetTabs Array("Party Members")
    Editor.EnableProperties = False
    Refresh
End Sub

Public Sub Editor_TabSelected(Tab)
End Sub

Public Sub lstMembers_Select(Item)
On Error Resume Next
    RefreshItem
End Sub

Public Sub frmParty_Resize()
On Error Resume Next
Dim TheCtl, X, Y, XSpace, W, H
    Set lstMembers.Rectangle = F2Rect(10, 40, This.Rectangle.Width - 20, 100, False)
    Set fraMember.Rectangle = F2Rect(lstMembers.Rectangle.Left, lstMembers.Rectangle.Bottom + 10, lstMembers.Rectangle.Width, This.Rectangle.Height - lstMembers.Rectangle.Bottom - 20, False)
    Y = 18
    XSpace = 70
    X = 0
    For Each TheCtl In fraMember.Children
        If TypeName(TheCtl) = "TextField" Then
            If (X > 0) Then Y = Y + H + 7
            X = 0
            H = 15
            Set TheCtl.Rectangle = F2Rect(5 + X + XSpace, Y, fraMember.Rectangle.Width - XSpace - 10, H, False)
            Y = Y + H + 7
        ElseIf TypeName(TheCtl) = "ListBox" Then
            If (X > 0) Then Y = Y + H + 7
            X = 0
            H = 15 * 5
            Set TheCtl.Rectangle = F2Rect(5 + X + XSpace, Y, fraMember.Rectangle.Width - XSpace - 10, H, False)
            Y = Y + H + 7
        ElseIf TypeName(TheCtl) = "Button" Then
            H = 17
            W = 80
            Set TheCtl.Rectangle = F2Rect(5 + X + XSpace, Y, W, H, False)
            X = X + W + 12
        End If
    Next
End Sub

Public Sub cmdAddMember_Click()
On Error Resume Next
Dim NewMember
    Set NewMember = Party.CreateMember()
    NewMember.Name = "New Member"
    Party.Members.Add NewMember
    lstMembers.Items.AddItem NewMember.Name
    lstMembers.SelectedItem = lstMembers.Items.Count
    RefreshItem
End Sub

Public Sub cmdRemoveMember_Click()
On Error Resume Next
Dim I
    I = lstMembers.SelectedItem
    Party.Members.Remove lstMembers.SelectedItem
    lstMembers.Items.Remove lstMembers.SelectedItem
    lstMembers.SelectedItem = ClipInteger(I, 1, lstMembers.Items.Count)
    RefreshItem
End Sub

Public Sub cmdAddAction_Click()
On Error Resume Next
Dim ActionName, Arr
    ActionName = InputBox("Name:", "Add Action")
    If Len(Trim(CStr(ActionName))) = 0 Then Exit Sub
    With Party.Members(lstMembers.SelectedItem)
        Arr = .Actions
        ArrayInsert Arr, ActionName, lstActions.SelectedItem - 1
        .Actions = Arr
    End With
    RefreshItem
End Sub

Public Sub cmdRemoveAction_Click()
On Error Resume Next
Dim Arr
    With Party.Members(lstMembers.SelectedItem)
        Arr = .Actions
        ArrayRemove Arr, lstActions.SelectedItem - 1
        .Actions = Arr
    End With
    RefreshItem
End Sub

Public Sub txtMemberName_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .Name = txtMemberName.Text
        lstMembers.Items(lstMembers.SelectedItem).Text = .Name
    End With
End Sub

Public Sub txtMemberLevel_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .Level = CLng(txtMemberLevel.Text)
    End With
End Sub

Public Sub txtMemberHP_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .MaxHP = CSng(txtMemberHP.Text)
        .HP = .MaxHP
    End With
End Sub

Public Sub txtMemberMP_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .MaxMP = CSng(txtMemberMP.Text)
        .MP = .MaxMP
    End With
End Sub

Public Sub txtMemberStrength_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .Strength = CSng(txtMemberStrength.Text)
    End With
End Sub

Public Sub txtMemberAgility_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .Agility = CSng(txtMemberAgility.Text)
    End With
End Sub

Public Sub txtMemberIntelligence_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .Intelligence = CSng(txtMemberIntelligence.Text)
    End With
End Sub

Public Sub txtMemberSprite_Change()
On Error Resume Next
    With Party.Members(lstMembers.SelectedItem)
        .SpriteFilename = txtMemberSprite.Text
    End With
End Sub

Public Sub Refresh()
On Error Resume Next
Dim Member, I
    I = lstMembers.SelectedItem
    lstMembers.Items.Clear
    For Each Member In Party
        lstMembers.Items.AddItem Member.Name
    Next
    lstMembers.SelectedItem = ClipInteger(I, 1, lstMembers.Items.Count)
    RefreshItem
End Sub

Public Sub RefreshItem()
On Error Resume Next
Dim Action
    With Party.Members(lstMembers.SelectedItem)
        txtMemberName.Text = .Name
        txtMemberLevel.Text = .Level
        txtMemberHP.Text = .MaxHP
        txtMemberMP.Text = .MaxMP
        txtMemberStrength.Text = .Strength
        txtMemberIntelligence.Text = .Intelligence
        txtMemberAgility.Text = .Agility
        txtMemberSprite.Text = .SpriteFilename
        lstActions.Items.Clear
        For Each Action In .Actions
            lstActions.Items.AddItem Action
        Next
    End With
End Sub