Please report all spam threads, posts and suspicious members. We receive spam notifications and will take immediate action!
Results 1 to 5 of 5

Thread: code




  1. #1
    Join Date
    Jan 2003
    Posts
    115

    Default

    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

  2. #2
    Join Date
    Dec 2002
    Location
    Isle of man
    Posts
    1,332

    Default

    may i ask wot that is:confused:
    What the fcuk happened to my sig?

  3. #3
    Join Date
    Dec 2002
    Location
    caves of bedrock
    Posts
    3,129

    Default

    and why did you post it here...:confused:
    you didn't ask for any assistance either...so wat does it mean...:?:
    Latest Microsoft Security Updates.
    Last Updated:
    10th MARCH


    If you are a security freak: Use Microsoft Baseline Security Analyzer (NT/2000/XP/2003)
    ======================
    icq : 203189004
    jabber : asklepios20@jabber.org
    =======================
    Linux user since: April 24, 2003 312478
    yabaa dabaa doo...
    Customized for 1024x768

  4. #4
    Join Date
    Jul 2002
    Posts
    662

    Default

    I think LiOnHeArT is a very confused puppy, which breeds more confusion.

  5. #5
    Join Date
    Feb 2003
    Posts
    346

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •