VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Updated Version of CoolFlex

by John/Phred/Cyrus Lacaba (2 Submissions)
Category: OLE/COM/DCOM/Active-X
Compatability: VB.NET
Difficulty: Unknown Difficulty
Originally Published: Tue 18th July 2006
Date Added: Mon 8th February 2021
Rating: (1 Votes)

Updated Version of CoolFlex

Rate Updated Version of CoolFlex



'Program Title:CoolFlex OCX
'Date : 27 July 2001
'Author: John
'Requirement:Microsoft DAO library
'select Microsoft DAO .... in Project->Reference first
'Note:
'This is based off the EasyFlex control submitted by Joe (Email: [email protected])
'Many properties and methods were added
'16 Aug 2001 - added several more properties and methods to the control


'Program Title:CoolFlex OCX
'Date : 21 Feb 2003, 22 Apr 2003
'Author: Phred
'This is based off the CoolFlex control submitted by John ([email protected])
'Added Button to grid - use CellButtonClick in your form to control what happens when button
'  is clicked.
'Most of this is from John's work. I only added the eButton routines. I could have used an
' event when the row was left but a "Save" button is more intuitive.


'Program Title:CoolFlex OCX
'Date : 9 May 2006, 10 May 2006
'Author:  Cyrus Lacaba - Death ®
'Place: Las Piñas City, Philippines
'This is based off the CoolFlex control submitted by John ([email protected]) and Phred
'Most of this is from John's and Phred's work.
'I only added validation for numeric and alpha-numeric entry on Text Box and autoselect on Combo Box


Option Explicit
Private MyDataName As Database
Private MyRecord As Long       'var for total record
Private MyRecordPos As Long    'var for record pos
Private AutoFix As Boolean       'var for automatic fixed
Private ModifyWidth As Long
Private MyAlignment As AlignmentSettings   'var for alignment setting
Private MyEdit As Boolean                          'var for edit flexgrid
Private LoadRecord As Boolean            'var for specify wheter record is loading or not
Private ColumnType() As CoolFlexColType
Private SetColumnTypeArray As Boolean
Private LastCol As Long

Private ComboBoxCount As Integer
Private ComboBoxIndex As Integer
Private m_ColSel As Long

Private mLaunchForm As String
Private SortOnHeader As Boolean
Private SortOnHeaderValue As CoolFlexSort
Private m_DecimalEntry As Boolean
Private m_lngpopulated&

'-----------------------
'Appended by Cyrus for Auto Select Combo
Private a As New Collection
Private b As New Collection
Private lngpopulated&
Private strconcat$
'-----------------------
Private bIsTime As Boolean

Private m_collection() As String

'component activity
Public Event Click()
Public Event EnterCell(Rowsel As Long, Colsel As Long, Value As String)
Public Event DblClick()
Public Event LeaveCell()
Public Event RowColChange()
Public Event CellComboBoxClick(ColIndex As Long, Value As String)
Public Event CellComboBoxChange(ColIndex As Long)
Public Event CellCheckBoxClick(ColIndex As Long, Value As Integer)
Public Event CellButtonClick(RowIndex As Long, Value As Integer)

Public Event CellDateChange(Index As Integer) 'Ian 4/26/06
Public Event CellDateClick(Index As Integer) 'Ian 4/26/06
Public Event CellDateKeyPress(Index As Integer, KeyAscii As Integer) 'Ian 4/26/06
Public Event CellDateKeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) 'Ian 4/26/06



Public Enum CoolFlexGridLines
    GridFlat = 1
    GridInset = 2
    GridNone = 0
    GridRaised = 3
End Enum

Public Enum CoolFlexScrollBar
    ScrollBarBoth = 3
    ScrollBarHorizontal = 1
    ScrollBarNone = 0
    ScrollBarVertical = 2
End Enum

Public Enum CoolFlexSort
    SortNone = 0
    SortGenericAscending = 1
    SortGenericDescending = 2
    SortNumericAscending = 3
    SortNumericDescending = 4
    SortStringNoCaseAsending = 5
    SortNoCaseDescending = 6
    SortStringAscending = 7
    SortStringDescending = 8
End Enum

Public Enum CoolFlexColType
    etextbox = 0
    eCheckbox = 1
    eCombobox = 2
    eButton = 3
    eDatePicker = 4
    eTimePicker = 5
End Enum
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Combo1_Change(Index As Integer)

    RaiseEvent CellComboBoxChange(MSFlexGrid1.Col)

End Sub

Private Sub Combo1_Click(Index As Integer)

    If Combo1(LastCol).Visible = True Then
        MSFlexGrid1.Text = Combo1(LastCol).Text
        Combo1(LastCol).Text = ""
        Combo1(LastCol).Visible = False
    End If
    RaiseEvent CellComboBoxClick(MSFlexGrid1.Col, MSFlexGrid1.Text)

End Sub

Private Sub Combo1_GotFocus(Index As Integer)
'Appended by Cyrus for Auto Select Combo
Dim i&
Debug.Print Combo1(Index).ListCount - 1
For i& = 0 To Combo1(Index).ListCount - 1
    a.Add Combo1(Index).List(i&)
    Debug.Print a.Item(i& + 1)
Next

End Sub

Private Function ClearCollectionB(m_collection As Collection) As Boolean
On Error GoTo ErrorHandler
Dim i&
    
    For i = 1 To m_collection.Count
        m_collection.Remove i
    Next
    
    ClearCollectionB = True
    Exit Function
    
ErrorHandler:

    ClearCollectionB = False
    
End Function

Private Sub Combo1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
'Appended by Cyrus for Auto Select Combo
Static md&, i&, p&
    
    Select Case KeyCode
        Case vbKeyLButton, _
            vbKeyRButton, _
            vbKeyCancel, _
            vbKeyMButton, _
            vbKeyTab, _
            vbKeyClear, _
            vbKeyReturn, _
            vbKeyShift, _
            vbKeyControl, _
            vbKeyMenu, _
            vbKeyPause, _
            vbKeyCapital, _
            vbKeyEscape, _
            vbKeySpace, _
            vbKeyPageUp, _
            vbKeyPageDown, _
            vbKeyEnd, _
            vbKeyHome, _
            vbKeyLeft, _
            vbKeyUp, _
            vbKeyRight, _
            vbKeyDown, _
            vbKeySelect, _
            vbKeyPrint
            Exit Sub
        Case vbKeyExecute, _
            vbKeySnapshot, _
            vbKeyInsert, _
            vbKeyHelp, _
            vbKeyNumlock, _
            vbKeyF1, _
            vbKeyF2, _
            vbKeyF3, _
            vbKeyF4, _
            vbKeyF5, _
            vbKeyF6, _
            vbKeyF7, _
            vbKeyF8, _
            vbKeyF9, _
            vbKeyF10, _
            vbKeyF11, _
            vbKeyF12, _
            vbKeyF13, _
            vbKeyF14, _
            vbKeyF15, _
            vbKeyF16
            Exit Sub
    End Select

    If a.Count = 0 Then Exit Sub
    
    strconcat$ = Combo1(Index).Text
    
    Set b = New Collection
    
    If Combo1(Index).Text <> vbNullString Then
        If ClearCollectionB(b) = False Then Exit Sub
        For i = 1 To a.Count
            If InStr(1, a.Item(i), Combo1(Index).Text) = 1 Then
                 b.Add a.Item(i)
            End If
        Next
        m_lngpopulated = b.Count
    Else
        If ClearCollectionB(b) = False Then Exit Sub
        Combo1(Index).Clear
        For i = 1 To a.Count
            Combo1(Index).AddItem a.Item(i)
        Next
        Exit Sub
    End If

    If b.Count = m_lngpopulated Then
        If md& = 0 Then
            Do While Combo1(Index).ListCount <> 0
               Combo1(Index).RemoveItem Combo1(Index).ListCount - 1
               DoEvents
            Loop
        End If
        
        For p = 1 To b.Count
            Combo1(Index).AddItem b.Item(p)
            md& = 1
        Next
        
        If Combo1(Index).ListCount <> 0 Then
            Combo1(Index).Text = Combo1(Index).List(0)
            Combo1(Index).SelStart = Len(strconcat$)
            Combo1(Index).SelLength = Len(Combo1(Index).Text) - 1
        End If
        
        If Combo1(Index).ListCount = m_lngpopulated Then
            md& = 0
        End If
    End If

End Sub

Private Sub DTPicker1_Change(Index As Integer)
  RaiseEvent CellDateChange(Index)
End Sub

Private Sub DTPicker1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
  Case 13
       MSFlexGrid1_LeaveCell
  Case 27 'ESC - OOPS, restore old text
       DTPicker1(Index).Visible = False
       MSFlexGrid1.SetFocus
  End Select
 
 RaiseEvent CellDateKeyDown(Index, KeyCode, Shift)
 
End Sub

Private Sub DTPicker1_KeyPress(Index As Integer, KeyAscii As Integer)
  RaiseEvent CellDateKeyPress(Index, KeyAscii)
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim Rowsel As Long
  Dim Colsel As Long
  Dim Value As String

       
  If Button = 2 Then Exit Sub
    
    bIsTime = False 'IanC Added for defaults
    
    LastCol = MSFlexGrid1.Colsel
    Rowsel = MSFlexGrid1.Rowsel
    Colsel = MSFlexGrid1.Colsel
    Value = MSFlexGrid1.TextMatrix(MSFlexGrid1.Rowsel, MSFlexGrid1.Colsel)

    If MSFlexGrid1.MouseRow = 0 And SortOnHeader = True Then
        MSFlexGrid1.Sort = SortOnHeaderValue
    End If

    If MyEdit = True And LoadRecord = False Then
        Select Case ColumnType(Colsel)
          Case etextbox 'default
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                Text1.BackColor = MSFlexGrid1.BackColor
                Text1.ForeColor = MSFlexGrid1.ForeColor
                Set Text1.Font = MSFlexGrid1.Font
                Text1.Width = MSFlexGrid1.CellWidth
                Text1.Height = MSFlexGrid1.CellHeight
                Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
                Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
                Text1.Text = Value
                Text1.Visible = True
                Text1.SetFocus
                Text1.SelStart = 0
                Text1.SelLength = Len(Text1.Text)
            End If
            RaiseEvent Click
          Case eButton
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                MSFlexGrid1.CellPictureAlignment = 4 'center x center
                Set MSFlexGrid1.CellPicture = imgButtonIn.Picture  'LoadPicture(App.Path & "\Checked.bmp")
                DoEvents
                Sleep (200)
                Set MSFlexGrid1.CellPicture = imgButtonOut.Picture
                RaiseEvent CellButtonClick(MSFlexGrid1.Row, 0)
            End If
          Case eCheckbox
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                MSFlexGrid1.CellPictureAlignment = 4 'center x center
                If MSFlexGrid1.Text = "C" Then
                    Set MSFlexGrid1.CellPicture = imgUnchecked.Picture  'LoadPicture(App.Path & "\Checked.bmp")
                    MSFlexGrid1.Text = "U"
                    RaiseEvent CellCheckBoxClick(MSFlexGrid1.Col, 0)
                  Else 'NOT MSFLEXGRID1.TEXT...
                    Set MSFlexGrid1.CellPicture = imgChecked.Picture  'LoadPicture(App.Path & "\Checked.bmp")
                    MSFlexGrid1.Text = "C"
                    RaiseEvent CellCheckBoxClick(MSFlexGrid1.Col, 1)
                End If
              Else 'NOT MSFLEXGRID1.MOUSECOL...
                RaiseEvent Click
            End If
          Case eCombobox
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                Combo1(Colsel).BackColor = MSFlexGrid1.BackColor
                Combo1(Colsel).ForeColor = MSFlexGrid1.ForeColor
                Set Combo1(Colsel).Font = MSFlexGrid1.Font
                Combo1(Colsel).Width = MSFlexGrid1.CellWidth
                Combo1(Colsel).Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
                Combo1(Colsel).Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
                Combo1(Colsel).Text = Value
                Combo1(Colsel).Visible = True
                Combo1(Colsel).ZOrder
                Combo1(Colsel).SetFocus
                Combo1(Colsel).SelStart = 0
                Combo1(Colsel).SelLength = Len(Combo1(Colsel).Text)
            End If
            
            Case eDatePicker
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                DTPicker1(Colsel).CalendarBackColor = MSFlexGrid1.BackColor
                DTPicker1(Colsel).CalendarForeColor = MSFlexGrid1.ForeColor
                Set DTPicker1(Colsel).Font = MSFlexGrid1.Font
                DTPicker1(Colsel).Width = MSFlexGrid1.CellWidth
                DTPicker1(Colsel).Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
                DTPicker1(Colsel).Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
                '--------Do some validation
                DTPicker1(Colsel).Value = IIf(Value = "", Now, Value)
                '--------------------------
                DTPicker1(Colsel).Visible = True
                DTPicker1(Colsel).ZOrder
                DTPicker1(Colsel).SetFocus
            End If
            
            Case eTimePicker
            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
                DTPicker1(Colsel).CalendarBackColor = MSFlexGrid1.BackColor
                DTPicker1(Colsel).CalendarForeColor = MSFlexGrid1.ForeColor
                Set DTPicker1(Colsel).Font = MSFlexGrid1.Font
                DTPicker1(Colsel).Width = MSFlexGrid1.CellWidth
                DTPicker1(Colsel).Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
                DTPicker1(Colsel).Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
                '--------Do some validation
                DTPicker1(Colsel).Value = IIf(Value = "", Now, Value)
                '--------------------------
                DTPicker1(Colsel).Visible = True
                DTPicker1(Colsel).ZOrder
                DTPicker1(Colsel).SetFocus
                bIsTime = True
            End If
            RaiseEvent Click
            
        End Select
      Else 'NOT MYEDIT...
        RaiseEvent Click
    End If

End Sub


'Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'        Select Case ColumnType(Colsel)
'            Case eButton
'                If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                    MSFlexGrid1.CellPictureAlignment = 4 'center x center
'                    Set MSFlexGrid1.CellPicture = imgButtonOut.Picture  'LoadPicture(App.Path & "\Checked.bmp")
'                End If
'        End Select
'End Sub

Private Sub MSFlexGrid1_RowColChange()

    RaiseEvent RowColChange

End Sub

Private Sub MSFlexGrid1_Click()
  

'
'  Dim Rowsel As Long
'  Dim Colsel As Long
'  Dim Value As String
'
'    LastCol = MSFlexGrid1.Colsel
'    Rowsel = MSFlexGrid1.Rowsel
'    Colsel = MSFlexGrid1.Colsel
'    Value = MSFlexGrid1.TextMatrix(MSFlexGrid1.Rowsel, MSFlexGrid1.Colsel)
'
'    If MSFlexGrid1.MouseRow = 0 And SortOnHeader = True Then
'        MSFlexGrid1.Sort = SortOnHeaderValue
'    End If
'
'    If MyEdit = True And LoadRecord = False Then
'        Select Case ColumnType(Colsel)
'          Case etextbox 'default
'            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                Text1.BackColor = MSFlexGrid1.BackColor
'                Text1.ForeColor = MSFlexGrid1.ForeColor
'                Set Text1.Font = MSFlexGrid1.Font
'                Text1.Width = MSFlexGrid1.CellWidth
'                Text1.Height = MSFlexGrid1.CellHeight
'                Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
'                Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
'                Text1.Text = Value
'                Text1.Visible = True
'                Text1.SetFocus
'                Text1.SelStart = 0
'                Text1.SelLength = Len(Text1.Text)
'            End If
'            RaiseEvent Click
'          Case eButton
'            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                MSFlexGrid1.CellPictureAlignment = 4 'center x center
'                Set MSFlexGrid1.CellPicture = imgButtonIn.Picture  'LoadPicture(App.Path & "\Checked.bmp")
'                DoEvents
'                Sleep (200)
'                Set MSFlexGrid1.CellPicture = imgButtonOut.Picture
'                RaiseEvent CellButtonClick(MSFlexGrid1.Row, 0)
'            End If
'          Case eCheckbox
'            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                MSFlexGrid1.CellPictureAlignment = 4 'center x center
'                If MSFlexGrid1.Text = "C" Then
'                    Set MSFlexGrid1.CellPicture = imgUnchecked.Picture  'LoadPicture(App.Path & "\Checked.bmp")
'                    MSFlexGrid1.Text = "U"
'                    RaiseEvent CellCheckBoxClick(MSFlexGrid1.Col, 0)
'                  Else 'NOT MSFLEXGRID1.TEXT...
'                    Set MSFlexGrid1.CellPicture = imgChecked.Picture  'LoadPicture(App.Path & "\Checked.bmp")
'                    MSFlexGrid1.Text = "C"
'                    RaiseEvent CellCheckBoxClick(MSFlexGrid1.Col, 1)
'                End If
'              Else 'NOT MSFLEXGRID1.MOUSECOL...
'                RaiseEvent Click
'            End If
'          Case eCombobox
'            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                Combo1(Colsel).BackColor = MSFlexGrid1.BackColor
'                Combo1(Colsel).ForeColor = MSFlexGrid1.ForeColor
'                Set Combo1(Colsel).Font = MSFlexGrid1.Font
'                Combo1(Colsel).Width = MSFlexGrid1.CellWidth
'                Combo1(Colsel).Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
'                Combo1(Colsel).Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
'                Combo1(Colsel).Text = Value
'                Combo1(Colsel).Visible = True
'                Combo1(Colsel).ZOrder
'                Combo1(Colsel).SetFocus
'                Combo1(Colsel).SelStart = 0
'                Combo1(Colsel).SelLength = Len(Combo1(Colsel).Text)
'            End If
'            Case eDatePicker
'            If MSFlexGrid1.MouseCol > 0 And MSFlexGrid1.MouseRow > 0 Then
'                DTPicker1(0).CalendarBackColor = MSFlexGrid1.BackColor
'                DTPicker1(0).CalendarForeColor = MSFlexGrid1.ForeColor
'                Set DTPicker1(0).Font = MSFlexGrid1.Font
'                DTPicker1(0).Width = MSFlexGrid1.CellWidth
'                DTPicker1(0).Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
'                DTPicker1(0).Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
'                '--------Do some validation
'                DTPicker1(0).Value = Value
'                '--------------------------
'                DTPicker1(0).Visible = True
'                DTPicker1(0).ZOrder
'                DTPicker1(0).SetFocus
'            End If
'            RaiseEvent Click
'        End Select
'      Else 'NOT MYEDIT...
'        RaiseEvent Click
'    End If

