ht205sr.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form FSearchResults 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Search Results"
   ClientHeight    =   2520
   ClientLeft      =   2310
   ClientTop       =   3270
   ClientWidth     =   7200
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2520
   ScaleWidth      =   7200
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   465
      Index           =   1
      Left            =   5940
      TabIndex        =   2
      Top             =   720
      Width           =   1005
   End
   Begin VB.CommandButton cmd 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   465
      Index           =   0
      Left            =   5940
      TabIndex        =   1
      Top             =   90
      Width           =   1005
   End
   Begin ComctlLib.ListView lvwResults 
      Height          =   2355
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   5595
      _ExtentX        =   9869
      _ExtentY        =   4154
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   327680
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      MouseIcon       =   "HT205SR.frx":0000
      NumItems        =   0
   End
End
Attribute VB_Name = "FSearchResults"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' This form will run an ad-hoc query and
' display the results in the list view control

' command button array constants
Const cmdOK = 0
Const cmdCancel = 1

' cancel property
Private mblnCancelled As Boolean
' selected key value
Private mvntKeyValue As Variant
' subitem index for key value
Private mintItemIdx As Integer

Private Sub cmd_Click(Index As Integer)

    If Index = cmdOK Then
        mblnCancelled = False
    Else
        mblnCancelled = True
    End If
    
    Me.Hide

End Sub

Private Sub lvwResults_ItemClick(ByVal Item As ComctlLib.ListItem)
On Error GoTo ProcError

    mvntKeyValue = Item.SubItems(mintItemIdx)
    
ProcExit:
    Exit Sub
    
ProcError:
    MsgBox Err.Description, vbExclamation
    Resume ProcExit

End Sub

Public Property Get Cancelled()

    Cancelled = mblnCancelled

End Property

Public Property Get KeyValue() As Variant

    KeyValue = mvntKeyValue
    
End Property

Public Sub Search( _
    strKeyField As String, _
    strSQLStatement As String, _
    frmParent As Form)
' run the specified query and populate the
' listview with the results

    Dim strDBName As String
    Dim lngOrdRecPos As Long
    Dim db As Database
    Dim rs As Recordset
    Dim fld As Field
    
    strDBName = BiblioPath()
    Set db = DBEngine(0).OpenDatabase(strDBName)
    Set rs = db.OpenRecordset(strSQLStatement, _
        dbOpenDynaset, dbReadOnly)
    
    ' test for no records
    If Not rs.EOF Then
        ' create the ordinal position column
        lvwResults.ColumnHeaders.Add , "Ordinal", "Record"
        ' set width
        lvwResults.ColumnHeaders("Ordinal").Width = 600
        ' create the columns in the listview
        For Each fld In rs.Fields
            lvwResults.ColumnHeaders.Add , fld.Name, fld.Name
            ' best guess column width
            lvwResults.ColumnHeaders(fld.Name).Width _
                = 150 * Len(fld.Name)
            If fld.Name = strKeyField Then
                ' mark the item index for later retrieval
                mintItemIdx = fld.OrdinalPosition + 1
            End If
        Next    ' field
        ' populate the list
        Do
            ' increment the ordinal position counter
            lngOrdRecPos = lngOrdRecPos + 1
            ' add the item
            lvwResults.ListItems.Add _
                lngOrdRecPos, , CStr(lngOrdRecPos)
            ' add the fields to the rest of the columns
            For Each fld In rs.Fields
                lvwResults.ListItems(lngOrdRecPos). _
                SubItems(fld.OrdinalPosition + 1) = _
                fld.Value & ""
            Next    ' field
            ' go to next record
            rs.MoveNext
        Loop While Not rs.EOF
        ' clean up
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing

        ' show modally
        Me.Show vbModal, frmParent
    Else
        ' no data, treat as a cancel
        mblnCancelled = True
        MsgBox "No matching records found.", vbInformation
        Me.Hide
    End If

End Sub