Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Sub PutFocus Lib "user32" Alias "SetFocus" (ByVal hWnd)
Private Type ColInfo
myColWidth As Long
myHeader As String
myFieldName As String
myFieldTranslation As Boolean
End Type
Public Enum SortDirection
Ascending = 1
Descending = 2
End Enum
Private Const DefWidth As Long = 510 'column 0 width
Private Const MinIx As Long = 1
Private Const MaxIx As Long = 15
Private Const NavCodes As String = "$!&(""#" 'keycodes for Pos1 PageUp CursorUp CursorDown PageDown End
Private myEnabled As Boolean
Private myAutosize As Boolean
Private myDynamicScroll As Boolean
Private myDisplayName As String
Private myRecordset As DAO.Recordset
Private myOrderedBy As String
Private mySortOrder As SortDirection
Private myColumnInfo() As ColInfo
Private myCurrBookmark(1 To MaxIx) As String
Private Head As String
Private ForwardLine As Boolean
Private ForwardPage As Boolean
Private ReverseLine As Boolean
Private ReversePage As Boolean
Private NotFull As Boolean
Private PageScroll As Boolean
Private ScrChanged As Boolean
Private FieldContents As Variant
Private CompOper As String
Private OtherCompOper As String
Private ScrollDivi As Long
Private TotalWidth As Long
Private PreviousRow As Long
Private FilledTo As Long
Private TpP As Long
Public Event OK()
Public Event Cancel()
Public Event PositionChanged(ByVal Row As Long)
Public Event TranslateColumn(ByVal FieldName As String, ByVal OldValue As Variant, NewValue As Variant)
Public Sub AdjustCol(ByVal Col As Long)
ColWidth(Col) = RequiredColWidth(Col)
End Sub
Public Sub AdjustCols()
Dim i
For i = 1 To gdBrowse.Cols - 1
AdjustCol (i)
Next i
End Sub
Public Property Let Autosize(ByVal nuAutosize As Boolean)
Attribute Autosize.VB_Description = "Sets / returns whether the Control will automatically adjust the column widths to the text displayed."
Attribute Autosize.VB_HelpID = 10007
myAutosize = (nuAutosize <> False)
If Ambient.UserMode Then
AdjustCols
End If
PropertyChanged "Autosize"
End Property
Public Property Get Autosize() As Boolean
Autosize = myAutosize
End Property
Public Property Get Backcolor() As OLE_COLOR
Backcolor = gdBrowse.Backcolor
End Property
Public Property Let Backcolor(ByVal nuBackColor As OLE_COLOR)
gdBrowse.Backcolor = nuBackColor
PropertyChanged "Backcolor"
End Property
Public Property Let BarBackcolor(ByVal nuBackColor As OLE_COLOR)
Attribute BarBackcolor.VB_Description = "Sets / returns the highlite bar backcolor."
Attribute BarBackcolor.VB_HelpID = 10012
gdBrowse.BackColorSel = nuBackColor
PropertyChanged "BarBackcolor"
End Property
Public Property Get BarBackcolor() As OLE_COLOR
BarBackcolor = gdBrowse.BackColorSel
End Property
Public Property Let BarForecolor(ByVal nuForecolor As OLE_COLOR)
Attribute BarForecolor.VB_Description = "Sets / returns the highlite bar forecolor."
Attribute BarForecolor.VB_HelpID = 10013
gdBrowse.ForeColorSel = nuForecolor
PropertyChanged "BarForeColor"
End Property
Public Property Get BarForecolor() As OLE_COLOR
BarForecolor = gdBrowse.ForeColorSel
End Property
Public Property Get Bookmark(Row As Long) As String
If Row >= MinIx And Row <= MaxIx Then
Bookmark = myCurrBookmark(Row)
End If
End Property
Private Sub btNav_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
tmrTick.Interval = 333
Select Case Index
Case 0 'BOF
GoFirst
Case 1 'Page back
ReversePage = True
ScrollPageRev
tmrTick.Enabled = True
Case 2 'Line back
ReverseLine = True
ScrollLineRev
tmrTick.Enabled = True
Case 3 'Line forward
ForwardLine = True
ScrollLineFwd
tmrTick.Enabled = True
Case 4 'Page forward
ForwardPage = True
ScrollPageFwd
tmrTick.Enabled = True
Case 5 'EOF
GoLast
End Select
End Sub
Private Sub btNav_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
tmrTick.Enabled = False
ForwardLine = False
ForwardPage = False
ReverseLine = False
ReversePage = False
gdBrowse.SetFocus
End Sub
Private Sub btOKCan_Click(Index As Integer)
If Index = 0 Then
RaiseEvent OK
Else 'NOT INDEX...
RaiseEvent Cancel
End If
End Sub
Private Sub ChangedPosition(NewRow)
If NewRow <> PreviousRow Then
PreviousRow = NewRow
RaiseEvent PositionChanged(NewRow)
End If
End Sub
Public Property Get Cols() As Long
Attribute Cols.VB_Description = "Sets / returns the number of columns for the grid."
Attribute Cols.VB_HelpID = 10033
Cols = gdBrowse.Cols - 1
End Property
Public Property Let Cols(ByVal nuCols As Long)
If nuCols < 1 Then
Err.Raise 9, Ambient.DisplayName
Else 'NOT NUCOLS...
gdBrowse.Cols = nuCols + 1
ReDim Preserve myColumnInfo(1 To nuCols)
EqualColWidth
gdBrowse.Col = 1
gdBrowse.ColSel = gdBrowse.Cols - 1
End If
End Property
Public Property Let ColWidth(ByVal Col As Long, ByVal nuColWidth As Long)
Attribute ColWidth.VB_Description = "Sets / returns the width in twips for a specific column."
Attribute ColWidth.VB_HelpID = 10038
Dim i
If Ambient.UserMode = False Then
Err.Raise 387, Ambient.DisplayName
Else 'NOT AMBIENT.USERMODE...
If Col < LBound(myColumnInfo) Or Col > UBound(myColumnInfo) Then
Err.Raise 9, Ambient.DisplayName
Else 'NOT COL...
i = gdBrowse.ColWidth(gdBrowse.Cols - 1) + gdBrowse.ColWidth(Col) - nuColWidth
If i < 120 Then
i = 120
End If
myColumnInfo(gdBrowse.Cols - 1).myColWidth = i
myColumnInfo(Col).myColWidth = nuColWidth
SetColWidth
End If
End If
End Property
Public Property Get ColWidth(ByVal Col As Long) As Long
If Col < LBound(myColumnInfo) Or Col > UBound(myColumnInfo) Then
Err.Raise 9, Ambient.DisplayName
Else 'NOT COL...
ColWidth = myColumnInfo(Col).myColWidth
End If
End Property
Public Property Get CurrentBookmark() As String
CurrentBookmark = myCurrBookmark(gdBrowse.Row)
End Property
Public Property Get DisplayName() As String
Attribute DisplayName.VB_Description = "Sets / returns a user friendly name for the order-by field."
Attribute DisplayName.VB_HelpID = 10011
DisplayName = lbSearchName
End Property
Public Property Let DisplayName(ByVal nuDisplayName As String)
lbSearchName = nuDisplayName
PropertyChanged "DisplayName"
End Property
Public Property Get DynamicScroll() As Boolean
Attribute DynamicScroll.VB_Description = "Sets / returns whether the srcollbar will dynamically scroll the grid."
Attribute DynamicScroll.VB_HelpID = 10006
DynamicScroll = myDynamicScroll
End Property
Public Property Let DynamicScroll(ByVal nuDynamicScroll As Boolean)
myDynamicScroll = (nuDynamicScroll <> False)
PropertyChanged "DynamicScroll"
End Property
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Gibt einen Wert zurⁿck, der bestimmt, ob ein Objekt auf vom Benutzer erzeugte Ereignisse reagieren kann, oder legt diesen fest."
Attribute Enabled.VB_HelpID = 10005
Enabled = myEnabled
End Property
Public Property Let Enabled(ByVal nuEnabled As Boolean)