End Sub

Private Sub MSFlexGrid1_DblClick()

    RaiseEvent DblClick

End Sub

'end of component activity

'component methods
Public Sub Clear()

  Dim X As Long

    MSFlexGrid1.Clear

    Text1.Text = ""
    Text1.Visible = False
    
    For X = 0 To DTPicker1.UBound
        DTPicker1(X).Value = Now
        DTPicker1(X).Visible = False
    Next X
    
    For X = 0 To Combo1.UBound
        Combo1(X).Text = ""
        Combo1(X).Visible = False
    Next X

    SetCheckBoxes

End Sub

Public Sub RemoveItem(ByVal Index As Long)

    MSFlexGrid1.RemoveItem Index
    Text1.Text = ""
    Text1.Visible = False
    
    DTPicker1(LastCol).Value = Now
    DTPicker1(LastCol).Visible = False

    Combo1(LastCol).Visible = False
    Combo1(LastCol).Text = ""

End Sub

Public Sub ColType(ByVal colnumber As Long, ByVal eType As CoolFlexColType)

    ColumnType(colnumber) = eType
    Select Case eType
      Case etextbox 'default
      Case eButton
        SetButtons
      Case eCheckbox
        SetCheckBoxes
      Case eCombobox
      Case eDatePicker
        DTPicker1(colnumber).Format = dtpShortDate
      Case eTimePicker
        DTPicker1(colnumber).Format = dtpTime
    End Select

End Sub

Public Sub ComboBoxAddItem(ByVal Col As Long, ByVal Item As String)

    Combo1(Col).AddItem Item
    
End Sub

Public Sub ComboBoxClear(ByVal Col As Long)

    Combo1(Col).Clear
    
End Sub

Public Sub ComboBoxRemoveItem(ByVal Col As Long, ByVal Index As Integer)

    Combo1(Col).RemoveItem Index
    a.Remove Index
    
End Sub

Public Sub SortOnHeaderClick(ByVal SortOn As Boolean, ByVal NewValue As CoolFlexSort)

    SortOnHeader = SortOn
    SortOnHeaderValue = NewValue

End Sub

'end component methods

