PDA

View Full Version : code



LiOnHeArT
03-06-2003, 06:11 AM
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

rugbydude
03-06-2003, 06:20 AM
may i ask wot that is:confused:

asklepios
03-06-2003, 02:56 PM
and why did you post it here...:confused:
you didn't ask for any assistance either...so wat does it mean...:?:

elrado1
03-06-2003, 09:24 PM
I think LiOnHeArT is a very confused puppy, which breeds more confusion.

theyneverknew
03-16-2003, 02:49 AM
argh I hate VB :shoot: