frmdwfy.frm

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

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmDWFY 
   BackColor       =   &H80000018&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "单位费用清单打印"
   ClientHeight    =   6540
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   9675
   Icon            =   "frmDWFY.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6540
   ScaleWidth      =   9675
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "汇总条件"
      Height          =   735
      Left            =   90
      TabIndex        =   0
      Top             =   180
      Width           =   9315
      Begin VB.ComboBox cmbDWei 
         Height          =   315
         Left            =   990
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   270
         Width           =   3405
      End
      Begin MSComCtl2.DTPicker dtpStop 
         Height          =   285
         Left            =   7710
         TabIndex        =   2
         Top             =   300
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   503
         _Version        =   393216
         Format          =   55443457
         UpDown          =   -1  'True
         CurrentDate     =   38039
         MaxDate         =   109939
         MinDate         =   2
      End
      Begin MSComCtl2.DTPicker dtpBegin 
         Height          =   285
         Left            =   5670
         TabIndex        =   3
         Top             =   300
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   503
         _Version        =   393216
         Format          =   55443457
         UpDown          =   -1  'True
         CurrentDate     =   38039
         MaxDate         =   109939
         MinDate         =   2
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "到"
         Height          =   195
         Left            =   7320
         TabIndex        =   6
         Top             =   330
         Width           =   180
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "体检日期  从"
         Height          =   195
         Left            =   4590
         TabIndex        =   5
         Top             =   330
         Width           =   990
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "体检单位："
         Height          =   225
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   330
         Width           =   960
      End
   End
End
Attribute VB_Name = "frmDWFY"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

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 strHealthID As String
    Dim strBBID As String

    'cdlPDHidePrintToFile+cdlPDHelpButton
    
    '------Flags 属性（“打印”对话框）-----------------------
    'cdlPDAllPages &H0 返回或设置全部页选项按钮的状态。
    'cdlPDCollate &H10 返回或设置分页复选框的状态。
    'cdlPDDisablePrintToFile &H80000 使打印到文件复选框无效。
    'cdlPDHelpButton &H800 要求对话框显示帮助按钮。
    'cdlPDHidePrintToFile &H100000 隐藏打印到文件复选框。
    'cdlPDNoPageNums &H8 使页选项按钮和相关的编辑控件无效。
    'cdlPDNoSelection &H4 使选择选项按钮无效。
    'cdlPDNoWarning &H80 防止没有缺省打印机时显示警告信息。
    'cdlPDPageNums &H2 返回或设置页选项按钮的状态。
    'cdlPDPrintSetup &H40 使系统显示“打印设置”对话框而不是“打印”对话框。
    'cdlPDPrintToFile &H20 返回或设置打印到文件复选框的状态。
    'cdlPDReturnDC &H100 为该对话框中选择的打印机返回一个设备描述体。设备描述体返回到对话框的 hDC 属性中。
    '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纸
    Err.Clear
    Printer.ScaleMode = vbMillimeters
    Printer.ScaleWidth = 210
    Printer.ScaleHeight = 297
    
    '调用打印程序
    '打印选中的每一条记录
    For i = 1 To lvwSJRY.ListItems.Count
        '总计行不能打印
        If (lvwSJRY.ListItems(i).Selected = True) And (Len(lvwSJRY.ListItems(i).Key) > 1) Then
            PrintFYQD Val(Mid(lvwSJRY.ListItems(i).Key, 2)), lvwSJRY.ListItems(i).SubItems(4)
        End If
    Next
'    If MsgBox("已经就绪,立即打印吗?", vbYesNo + vbQuestion + vbDefaultButton1, "打印提示") = vbYes Then
'       Printer.EndDoc
'    Else
'       Printer.KillDoc
'    End If
    Exit Sub
Print_Cancel:
    MousePointer = 0
    If Err.Number <> cdlCancel Then
        Status = SetError(Err.Number, "无法完成打印，请确认打印机电源已经开启并与计算机正确连接！:" _
                & vbCrLf & Err.Description, Err.Source)
        ErrMsg Status
    End If
End Sub

'打印当前选择用户的费用清单
Public Sub PrintFYQD_DW(ByVal lngGUID As Long, ByVal strType As String)
On Error Resume Next
    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 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 sngNameLeft As Single '性命
    Dim sngSexLeft As Single '性别
    Dim sngTCanLeft As Single '套餐
    Dim sngJGeLeft As Single '套餐价格
    Dim sngOtherJGeLeft As Single '加项价格
    Dim sngHeaderTop As Single
    Dim sngTextTop As Single
    Dim sngTextBottom As Single
    Dim sngPageNumberTop As Single
    
    Me.MousePointer = 11
    
    sngTitleTop = 25
    sngHospitalTop = 34
    sngPersonTop = 42
    sngTextLeft = 30
    sngNameLeft = sngTextLeft
    sngSexLeft = sngTextLeft + 30
    sngTCanLeft = sngTextLeft + 70
    sngJGeLeft = sngTextLeft + 110
    sngOtherJGeLeft = sngTextLeft + 125
    sngHeaderTop = 52
    sngTextTop = 59