frmdwtjxj.frm

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

    'cdlPDReturnDefault &H400 返回缺省的打印机名称。
    'cdlPDReturnIC &H200 为该对话框中选择的打印机返回一个信息上下文。信息上下文提供了一个不用建立设备描述体就能得到设备信息的快速方法。信息上下文返回到对话框的 hDC 属性中。
    'cdlPDSelection &H1 返回或设置选择选项按钮的状态。如果 cdlPDPageNums 或 cdlPDSelection 均未指定，全部选项按钮就处于被选状态。
    'CdlPDUseDevModeCopies &H40000 如果打印机驱动程序不支持多份数打印，则设置该属性将使打印对话中的份数微调控件的数值无效。如果驱动程序支持多份数打印，则设置该属性指示对话框将所要的份数值存放在 Copies 属性中。
    '说明
    '这些常数在对象浏览器的 Microsoft CommonDialog 控件 (MSComDlg) 对象库中列出。
    '也可以定义所选择的标志。使用启动窗体声明部分的 Const 关键字来定义想使用的标志。例如：
 'Const ReadOnly = &H1&
 'Const Effects = &H100&
    '使用 Or 操作符可以为一个对话框设置多个标志。如：
    'CommonDialog.Flags =CdlPDUseDevModeCopies ' &H10& Or &H200&
    '将所希望的常数值相加能产生同样的结果?下例与上例等效:
    'CommonDialog.Flags = &H210&
    '数据类型 Long
    
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '                                  是否已经注册
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    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.ScaleMode = vbMillimeters
    Printer.ScaleWidth = 210
    Printer.ScaleHeight = 297
    
    '调用打印程序
    '循环每一个人
    For i = 1 To lvwSJRY.ListItems.Count
        If lvwSJRY.ListItems(i).Selected = True Then
            lngGUID = Val(Mid(lvwSJRY.ListItems(i).Key, 2))
            PrintDWTJXJ lngGUID
        End If
    Next i
    
    
'    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 PrintDWTJXJ(ByVal lngGUID As Long)
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim strHealthID As String '档案号
    Dim strName As String '姓名
    Dim strSex As String '性别
    Dim strTJRQ As String '体检日期
    Dim strZJJLun As String '总检结论
    Dim strZJJYi As String '总检建议
    Dim intCount As Integer '文本框的行数
    Dim strLine As String '文本框里的每一行文本
    Dim intFontSize As Integer '正文字体大小
    Dim blnBold As Boolean '是否粗体
    
    Dim intPage As Integer '页码
    Dim sngCurrY As Single '当前的纵坐标
    Dim intCurrLine As Integer '当前行
    
    Dim sngTitleTop As Single
    Dim sngHospitalTop As Single
    
    Dim sngCurLeft As Single
    
    Dim sngPersonTop As Single
    Dim sngTextLeft As Single
    Dim sngBodyText 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
    sngBodyText = sngTextLeft + 3.4
    sngHeaderTop = 52
    sngTextTop = 59
    sngTextBottom = 272
    sngPageNumberTop = 285
    
    '首先获取客户的个人信息
    strSQL = "select HealthID,YYRXM,SEX,TJRQ from SET_GRXX" _
                & " where GUID=" & lngGUID
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    strHealthID = rstemp("HealthID")
    strName = rstemp("YYRXM")
    strSex = rstemp("Sex")
    strTJRQ = str(rstemp("TJRQ"))
    rstemp.Close
    
    '获取总检结论
    strSQL = "select JLValue from DATA_ZJJL" _
            & " where GUID=" & lngGUID
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not (rstemp.EOF) Then
        strZJJLun = rstemp("JLValue") & ""
        rstemp.Close
    End If
    
    '获取总检建议
    strSQL = "select JyValue from DATA_ZJJY" _
            & " where GUID=" & lngGUID
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not (rstemp.EOF) Then
        strZJJYi = rstemp("JYValue") & ""
        rstemp.Close
    End If
    Set rstemp = Nothing
'    '如果结论和建议都为空，则无需打印
'    If strZJJLun = "" And astrzjjyi = "" Then GoTo ExitLab
    
    intPage = 1 '从第一页开始
    '打印第一页的标题
    GoSub PrintTitle

    With Printer
        '打印报表正文
        '首先打印体检结论
        intCurrLine = 1
        intFontSize = 9
        blnBold = True
        sngCurLeft = sngTextLeft - 5
        strLine = "体检结论："
        GoSub PrintLine
        
        intCurrLine = intCurrLine + 1
        intFontSize = 9
        blnBold = False
        sngCurLeft = sngBodyText
        If Len(strZJJLun) <= 2 Then
            strLine = strZJJLun
            GoSub PrintLine
            intCurrLine = intCurrLine + 1
        Else
            txtTemp.Text = strZJJLun
            intCount = GetLineCount(txtTemp)
            For i = 0 To intCount - 1
                strLine = GetPosChar(i, txtTemp)
                If strLine <> "" Then
                    GoSub PrintLine
                End If
                
                intCurrLine = intCurrLine + 1
            Next
        End If
        
        '空一行之后打印体检建议
        intCurrLine = intCurrLine + 2
        intFontSize = 9
        blnBold = True
        sngCurLeft = sngTextLeft - 5
        strLine = "体检建议："
        GoSub PrintLine
        
        intCurrLine = intCurrLine + 1
        intFontSize = 9
        blnBold = False
        sngCurLeft = sngBodyText
        If Len(strZJJYi) <= 2 Then
            strLine = strZJJYi
            GoSub PrintLine
            intCurrLine = intCurrLine + 1
        Else
            txtTemp.Text = strZJJYi
            intCount = GetLineCount(txtTemp)
            For i = 0 To intCount - 1
                strLine = GetPosChar(i, txtTemp)
                If strLine <> "" Then
                    GoSub PrintLine
                End If
                
                intCurrLine = intCurrLine + 1
            Next
        End If
        
        '每个客户提交一次打印
        Printer.EndDoc
    End With
    
    GoTo ExitLab

'打印某一行
PrintLine:
    With Printer
        .FontSize = intFontSize
        .FontBold = False
        '计算纵坐标
        sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
        If sngCurrY > sngTextBottom Then '该分页
            Printer.NewPage
            intPage = intPage + 1
            GoSub PrintTitle
            
            intCurrLine = 1
            .FontSize = intFontSize
            .FontBold = False
            '分页后重新计算纵坐标
            sngCurrY = sngTextTop + (intCurrLine - 1) * .TextHeight("高度") * 1.5
        End If
        .CurrentX = sngCurLeft
        .CurrentY = sngCurrY
        .FontBold = blnBold
        Printer.Print strLine
    End With
    Return

'打印报表标题
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 = 9
        .CurrentX = sngTextLeft - 5
        .CurrentY = sngPersonTop
        Printer.Print "档案号：" & strHealthID
        
        .CurrentX = sngTextLeft + 43 - 5
        .CurrentY = sngPersonTop
        Printer.Print "姓名：" & strName
        
        .CurrentX = sngTextLeft + 75 - 5
        .CurrentY = sngPersonTop
        Printer.Print "性别：" & strSex
        
        .CurrentX = sngTextLeft + 95 - 5
        .CurrentY = sngPersonTop
        Printer.Print "体检日期：" & strTJRQ
        
        '打印报表题头
        Printer.DrawWidth = 5
        Printer.Line (sngTextLeft - 5, sngHeaderTop - 1.5)-(sngTextLeft + 158, sngHeaderTop - 1.5)
        
'        .CurrentX = sngTextLeft
'        .CurrentY = sngHeaderTop
'        If mblnKShi = True Then
'            Printer.Print "科室名称"
'        Else
'            Printer.Print "工作人员"
'        End If
'
'        .CurrentX = sngTextLeft + 100
'        .CurrentY = sngHeaderTop
'        Printer.Print "工作量(人次)"
'        Printer.Line (sngTextLeft - 5, sngHeaderTop + .TextHeight("高度") + 1)-(sngTextLeft + 120, 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