frmcwhz.frm

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

    strSQL = "select DXMC,DXJG,KSMC from SET_DX,YY_SJDJDX,SET_KSSZ" _
            & " where YY_SJDJDX.GUID=" & lngGUID _
            & " and YY_SJDJDX.DXID=SET_DX.DXID" _
            & " and left(SET_DX.DXID,2)=SET_KSSZ.KSID" _
            & " order by SET_KSSZ.SXH,SET_DX.SXH"
    Set rsHZ = New ADODB.Recordset
    rsHZ.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not (rsHZ.EOF) Then
        rsHZ.MoveFirst
        Do
            Set itmHZ = lvwFYQD.ListItems.Add(, , rsHZ("KSMC"))
            itmHZ.SubItems(1) = rsHZ("DXMC")
            itmHZ.SubItems(2) = rsHZ("DXJG") & ""
            '累加项目价格
            If Not IsNull("DXJG") Then
                curTotal_XMJG = curTotal_XMJG + rsHZ("DXJG")
            End If
            
            rsHZ.MoveNext
        Loop Until rsHZ.EOF
        rsHZ.Close
        
        '加上一行项目合计
        Set itmHZ = lvwFYQD.ListItems.Add(, , "项目合计")
        itmHZ.SubItems(2) = CStr(curTotal_XMJG)
        
        '加上一行成交价格
        Set itmHZ = lvwFYQD.ListItems.Add(, , "成交价格")
        itmHZ.SubItems(2) = lvwSJRY.SelectedItem.SubItems(7)
    End If
    Set rsHZ = Nothing
    
    mstrFYQD = strSQL
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set FrmCwhz = Nothing
End Sub

Private Sub lvwSJRY_DblClick()
'    If cmdPrint.Enabled = False Then Exit Sub
'
'    If Me.lvwSJRY.SelectedItem Is Nothing Then
''        MsgBox "请在右边的网格中选择一个客户！", vbInformation, "提示"
'        Exit Sub
'    End If
'
'    frmTJResult.ShowPersonInfo Val(Mid(Me.lvwSJRY.SelectedItem.Key, 2)), Me.lvwSJRY.SelectedItem.SubItems(1)
    Dim item As ListItem
    Set item = lvwSJRY.SelectedItem
    If Not (item Is Nothing) Then
        If item.Text <> "合计:" And item.Text <> "" Then
         FrmFYHZ.ShowFYMX (DateValue(item.Text))
         End If
    End If
   
End Sub

Private Sub lvwSJRY_KeyUp(KeyCode As Integer, Shift As Integer)
    If (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) Then
        lvwSJRYClick
    End If
End Sub
    
Private Sub lvwSJRY_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'    lvwSJRYClick
'
'    If lvwSJRY.ListItems.Count > 0 Then
'
'        If Button = vbRightButton Then
'            If Len(lvwSJRY.SelectedItem.Key) > 1 Then
'                PopupMenu fMainForm.mnuPrint_
'            End If
'        Else
'            If Len(lvwSJRY.SelectedItem.Key) > 1 Then
'                cmdPrint.Enabled = True
'            Else
'                cmdPrint.Enabled = False
'            End If
'        End If
'    End If
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
    
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '                                  是否已经注册
'    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    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纸
    Err.Clear
    Printer.ScaleMode = vbMillimeters
    Printer.ScaleWidth = 210
    Printer.ScaleHeight = 297
    Call PrintHz
    
    '调用打印程序
    '打印选中的每一条记录
'    For i = 1 To lvwSJRY.ListItems.Count
'        '总计行不能打印
'        If (lvwSJRY.ListItems(i).Selected = True) And (Len(lvwSJRY.ListItems(i).Key) > 1) Then
'
'           'Call PrintFYQD(Val(Mid(lvwSJRY.ListItems(i).Key, 2)))
'        End If
'    Next
'    If MsgBox("已经就绪,立即打印吗?", vbYesNo + vbQuestion + vbDefaultButton1, "打印提示") = vbYes Then
'       Printer.EndDoc
'    Else
'       Printer.KillDoc
'    End If
    Exit Sub
