frmjbqctj.frm

来自「本系统可用于医院和专业体检中心的健康体检管理」· FRM 代码 · 共 1,259 行 · 第 1/4 页

        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 70, 79)
        itmTemp.SubItems(24) = lngTemp
        '添加患此病的70-79男性百分比
        itmTemp.SubItems(25) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的70-79女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 70, 79)
        itmTemp.SubItems(26) = lngTemp
        '添加患此病的70-79女性百分比
        itmTemp.SubItems(27) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的80-89男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 80, 89)
        itmTemp.SubItems(28) = lngTemp
        itmTemp.SubItems(29) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的80-89女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 80, 89)
        itmTemp.SubItems(30) = lngTemp
        itmTemp.SubItems(31) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的90-99男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 90, 99)
        itmTemp.SubItems(32) = lngTemp
        itmTemp.SubItems(33) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的90-99女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 90, 99)
        itmTemp.SubItems(34) = lngTemp
        itmTemp.SubItems(35) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '刷新
        DoEvents
    Next i
End Sub

'显示图形
Private Sub ShowChart(inNumber As Integer)
    Dim index1, index2, index3, index4 As Integer
    Dim strYYID As String
    
    If Me.CmbTJDW.Text <> "" Then
        strYYID = arrYYID(CmbTJDW.ListIndex)
    End If
    
    arrResult(1, 1) = "0-29"
    arrResult(1, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 0, 29)
    arrResult(1, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 0, 29)
        
    arrResult(2, 1) = "30-39"
    arrResult(2, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 30, 39)
    arrResult(2, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 30, 39)
    
    DoEvents

    arrResult(3, 1) = "40-49"
    arrResult(3, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 40, 49)
    arrResult(3, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 40, 49)

    arrResult(4, 1) = "50-59"
    arrResult(4, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 50, 59)
    arrResult(4, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 50, 59)
    
    DoEvents

    arrResult(5, 1) = "60-69"
    arrResult(5, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 60, 69)
    arrResult(5, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 60, 69)

    arrResult(6, 1) = "70-79"
    arrResult(6, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 70, 79)
    arrResult(6, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 70, 79)
    
    DoEvents

    arrResult(7, 1) = "80-89"
    arrResult(7, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 80, 89)
    arrResult(7, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 80, 89)

    arrResult(8, 1) = "90-99"
    arrResult(8, 2) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "男", 90, 99)
    arrResult(8, 3) = getJBCount(strYYID, arrBHMC(inNumber), dtpStart.Value, dtpEnd.Value, "女", 90, 99)

    With MSChart1
        .Plot.SeriesCollection(1).LegendText = "男"
        .Plot.SeriesCollection(2).LegendText = "女"
        .ChartData = arrResult
        .ChartType = VtChChartType2dBar
        .ShowLegend = True
        .SelectPart VtChPartTypePlot, index1, index2, index3, index4
        .EditCopy
        .SelectPart VtChPartTypeLegend, index1, index2, index3, index4
        .EditPaste
    End With
End Sub