Private Sub MSFlexGrid1_EnterCell()

  Dim Rowsel As Long
  Dim Colsel As Long
  Dim Value As String

    LastCol = MSFlexGrid1.Colsel
    Rowsel = MSFlexGrid1.Rowsel
    Colsel = MSFlexGrid1.Colsel
    m_ColSel = Colsel
    RaiseEvent EnterCell(Rowsel, Colsel, Value)

End Sub

Private Sub MSFlexGrid1_LeaveCell()

    If Text1.Visible = True Then
        MSFlexGrid1.Text = Text1.Text
        Text1.Text = ""
        Text1.Visible = False
    End If

   If DTPicker1(Colsel).Visible = True Then
        DTPicker1(Colsel).Visible = False
        If ColumnType(Colsel) = eDatePicker Then MSFlexGrid1.Text = Format(DTPicker1(Colsel).Value, "mm/dd/yy")
        If ColumnType(Colsel) = eTimePicker And bIsTime = True Then MSFlexGrid1.Text = Format(DTPicker1(Colsel).Value, "hh:mm am/pm")
        'MSFlexGrid1.CellForeColor = &HC00000
    End If

    If Combo1(LastCol).Visible = True Then
        MSFlexGrid1.Text = Combo1(LastCol).Text
        Combo1(LastCol).Text = ""
        Combo1(LastCol).Visible = False
    End If

    RaiseEvent LeaveCell

End Sub

Private Sub MSFlexGrid1_Scroll()

    Text1.Visible = False
    DTPicker1(LastCol).Visible = False
    Combo1(LastCol).Visible = False

End Sub

Private Sub Combo1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

    Select Case KeyCode
      Case vbKeyEscape        'user press escape key
        Combo1(Index).Visible = False

      Case vbKeyDown          'user press arrow down key
        '           MSFlexGrid1.SetFocus
        '           DoEvents
        '           If MSFlexGrid1.Row < MSFlexGrid1.Rows - 1 Then
        '              MSFlexGrid1.Row = MSFlexGrid1.Row + 1
        '           End If

      Case vbKeyUp            'user press arrow up key
        '           MSFlexGrid1.SetFocus
        '           DoEvents
        '           If MSFlexGrid1.Row > MSFlexGrid1.FixedRows Then
        '              MSFlexGrid1.Row = MSFlexGrid1.Row - 1
        '            End If

      Case vbKeyLeft
        '            If Combo1(Index).SelStart = 0 And Len(Combo1(Index).SelText) = 0 Then
        '                MSFlexGrid1.Col = MSFlexGrid1.Col - 1
        '            ElseIf Combo1(Index).SelStart = 0 And Len(Combo1(Index).SelText) = Len(Combo1(Index).Text) Then
        '                Combo1(Index).SelStart = 0
        '            End If

      Case vbKeyRight
        '            If Combo1(Index).SelStart = Len(Combo1(Index).Text) Then
        '                MSFlexGrid1.Col = MSFlexGrid1.Col + 1
        '            ElseIf Combo1(Index).SelStart = 0 And Len(Combo1(Index).SelText) = Len(Combo1(Index).Text) Then
        '                Combo1(Index).SelStart = Len(Combo1(Index).Text)
        '            End If

    End Select

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)

    Select Case KeyCode
      Case vbKeyEscape        'user press escape key
        Text1.Visible = False

      Case vbKeyDown          'user press arrow down key
        MSFlexGrid1.SetFocus
        DoEvents
        If MSFlexGrid1.Row < MSFlexGrid1.Rows - 1 Then
            MSFlexGrid1.Row = MSFlexGrid1.Row + 1
        End If

      Case vbKeyUp            'user press arrow up key
        MSFlexGrid1.SetFocus
        DoEvents
        If MSFlexGrid1.Row > MSFlexGrid1.FixedRows Then
            MSFlexGrid1.Row = MSFlexGrid1.Row - 1
        End If

      Case vbKeyLeft
        If Text1.SelStart = 0 And Len(Text1.SelText) = 0 Then
            MSFlexGrid1.Col = MSFlexGrid1.Col - 1
          ElseIf Text1.SelStart = 0 And Len(Text1.SelText) = Len(Text1.Text) Then 'NOT TEXT1.SELSTART...
            Text1.SelStart = 0
        End If

      Case vbKeyRight
        If Text1.SelStart = Len(Text1.Text) Then
            MSFlexGrid1.Col = MSFlexGrid1.Col + 1
          ElseIf Text1.SelStart = 0 And Len(Text1.SelText) = Len(Text1.Text) Then 'NOT TEXT1.SELSTART...
            Text1.SelStart = Len(Text1.Text)
        End If

    End Select

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    
    If m_DecimalEntry = True Then
        KeyPress_Decimal 1, Text1, KeyAscii, 2
    ElseIf m_DecimalEntry = False Then
        KeyPress_Decimal 0, Text1, KeyAscii, 2
    End If
    
