Forum społeczności użytkowników OpenOffice i LibreOffice

Kod: Zaznacz cały

REM-------------------------------------------------------------------------------------------------------------------------------------
Function FindRecord(Criteria As String,Optional MatchPosition As Integer,Optional Optional MatchCase As Boolean,Optional ColumnPosition As Integer,_
                    Optional StartingRecord As Integer,Optional SearchDirection As Integer,Optional FormName As String) As Boolean
On Error Goto HandleError
    Dim Form As Object
    Dim RecordIndex As Long
    Dim rstClone As Object
    Dim SearchCriteria As String
    Dim strTmp As String
    Dim bFound As Boolean
    Dim ColValue As String
    Dim ColStart As Integer
    Dim ColEnd As Integer
    Dim I As Integer
    Dim CritLen As Integer
    
    FindRecord=False
    If IsMissing(FormName) Or FormName="" Then
        Form=MeModel
        RecordSearchFormName="this." & Form.Name
    Else
        Form=Forms.getForm(FormName)
        RecordSearchFormName=FormName
    End If
    If IsNull(Form) Then Exit Function
    rstClone=Form.createResultSet()
    If IsMissing(MatchPosition) Then MatchPosition=bcMatchAnyWhere
    If IsMissing(MatchCase) Then MatchCase=False
    If IsMissing(StartingRecord) Then StartingRecord=bcFirstRecord
    If IsMissing(SearchDirection) Then SearchDirection=bcForward
    If IsMissing(ColumnPosition) Then  ColumnPosition=bcAllFields 'search all columns
    Select Case ColumnPosition
        Case bcAllFields
            ColStart=1
            ColEnd=rstClone.MetaData.getColumnCount()
        Case Else 'search only specified column
            If ColumnPosition<>bcAllFields And (ColumnPosition <1 Or ColumnPosition>rstClone.MetaData.getColumnCount()) Then Exit Function
            ColStart=ColumnPosition 
            ColEnd=ColumnPosition
    End select
    SearchCriteria=Criteria
    REM set where in column to search
    If MatchCase=True then SearchCriteria=UCase(SearchCriteria)
    CritLen=Len(SearchCriteria)
    REM set record to start search
    Select Case StartingRecord
        Case bcFirstRecord: rstClone.first()
        Case bcLastRecord: rstClone.last()
        Case bcCurrentRecord: rstClone.absolute(Form.Row)
        Case Else
            If StartingRecord>0 And StartingRecord<=Form.RowCount Then
                rstClone.absolute(StartingRecord)
            Else    
                Exit Function 'invalid staring record number
            End If
    End Select
    Do
        For I= ColStart To ColEnd
            ColValue=rstClone.getString(I) 'use get string for now. use getXXX(...) later
            If MatchCase Then ColValue=UCase(ColValue)
            Select Case MatchPosition
                Case bcMatchStart
                    strTmp=Left(ColValue,CritLen)
                    bFound=SearchCriteria=strTmp
                Case bcMatchEnd
                    strTmp=Right(ColValue,CritLen)
                    bFound=SearchCriteria=strTmp
                Case bcMatchAnyWhere
                    bFound=InStr(ColValue,SearchCriteria)>0
                Case bcMatchAll: bFound=(SearchCriteria=ColValue)
            End Select
            If bFound=True Then Goto EndOfSearch
        Next I
        Select Case SearchDirection
            Case bcForward:
                If Not rstClone.next() Or rstClone.isAfterLast() Then Exit Function
            Case bcBackward:
                If Not rstClone.previous() Or rstClone.isBeforeFirst() Then Exit Function
        End Select
    Loop While bFound=False
EndOfSearch:
    If bFound Then
        Form.absolute(rstClone.Row)
        FindRecord=True
        REM set vars for FindNextRecord
        RecordSearchCriteria =SearchCriteria
        RecordSearchDirection =SearchDirection
        RecordSearchStartingRecord=bcCurrentRecord
        RecordSearchMatchPosition =MatchPosition
        RecordSearchColumn=ColumnPosition
        RecordSearchMatchCase=MatchCase
    End If
HandleError:
    If err<>0 Then Exit Function
End Function