Print_Cancel:
    MousePointer = vbDefault
    If Err.Number <> cdlCancel Then
        Status = SetError(Err.Number, "无法完成打印，请确认打印机电源已经开启并与计算机正确连接！:" _
                & vbCrLf & Err.Description, Err.Source)
        ErrMsg Status
    End If
End Sub
Public Sub PrintHz()
On Error GoTo ErrMsg
    Dim Status
   
    Dim i As Integer

    
    Dim intPage As Integer
    Dim sngCurrY As Single
    Dim intCurrLine As Integer
    
    Dim sngTitleTop As Single
    Dim sngHospitalTop As Single
    
    Dim sngPersonTop As Single
    Dim sngTextLeft As Single
    Dim sngKShiLeft As Single '科室
    Dim sngXMuLeft As Single '项目
    Dim sngTCanLeft As Single '套餐
    Dim sngJGeLeft As Single '价格
    Dim sngHeaderTop As Single
    Dim sngTextTop As Single
    Dim sngTextBottom As Single
    Dim sngPageNumberTop As Single
    
    Me.MousePointer = vbHourglass
    
    sngTitleTop = 25
    sngHospitalTop = 34
    sngPersonTop = 42
    sngTextLeft = 30
    sngKShiLeft = sngTextLeft
    sngXMuLeft = sngTextLeft + 20
    sngTCanLeft = sngTextLeft + 50
    sngJGeLeft = sngTextLeft + 80
    sngHeaderTop = 52
    sngTextTop = 59
    sngTextBottom = 272
    sngPageNumberTop = 285



   
    intPage = 1 '从第一页开始
    '打印第一页的标题
    GoSub PrintTitle
    
    'rsTemp.MoveFirst
    With Printer
        '打印报表正文
        '循环打印所有记录
        intCurrLine = 1
        For i = 2 To lvwSJRY.ListItems.Count
            .FontSize = 9
            .FontBold = False
            '计算纵坐标
            sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            If sngCurrY > sngTextBottom Then '该分页
                Printer.NewPage
                intPage = intPage + 1
                GoSub PrintTitle
                
                intCurrLine = 1
                .FontSize = 10
                .FontBold = False
                '分页后重新计算纵坐标
                sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
            End If
           '体检日期
            .CurrentX = sngTextLeft
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).Text
           ' MsgBox lvwSJRY.ListItems(i).SubItems(2)
            
            '人数
            .CurrentX = sngTextLeft + 30
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).SubItems(1)
            
            '应受金额
            .CurrentX = sngTextLeft + 60
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).SubItems(2)

            '成交金额
            .CurrentX = sngTextLeft + 90
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).SubItems(3)
'
'            '体检人数
            .CurrentX = sngTextLeft + 120
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).SubItems(4)

           '实收金额
            .CurrentX = sngTextLeft + 150
            .CurrentY = sngCurrY
            Printer.Print lvwSJRY.ListItems(i).SubItems(5)
            
            '
            intCurrLine = intCurrLine + 1
          
        Next i
        
        '打印合计行
        '在最后一页上打印合计
        .FontSize = 9
        .FontBold = True
        sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5 + 5
        Printer.Line (sngTextLeft - 5, sngCurrY - 1.5)-(sngTextLeft + sngJGeLeft + 50, sngCurrY - 1.5)
        .CurrentX = sngTextLeft
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).Text
        
        .CurrentX = sngTextLeft + 30
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).SubItems(1) & "人"

        .CurrentX = sngTextLeft + 60
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).SubItems(2) & "元"

        .CurrentX = sngTextLeft + 90
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).SubItems(3) & "元"

        .CurrentX = sngTextLeft + 120
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).SubItems(4) & "人"
        
        .CurrentX = sngTextLeft + 150
        .CurrentY = sngCurrY
        Printer.Print lvwSJRY.ListItems(1).SubItems(5) & "元"
        
        '为每个客户提交一次打印
        Printer.EndDoc
    End With
    GoTo ExitLab

