frminquire.frm

常驻人口户籍管理系统DELPHI开的的,还不错.学习用

VERSION 5.00
Begin VB.Form frminquire 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "查询"
   ClientHeight    =   1140
   ClientLeft      =   540
   ClientTop       =   5835
   ClientWidth     =   4860
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1140
   ScaleWidth      =   4860
   Begin VB.ListBox List1 
      Height          =   780
      Left            =   120
      TabIndex        =   6
      Top             =   1200
      Width           =   855
   End
   Begin VB.CommandButton Command3 
      Caption         =   "查找"
      Height          =   255
      Left            =   3960
      TabIndex        =   1
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton Command2 
      Caption         =   "下一个(&N)"
      Height          =   375
      Left            =   1200
      TabIndex        =   4
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "上一个(&L)"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   720
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1200
      TabIndex        =   0
      Top             =   240
      Width           =   2655
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   2280
      TabIndex        =   7
      Top             =   840
      Width           =   975
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Height          =   375
      Left            =   3480
      TabIndex        =   5
      Top             =   720
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "查询"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   855
   End
End
Attribute VB_Name = "frminquire"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim seekstr As String
Dim pos As Long
Private Sub Command1_Click()
Dim i As Long
If List1.ListCount = 0 Then Exit Sub
pos = (pos - 1 + List1.ListCount) Mod List1.ListCount
Mrec.MoveFirst
For i = 1 To List1.List(pos)
    Mrec.MoveNext
Next
Label3.Caption = CStr(pos + 1) + "/" + CStr(List1.ListCount)
frmMain.ShowA
End Sub

Private Sub Command2_Click()
    Dim i As Long
    If List1.ListCount = 0 Then Exit Sub
    pos = (pos + 1) Mod List1.ListCount
    Mrec.MoveFirst
    For i = 1 To List1.List(pos)
        Mrec.MoveNext
    Next
    Label3.Caption = CStr(pos + 1) + "/" + CStr(List1.ListCount)
    frmMain.ShowA
End Sub

Private Sub Command3_Click()
'trim???

seekstr = Trim(Text1.Text)

Dim tstr As String
If seekstr = "" Then Exit Sub
List1.Clear
Mrec.MoveFirst
'i为行指针，j为列指针
Dim i As Long, j As Long
    For i = 0 To Mrec.RecordCount - 1 'EOF的上一个记录
        For j = 1 To Mrec.Fields.Count - 1
            If IsNull(Mrec.Fields(j)) Then '如果字段为空，置一个空字符
            
            Else
                '去掉无效字符
                tstr = Trim(Mrec.Fields(j) + "")
                If StrInStr(tstr) Then
          '?????
                    List1.AddItem i
                    j = Mrec.Fields.Count
                End If
            End If
        Next
        Mrec.MoveNext
    Next
    
'输出结果，主窗体显示第1条记录
Mrec.MoveFirst

If List1.ListCount = 0 Then
    Label2.Caption = "没有结果，或者输入错误。"
    Label3.Caption = ""
Else
    'Cstr（）强制变换为字符
    Label2.Caption = "找到" + CStr(List1.ListCount) + "个记录"
    Label3.Caption = "1/" + CStr(List1.ListCount)
    pos = 0
    For i = 1 To List1.List(pos)
        Mrec.MoveNext
    Next
    '主窗体显示
    frmMain.ShowA
End If
End Sub

Private Function StrInStr(Str As String) As Boolean
    If InStr(1, Str, seekstr, 1) = 0 Then StrInStr = False Else StrInStr = True
End Function