End Sub

'Private Sub Timer1_Timer()
'
''    Text1.Width = MSFlexGrid1.CellWidth
''    Text1.Left = MSFlexGrid1.CellLeft
''    Text1.Top = MSFlexGrid1.CellTop
''    Text1.Height = MSFlexGrid1.CellHeight
''
''    Combo1(m_ColSel).Width = MSFlexGrid1.CellWidth
''    Combo1(m_ColSel).Left = MSFlexGrid1.CellLeft
''    Combo1(m_ColSel).Top = MSFlexGrid1.CellTop
''
''    DTPicker1(0).Width = MSFlexGrid1.CellWidth
''    DTPicker1(0).Left = MSFlexGrid1.CellLeft
''    DTPicker1(0).Top = MSFlexGrid1.CellTop
''    DTPicker1(0).Height = MSFlexGrid1.CellHeight
'
'End Sub

Private Sub UserControl_Initialize()

  'initialize control in design time
    
    MSFlexGrid1.Top = 0
    MSFlexGrid1.Left = 0
    MSFlexGrid1.Width = UserControl.Width - 60
    MSFlexGrid1.Height = UserControl.Height - 60
'    FixHeader
    'coordinate progress
    Picture1.Left = (UserControl.Width / 2) - (Picture1.Width / 2)
    Picture1.Top = (UserControl.Height / 2) - (Picture1.Height / 2)

End Sub

Private Sub UserControl_Resize()

    MSFlexGrid1.Top = 0
    MSFlexGrid1.Left = 0
    MSFlexGrid1.Width = UserControl.Width - 60
    MSFlexGrid1.Height = UserControl.Height - 60
    Picture1.Left = (UserControl.Width / 2) - (Picture1.Width / 2)
    Picture1.Top = (UserControl.Height / 2) - (Picture1.Height / 2)

End Sub

Public Sub Show_Record(ByVal SQLCommand As String)

  Dim Maindb As Database
  Dim theset As Object
  Dim c As Long, No As Long
  Dim DynamicCol() As Long
  Dim TotalColoumn As Long
  Dim MyData As String
  Dim DataWidth As Long

    'On Error GoTo errorhandler

    LoadRecord = True
    
    'open recordset
    Set theset = MyDataName.OpenRecordset(SQLCommand)

    If theset.EOF Then Exit Sub  'if no record exist
    'calculate total field
    TotalColoumn = theset.Fields.Count

    Set_Grid (TotalColoumn)
    'recreate array in run time

    For c = 1 To theset.Fields.Count
        MSFlexGrid1.TextMatrix(0, c) = theset.Fields(c - 1).Name
    Next c

    theset.MoveLast
    MyRecord = theset.AbsolutePosition + 1
    theset.MoveFirst

    If AutoFixCol = False Then
        Do While Not theset.EOF
            DoEvents
            No = No + 1
            MyRecordPos = theset.AbsolutePosition + 1
            Label2.Caption = Format$(MyRecordPos / MyRecord * 100, "##") & "  % Completed"
            MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
            MSFlexGrid1.TextMatrix(No, 0) = Str$(No)
            For c = 1 To theset.Fields.Count
                MSFlexGrid1.Col = c
                MSFlexGrid1.Row = No
                MSFlexGrid1.CellAlignment = MyAlignment

Download this snippet    Add to My Saved Code

Updated Version of CoolFlex Comments

No comments have been posted about Updated Version of CoolFlex. Why not be the first to post a comment about Updated Version of CoolFlex.

Post your comment

Subject:
Message:
0/1000 characters