'打印报表标题
PrintTitle:
    With Printer
        '打印标题
        .FontName = "宋体"
        .FontSize = 17
        .FontBold = True
        .FontItalic = False
        .FontUnderline = False
        
        .CurrentX = (Printer.ScaleWidth - .TextWidth("体检费用汇总")) / 2
        .CurrentY = sngTitleTop
        Printer.Print "体检费用汇总"
        
        '打印单位
        .FontSize = 11
        .CurrentX = (Printer.ScaleWidth - .TextWidth(gstrHospital)) / 2
        .CurrentY = sngHospitalTop
        Printer.Print gstrHospital




        '打印报表题头
         .FontSize = 11
         '.CurrentX = (Printer.ScaleWidth - .TextWidth(gstrHospital)) / 2 + 30
          .CurrentX = Printer.ScaleWidth - 65
         .CurrentY = sngHospitalTop + 12
          Printer.Print "打印日期：" & Date
        Printer.DrawWidth = 5
        Printer.Line (sngTextLeft - 5, sngHeaderTop - 1.5)-(sngTextLeft + sngJGeLeft + 50, sngHeaderTop - 1.5)
        
        .CurrentX = sngKShiLeft
        .CurrentY = sngHeaderTop
        Printer.Print "体检日期"
        
        .CurrentX = sngXMuLeft
        .CurrentY = sngHeaderTop
        Printer.Print "登记人数"
        
        .CurrentX = sngTCanLeft
        .CurrentY = sngHeaderTop
        Printer.Print "应收金额"
        
        .CurrentX = sngJGeLeft
        .CurrentY = sngHeaderTop
        Printer.Print "成交金额"
        
         .CurrentX = sngJGeLeft + 30
        .CurrentY = sngHeaderTop
        Printer.Print "体检人数"
        
         .CurrentX = sngJGeLeft + 60
        .CurrentY = sngHeaderTop
        Printer.Print "实收金额"
        Printer.Line (sngTextLeft - 5, sngHeaderTop + .TextHeight("高度") + 1)-(sngTextLeft + sngJGeLeft + 50, sngHeaderTop + .TextHeight("高度") + 1)
    
        .CurrentX = (Printer.ScaleWidth - .TextWidth(str(intPage))) / 2
        .CurrentY = sngPageNumberTop
        Printer.Print intPage
    End With
    Return

ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub
'打印当前选择用户的费用清单
Public Sub PrintFYQD(ByVal lngGUID As Long)
On Error GoTo ErrMsg
    Dim Status
    Dim strHealthID As String '当前选中客户
    Dim strYYID As String
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim strName As String
    Dim strSex As String
    Dim strTJRQ As String
    Dim curTotal As Currency
    Dim blnTC As Boolean '是否选择了套餐
    Dim lngTCID As Long '套餐ID
    Dim strTCMC As String '套餐名称
    Dim curTCJG As Currency '套餐价格
    Dim curOtherXMu As Currency '加项价格
    Dim sngZheKou As Single '折扣
    Dim curTotal_CJJG As Currency '成交价格
    
    Dim intPage As Integer
    Dim sngCurrY As Single
    Dim intCurrLine As Integer
    
    Dim sngTitleTop As Single
    Dim sngHospitalTop As Single
    
    Dim sngPersonTop As Single
    Dim sngTextLeft As Single
    Dim sngKShiLeft As Single '科室
    Dim sngXMuLeft As Single '项目
    Dim sngTCanLeft As Single '套餐
    Dim sngJGeLeft As Single '价格
    Dim sngHeaderTop As Single
    Dim sngTextTop As Single
    Dim sngTextBottom As Single
    Dim sngPageNumberTop As Single
    
    Me.MousePointer = vbHourglass
    
    sngTitleTop = 25
    sngHospitalTop = 34
    sngPersonTop = 42
    sngTextLeft = 30
    sngKShiLeft = sngTextLeft
    sngXMuLeft = sngTextLeft + 30
    sngTCanLeft = sngTextLeft + 80
    sngJGeLeft = sngTextLeft + 120
    sngHeaderTop = 52
    sngTextTop = 59