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
'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