'打印/导出
Private Sub PrintAndExport(ByVal blnPrint As Boolean)
On Error GoTo ErrMsg
    Dim Status
    Dim intPage As Integer
    Dim sngTitleTop  As Single   '页面上边距
    Dim sngLineInterval As Single   '行间距
    Dim sngLeft, sngRight As Single '左、右页边距
    Dim sngCurrX, sngCurrY As Single      '当前打印机纵坐标
    Dim intLineCount As Integer     '当前页已打印的行数
    Dim i As Integer
    Dim intLinePerPage As Integer     '每页打印的行数
    Dim strPrint As String '当前打印的内容
    Dim strExport As String
    Dim strFileName As String
    
    intLinePerPage = 43
    
    If blnPrint Then
        If DetectPrinter() = False Then
            MsgBox "您还未安装打印机", vbInformation, "提示"
            Exit Sub
        End If
    Else
        strFileName = GetFileName(Me.CommonDialog1, "文本文件|*.txt", _
                "另存为", "疾病趋势统计结果.txt", WRITEFILE)
    End If
    
    sngTitleTop = 25
    sngLeft = 15
    sngRight = 15
    sngLineInterval = 2
        
    '首先进行查找
    If mblQuery = False Then
        cmdQuery_Click
    End If
    If mblQuery = True And lvwJG.ListItems.Count = 0 Then
        MsgBox "没有查到符合条件的记录,请重新设置查询条件", vbInformation, "提示"
        Exit Sub
    End If
    
    '初始为第一页
    intPage = 1
    '调整字体
    With Printer
        '设成A4纸
        .ScaleMode = vbMillimeters
        .ScaleWidth = 210
        .ScaleHeight = 297
        
        '打表头
        GoSub PrintTitle
        GoSub DrawLine
        
        intLineCount = 1
        For i = 1 To lvwJG.ListItems.Count
            strPrint = "病患名称：" & lvwJG.ListItems(i)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "符合查询条件体检总人数：" & m_lngSelectedPersons(i) & "人，患病人数 " _
                    & lvwJG.ListItems(i).SubItems(2) _
                    & " 人, 百分比 " & lvwJG.ListItems(i).SubItems(3) & "%。"
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "0-29男性人数：" & lvwJG.ListItems(i).SubItems(4) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(5) _
                    & "；  0-29女性人数：" & lvwJG.ListItems(i).SubItems(6) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(7)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
                    
            strPrint = "30-39男性人数：" & lvwJG.ListItems(i).SubItems(8) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(9) _
                    & "；  30-39女性人数：" & lvwJG.ListItems(i).SubItems(10) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(11)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            
            strPrint = "40-49男性人数：" & lvwJG.ListItems(i).SubItems(12) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(13) _
                    & "；  40-49女性人数：" & lvwJG.ListItems(i).SubItems(14) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(15)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "50-59男性人数：" & lvwJG.ListItems(i).SubItems(16) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(17) _
                    & "；  50-59女性人数：" & lvwJG.ListItems(i).SubItems(18) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(19)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "60-69男性人数：" & lvwJG.ListItems(i).SubItems(20) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(21) _
                    & "；  60-69女性人数：" & lvwJG.ListItems(i).SubItems(23) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(24)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "70-79男性人数：" & lvwJG.ListItems(i).SubItems(24) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(25) _
                    & "；  70-79女性人数：" & lvwJG.ListItems(i).SubItems(26) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(27)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "80-89男性人数：" & lvwJG.ListItems(i).SubItems(28) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(29) _
                    & "；  80-89女性人数：" & lvwJG.ListItems(i).SubItems(30) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(31)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            strPrint = "90-99男性人数：" & lvwJG.ListItems(i).SubItems(32) _
                    & " 人, 百分比：" & lvwJG.ListItems(i).SubItems(33) _
                    & "；  90-99女性人数：" & lvwJG.ListItems(i).SubItems(34) & " 人，百分比：" _
                    & lvwJG.ListItems(i).SubItems(35)
            GoSub PrintLine
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
            
            sngCurrY = sngCurrY + Printer.TextHeight("高度") + sngLineInterval
            intLineCount = intLineCount + 1
        Next i
        
        If blnPrint Then
            '提交打印
            .EndDoc
        End If
    End With
    
    If Not blnPrint Then
        strExport = "疾病趋势统计结果" & vbCrLf & strExport
        Call WriteTextFile(strFileName, strExport)
        Shell gstrCurrPath & "wordpad.exe " & Chr(34) & strFileName, vbNormalFocus
    End If
   
    GoTo ExitLab

PrintLine:
    If blnPrint Then
        If intLineCount >= intLinePerPage Then
            intLineCount = 1
            Printer.NewPage
            intPage = intPage + 1
            GoSub PrintTitle
            GoSub DrawLine
        End If
        With Printer
            '调整字体
            .FontName = "宋体"
            .FontSize = 9
            .FontBold = False
            .FontItalic = False
            .FontUnderline = False
            
            .CurrentX = sngCurrX
            .CurrentY = sngCurrY
            Printer.Print strPrint
        End With
    Else
        strExport = strExport & vbCrLf & strPrint
    End If
    Return
   
DrawLine:
    If blnPrint Then
        Printer.DrawWidth = 8
        Printer.DrawStyle = 2
        Printer.Line (sngLeft + 5, sngCurrY + sngLineInterval)-(sngLeft + 173, sngCurrY + sngLineInterval)
        sngCurrY = sngCurrY + 5
    End If
    Return
    
PrintTitle:
    If blnPrint Then
        '打印表头
        With Printer
            .FontName = "宋体"
            .FontSize = 15
            .FontBold = True
            .FontItalic = False
            .FontUnderline = False
            
            .CurrentY = sngTitleTop
            If intPage = 1 Then
                .CurrentX = (.ScaleWidth - .TextWidth("疾病趋势统计结果")) / 2
                Printer.Print "疾病趋势统计结果"
            Else
                .CurrentX = (.ScaleWidth - .TextWidth("疾病趋势统计结果(续表)")) / 2
                Printer.Print "疾病趋势统计结果(续表)"
            End If
        End With
        sngCurrY = sngTitleTop + Printer.TextHeight("高度") + sngLineInterval
        sngCurrX = sngLeft + 10
    End If
    Return

ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    '
End Sub