Public Property Get Count() As Long
Count = mvarCollection.Count
End Property
Public Function Item(ByVal Index) As PropertyItem
On Error GoTo ExitErr
Set Item = mvarCollection.Item(Index)
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Function
Public Function Add(ByVal mCaption As String, ByVal mvalue As Variant, Optional ByVal ItemKey As String, Optional ByVal mvalueType As PropertyItemType = EditBox) As PropertyItem
On Error GoTo ExitErr
Dim mPropertyItem As New PropertyItem
Grid.AddItem mCaption
mPropertyItem.Index = Grid.Rows
If ItemKey = "" Then
mvarCollection.Add mPropertyItem
Else
mvarCollection.Add mPropertyItem, ItemKey
End If
Grid.ColAlignment(0) = 1
Grid.ColAlignment(1) = 1
mPropertyItem.Caption = mCaption
mPropertyItem.PropertyType = mvalueType
mPropertyItem.value = mvalue
Call SetGrid
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Else
Set Add = mPropertyItem
End If
End Function
Private Sub SetGrid()
Grid.Rows = mvarCollection.Count
If Grid.Rows > 0 Then
PicScrollBox.Visible = True
Grid.Visible = True
Grid.Height = Grid.Rows * Grid.RowHeight(0)
PicScrollBox.Height = Grid.Height
Grid.Width = PicScrollBox.Width + IIf(HasScrollBar, -240, 0)
Call SetScrollvalue
Else
PicScrollBox.Visible = False
Grid.Visible = False
End If
End Sub
Private Sub SetScrollvalue()
Dim Maxvalue As Single
Maxvalue = PicScrollBox.Height - GridBox.Height + 55
If Maxvalue > 0 Then
m_cScroll.Max(efsVertical) = Maxvalue
m_cScroll.LargeChange(efsVertical) = Grid.RowHeight(0) * (Grid.Height / Grid.RowHeight(0))
m_cScroll.SmallChange(efsVertical) = Grid.RowHeight(0)
m_cScroll.Visible(efsVertical) = True
Call SetEditBox
Else
m_cScroll.Visible(efsVertical) = False
End If
End Sub
Public Sub Remove(ByVal Index)
Dim i As Long
On Error GoTo ExitErr
mvarCollection.Remove Index
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Else
If Index = 1 And Grid.Rows = 1 Then
Grid.Rows = 0
Else
Grid.RemoveItem Index - 1
End If
For i = 1 To mvarCollection.Count
Item(i).Index = i
Next i
Call SetGrid
End If
End Sub
Public Sub Clear()
Set mvarCollection = Nothing
Set mvarCollection = New Collection
Grid.Rows = 0
Call SetGrid
End Sub
'================================================= =======================
'================================================= =======================
Private Sub ChkEdit_Click()
ChkEdit.Caption = IIf(ChkEdit.value = 1, "True", "False")
If Not bAppChangevalue Then
Item(SelectIndex).value = IIf(ChkEdit.value = 1, True, False)
End If
End Sub
Private Sub ChkEdit_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub ChkEdit_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub ChkEdit_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub CmbObject_Click()
RaiseEvent ObjectSelect(CmbObject.Text)
End Sub
Private Sub CmbObject_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub CmbObject_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub CmbObject_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub CmdEdit_Click()
RaiseEvent ButtonClick(SelectIndex)
End Sub
Private Sub CmdEdit_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub CmdEdit_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub CmdEdit_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub ComboEdit_Change()
If Not bAppChangevalue Then
Item(SelectIndex).value = ComboEdit.Text
End If
End Sub
Private Sub ComboEdit_Click()
If Not bAppChangevalue Then
Item(SelectIndex).value = ComboEdit.Text
End If
End Sub
Private Sub ComboEdit_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
RaiseEvent KeyDown(KeyCode.value, Shift)
End Sub
Private Sub ComboEdit_KeyPress(KeyAscii As MSForms.ReturnInteger)
RaiseEvent KeyPress(KeyAscii.value)
End Sub
Private Sub ComboEdit_KeyUp(KeyCode As MSForms.ReturnInteger, Shift As Integer)
RaiseEvent KeyUp(KeyCode.value, Shift)
End Sub
Private Sub Grid_Click()
Grid_RowColChange
End Sub
Private Sub Grid_DblClick()
Dim i As Long
Dim bFindInEnum As Boolean
Select Case Item(SelectIndex).PropertyType
Case 1
Call CmdEdit_Click
Case 2
TxtEdit.SelStart = 0
TxtEdit.SelLength = Len(TxtEdit.Text)
Case 3 'Combox
If Item(SelectIndex).Enumvalue.Count > 0 Then
For i = 0 To ComboEdit.ListCount - 1
If ComboEdit.List(i) = Item(SelectIndex).value Then
If i + 1 <= ComboEdit.ListCount - 1 Then
ComboEdit.ListIndex = i + 1
Else
ComboEdit.ListIndex = 0
End If
bFindInEnum = True
Exit For
End If
Next i
If Not bFindInEnum Then
ComboEdit.ListIndex = 0
End If
End If
Case 4 'Check
ChkEdit.value = IIf(ChkEdit.value = 1, 0, 1)
End Select
End Sub
Private Sub Grid_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub Grid_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub Grid_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub Grid_LeaveCell()
Grid.CellBackColor = &H80000005
End Sub
Private Sub SetEditBox()
PicEditBox.Move Grid.ColWidth(0) + 10, Grid.Top + Grid.CellTop, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) - 10, Grid.RowHeight(0) - 10
TxtEdit.Move Grid.ColWidth(0), Grid.Top + Grid.CellTop - 20, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0)
ComboEdit.Move -120, 0, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) + 110, Grid.RowHeight(0)
CmdEdit.Move PicScrollBox.Width - 50 + IIf(HasScrollBar, -240, 0) - CmdEdit.Width, Grid.Top + Grid.CellTop, Grid.RowHeight(0), Grid.RowHeight(0)
ChkEdit.Move 0, 0, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) - 10, Grid.RowHeight(0)
End Sub
Private Sub Grid_RowColChange()
If Grid.Rows <> 0 Then
Call SetEditBox
SelectIndex = Grid.Row + 1
Grid.CellBackColor = m_SelectColor
Call CreateEditBox(Item(SelectIndex))
RaiseEvent Click(SelectIndex)
End If
End Sub
Private Sub CreateEditBox(ByVal PropertyType As PropertyItem)
On Error Resume Next
Dim i As Long
bAppChangevalue = True
Select Case PropertyType.PropertyType
Case 1 'Button
PicEditBox.Visible = False
TxtEdit.Visible = False
ChkEdit.Visible = False
Count = mvarCollection.Count
End Property
Public Function Item(ByVal Index) As PropertyItem
On Error GoTo ExitErr
Set Item = mvarCollection.Item(Index)
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Function
Public Function Add(ByVal mCaption As String, ByVal mvalue As Variant, Optional ByVal ItemKey As String, Optional ByVal mvalueType As PropertyItemType = EditBox) As PropertyItem
On Error GoTo ExitErr
Dim mPropertyItem As New PropertyItem
Grid.AddItem mCaption
mPropertyItem.Index = Grid.Rows
If ItemKey = "" Then
mvarCollection.Add mPropertyItem
Else
mvarCollection.Add mPropertyItem, ItemKey
End If
Grid.ColAlignment(0) = 1
Grid.ColAlignment(1) = 1
mPropertyItem.Caption = mCaption
mPropertyItem.PropertyType = mvalueType
mPropertyItem.value = mvalue
Call SetGrid
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Else
Set Add = mPropertyItem
End If
End Function
Private Sub SetGrid()
Grid.Rows = mvarCollection.Count
If Grid.Rows > 0 Then
PicScrollBox.Visible = True
Grid.Visible = True
Grid.Height = Grid.Rows * Grid.RowHeight(0)
PicScrollBox.Height = Grid.Height
Grid.Width = PicScrollBox.Width + IIf(HasScrollBar, -240, 0)
Call SetScrollvalue
Else
PicScrollBox.Visible = False
Grid.Visible = False
End If
End Sub
Private Sub SetScrollvalue()
Dim Maxvalue As Single
Maxvalue = PicScrollBox.Height - GridBox.Height + 55
If Maxvalue > 0 Then
m_cScroll.Max(efsVertical) = Maxvalue
m_cScroll.LargeChange(efsVertical) = Grid.RowHeight(0) * (Grid.Height / Grid.RowHeight(0))
m_cScroll.SmallChange(efsVertical) = Grid.RowHeight(0)
m_cScroll.Visible(efsVertical) = True
Call SetEditBox
Else
m_cScroll.Visible(efsVertical) = False
End If
End Sub
Public Sub Remove(ByVal Index)
Dim i As Long
On Error GoTo ExitErr
mvarCollection.Remove Index
ExitErr:
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Else
If Index = 1 And Grid.Rows = 1 Then
Grid.Rows = 0
Else
Grid.RemoveItem Index - 1
End If
For i = 1 To mvarCollection.Count
Item(i).Index = i
Next i
Call SetGrid
End If
End Sub
Public Sub Clear()
Set mvarCollection = Nothing
Set mvarCollection = New Collection
Grid.Rows = 0
Call SetGrid
End Sub
'================================================= =======================
'================================================= =======================
Private Sub ChkEdit_Click()
ChkEdit.Caption = IIf(ChkEdit.value = 1, "True", "False")
If Not bAppChangevalue Then
Item(SelectIndex).value = IIf(ChkEdit.value = 1, True, False)
End If
End Sub
Private Sub ChkEdit_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub ChkEdit_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub ChkEdit_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub CmbObject_Click()
RaiseEvent ObjectSelect(CmbObject.Text)
End Sub
Private Sub CmbObject_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub CmbObject_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub CmbObject_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub CmdEdit_Click()
RaiseEvent ButtonClick(SelectIndex)
End Sub
Private Sub CmdEdit_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub CmdEdit_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub CmdEdit_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub ComboEdit_Change()
If Not bAppChangevalue Then
Item(SelectIndex).value = ComboEdit.Text
End If
End Sub
Private Sub ComboEdit_Click()
If Not bAppChangevalue Then
Item(SelectIndex).value = ComboEdit.Text
End If
End Sub
Private Sub ComboEdit_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
RaiseEvent KeyDown(KeyCode.value, Shift)
End Sub
Private Sub ComboEdit_KeyPress(KeyAscii As MSForms.ReturnInteger)
RaiseEvent KeyPress(KeyAscii.value)
End Sub
Private Sub ComboEdit_KeyUp(KeyCode As MSForms.ReturnInteger, Shift As Integer)
RaiseEvent KeyUp(KeyCode.value, Shift)
End Sub
Private Sub Grid_Click()
Grid_RowColChange
End Sub
Private Sub Grid_DblClick()
Dim i As Long
Dim bFindInEnum As Boolean
Select Case Item(SelectIndex).PropertyType
Case 1
Call CmdEdit_Click
Case 2
TxtEdit.SelStart = 0
TxtEdit.SelLength = Len(TxtEdit.Text)
Case 3 'Combox
If Item(SelectIndex).Enumvalue.Count > 0 Then
For i = 0 To ComboEdit.ListCount - 1
If ComboEdit.List(i) = Item(SelectIndex).value Then
If i + 1 <= ComboEdit.ListCount - 1 Then
ComboEdit.ListIndex = i + 1
Else
ComboEdit.ListIndex = 0
End If
bFindInEnum = True
Exit For
End If
Next i
If Not bFindInEnum Then
ComboEdit.ListIndex = 0
End If
End If
Case 4 'Check
ChkEdit.value = IIf(ChkEdit.value = 1, 0, 1)
End Select
End Sub
Private Sub Grid_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub Grid_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub Grid_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub Grid_LeaveCell()
Grid.CellBackColor = &H80000005
End Sub
Private Sub SetEditBox()
PicEditBox.Move Grid.ColWidth(0) + 10, Grid.Top + Grid.CellTop, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) - 10, Grid.RowHeight(0) - 10
TxtEdit.Move Grid.ColWidth(0), Grid.Top + Grid.CellTop - 20, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0)
ComboEdit.Move -120, 0, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) + 110, Grid.RowHeight(0)
CmdEdit.Move PicScrollBox.Width - 50 + IIf(HasScrollBar, -240, 0) - CmdEdit.Width, Grid.Top + Grid.CellTop, Grid.RowHeight(0), Grid.RowHeight(0)
ChkEdit.Move 0, 0, Grid.ColWidth(1) - 60 + IIf(HasScrollBar, -240, 0) - 10, Grid.RowHeight(0)
End Sub
Private Sub Grid_RowColChange()
If Grid.Rows <> 0 Then
Call SetEditBox
SelectIndex = Grid.Row + 1
Grid.CellBackColor = m_SelectColor
Call CreateEditBox(Item(SelectIndex))
RaiseEvent Click(SelectIndex)
End If
End Sub
Private Sub CreateEditBox(ByVal PropertyType As PropertyItem)
On Error Resume Next
Dim i As Long
bAppChangevalue = True
Select Case PropertyType.PropertyType
Case 1 'Button
PicEditBox.Visible = False
TxtEdit.Visible = False
ChkEdit.Visible = False
Comment