dlgreport.frm

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

VERSION 5.00
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form dlgReport 
   BackColor       =   &H80000018&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Dialog Caption"
   ClientHeight    =   3585
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4965
   Icon            =   "dlgReport.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3585
   ScaleWidth      =   4965
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.ComboBox cmbPaper 
      Height          =   315
      ItemData        =   "dlgReport.frx":0CCA
      Left            =   1230
      List            =   "dlgReport.frx":0CDA
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1845
      Width           =   3165
   End
   Begin VB.TextBox txtReport 
      Height          =   300
      Left            =   1230
      TabIndex        =   1
      Top             =   930
      Width           =   3165
   End
   Begin XPControls.XPCommandButton cmdCancel 
      Cancel          =   -1  'True
      Height          =   375
      Left            =   2745
      TabIndex        =   4
      Top             =   2850
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      Caption         =   "取消(&C)"
      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
   End
   Begin XPControls.XPCommandButton cmdOK 
      Height          =   375
      Left            =   1185
      TabIndex        =   5
      Top             =   2850
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      Caption         =   "确定(&O)"
      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
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "请选择纸张型号："
      Height          =   195
      Left            =   420
      TabIndex        =   2
      Top             =   1575
      Width           =   1440
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "请输入要添加的报告名称（该名称必须唯一）："
      Height          =   195
      Left            =   420
      TabIndex        =   0
      Top             =   555
      Width           =   3780
   End
End
Attribute VB_Name = "dlgReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim menuOperation As OperationType
Dim mstrBBID As String
Dim mstrBBMC As String
Dim mblnOK As Boolean

'被调函数，被frmCustomer调用
'返回值：BBID
Public Function ShowReport(ByVal enuOperation As OperationType, Optional ByVal strBBID As String) As String
On Error Resume Next
    Dim strSQL As String
    Dim rsTemp As ADODB.Recordset
    
    menuOperation = enuOperation
    If menuOperation = Modify Then
        Me.Caption = "修改报表"
        mstrBBID = strBBID
        
        strSQL = "select * from REPORT_MC" _
                & " where BBID='" & strBBID & "'"
        Set rsTemp = New ADODB.Recordset
        rsTemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        If Not rsTemp.EOF Then
            mstrBBMC = rsTemp("BBMC")
            txtReport.Text = rsTemp("BBMC")
            cmbPaper.Text = rsTemp("BBZX")
        End If
    Else
        '添加时默认选中A4纸
        cmbPaper.ListIndex = 1
        Me.Caption = "新增报表"
    End If
    
    Me.Show vbModal
    
    If mblnOK = True Then
        ShowReport = mstrBBID
    End If
End Function

Private Sub cmdCancel_Click()
    mblnOK = False
    Unload Me
End Sub

Private Sub cmdOK_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rsTemp As ADODB.Recordset
    
    Me.MousePointer = vbHourglass
    
    '是否输入了名称
    If txtReport.Text = "" Then
        MsgBox "请输入报表名称！", vbInformation, "提示"
        txtReport.SetFocus
        GoTo ExitLab
    End If
    
    '是否选择了纸型
    If cmbPaper.Text = "" Then
        MsgBox "请选择一种纸型！", vbInformation, "提示"
        cmbPaper.SetFocus
        GoTo ExitLab
    End If
    
    '报表名称是否已经存在
    If (menuOperation = Add) Or _
            ((menuOperation = Modify) And (txtReport.Text <> mstrBBMC)) Then
        '校验是否重复
        strSQL = "select Count(*) from REPORT_MC" _
                & " where BBMC='" & txtReport.Text & "'"
        Set rsTemp = New ADODB.Recordset
        rsTemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rsTemp(0) >= 1 Then
            MsgBox "您输入的报表名称已经存在，请核对后重新输入！", vbInformation, "提示"
            txtReport.SetFocus
            GoTo ExitLab
        End If
    End If
    
    '如果是添加，获取当前最大的编号
    If menuOperation = Add Then
        mstrBBID = GetMaxID("REPORT_MC", "BBID", "00001")
        '插入一条空记录
        strSQL = "insert into REPORT_MC(BBID) values(" _
                & "'" & mstrBBID & "')"
        GCon.Execute strSQL
    End If
    
    '更新其余信息
    strSQL = "update REPORT_MC set" _
            & " BBMC='" & txtReport.Text & "'" _
            & ",BBZX='" & cmbPaper.Text & "'" _
            & " where BBID='" & mstrBBID & "'"
    GCon.Execute strSQL
    
    mblnOK = True
    
    Unload Me
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub