frmquery_a.frm

本系统可用于医院和专业体检中心的健康体检管理

         Strikethrough   =   0   'False
      EndProperty
      Height          =   945
      Left            =   6210
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   4095
      Visible         =   0   'False
      Width           =   2415
   End
   Begin VB.TextBox txtLongText 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   945
      Left            =   4650
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   6030
      Visible         =   0   'False
      Width           =   7380
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   30
      Left            =   5280
      TabIndex        =   1
      Top             =   3795
      Width           =   30
      _ExtentX        =   53
      _ExtentY        =   53
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   7950
      Top             =   2490
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin ResizeLibCtl.ReSize ReSize1 
      Left            =   7110
      Top             =   2970
      _Version        =   131072
      _ExtentX        =   741
      _ExtentY        =   741
      _StockProps     =   0
      Enabled         =   -1  'True
      FormMinWidth    =   0
      FormMinHeight   =   0
      FormDesignHeight=   9675
      FormDesignWidth =   14025
   End
   Begin MSComctlLib.ListView lvwSJRY 
      Height          =   7245
      Left            =   3990
      TabIndex        =   32
      Top             =   2280
      Width           =   9915
      _ExtentX        =   17489
      _ExtentY        =   12779
      View            =   3
      LabelEdit       =   1
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   12648384
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   7
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "系统档案号"
         Object.Width           =   3246
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "自定义档案号"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "体检序号"
         Object.Width           =   1835
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "姓名"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "性别"
         Object.Width           =   1481
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   5
         Text            =   "身份证号"
         Object.Width           =   3598
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   6
         Text            =   "体检日期"
         Object.Width           =   4304
      EndProperty
   End
End
Attribute VB_Name = "frmQuery_A"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrSQL As String
Dim mintlvPXFC As Integer       '标识lvwSJRY的排序方式,0为升序,1为降序


Private Sub chkAge_Click()
    If chkAge.Value = 1 Then
        txtAge(0).Enabled = True
        txtAge(1).Enabled = True
        txtAge(0).SetFocus
    Else
        txtAge(0).Enabled = False
        txtAge(1).Enabled = False
    End If
End Sub

Private Sub chkDate_Click()
    If chkDate.Value = 1 Then
        dtpDate(0).Enabled = True
        dtpDate(1).Enabled = True
        dtpDate(0).SetFocus
    Else
        dtpDate(0).Enabled = False
        dtpDate(1).Enabled = False
    End If
End Sub

Private Sub chkDWei_Click()
    If chkDWei.Value = 1 Then
        cmbDWei.Enabled = True
        cmbDWei.SetFocus
    Else
        cmbDWei.Enabled = False
    End If
End Sub

Private Sub chkHealthID_Click()
    If chkHealthID.Value = 1 Then
        txtHealthID.Enabled = True
        txtHealthID.SetFocus
    Else
        txtHealthID.Enabled = False
    End If
End Sub

Private Sub chkName_Click()
    If chkName.Value = 1 Then
        txtName.Enabled = True
        txtName.SetFocus
    Else
        txtName.Enabled = False
    End If
End Sub

Private Sub chkSex_Click()
    If chkSex.Value = 1 Then
        cmbSex.Enabled = True
        cmbSex.SetFocus
    Else
        cmbSex.Enabled = False
    End If
End Sub

Private Sub ChkSFZH_Click()
    If ChkSFZH.Value = 1 Then
        TxtSFZH.Enabled = True
        TxtSFZH.SetFocus
    Else
        TxtSFZH.Enabled = False
    End If
End Sub

Private Sub cmbBBZH_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rsReport As ADODB.Recordset
    Dim i As Integer
    
    Me.MousePointer = vbHourglass
    lstReport.Clear
    
    '获取当前组合包含的报表
    strSQL = "select BBID,BBMC from REPORT_MC" _
            & " where BBID in (" _
            & "select BBID from REPORT_ZHDT" _
            & " where ZHID='" _
            & LongToString(cmbBBZH.ItemData(cmbBBZH.ListIndex), 5) & "')"
    Set rsReport = New ADODB.Recordset
    rsReport.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not rsReport.EOF Then
        rsReport.MoveFirst
        Do
            lstReport.AddItem rsReport("BBMC")
            lstReport.ItemData(lstReport.NewIndex) = rsReport("BBID")
            lstReport.Selected(lstReport.NewIndex) = True
            
            rsReport.MoveNext
        Loop Until rsReport.EOF
        rsReport.Close
    End If
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub cmbDWei_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        CmdQuery_Click
    End If
End Sub

Private Sub cmbSex_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        CmdQuery_Click
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdPreviewUniversal_Click()
    Dim strReports As String
    Dim blnHave As Boolean
    Dim i As Integer
    
    '是否有客户
    If Me.lvwSJRY.ListItems.Count < 1 Then
        MsgBox "当前没有要打印资料的客户！请在左侧设置查询条件，然后单击“查询”列出要打印资料的客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    '是否有选择客户
    If Me.lvwSJRY.SelectedItem Is Nothing Then
        MsgBox "当前没有选择要打印资料的客户！请在下方的列表中选择要打印资料的客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    '截掉最后的逗号
    strReports = "通用报表"
    frmPPreview.ShowPreview mstrSQL, strReports, UNIVERSALREPORT
End Sub

Public Sub PrintReport()
On Error GoTo Print_Cancel
    Dim Status
    Dim Msg As String
    Dim PrintNummber As Integer
    Dim i As Integer, j As Integer
    Dim lngGUID As Long '每个客户的唯一编号，便于批量打印
    Dim strHealthID As String
    Dim strBBID As String
    
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '                                  是否已经注册
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    If gblnRegister = False Then
        MsgBox "您使用的是未注册版本，不能使用该功能，请通过“系统设置”->“系统注册”进行注册！", vbInformation, "提示"
        Exit Sub
    End If
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    
    CommonDialog1.CancelError = True
    CommonDialog1.Flags = cdlPDCollate Or cdlPDNoSelection     ' cdlPDUseDevModeCopies
     'CommonDialog1.Flags = cdlPDPageNums
    CommonDialog1.Min = 1
    CommonDialog1.Max = 1
    CommonDialog1.FromPage = 1
    CommonDialog1.ToPage = 1
    
    CommonDialog1.ShowPrinter
On Error Resume Next
    Printer.Copies = CommonDialog1.Copies
    If Printer.Copies < 1 Then Printer.Copies = 1
    '纵向走纸
    Printer.Orientation = cdlPortrait
On Error GoTo Print_Cancel

    '设成A4纸
'    Printer.ScaleWidth = 210
'    Printer.ScaleHeight = 297
    
    '调用打印程序
    Me.MousePointer = vbHourglass
    '循环每一个人
    For i = 1 To lvwSJRY.ListItems.Count
        If lvwSJRY.ListItems(i).Selected = True Then
            lngGUID = Val(Mid(lvwSJRY.ListItems(i).Key, 2))
            '循环每张报表
            For j = 0 To lstReport.ListCount - 1
                '只打印用户选择的报表
                If lstReport.Selected(j) = True Then
                    strBBID = LongToString(lstReport.ItemData(j), 5)
                    PrintCustomDatabase lngGUID, strBBID, picTemp, txtTemp, Me, Printer
                    If j < lstReport.ListCount - 1 Then
                        Printer.NewPage
                    End If