home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code2
/
v_browse
/
brw001m.bas
< prev
next >
Wrap
BASIC Source File
|
1993-09-20
|
76KB
|
1,628 lines
Global ngBRWFormTxtInstances As Integer
Global ngCurrListIdx As Integer
Global ngLBXBrowserDispItems As Integer
Global ngLBXBrowserFirstRow As Integer
Global ngLBXBrowserLastRow As Integer
Global ngLBXBrowserNumOfRows As Integer
Global ngLBXBrowserValue As Integer
Global ngIgnoreTblsClick As Integer
Global ngIgnoreVSRChangeEvent As Integer
Global ngJETRowNumber As Integer
Global ngViewJETFlag As Integer
Global Const BRW_ADD_ABOVE_FLAG = -100
Global Const BRW_ADD_BELOW_FLAG = -101
Global Const BRW_BACKWARD_DIRECTION = -1
Global Const BRW_ERROR = -99
Global Const BRW_FORWARD_DIRECTION = 1
Global Const BRW_MOVE_FIRST = 22
Global Const BRW_MOVE_FROM_BOF_POS = 1
Global Const BRW_MOVE_FROM_CURR_POS = 2
Global Const BRW_MOVE_FROM_EOF_POS = 3
Global Const BRW_MOVE_FROM_UNKNOWN = 0
Global Const BRW_RETURN_FIRST_LISTINDEX = -200
Global Const BRW_RETURN_LAST_LISTINDEX = -201
Global Const BRW_RETURN_SPECIFIED_LISTINDEX = -202
Global Const BRW_SUCCESSFUL = -1
Global Const BRW_UNSUCCESSFUL = -2001
Global Const BRW_VISIBLE_LISTBOX_ITEMS = 10
Global Const DEFAULT_ICON = 0
Global Const HOURGLASS_ICON = 11
Global Const WM_SETREDRAW = &HB
Declare Function GetFocus Lib "User" () As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Function BRW001FclbTblsClick% (nIndex%)
Dim nCols%
Dim nFirstRow%
Dim nFunctRetVal%
Dim nNumOfRows%
Dim nRetIdxTypeFlag%
Dim nRetVal%
Dim szMDBTblName$
On Error GoTo BRW001FclbTblsClickErr
ngIgnoreTblsClick = True
BRW001F.lbxBrowser.Clear
BRW001F.lbxBrowser.Enabled = False
BRW001F.pbtNext.Enabled = False
BRW001F.pbtPrevious.Enabled = False
BRW001F.pbtPageUp.Enabled = False
BRW001F.pbtPageDn.Enabled = False
BRW001F.vsrBrowser.Enabled = False
BRW001F.picData.Visible = False
BRW001F.pbtViewJET.Caption = "View &JET"
BRW001F.pbtViewJET.Enabled = False
ngViewJETFlag = False
ngIgnoreVSRChangeEvent = True
BRW001F.vsrBrowser.Value = 1
BRW001F.lblRowNum.Caption = Str$(BRW001F.vsrBrowser.Value)
ngIgnoreVSRChangeEvent = False
szMDBTblName$ = BRW001F.clbTbls.List(nIndex%)
nCols% = fntGetMDBTblNames%(szMDBTblName$)
If (nCols% = False) Then
'-------------------------------------------------------------------------
' NOTE-> number of COLUMNS is ZERO...
'-------------------------------------------------------------------------
szMsg$ = "WARNING-> " + szMDBTblName$ + " has NO COLUMNS..."
MsgBox szMsg$
ngIgnoreTblsClick = False
nFunctRetVal% = False
BRW001FclbTblsClick% = nFunctRetVal%
Exit Function
End If
' JDE-> If (ngBRWFormTxtInstances > 1) Then
' JDE-> nRetVal% = fntUnloadTxtDataInstances%()
' JDE->End If
nRetVal% = fntLoadTxtDataInstances%(nCols%)
'----------------------------------------------------------------------------
' NOTE-> get the record count for the table...
' requires a MoveLast and a MoveFirst...
'----------------------------------------------------------------------------
BRW001F.datJET.RecordSource = szMDBTblName$
BRW001F.datJET.Refresh
If ((BRW001F.datJET.Recordset.BOF = True) And (BRW001F.datJET.Recordset.EOF = True)) Then
'-------------------------------------------------------------------------
' NOTE-> EMPTY TABLE...so INFORM the user about this...and EXIT...
'-------------------------------------------------------------------------
szMsg$ = "WARNING-> " + szMDBTblName$ + " is EMPTY..."
MsgBox szMsg$
ngIgnoreTblsClick = False
Exit Function
End If
BRW001F.datJET.Recordset.MoveLast
BRW001F.datJET.Recordset.MoveFirst
nTblRecCount% = BRW001F.datJET.Recordset.RecordCount
ngJETRowNumber = 1
BRW001F.vsrBrowser.Min = 1
BRW001F.vsrBrowser.Max = nTblRecCount%
ngLBXBrowserDispItems = BRW_VISIBLE_LISTBOX_ITEMS
'----------------------------------------------------------------------------
' NOTE-> load virtual listbox with first (ngLBXBrowserDispItems * 3) rows...
'----------------------------------------------------------------------------
nFirstRow% = 1
nNumOfRows% = ngLBXBrowserDispItems * 3
nRetIdxTypeFlag% = BRW_RETURN_FIRST_LISTINDEX
nRetVal% = fntLoadBrowserLB%(nFirstRow%, nNumOfRows%, nRetIdxTypeFlag%, nValue%)
BRW001F.lblRowNum.Caption = Str$(BRW001F.vsrBrowser.Value)
BRW001F.clbTbls.SetFocus
nFunctRetVal% = True
BRW001FclbTblsClick% = nFunctRetVal%
ngIgnoreTblsClick = False
BRW001F.lbxBrowser.Enabled = True
BRW001F.pbtNext.Enabled = True
BRW001F.pbtPrevious.Enabled = True
BRW001F.pbtPageUp.Enabled = True
BRW001F.pbtPageDn.Enabled = True
BRW001F.vsrBrowser.Enabled = True
BRW001F.pbtViewJET.Caption = "View &JET"
BRW001F.pbtViewJET.Enabled = True
Exit Function
BRW001FclbTblsClickErr:
szMsg$ = "ERROR-> " + Error$
MsgBox szMsg$
ngIgnoreTblsClick = False
Exit Function
BRW001FclbTblsClickExit:
BRW001FclbTblsClick% = False
End Function
Function BRW001FpbtExitClick% ()
Dim nFunctRetVal%
Unload BRW001F
End Function
Function BRW001FvsrBrowserChange% (nValue%)
Dim nAboveRow%
Dim nAddListIdx%
Dim nBelowRow%
Dim nCount%
Dim nDelta%
Dim nEnd%
Dim nFirstRow%
Dim nFunctRetVal%
Dim nItemsInBlock%
Dim nJETCurrPosToFirstRow%
Dim nJETFirstRow%
Dim nJETLastRow%
Dim nLastBrowserRow%
Dim nLCount%
Dim nListCount%
Dim nNearEOF%
Dim nNumOfRows%
Dim nNewIdx%
Dim nRecCount%
Dim nRedraw%
Dim nRetVal%
Dim nRowsUntilEOF%
Dim nStart%
Dim nSteps%
Dim nVSRMax%
nRedraw% = 1
If (nValue% = ngLBXBrowserValue) Then
nFunctRetVal% = True
BRW001FvsrBrowserChange% = nFunctRetVal%
Exit Function
End If
If (ngIgnoreVSRChangeEvent = True) Then
nFunctRetVal% = True
BRW001FvsrBrowserChange% = nFunctRetVal%
Exit Function
End If
nCount% = BRW001F.lbxBrowser.ListCount
If (nCount% < 1) Then
nFunctRetVal% = False
BRW001FvsrBrowserChange% = nFunctRetVal%
Exit Function
End If
nListCount% = nCount% - 1
'----------------------------------------------------------------------------
' NOTE-> the general +idea+ is that the dynaset is read via the datJET
' control +only+ when rows are +not+ in the browser listbox...
' so...we keep track of which rows are currently loaded into the
' listbox...when necessary we add more rows to the listbox, but we
' can also remove rows from the listbox (so that it does not contain
' a large amount of data at any given time)...
' using ngLBXBrowserFirstRow and ngLBXBrowserLastRow, we can determine
' whether the row data for the +new+ TOP item in the listbox is
' already loaded into the listbox...in that case, we need to determine
' the listbox index corresponding to that particular row's data...
' when that is done, we can set the listbox's ListIndex property to
' move that item to the top of the visible portion of the listbox...
' the next concern is whether there are enough rows +following+ the
' one that is now at the top of the listbox to completely fill the
' visible portion of the listbox...this is where the first and last
' loaded row global variables are necessary...if there are not enough
' rows already loaded to fill the listbox, then we get a few more
' rows and add them to the listbox...
'----------------------------------------------------------------------------
' NEXT-> at this point, we could stop and everything would work correctly
' but the number of items in the listbox would eventually increase to
' the point at which +all+ of the rows from the datJET dynaset were
' loaded into the listbox...not such a problem for a few hundred rows,
' but the +key+ to this virtual browser is the fact that it only
' contains and displays a small +subset+ of the dynaset controlled by
' datJET...so, we have to provide an algorithm for removing row data
' from the listbox...in this case, there are also several
' considerations...one approach is to load a few more rows initially
' than the listbox can display in its visible portion, and then unload
' as many rows as we need to load whenever rows are loaded...as we
' load and unload rows from the listbox, it is important not to unload
' too many rows...the general idea is to keep the listbox in the
' middle of its items and to limit the total number of items in the
' listbox to (perhaps) three times the number of items that can be
' displayed at any time...this gives us a buffered set of rows that
' can be scrolled...one way to accomplish this is to calculate how
' many items will be above the +new+ TOP item, and if there are more
' of them than some fixed constant amount, then remove them and adjust
' all of our global positioning variables...similarly, as we unload
' those items, we can load an equal amount...that will most likely
' solve the problem of maintaining enough rows beneath the +new+ TOP
' row to fill the listbox...there are two special cases: (1) BOF and
' (2) EOF for datJET...in other words, we cannot unload rows above
' the first row--because there are +none+ to unload, and we cannot
' unload rows beneath the last row...
'----------------------------------------------------------------------------
If ((nValue% >= ngLBXBrowserFirstRow) And (nValue% <= ngLBXBrowserLastRow)) Then
'-------------------------------------------------------------------------
' NOTE-> ROW to position at TOP of lbxBrowser is already loaded...
'-------------------------------------------------------------------------
nNewIdx% = nValue% - ngLBXBrowserFirstRow
If ((nNewIdx% > nListCount%) Or (nNewIdx% < 0)) Then
nFunctRetVal% = False
BRW001FvsrBrowserChange% = nFunctRetVal%
Exit Function
End If
ngLBXBrowserValue = nValue%
'-------------------------------------------------------------------------
' NOTE-> do we need to get more ROWS...
' ngLBXBrowserDispItems contains the number of +visible+ items the
' listbox can display...so if nDelta% is a greater than 0 we need
' to load more rows...
'-------------------------------------------------------------------------
nDelta% = ngLBXBrowserDispItems - (ngLBXBrowserLastRow - ngLBXBrowserValue)
If (nDelta% > 0) Then
'----------------------------------------------------------------------
' NOTE-> need to get nDelta% more ROWS from datJET...
' and add to lbxBrowser...
'----------------------------------------------------------------------
nNumOfRows% = nDelta%
nAddListIdx% = nListCount% + 1
nJETLastRow% = ngLBXBrowserLastRow
'----------------------------------------------------------------------
' NOTE-> fntAddMoreBrowserRows%() will cause ngLBXBrowserLastRow to
' change...
'----------------------------------------------------------------------
' REDRAW-> nRedraw% = 0
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
nRetVal% = fntAddMoreBrowserRows%(nNumOfRows%, nAddListIdx%, nJETLastRow%)
'----------------------------------------------------------------------
' NOTE-> since we just added a few items...we can also remove a few
' items...observing that removing items will +change+ the value
' that represents the ListIndex property for the +new+ item...
'----------------------------------------------------------------------
' NOTE-> fntRemSomeBrowserRows%() will cause ngLBXBrowserFirstRow to
' change...
'----------------------------------------------------------------------
' NOTE-> we need to adjust nNewIdx% +because+ we are removing from the
' +top+ of the listbox...
'----------------------------------------------------------------------
' NOTE-> nDelta% => number of items to remove from end of listbox...
' nNewIdx% => current value for nNewIdx%...
' nJETLastRow% => ROW number of LAST LOADED ROW...
'----------------------------------------------------------------------
' NOTE-> fntRemSomeBrowserRows%() returns the +new+ nNewIdx% value or
' a negative error code...
'----------------------------------------------------------------------
nJETLastRow% = ngLBXBrowserLastRow
nItemsInBlock% = (ngLBXBrowserDispItems * 3)
nRecCount% = BRW001F.vsrBrowser.Max
nRowsUntilEOF% = nRecCount% - nJETLastRow%
nLCount% = BRW001F.lbxBrowser.ListCount
If ((nRowsUntilEOF% <= nItemsInBlock%) And (nLCount% < (nItemsInBlock% + 1))) Then
'-------------------------------------------------------------------
' NOTE-> since we did not ADD any ITEMS...we should not REMOVE any...
' otherwise...the number of items in the listbox will
' decrease too much...the idea is to always have
' (ngLBXBrowserDispItems * 3) items in a block--except when
' the dynaset has fewer than that many items (TOTAL)...
'-------------------------------------------------------------------
Else
'-------------------------------------------------------------------
' NOTE-> there are so +many+ possibilities that we might as well
' be a bit careful...
'-------------------------------------------------------------------
nCount% = BRW001F.lbxBrowser.ListCount
nExtraLBXItems% = nCount% - nItemsInBlock%
If (nDelta% > nExtraLBXItems%) Then
nDelta% = nExtraLBXItems%
End If
nRetVal% = fntRemSomeBrowserRows%(nDelta%, nNewIdx%, nJETLastRow%)
If (nRetVal% < 0) Then
'---------------------------------------------------------------
' NOTE-> an error occurred...
'---------------------------------------------------------------
nFunctRetVal% = nRetVal%
BRW001FvsrBrowserChange% = nFunctRetVal%
' REDRAW-> If (nRedraw% = 0) Then
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
' REDRAW-> End If
Exit Function
Else
nNewIdx% = nRetVal%
End If
End If
End If
ngCurrListIdx = nNewIdx%
BRW001F.lbxBrowser.ListIndex = nNewIdx%
' REDRAW-> If (nRedraw% = 0) Then
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
' REDRAW-> End If
Else
'-------------------------------------------------------------------------
' NOTE-> ROW to position at TOP of lbxBrowser is NOT loaded...
'-------------------------------------------------------------------------
' ((nValue% >= ngLBXBrowserFirstRow) And (nValue% <= ngLBXBrowserLastRow)) Then
'-------------------------------------------------------------------------
' NOTE-> since the vsrBrowser vertical scrollbar is set so that its
' +minimum+ value is the first row in the dynaset, we do not have
' to be concerned with nValue% being +negative+...so...one very
' simple approach is just to remove as many items as we add...
' within the constraints of the special cases (i.e., BOF and EOF)...
'-------------------------------------------------------------------------
' NOTE-> since the ROW to position at TOP of lbxBrowser is NOT loaded,
' we may as well clear the listbox and reload it so that there are
' a convenient number of rows +above+ and +below+ the item that is
' going to be the TOP of the listbox...
'-------------------------------------------------------------------------
nNearEOF% = BRW001F.vsrBrowser.Max - ngLBXBrowserDispItems
nFuzzyZone% = nValue% - ngLBXBrowserValue
If (nValue% >= nNearEOF%) Then
If ((nValue% = BRW001F.vsrBrowser.Max) And (nFuzzyZone% = 1)) Then
GoTo 1
End If
'----------------------------------------------------------------------
' > > > +near+ datJET.Recordset.EOF < < <
'----------------------------------------------------------------------
' NOTE-> the second special case occurs when nValue% is within
' ngLBXBrowserDispItems of datJET.Recordset.EOF (a.k.a. the
' vsrBrowser.Max value)...in which case we can do a
' datJET.Recordset.MoveLast, lbxBrowser.Clear, and
' then do (ngLBXBrowserDispItems * 3) datJET.Recordset.MovePrev
' commands and lbxBrowser.AddItem each row +but+ in +reverse+
' order because we are reading backwards...
'----------------------------------------------------------------------
' REDRAW-> nRedraw% = 0
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
nRetVal% = fntLoadLastBlock%(nValue%)
If (nRetVal% = False) Then
'-------------------------------------------------------------------
' NOTE-> some unusual ERROR probably occurred...
'-------------------------------------------------------------------
nFunctRetVal% = nRetVal%
BRW001FvsrBrowserChange% = nFunctRetVal%
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
Exit Function
End If
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
Else
1 :
'----------------------------------------------------------------------
' NOTE-> this is the more +general+ case in which nValue% is either
' +above+ or +below+ our currently loaded group of rows...
' but is not the special case (i.e., within
' ngLBXBrowserDispItems rows from datJET.Recordset.BOF)...
'----------------------------------------------------------------------
' NOTE-> (perhaps) the +best+ way to solve this general problem is
' to determine how far forward or backward we are moving...
' if we are moving less than ngLBXBrowserDispItems from
' the TOP or BOTTOM of the currently loaded subset of ROWS
' from datJET.Recordset, the it is probably most efficient
' to add and remove just the number of ROWS necessary to get
' the desired ROW into +view+ at the TOP or BOTTOM of the
' listbox...otherwise, we are probably responding to a PageUP
' or PageDN type of vsrBrowser scrollbar movement and may as
' well do a lbxBrowser.Clear and reload the listbox with
' (ngLBXBrowserDispItems * 3) items...
'----------------------------------------------------------------------
nAboveRow% = ngLBXBrowserFirstRow - ngLBXBrowserDispItems
nBelowRow% = ngLBXBrowserLastRow + ngLBXBrowserDispItems
If ((nValue% >= nAboveRow%) And (nValue% <= nBelowRow%)) Then
'-------------------------------------------------------------------
' NOTE-> all we need to do is ADD and REMOVE an equal number of
' items so we can scroll the nValue% ROW into view...
'-------------------------------------------------------------------
' NOTE-> nNewIdx% will be changed by this process...so be sure to
' adjust it...
'-------------------------------------------------------------------
If (nValue% < ngLBXBrowserFirstRow) Then
nDelta% = ngLBXBrowserFirstRow - nValue%
nAddToListLocFlag% = BRW_ADD_ABOVE_FLAG
Else
nDelta% = nValue% - ngLBXBrowserLastRow
nAddToListLocFlag% = BRW_ADD_BELOW_FLAG
End If
nJETFirstRow% = ngLBXBrowserFirstRow
nJETLastRow% = ngLBXBrowserLastRow
'-------------------------------------------------------------------
' NOTE-> fntAdjDeltaBrowserItems% returns the +new+ ListIndex
' value or a negative error code...
'-------------------------------------------------------------------
' NOTE-> nDelta% => the number of rows to adjust...
' nAddToListLocFlag% => where to AddItem(s)...
' nValue% => the current vsrBrowser scrollbar VALUE...
' nJETFirstRow% => the beginning ROW number of the subset...
' nJETLastRow% => the ending ROW number of the subset...
'-------------------------------------------------------------------
' REDRAW-> nRedraw% = 0
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
nRetVal% = fntAdjDeltaBrowserItems%(nDelta%, nAddToListLocFlag%, nValue%, nJETFirstRow%, nJETLastRow%)
If (nRetVal% = BRW_ERROR) Then
'----------------------------------------------------------------
' NOTE-> an error occurred...
'----------------------------------------------------------------
nFunctRetVal% = nRetVal%
BRW001FvsrBrowserChange% = nFunctRetVal%
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
Exit Function
Else
nNewIdx% = nRetVal%
ngCurrListIdx = nNewIdx%
BRW001F.lbxBrowser.ListIndex = nNewIdx%
End If
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
If (ngJETRowNumber = 1) Then
'----------------------------------------------------------------
' NOTE-> we are are at the TOP of the dynaset...
' and our logic for traversing it at this point is
' based upon the way things are after we load the first
' SUBSET of ROWS into the LISTBOX...and this is nearly
' an identical STATE--EXCEPT for the fact that datJET
' is currently positioned at the BEGINNING of the SUBSET
' rather than at the END (where it SHOULD BE)...
' so...we want to make this otherwise unusual case
' appear to be the NORMAL case...and the way to do that
' is to POSITION datJET at the END of the SUBSET of ROWS...
' rather an UNUSUAL thing to do...but it WORKS...
'----------------------------------------------------------------
nStart% = 2 ' NOTE-> datJET is ALREADY on the first record...
nJETCurrPosToFirstRow% = ngLBXBrowserDispItems * 3
nVSRMax% = BRW001F.vsrBrowser.Max
If (nJETCurrPosToFirstRow% > nVSRMax%) Then
nJETCurrPosToFirstRow% = nVSRMax%
End If
nEnd% = nJETCurrPosToFirstRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nSteps%
End If
Else
'-------------------------------------------------------------------
' NOTE-> we may as well do a zap the listbox contents and
' reload (ngLBXBrowserDispItems * 3) items because we are
' here as a result of a change in vsrBrowser.Value that
' is greater than ngLBXBrowserDispItems...so there are
' several ways to +predict+ the most efficient way to
' reload the listbox...if the user is scrolling upward
' then the +smart+ thing is to load with all +upward+
' rows and set the ListIndex to the +bottom+ of the
' listbox...similarly, if the user is scrolling downward
' then the +smart+ thing is to load with all +downward+
' rows and set the ListIndex to the +top+ of the
' listbox...the problem with +predicting+ this way is it
' may not be accurate...however, it is a good place to
' begin experimentation with browser +behaviors+...
'-------------------------------------------------------------------
' NOTE-> nNewIdx% will be changed by this process...so be sure to
' adjust it...
'-------------------------------------------------------------------
' > > > WHY WE ARE HERE < < <
'-------------------------------------------------------------------
' nAboveRow% = ngLBXBrowserFirstRow - ngLBXBrowserDispItems
' nBelowRow% = ngLBXBrowserLastRow + ngLBXBrowserDispItems
'-------------------------------------------------------------------
' THIS IS TRUE-> (nValue% < nAboveRow%) Or (nValue% > nBelowRow%)
'-------------------------------------------------------------------
If (nValue% < ngLBXBrowserFirstRow) Then
'----------------------------------------------------------------
' NOTE-> we +predict+ the user is scrolling UPWARDS...
'----------------------------------------------------------------
nRetIdxTypeFlag% = BRW_RETURN_FIRST_LISTINDEX
nFirstRow% = nValue%
nNumOfRows% = ngLBXBrowserDispItems * 3
' REDRAW-> nRedraw% = 0
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
nRetVal% = fntLoadBrowserLB%(nFirstRow%, nNumOfRows%, nRetIdxTypeFlag%, nValue%)
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
Else
If (nValue% > ngLBXBrowserLastRow) Then
'-------------------------------------------------------------
' NOTE-> we +predict+ the user is scrolling DOWNWARDS...
'-------------------------------------------------------------
nRetIdxTypeFlag% = BRW_RETURN_SPECIFIED_LISTINDEX
nFirstRow% = nValue%
nNumOfRows% = ngLBXBrowserDispItems * 3
' REDRAW-> nRedraw% = 0
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
nRetVal% = fntLoadBrowserLB%(nFirstRow%, nNumOfRows%, nRetIdxTypeFlag%, nValue%)
' REDRAW-> nRedraw% = 1
' REDRAW-> lRetVal& = SendMessage(BRW001F.lbxBrowser.hWnd, WM_SETREDRAW, nRedraw%, ByVal 0&)
Else
'-------------------------------------------------------------
' NOTE-> we +predict+ this should NEVER occur (g)...
'-------------------------------------------------------------
End If
End If
End If
End If
End If
BRW001FvsrBrowserChange% = nFunctRetVal%
End Function
Function fntAddMoreBrowserRows% (nNumOfRows%, nAddListIdx%, nJETLastRow%)
Dim nFunctRetVal%
Dim nCols%
Dim nEnd%
Dim nEOF%
Dim nIdx%
Dim nListCols%
Dim nRowsAdded%
Dim nRowIdx%
Dim nStart%
Dim nVSRMax%
Dim szLBStr$
Dim szTxt$
On Error GoTo fntAddMoreBrowserRowsErr
'----------------------------------------------------------------------------
' NOTE-> do NOT attempt to add more ROWS if we are already at the LAST ROW...
'----------------------------------------------------------------------------
nMaxValue% = BRW001F.vsrBrowser.Max
If ((ngLBXBrowserLastRow = nMaxValue%) And (ngJETRowNumber = nMaxValue%)) Then
nFunctRetVal% = True
fntAddMoreBrowserRows% = nFunctRetVal%
Exit Function
End If
nCols% = BRW001F.clbCols.ListCount
If (nCols% < 1) Then
nFunctRetVal% = False
fntAddMoreBrowserRows% = nFunctRetVal%
Exit Function
End If
nListCols% = nCols% - 1
nRowsAdded% = 0
If (ngLBXBrowserLastRow = nMaxValue%) Then
nFunctRetVal% = True
fntAddMoreBrowserRows% = nFunctRetVal%
Exit Function
End If
'----------------------------------------------------------------------------
' NOTE-> build the lbxBrowser STRING using ALL fields in the TABLE for
' the CURRENT ROW...
'----------------------------------------------------------------------------
' WARNING-> the lbxBrowser STRING must be NULL-terminated...
' this is because VB listbox controls are +really+ Windows
' listbox controls, and Windows controls know absolutely
' nothing about VB strings--they only know 'C' strings...
'----------------------------------------------------------------------------
nStart% = nAddListIdx%
nEnd% = nAddListIdx% + (nNumOfRows% - 1)
nOnLastRowExitForEarly% = False
If (ngJETRowNumber < ngLBXBrowserLastRow) Then
nSteps% = ngLBXBrowserLastRow - ngJETRowNumber
For nIdx% = 1 To nSteps%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nIdx%
End If
For nRowIdx% = nStart% To nEnd%
nVSRMax% = BRW001F.vsrBrowser.Max
If (ngJETRowNumber = nVSRMax%) Then
If (nRowIdx% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
nEOF% = BRW001F.datJET.Recordset.EOF
If (nEOF%) Then
'----------------------------------------------------------------------
' NOTE-> just in case we made a mistake...
'----------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveLast
ngJETRowNumber = ngJETRowNumber - 1
If (nRowIdx% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
szLBStr$ = Space$(1)
For nIdx% = 0 To nListCols%
szTxt$ = BRW001F.txtData(nIdx%).Text
lTxtLen& = Len(szTxt$)
szType$ = BRW001F.clbTypes.List(nIdx%)
nBeginParen% = InStr(1, szType$, "(")
nStart% = nBeginParen% + 1
nEndParen% = InStr(nStart%, szType$, ")")
nLen% = nEndParen% - nStart%
szLen$ = Mid$(szType$, nStart%, nLen%)
lMaxTxtLen& = Val(szLen$)
lDeltaLen& = lMaxTxtLen& - lTxtLen&
szLBStr$ = szLBStr$ + szTxt$ + Space$(2)
If (lDeltaLen& > 0) Then
szLBStr$ = szLBStr$ + Space$(lDeltaLen&)
End If
Next nIdx%
szLBStr$ = szLBStr$ + Chr$(0)
BRW001F.lbxBrowser.AddItem szLBStr$
nRowsAdded% = nRowsAdded% + 1
Next nRowIdx%
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows + nRowsAdded%
ngLBXBrowserLastRow = ngLBXBrowserFirstRow + (ngLBXBrowserNumOfRows - 1)
nFunctRetVal% = True
fntAddMoreBrowserRows% = nFunctRetVal%
Exit Function
fntAddMoreBrowserRowsErr:
Resume Next
fntAddMoreBrowserRowsExit:
fntAddMoreBrowserRows% = True
End Function
Function fntAdjDeltaBrowserItems% (nDelta%, nAddToListLocFlag%, nValue%, nJETFirstRow%, nJETLastRow%)
Dim nBOF%
Dim nCols%
Dim nEnd%
Dim nEOF%
Dim nFirstIdx%
Dim nFunctRetVal%
Dim nIdx%
Dim nLastIdx%
Dim nListCols%
Dim nListCount%
Dim nNewIdx%
Dim nOnLastRowExitForEarly%
Dim nRetVal%
Dim nRowsAdded%
Dim nStart%
Dim nSteps%
Dim szLBStr$
Dim szTxt$
On Error GoTo fntAdjDeltaBrowserItemsErr
'----------------------------------------------------------------------------
' RETURNS-> 1. if (SUCCESSFUL) -> BRW_SUCCESSFUL
' 2. if (UNSUCCESSFUL) -> BRW_ERROR
'----------------------------------------------------------------------------
' NOTE-> this function adds a few rows to one end of the listbox and then
' removes an equal number of rows from the opposite end of the
' listbox...
'----------------------------------------------------------------------------
' RETURNS-> 1. if (SUCCESSFUL) -> the +new+ ListIndex
' 2. if (UNSUCCESSFUL) -> a negative error code...
'----------------------------------------------------------------------------
' LOGIC-> we know on which record number datJET is currently positioned
' (i.e., ngJETRowNumber), and we know all of the +stuff+ sent to
' us via the function parameters...
' and we are reasonably sure that we can read forward or backwards
' as many ROWS as we need to read or we probably would not be in
' this routine...
' so the general idea is first to ADD the new ITEMS (to whichever
' end the parameter [i.e., nAddToListLocFlag%] indicates), and then
' to REMOVE the unnecessary +extra+ ITEMS...
'----------------------------------------------------------------------------
' NOTE-> nDelta% => the number of rows to adjust...
' nAddToListLocFlag% => where to AddItem(s)...(TOP or BOTTOM)
' nValue% => the CURRENT VALUE of BRW001F.vsrBrowser...
' nJETFirstRow% => the beginning ROW number of the subset...
' nJETLastRow% => the ending ROW number of the subset...
'----------------------------------------------------------------------------
If (nAddToListLocFlag% = BRW_ADD_ABOVE_FLAG) Then
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_ABOVE_FLAG
'-------------------------------------------------------------------------
If (ngJETRowNumber > nJETFirstRow%) Then
'----------------------------------------------------------------------
' NOTE-> we need to MovePrevious to get to the first row to ADD...
'----------------------------------------------------------------------
nSteps% = ngJETRowNumber - nJETFirstRow%
'----------------------------------------------------------------------
' NOTE-> we begin the FOR LOOP with 0...
'----------------------------------------------------------------------
For nIdx% = 0 To nSteps%
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
Next nIdx%
'----------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
'----------------------------------------------------------------------
Else
If (ngJETRowNumber < nJETFirstRow%) Then
'-------------------------------------------------------------------
' NOTE-> we need to MoveNext to get to the first row to ADD...
'-------------------------------------------------------------------
nSteps% = nJETFirstRow% - ngJETRowNumber
'-------------------------------------------------------------------
' NOTE-> we begin the FOR LOOP with 0...
'-------------------------------------------------------------------
For nIdx% = 0 To nSteps%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nIdx%
'-------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
'-------------------------------------------------------------------
Else
'-------------------------------------------------------------------
' NOTE-> we need to MovePrevious ONE ROW to get to the first row
' of the subset...and then some amount further to get to
' the first record outside of the subset...
'-------------------------------------------------------------------
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
'-------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
'-------------------------------------------------------------------
End If
End If
Else
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_BELOW_FLAG
'-------------------------------------------------------------------------
If (ngJETRowNumber > nJETLastRow%) Then
'----------------------------------------------------------------------
' NOTE-> we need to MovePrevious to get to the first row to ADD...
'----------------------------------------------------------------------
nSteps% = ngJETRowNumber - nJETLastRow%
'----------------------------------------------------------------------
' NOTE-> we begin the FOR LOOP with 2 rather than 1...
'----------------------------------------------------------------------
For nIdx% = 2 To nSteps%
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
Next nIdx%
'----------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
' we are ADDING to the TOP...so need to be positioned BEFORE...
'----------------------------------------------------------------------
Else
If (ngJETRowNumber < nJETLastRow%) Then
'-------------------------------------------------------------------
' NOTE-> we need to MoveNext to get to the first row to ADD...
'-------------------------------------------------------------------
nSteps% = nJETFirstRow% - ngJETRowNumber
'-------------------------------------------------------------------
' NOTE-> we begin the FOR LOOP with 0...
'-------------------------------------------------------------------
For nIdx% = 0 To nSteps%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nIdx%
'-------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
'-------------------------------------------------------------------
Else
'-------------------------------------------------------------------
' NOTE-> we need to MoveNext ONE ROW to get to the first row to ADD...
' we are ADDING to the BOTTOM...so need to be positioned AFTER...
'-------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
'-------------------------------------------------------------------
' NOTE-> now ngJETRowNumber is +THE+ first ROW to ADD to the listbox...
'-------------------------------------------------------------------
End If
End If
End If
'----------------------------------------------------------------------------
' NOTE-> at this point datJET is positioned on the FIRST ROW that needs to
' be ADDED to lbxBrowser...so we (again) need to check to which end we
' adding to and then do a FOR LOOP and add the ROWS...using
' MoveNext or MovePrevious as appropriate...
' also note that adding to the TOP is done by +explicitly+ specifying
' and INDEX = 0 value on the AddItem method...whereas positioning the
' listbox on its last item and then doing sequential AddItem methods
' +without+ specifying an INDEX parameter will append the items...
' UNLESS we somehow set the listbox SORT property to TRUE--in which
' case we are quite confused...
'----------------------------------------------------------------------------
' NOTE-> nDelta% => the number of rows to adjust...
' nAddToListLocFlag% => where to AddItem(s)...(TOP or BOTTOM)
' nValue% => the CURRENT VALUE of BRW001F.vsrBrowser...
' nJETFirstRow% => the beginning ROW number of the subset...
' nJETLastRow% => the ending ROW number of the subset...
'----------------------------------------------------------------------------
' NOTE-> get the number of columns in the COLUMNS combo listbox
'----------------------------------------------------------------------------
nCols% = BRW001F.clbCols.ListCount
If (nCols% < 1) Then
nFunctRetVal% = False
fntAdjDeltaBrowserItems% = nFunctRetVal%
Exit Function
End If
nListCols% = nCols% - 1
If (nAddToListLocFlag% = BRW_ADD_ABOVE_FLAG) Then
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_ABOVE_FLAG
'-------------------------------------------------------------------------
nStart% = 1
nEnd% = nDelta%
nOnLastRowExitForEarly% = False
For nIdx% = nStart% To nEnd%
'----------------------------------------------------------------------
' NOTE-> build the listbox item STRING...
'----------------------------------------------------------------------
szLBStr$ = Space$(1)
For nCols% = 0 To nListCols%
szTxt$ = BRW001F.txtData(nCols%).Text
lTxtLen& = Len(szTxt$)
szType$ = BRW001F.clbTypes.List(nCols%)
nBeginParen% = InStr(1, szType$, "(")
nStart% = nBeginParen% + 1
nEndParen% = InStr(nStart%, szType$, ")")
nLen% = nEndParen% - nStart%
szLen$ = Mid$(szType$, nStart%, nLen%)
lMaxTxtLen& = Val(szLen$)
lDeltaLen& = lMaxTxtLen& - lTxtLen&
szLBStr$ = szLBStr$ + szTxt$ + Space$(2)
If (lDeltaLen& > 0) Then
szLBStr$ = szLBStr$ + Space$(lDeltaLen&)
End If
Next nCols%
szLBStr$ = szLBStr$ + Chr$(0)
'----------------------------------------------------------------------
' NOTE-> ADD the item to lbxBrowser...at the TOP...(Index = 0)
'----------------------------------------------------------------------
BRW001F.lbxBrowser.AddItem szLBStr$, 0
ngLBXBrowserValue = nValue%
ngLBXBrowserFirstRow = ngJETRowNumber
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows + 1
ngLBXBrowserLastRow = ngLBXBrowserFirstRow + (ngLBXBrowserNumOfRows - 1)
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
nBOF% = BRW001F.datJET.Recordset.BOF
If (nBOF%) Then
'-------------------------------------------------------------------
' NOTE-> just in case we made a mistake...
'-------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveFirst
ngJETRowNumber = 1
If (nIdx% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
Next nIdx%
If (nOnLastRowExitForEarly% = True) Then
'----------------------------------------------------------------------
' NOTE-> we were unable to ADD nDelta% ITEMS...so REMOVE only the
' number of ITEMS we actually ADDED...
'----------------------------------------------------------------------
nRowsAdded% = nStart%
Else
nRowsAdded% = nDelta%
End If
Else
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_BELOW_FLAG
'-------------------------------------------------------------------------
nStart% = 1
nEnd% = nDelta%
nOnLastRowExitForEarly% = False
For nIdx% = nStart% To nEnd%
'----------------------------------------------------------------------
' NOTE-> build the listbox item STRING...
'----------------------------------------------------------------------
szLBStr$ = Space$(1)
For nCols% = 0 To nListCols%
szTxt$ = BRW001F.txtData(nCols%).Text
lTxtLen& = Len(szTxt$)
szType$ = BRW001F.clbTypes.List(nCols%)
nBeginParen% = InStr(1, szType$, "(")
nStart% = nBeginParen% + 1
nEndParen% = InStr(nStart%, szType$, ")")
nLen% = nEndParen% - nStart%
szLen$ = Mid$(szType$, nStart%, nLen%)
lMaxTxtLen& = Val(szLen$)
lDeltaLen& = lMaxTxtLen& - lTxtLen&
szLBStr$ = szLBStr$ + szTxt$ + Space$(2)
If (lDeltaLen& > 0) Then
szLBStr$ = szLBStr$ + Space$(lDeltaLen&)
End If
Next nCols%
szLBStr$ = szLBStr$ + Chr$(0)
'----------------------------------------------------------------------
' NOTE-> ADD the item to lbxBrowser...at the BOTTOM...
'----------------------------------------------------------------------
' CAUTION-> it is VERY IMPORTANT that the Sort property of lbxBrowser
' be False...this means that the listbox is NOT SORTED...
' furthermore it means that by NOT SPECIFYING AN INDEX VALUE
' for the AddItem method, the ITEM will be added to the
' END of the listbox...
'----------------------------------------------------------------------
BRW001F.lbxBrowser.AddItem szLBStr$
ngLBXBrowserValue = nValue%
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows + 1
ngLBXBrowserLastRow = ngJETRowNumber
BRW001F.datJET.Recordset.MoveNext
nEOF% = BRW001F.datJET.Recordset.EOF
ngJETRowNumber = ngJETRowNumber + 1
If (nEOF%) Then
'-------------------------------------------------------------------
' NOTE-> just in case we made a mistake...
'-------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveLast
ngJETRowNumber = ngJETRowNumber - 1
If (nIdx% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
Next nIdx%
If (nOnLastRowExitForEarly% = True) Then
'----------------------------------------------------------------------
' NOTE-> we were unable to ADD nDelta% ITEMS...so REMOVE only the
' number of ITEMS we actually ADDED...
'----------------------------------------------------------------------
nRowsAdded% = nStart%
Else
nRowsAdded% = nDelta%
End If
End If
'----------------------------------------------------------------------------
' NOTE-> at this point we have ADDED nRowsAdded% ITEMS to lbxBrowser...
' so we need to REMOVE nRowsAdded% ITEMS from lbxBrowser...
'----------------------------------------------------------------------------
' NOTE-> nDelta% => the number of rows to adjust...
' nAddToListLocFlag% => where to AddItem(s)...(TOP or BOTTOM)
' nValue% => the CURRENT VALUE of BRW001F.vsrBrowser...
' nJETFirstRow% => the beginning ROW number of the subset...
' nJETLastRow% => the ending ROW number of the subset...
'----------------------------------------------------------------------------
If (nAddToListLocFlag% = BRW_ADD_ABOVE_FLAG) Then
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_ABOVE_FLAG
'-------------------------------------------------------------------------
nCount% = BRW001F.lbxBrowser.ListCount
If (nCount% < 1) Then
'----------------------------------------------------------------------
' NOTE-> listbox is EMPTY...
'----------------------------------------------------------------------
nFunctRetVal% = BRW_ERROR
fntAdjDeltaBrowserItems% = nFunctRetVal%
Exit Function
End If
nListCount% = nCount% - 1
nLastIdx% = nListCount%
nStart% = 1
nEnd% = nRowsAdded%
For nIdx% = nStart% To nEnd%
'----------------------------------------------------------------------
' NOTE-> REMOVE the item to lbxBrowser...at the BOTTOM...
'----------------------------------------------------------------------
BRW001F.lbxBrowser.RemoveItem nLastIdx%
nLastIdx% = nLastIdx% - 1
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows - 1
ngLBXBrowserLastRow = ngLBXBrowserFirstRow + (ngLBXBrowserNumOfRows - 1)
Next nIdx%
Else
'-------------------------------------------------------------------------
' NOTE-> BRW_ADD_BELOW_FLAG
'-------------------------------------------------------------------------
nCount% = BRW001F.lbxBrowser.ListCount
If (nCount% < 1) Then
'----------------------------------------------------------------------
' NOTE-> listbox is EMPTY...
'----------------------------------------------------------------------
nFunctRetVal% = BRW_ERROR
fntAdjDeltaBrowserItems% = nFunctRetVal%
Exit Function
End If
nListCount% = nCount% - 1
nFirstIdx% = 0
nStart% = 1
nEnd% = nRowsAdded%
For nIdx% = nStart% To nEnd%
'----------------------------------------------------------------------
' NOTE-> REMOVE the item to lbxBrowser...at the TOP...
' leave nFirstIdx% set to 0...
'----------------------------------------------------------------------
BRW001F.lbxBrowser.RemoveItem nFirstIdx%
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows - 1
ngLBXBrowserFirstRow = ngLBXBrowserFirstRow + 1
Next nIdx%
End If
'----------------------------------------------------------------------------
' NOTE-> at this point...we need to determine the +new+ value for nNewIdx%...
'----------------------------------------------------------------------------
If ((nValue% >= ngLBXBrowserFirstRow) And (nValue% <= ngLBXBrowserLastRow)) Then
nNewIdx% = nValue% - ngLBXBrowserFirstRow
Else
'-------------------------------------------------------------------------
' NOTE-> this should not occur...but if it does...set nNewIdx% to TOP...
'-------------------------------------------------------------------------
nNewIdx% = 0
End If
If (ngJETRowNumber <> nValue%) Then
If (ngJETRowNumber > nValue%) Then
nSteps% = ngJETRowNumber - nValue%
For nIdx% = 1 To nSteps%
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
Next nIdx%
Else
nSteps% = nValue% - ngJETRowNumber
For nIdx% = 1 To nSteps%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nIdx%
End If
End If
nFunctRetVal% = nNewIdx%
fntAdjDeltaBrowserItems% = nFunctRetVal%
Exit Function
fntAdjDeltaBrowserItemsErr:
Resume Next
fntAdjDeltaBrowserItemsExit:
fntAdjDeltaBrowserItems% = True
End Function
Function fntLoadBrowserLB% (nFirstRow%, nNumOfRows%, nRetIdxTypeFlag%, nValue%)
Dim nBOF%
Dim nBOFToFirstRow%
Dim nCols%
Dim nEOF%
Dim nEOFToFirstRow%
Dim nFunctRetVal%
Dim nHowToPosFlag%
Dim nIdx%
Dim nJETCurrPosToFirstRow%
Dim nJETCurrPosToFirstRowDirection%
Dim nListCols%
Dim nOnLastRowExitForEarly%
Dim nVSRMax%
Dim szLBStr$
Dim szTxt$
On Error GoTo fntLoadBrowserLBErr
nCols% = BRW001F.clbCols.ListCount
If (nCols% < 1) Then
nFunctRetVal% = False
fntLoadBrowserLB% = nFunctRetVal%
Exit Function
End If
nListCols% = nCols% - 1
BRW001F.lbxBrowser.Clear
'----------------------------------------------------------------------------
' NOTE-> build the lbxBrowser STRING using ALL fields in the TABLE for
' the CURRENT ROW...
'----------------------------------------------------------------------------
' WARNING-> the lbxBrowser STRING must be NULL-terminated...
' this is because VB listbox controls are +really+ Windows
' listbox controls, and Windows controls know absolutely
' nothing about VB strings--they only know 'C' strings...
'----------------------------------------------------------------------------
' NOTE-> since this function is used for SEVERAL cases, we cannot presume
' that datJET is currently positioned on nFirstRow%...
' so...we need to explicitly POSITION datJET on nFirstRow% if it is
' not already on it...
'----------------------------------------------------------------------------
' STRATEGY-> since we have to do positioning via MoveXXXX, (perhaps) the
' best way to improve efficiency is to minimize the number of
' MoveXXXX commands required to position datJET...
'----------------------------------------------------------------------------
If (nFirstRow% <> 1) Then ' NOTE-> OUTER IF...
'----------------------------------------------------------------------------
' NOTE-> currently...doing a MoveLast reads EVERY row in the dynaset...
' so...we need to add that count to our predicting variable...
'----------------------------------------------------------------------------
nVSRMax% = BRW001F.vsrBrowser.Max
nEOFToFirstRow% = (nVSRMax% - nFirstRow%) + nVSRMax%
nBOFToFirstRow% = nFirstRow%
nHowToPosFlag% = BRW_MOVE_FROM_UNKNOWN
If (ngJETRowNumber <> nFirstRow%) Then ' -------NOTE-> INNER If...
'-------------------------------------------------------------------------
' NOTE-> POSITION datJET to nFirstRow%...
'-------------------------------------------------------------------------
If (ngJETRowNumber < nFirstRow%) Then
'----------------------------------------------------------------------
' NOTE-> ngJETRowNumber < nFirstRow%...
'----------------------------------------------------------------------
nJETCurrPosToFirstRowDirection% = BRW_FORWARD_DIRECTION
nJETCurrPosToFirstRow% = nFirstRow% - ngJETRowNumber
Else
nJETCurrPosToFirstRowDirection% = BRW_BACKWARD_DIRECTION
nJETCurrPosToFirstRow% = ngJETRowNumber - nFirstRow%
End If
If (nJETCurrPosToFirstRow% <= nBOFToFirstRow%) Then
If (nJETCurrPosToFirstRow% <= nEOFToFirstRow%) Then
'-------------------------------------------------------------------
' NOTE-> use nJETCurrPosToFirstRow%...
'-------------------------------------------------------------------
nHowToPosFlag% = BRW_MOVE_FROM_CURR_POS
Else
'-------------------------------------------------------------------
' NOTE-> use nEOFToFirstRow%...
'-------------------------------------------------------------------
nHowToPosFlag% = BRW_MOVE_FROM_EOF_POS
End If
Else
If (nBOFToFirstRow% <= nEOFToFirstRow%) Then
'-------------------------------------------------------------------
' NOTE-> use nBOFToFirstRow%...
'-------------------------------------------------------------------
nHowToPosFlag% = BRW_MOVE_FROM_BOF_POS
Else
'-------------------------------------------------------------------
' NOTE-> use nEOFToFirstRow%...
'-------------------------------------------------------------------
nHowToPosFlag% = BRW_MOVE_FROM_EOF_POS
End If
End If
Else ' -------NOTE-> INNER If...
'-------------------------------------------------------------------------
' NOTE-> use nJETCurrPosToFirstRow%...
'-------------------------------------------------------------------------
nHowToPosFlag% = BRW_MOVE_FROM_CURR_POS
End If ' -------NOTE-> INNER If...
Else ' NOTE-> OUTER If...
nHowToPosFlag% = BRW_MOVE_FIRST
End If ' NOTE-> OUTER If...
Select Case nHowToPosFlag%
Case BRW_MOVE_FROM_BOF_POS
BRW001F.datJET.Recordset.MoveFirst
ngJETRowNumber = 1
nStart% = 2
nEnd% = nBOFToFirstRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nSteps%
Case BRW_MOVE_FROM_CURR_POS
Select Case nJETCurrPosToFirstRowDirection%
Case BRW_FORWARD_DIRECTION
nStart% = 1
nEnd% = nJETCurrPosToFirstRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nSteps%
Case BRW_BACKWARD_DIRECTION
nStart% = 1
nEnd% = nJETCurrPosToFirstRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
Next nSteps%
End Select
Case BRW_MOVE_FROM_EOF_POS
BRW001F.datJET.Recordset.MoveLast
ngJETRowNumber = BRW001F.vsrBrowser.Max
nStart% = 2
nEnd% = nBOFToFirstRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
Next nSteps%
Case BRW_MOVE_FIRST
BRW001F.datJET.Recordset.MoveFirst
ngJETRowNumber = 1
End Select
'----------------------------------------------------------------------------
' NOTE-> at this point...we should be positioned on the BEGINNING ROW of
' the subset of ROWS that we are adding to the listbox...
'----------------------------------------------------------------------------
nStart% = nFirstRow%
nEnd% = nFirstRow% + (nNumOfRows% - 1)
nOnLastRowExitForEarly% = False
For nRow% = nStart% To nEnd%
szLBStr$ = Space$(1)
For nIdx% = 0 To nListCols%
szTxt$ = BRW001F.txtData(nIdx%).Text
If (szTxt$ = "Dunn's Holdings") Then
nWhat% = 1
End If
lTxtLen& = Len(szTxt$)
szType$ = BRW001F.clbTypes.List(nIdx%)
nBeginParen% = InStr(1, szType$, "(")
nStart% = nBeginParen% + 1
nEndParen% = InStr(nStart%, szType$, ")")
nLen% = nEndParen% - nStart%
szLen$ = Mid$(szType$, nStart%, nLen%)
lMaxTxtLen& = Val(szLen$)
lDeltaLen& = lMaxTxtLen& - lTxtLen&
szLBStr$ = szLBStr$ + szTxt$ + Space$(2)
If (lDeltaLen& > 0) Then
szLBStr$ = szLBStr$ + Space$(lDeltaLen&)
End If
Next nIdx%
szLBStr$ = szLBStr$ + Chr$(0)
BRW001F.lbxBrowser.AddItem szLBStr$
'-------------------------------------------------------------------------
' NOTE-> are we already on the LAST record...if so then do NOT do a
' MoveNext because it will make our current position UNDEFINED...
' in which case we have to read the +entire+ dynaset to get back
' to the LAST record...
'-------------------------------------------------------------------------
nVSRMax% = BRW001F.vsrBrowser.Max
If (ngJETRowNumber = nVSRMax%) Then
If (nRow% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
nEOF% = BRW001F.datJET.Recordset.EOF
If (nEOF%) Then
'----------------------------------------------------------------------
' NOTE-> just in case we made a mistake...
'----------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveLast
ngJETRowNumber = ngJETRowNumber - 1
If (nRow% < nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
Next nRow%
'----------------------------------------------------------------------------
' NOTE-> did we do one extra datJET.Recordset.MoveNext...if so, we need
' to undo it so we know where we are next time we need to read...
'----------------------------------------------------------------------------
If (nOnLastRowExitForEarly% = True) Then
'-------------------------------------------------------------------------
' NOTE-> we are on the LAST row and have read it...so do NOTHING here...
'-------------------------------------------------------------------------
Else
'-------------------------------------------------------------------------
' NOTE-> we read one too many rows...so back up one row...
'-------------------------------------------------------------------------
If (ngJETRowNumber = 1) Then
'----------------------------------------------------------------------
' NOTE-> we cannot backup any more...we are on the FIRST row...
'----------------------------------------------------------------------
Else
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
End If
End If
Select Case nRetIdxTypeFlag%
Case BRW_RETURN_SPECIFIED_LISTINDEX
ngCurrListIdx = nValue - 1
BRW001F.lbxBrowser.ListIndex = nValue% - 1
ngLBXBrowserValue = nValue%
Case BRW_RETURN_FIRST_LISTINDEX
ngCurrListIdx = 0
BRW001F.lbxBrowser.ListIndex = 0
ngLBXBrowserValue = nFirstRow%
Case BRW_RETURN_LAST_LISTINDEX
nCount% = BRW001F.lbxBrowser.ListCount
If (nCount% < 1) Then
nFunctRetVal% = BRW_UNSUCCESSFUL
fntLoadBrowserLB% = nFunctRetVal%
Exit Function
End If
nListIdx% = nCount% - 1
ngCurrListIdx = nListIdx%
BRW001F.lbxBrowser.ListIndex = nListIdx%
ngLBXBrowserValue = nFirstRow%
End Select
ngLBXBrowserFirstRow = nFirstRow%
ngLBXBrowserNumOfRows = nNumOfRows%
ngLBXBrowserLastRow = ngLBXBrowserFirstRow + (ngLBXBrowserNumOfRows - 1)
nFunctRetVal% = BRW001F.lbxBrowser.ListIndex
fntLoadBrowserLB% = nFunctRetVal%
Exit Function
fntLoadBrowserLBErr:
Resume Next
fntLoadBrowserLBExit:
fntLoadBrowserLB% = True
End Function
Function fntLoadLastBlock% (nValue%)
Dim nBOF%
Dim nCols%
Dim nCount%
Dim nEnd%
Dim nEOF%
Dim nFunctRetVal%
Dim nIdx%
Dim nJETCurrPosToLastRow%
Dim nListCols%
Dim nListCount%
Dim nNewIdx%
Dim nOffset%
Dim nOnLastRowExitForEarly%
Dim nStart%
Dim nSteps%
Dim nVSRMax%
Dim szLBStr$
Dim szTxt$
'----------------------------------------------------------------------------
' NOTE-> the second special case occurs when nValue% is within
' ngLBXBrowserDispItems of datJET.Recordset.EOF (a.k.a. the
' vsrBrowser.Max value)...in which case we can do a
' datJET.Recordset.MoveLast, lbxBrowser.Clear, and
' then do (ngLBXBrowserDispItems * 3) datJET.Recordset.MovePrev
' commands and lbxBrowser.AddItem each row +but+ in +reverse+
' order because we are reading backwards...
'----------------------------------------------------------------------------
On Error GoTo fntLoadLastBlockErr
nCols% = BRW001F.clbCols.ListCount
If (nCols% < 1) Then
nFunctRetVal% = False
fntLoadLastBlock% = nFunctRetVal%
Exit Function
End If
nListCols% = nCols% - 1
BRW001F.lbxBrowser.Clear
'----------------------------------------------------------------------------
' NOTE-> build the lbxBrowser STRING using ALL fields in the TABLE for
' the CURRENT ROW...
'----------------------------------------------------------------------------
' WARNING-> the lbxBrowser STRING must be NULL-terminated...
' this is because VB listbox controls are +really+ Windows
' listbox controls, and Windows controls know absolutely
' nothing about VB strings--they only know 'C' strings...
'----------------------------------------------------------------------------
nRecCount% = BRW001F.vsrBrowser.Max
nItemsPerBlock% = ngLBXBrowserDispItems * 3
If (nRecCount% >= nItemsPerBlock%) Then
'-------------------------------------------------------------------------
' NOTE-> plenty of ROWS...so get the last nItemsPerBlock% ROWS...
' but not now....
'-------------------------------------------------------------------------
Else
'-------------------------------------------------------------------------
' NOTE-> NOT so many ROWS...so get ALL of the rows...
' this is the same thing we do when we first begin browsing...
'-------------------------------------------------------------------------
nFirstRow% = 1
nNumOfRows% = nRecCount%
nRetIdxTypeFlag% = BRW_RETURN_FIRST_LISTINDEX
nRetVal% = fntLoadBrowserLB%(nFirstRow%, nNumOfRows%, nRetIdxTypeFlag%, nValue%)
nFunctRetVal% = nRetVal%
fntLoadLastBlock% = nFunctRetVal%
Exit Function
End If
'----------------------------------------------------------------------------
' NOTE-> we are loading the listbox in +REVERSE+ order...
'----------------------------------------------------------------------------
' NOTE-> since we are probably near the LAST record, use a MoveNext LOOP to
' get to the LAST record...it is faster...
'----------------------------------------------------------------------------
nRecCount% = BRW001F.vsrBrowser.Max
nJetRowsUntilLast% = nRecCount% - ngJETRowNumber
nStart% = ngJETRowNumber + 1
nEnd% = nJetRowsUntilLast% + nStart%
nOnLastRowExitForEarly% = False
For nRow% = nStart% To nEnd%
'-------------------------------------------------------------------------
' NOTE-> are we already on the LAST record...if so then do NOT do a
' MoveNext because it will make our current position UNDEFINED...
' in which case we have to read the +entire+ dynaset to get back
' to the LAST record...
'-------------------------------------------------------------------------
nVSRMax% = BRW001F.vsrBrowser.Max
If (ngJETRowNumber = nVSRMax%) Then
If (nRow% <= nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
nEOF% = BRW001F.datJET.Recordset.EOF
If (nEOF%) Then
'----------------------------------------------------------------------
' NOTE-> just in case we made a mistake...
'----------------------------------------------------------------------
BRW001F.datJET.Recordset.MoveLast
ngJETRowNumber = ngJETRowNumber - 1
If (nRow% <= nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
Next nRow%
'----------------------------------------------------------------------------
' NOTE-> if all went well then we are sitting on the LAST row of the dynaset...
'----------------------------------------------------------------------------
nRecCount% = BRW001F.vsrBrowser.Max
nItemsPerBlock% = ngLBXBrowserDispItems * 3
nStart% = nRecCount%
nEnd% = (nStart% - nItemsPerBlock%) + 1
ngLBXBrowserNumOfRows = 0
nOnLastRowExitForEarly% = False
For nRow% = nStart% To nEnd% Step by - 1
szLBStr$ = Space$(1)
For nIdx% = 0 To nListCols%
szTxt$ = BRW001F.txtData(nIdx%).Text
lTxtLen& = Len(szTxt$)
szType$ = BRW001F.clbTypes.List(nIdx%)
nBeginParen% = InStr(1, szType$, "(")
nStart% = nBeginParen% + 1
nEndParen% = InStr(nStart%, szType$, ")")
nLen% = nEndParen% - nStart%
szLen$ = Mid$(szType$, nStart%, nLen%)
lMaxTxtLen& = Val(szLen$)
lDeltaLen& = lMaxTxtLen& - lTxtLen&
szLBStr$ = szLBStr$ + szTxt$ + Space$(2)
If (lDeltaLen& > 0) Then
szLBStr$ = szLBStr$ + Space$(lDeltaLen&)
End If
Next nIdx%
szLBStr$ = szLBStr$ + Chr$(0)
'-------------------------------------------------------------------------
' NOTE-> since we are going BACKWARDS...we need to add each item to
' lbxBrowser at INDEX = 0 location...
'-------------------------------------------------------------------------
BRW001F.lbxBrowser.AddItem szLBStr$, 0
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows + 1
BRW001F.datJET.Recordset.MovePrevious
ngJETRowNumber = ngJETRowNumber - 1
nBOF% = BRW001F.datJET.Recordset.BOF
If (nBOF%) Then
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = 1
'----------------------------------------------------------------------
' NOTE-> remember...we are going BACKWARDS...so FOR LOOP indexes are
' also going BACKWARDS...
'----------------------------------------------------------------------
If (nRow% > nEnd%) Then
nOnLastRowExitForEarly% = True
End If
Exit For
End If
Next nRow%
'----------------------------------------------------------------------------
' NOTE-> we did this in REVERSE...so the global first row is set to nEnd%
' since nEnd% < nStart% in the above FOR LOOP...
' UNLESS we had to exit early...in which case it is set to nRow%...
'----------------------------------------------------------------------------
If (nOnLastRowExitForEarly% = True) Then
ngLBXBrowserFirstRow = nRow%
Else
ngLBXBrowserFirstRow = nEnd%
End If
ngLBXBrowserLastRow = ngLBXBrowserFirstRow + (ngLBXBrowserNumOfRows - 1)
nVSRMax% = BRW001F.vsrBrowser.Max
If (ngJETRowNumber < nVSRMax%) Then
'-------------------------------------------------------------------------
' NOTE-> we are are at the near the END of the dynaset...
' and our logic for traversing it at this point is
' based upon the way things are after we get here as a
' result of single-stepping through the dynaset...
' in which case we would have gotten to the END via
' the 'ADD an ITEM/REMOVE an ITEM' method...and datJET
' would therefore be sitting on the LAST ROW in the
' dynaset...so...in order to do what we can to make this
' appear to be the NORMAL case...we will now proceed
' to POSITION datJET at the END of the SUBSET of ROWS...
' rather an UNUSUAL thing to do...but it WORKS...
'-------------------------------------------------------------------------
nStart% = 1
nJETCurrPosToLastRow% = ngLBXBrowserDispItems * 3
nVSRMax% = BRW001F.vsrBrowser.Max
If (nJETCurrPosToLastRow% > nVSRMax%) Then
nJETCurrPosToLastRow% = nVSRMax%
End If
nEnd% = nJETCurrPosToLastRow%
For nSteps% = nStart% To nEnd%
BRW001F.datJET.Recordset.MoveNext
ngJETRowNumber = ngJETRowNumber + 1
Next nSteps%
End If
'----------------------------------------------------------------------------
' NOTE-> position the listbox index and scrollbar...
'----------------------------------------------------------------------------
nVSRMax% = BRW001F.vsrBrowser.Max
nOffset% = nVSRMax% - nValue%
nCount% = BRW001F.lbxBrowser.ListCount
If (nCount% < 1) Then
'-------------------------------------------------------------------------
' NOTE- UNLIKELY error...
'-------------------------------------------------------------------------
End If
nListCount% = nCount% - 1
nNewIdx% = nListCount% - nOffset%
ngCurrListIdx = nNewIdx%
BRW001F.lbxBrowser.ListIndex = nNewIdx%
ngLBXBrowserValue = nValue%
nFunctRetVal% = True
fntLoadLastBlock% = nFunctRetVal%
Exit Function
fntLoadLastBlockErr:
Resume Next
fntLoadLastBlockExit:
fntLoadLastBlock% = False
End Function
Function fntLoadTxtDataInstances% (nCols%)
Dim nIdx%
Dim nListCols%
On Error GoTo fntLoadTxtDataInstancesErr
nListCols% = nCols% - 1
nIdx% = 0
BRW001F.txtData(nIdx%).DataField = BRW001F.clbCols.List(nIdx%)
For nIdx% = 1 To nListCols%
If (ngBRWFormTxtInstances < nIdx%) Then
Load BRW001F.txtData(nIdx%)
ngBRWFormTxtInstances = ngBRWFormTxtInstances + 1
End If
BRW001F.txtData(nIdx%).DataField = BRW001F.clbCols.List(nIdx%)
Next nIdx%
'----------------------------------------------------------------------------
' NOTE-> for some UNKNOWN reason...it is NOT EASY (perhaps NOT POSSIBLE) to
' to UNLOAD BOUND TEXT controls when they are no longer needed...
' this BIZARRE BEHAVIOR appears to be connected with using a DROPDOWN
' listbox for TABLE selection...
' the WORKAROUND is not to unload unnecessary BOUND CONTROLS...
' nevertheless...we can AT LEAST set the DataField property of these
' unnecessary BOUND CONTROLS to BLANK...this is a PERFECT EXAMPLE of
' Visual Basic's QUANTUM EVENT BEHAVIOR...at least in the sense that
' these EXTRA DYNAMICALLY-CREATED, BOUND CONTROLS do not need to EXIST
' insofar as WE are concerned, but Visual Basic NEEDS them and will
' NOT let us DESTROY them at this particular POINT in the
' QUANTUM EVENT CHAIN...so ALL we can do is make the controls INACTIVE...
'----------------------------------------------------------------------------
nExtraCtls% = ngBRWFormTxtInstances - nListCols%
If (nExtraCtls% > 0) Then
For nIdx% = nCols% To ngBRWFormTxtInstances
BRW001F.txtData(nIdx%).DataField = ""
Next nIdx%
End If
fntLoadTxtDataInstances% = True
Exit Function
fntLoadTxtDataInstancesErr:
'-------------------------------------------------------------------------
' WARNING-> we would NOT USUALLY do RESUME NEXT when we get an ERROR...
' but in this PARTICULAR function we EXPECT to get an ERROR
' because we are setting the DataField PROPERTY of BOUND
' controls to a FIELD that is PROBABLY NOT in the CURRENTLY
' SELECTED TABLE...consequently WHEN VB3 tells us IT detected
' an ERROR, our response is "SO WHAT! JUST DO WHAT WE TELL
' YOU TO DO AND QUIT COMPLAINING!"...
'-------------------------------------------------------------------------
Resume Next
End Function
Function fntRemSomeBrowserRows% (nDelta%, nNewIdx%, nJETLastRow%)
Dim nEnd%
Dim nFunctRetVal%
Dim nIdx%
Dim nStart%
'----------------------------------------------------------------------------
' NOTE-> this function removes some number of items from the +top+ of the
' lbxBrowser listbox, and adjusts the global tracking variables
' accordingly...
'----------------------------------------------------------------------------
' NOTE-> nDelta% => number of items to remove from TOP of listbox...
' nNewIdx% => current nNewIdx% value...
' nJETLastRow% => ROW number of LAST LOADED ROW...
'----------------------------------------------------------------------------
' RETURNS-> if (SUCCESSFUL) -> the new value for nNewIdx%
' if (UNSUCCESSFUL) -> BRW_ERROR
'----------------------------------------------------------------------------
nStart% = 0
nEnd% = nDelta% - 1
For nIdx% = nStart% To nEnd%
BRW001F.lbxBrowser.RemoveItem 0
ngLBXBrowserFirstRow = ngLBXBrowserFirstRow + 1
ngLBXBrowserNumOfRows = ngLBXBrowserNumOfRows - 1
nNewIdx% = nNewIdx% - 1
Next nIdx%
If (nNewIdx% < 0) Then
nFunctRetVal% = BRW_ERROR
Else
nFunctRetVal% = nNewIdx%
End If
fntRemSomeBrowserRows% = nFunctRetVal%
End Function
Function fntUnloadTxtDataInstances% ()
Dim nIdx%
Dim nTotalInstances%
On Error GoTo fntUnloadTxtDataInstancesErr
nTotalInstances% = ngBRWFormTxtInstances
nIdx% = 0
BRW001F.txtData(nIdx%).DataField = ""
For nIdx% = nTotalInstances% To 1 Step by - 1
BRW001F.txtData(nIdx%).DataField = ""
Unload BRW001F.txtData(nIdx%)
ngBRWFormTxtInstances = ngBRWFormTxtInstances - 1
Next nIdx%
fntUnloadTxtDataInstances% = True
Exit Function
fntUnloadTxtDataInstancesErr:
szMsg$ = "ERROR-> " + Error$
MsgBox szMsg$
ngIgnoreTblsClick = False
Exit Function
fntUnloadTxtDataInstancesExit:
fntUnloadTxtDataInstances% = False
End Function