frmwatermeterinput_pqselect.frm

自来水公司的一个管理系统

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form frmWaterMeterInput_PQSelect 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用水户区域选择"
   ClientHeight    =   1830
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4860
   Icon            =   "frmWaterMeterInput_PQSelect.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   MouseIcon       =   "frmWaterMeterInput_PQSelect.frx":0442
   ScaleHeight     =   1830
   ScaleWidth      =   4860
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   390
      Left            =   180
      TabIndex        =   5
      Top             =   1260
      Width           =   1065
   End
   Begin VB.Frame Frame1 
      Caption         =   "区域"
      ForeColor       =   &H00800000&
      Height          =   1005
      Left            =   150
      TabIndex        =   0
      Top             =   120
      Width           =   4500
      Begin VB.CheckBox chkQ 
         Caption         =   "小区："
         Enabled         =   0   'False
         Height          =   225
         Left            =   210
         TabIndex        =   4
         Top             =   645
         Width           =   870
      End
      Begin VB.CheckBox chkP 
         Caption         =   "片区："
         Height          =   225
         Left            =   210
         TabIndex        =   3
         Top             =   270
         Width           =   870
      End
      Begin MSDataListLib.DataCombo cboP 
         Height          =   330
         Left            =   1095
         TabIndex        =   1
         Top             =   195
         Width           =   2235
         _ExtentX        =   3942
         _ExtentY        =   582
         _Version        =   393216
         Enabled         =   0   'False
         Style           =   2
         Text            =   "DataCombo1"
      End
      Begin MSDataListLib.DataCombo cboQ 
         Height          =   330
         Left            =   1095
         TabIndex        =   2
         Top             =   570
         Width           =   2235
         _ExtentX        =   3942
         _ExtentY        =   582
         _Version        =   393216
         Enabled         =   0   'False
         Style           =   2
         Text            =   "DataCombo1"
      End
   End
End
Attribute VB_Name = "frmWaterMeterInput_PQSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public strReturnPID As String
Public strReturnQID As String
Public strReturnPName As String
Public strReturnQName As String

Dim adoPRS As ADODB.Recordset
Dim adoQRS As ADODB.Recordset


Private Sub cboP_LostFocus()
    If Me.chkQ.value = 1 Then
        Call FillQ(Me.cboP.BoundText)
    End If
End Sub

Private Sub chkP_Click()
    If Me.chkP.value = 0 Then
        Me.chkQ.value = 0
        Call ClearP
        Me.cboP.Enabled = False
    Else
        Me.chkQ.Enabled = True
        Me.cboP.Enabled = True
        Call FillP
        Me.cboP.SetFocus
    End If
End Sub

Private Sub chkQ_Click()
    If Me.chkQ.value = 0 Then
        Call ClearQ
        Me.cboQ.Enabled = False
    Else
        Me.cboQ.Enabled = True
        Call FillQ(Me.cboP.BoundText)
        Me.cboQ.SetFocus
    End If
End Sub

Private Sub cmdOK_Click()
    If Me.chkP.value = 1 And Trim(Me.cboP.Text) <> "" Then
        strReturnPID = Me.cboP.BoundText
        strReturnPName = Trim(Me.cboP.Text)
    End If
    If Me.chkQ.value = 1 And Trim(Me.cboQ.Text) <> "" Then
        strReturnQID = Me.cboQ.BoundText
        strReturnQName = Trim(Me.cboQ.Text)
    End If
    Unload Me
End Sub

Private Sub Form_Load()
    '初始化记录集
    On Error GoTo errHandleOpen
    Set adoPRS = New ADODB.Recordset
    Set adoPRS.ActiveConnection = gConnect
    adoPRS.CursorLocation = adUseClient
    adoPRS.CursorType = adOpenForwardOnly
    adoPRS.LockType = adLockOptimistic
    adoPRS.Open "select PID,PName from Pian"
    
    Set adoQRS = New ADODB.Recordset
    Set adoQRS.ActiveConnection = gConnect
    adoQRS.CursorLocation = adUseClient
    adoQRS.CursorType = adOpenForwardOnly
    adoQRS.LockType = adLockOptimistic
    On Error GoTo 0
    
    '初始化返回值
    strReturnPID = ""
    strReturnQID = ""
    strReturnPName = ""
    strReturnQName = ""
    
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集初始化失败！" & Chr(13) & Err.Description
    On Error GoTo 0
End Sub

Private Sub FillP()
    Set Me.cboP.RowSource = adoPRS
    Me.cboP.ListField = "PName"
    Me.cboP.BoundColumn = "PID"
    Me.cboP.Text = ""
End Sub

Private Sub ClearP()
    Set Me.cboP.RowSource = Nothing
    Me.cboP.Text = ""
End Sub

Private Sub FillQ(ByVal strPID As String)
    On Error Resume Next
    adoQRS.Close
    On Error GoTo 0
    On Error GoTo errHandleOpen
    adoQRS.Open "select QID,QName from Qu where PID='" & Trim(strPID) & "'"
    On Error GoTo 0
    
    Set Me.cboQ.RowSource = adoQRS
    Me.cboQ.ListField = "QName"
    Me.cboQ.BoundColumn = "QID"
    Me.cboQ.Text = ""
    Exit Sub
    
    '-------错误处理---------
errHandleOpen:
    Warning "记录集打开失败！" & Chr(13) & Err.Description
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub ClearQ()
    Set Me.cboQ.RowSource = Nothing
    Me.cboQ.Text = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    adoPRS.Close
    adoQRS.Close
    Set adoPRS = Nothing
    Set adoQRS = Nothing
    On Error GoTo 0
End Sub