⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dlgzybs.frm

📁 本系统可用于医院和专业体检中心的健康体检管理
💻 FRM
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form dlgZYBS 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "职业病史"
   ClientHeight    =   3945
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5925
   Icon            =   "dlgZYBS.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3945
   ScaleWidth      =   5925
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox TxtJHGL 
      Height          =   315
      Left            =   4200
      TabIndex        =   8
      Top             =   2700
      Width           =   975
   End
   Begin VB.TextBox TxtZGL 
      Height          =   315
      Left            =   1260
      TabIndex        =   7
      Top             =   2700
      Width           =   975
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "是否痊愈"
      Height          =   645
      Left            =   420
      TabIndex        =   18
      Top             =   1920
      Width           =   5265
      Begin VB.OptionButton OptNo 
         BackColor       =   &H80000018&
         Caption         =   "否"
         Height          =   285
         Left            =   3000
         TabIndex        =   6
         Top             =   270
         Width           =   1695
      End
      Begin VB.OptionButton OptYes 
         BackColor       =   &H80000018&
         Caption         =   "是"
         Height          =   345
         Left            =   1200
         TabIndex        =   5
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.ComboBox CmbZYBName 
      Height          =   315
      Left            =   1350
      TabIndex        =   0
      Top             =   240
      Width           =   4335
   End
   Begin VB.TextBox TxtZDDW 
      Height          =   315
      Left            =   1350
      TabIndex        =   4
      Top             =   1470
      Width           =   4335
   End
   Begin VB.ComboBox CmbDHMC 
      Height          =   315
      Left            =   1350
      TabIndex        =   1
      Top             =   660
      Width           =   4335
   End
   Begin XPControls.XPCommandButton CmdOK 
      Height          =   405
      Left            =   1530
      TabIndex        =   9
      Top             =   3330
      Width           =   825
      _ExtentX        =   1455
      _ExtentY        =   714
      Caption         =   "确 定"
      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 MSComCtl2.DTPicker dtpZDRQ 
      Height          =   345
      Left            =   4320
      TabIndex        =   3
      Top             =   1050
      Width           =   1365
      _ExtentX        =   2408
      _ExtentY        =   609
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Format          =   23855105
      CurrentDate     =   38037
      MaxDate         =   73415
      MinDate         =   2
   End
   Begin MSComCtl2.DTPicker dtpJCRQ 
      Height          =   345
      Left            =   1350
      TabIndex        =   2
      Top             =   1050
      Width           =   1365
      _ExtentX        =   2408
      _ExtentY        =   609
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Format          =   23855105
      CurrentDate     =   38037
      MaxDate         =   73415
      MinDate         =   2
   End
   Begin XPControls.XPCommandButton CmdCancel 
      Height          =   405
      Left            =   3630
      TabIndex        =   11
      Top             =   3330
      Width           =   825
      _ExtentX        =   1455
      _ExtentY        =   714
      Caption         =   "取 消"
      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 Label9 
      BackStyle       =   0  'Transparent
      Caption         =   "年"
      Height          =   225
      Left            =   5280
      TabIndex        =   20
      Top             =   2790
      Width           =   315
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "年"
      Height          =   225
      Left            =   2340
      TabIndex        =   19
      Top             =   2790
      Width           =   315
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "职业病名称:"
      Height          =   225
      Left            =   120
      TabIndex        =   17
      Top             =   285
      Width           =   1125
   End
   Begin VB.Label Label5 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "诊断日期:"
      Height          =   225
      Left            =   3180
      TabIndex        =   16
      Top             =   1140
      Width           =   1035
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "检查日期:"
      Height          =   225
      Left            =   210
      TabIndex        =   15
      Top             =   1140
      Width           =   1035
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "总工龄:"
      Height          =   225
      Left            =   180
      TabIndex        =   14
      Top             =   2775
      Width           =   1035
   End
   Begin VB.Label Label6 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "诊断单位:"
      Height          =   225
      Left            =   210
      TabIndex        =   13
      Top             =   1545
      Width           =   1035
   End
   Begin VB.Label Label8 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "毒害名称:"
      Height          =   225
      Left            =   210
      TabIndex        =   12
      Top             =   735
      Width           =   1035
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "接害工龄:"
      Height          =   225
      Left            =   3180
      TabIndex        =   10
      Top             =   2790
      Width           =   1035
   End
End
Attribute VB_Name = "dlgZYBS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mblnOK As Boolean       '用户单击了哪个按钮
Dim mstrRet As String
Dim menuOperation As OperationType


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

Private Sub cmdOK_Click()
    Dim itmZYBS As ListItem
    
    '校验用户输入的合法性
    '检查日期
    If dtpJCRQ.Value > Date Then
        MsgBox "您输入的检查日期不符合实际情况,请重新输入!", vbInformation, "提示"
        dtpJCRQ.SetFocus
        Exit Sub
    End If
    
    '诊断日期
    If dtpZDRQ.Value > Date Then
        MsgBox "您输入的诊断日期不符合实际情况,请重新输入!", vbInformation, "提示"
        dtpZDRQ.SetFocus
        Exit Sub
    End If
    
    '检查日期是否在诊断日期前面
    If dtpJCRQ.Value > dtpZDRQ.Value Then
        MsgBox "检查日期不应该比诊断日期迟!请重新输入!", vbInformation, "提示"
        dtpJCRQ.SetFocus
        Exit Sub
    End If
     
    '校验完毕
    mblnOK = True
    
    If OptYes.Value = True Then
        mstrRet = CmbZYBName.Text & JoinSymbol _
                & CmbDHMC.Text & JoinSymbol _
                & dtpJCRQ.Value & JoinSymbol _
                & dtpZDRQ & JoinSymbol _
                & TxtZDDW.Text & JoinSymbol _
                & "是" & JoinSymbol _
                & TxtZGL.Text & JoinSymbol _
                & TxtJHGL.Text
    ElseIf OptNo.Value = True Then
        mstrRet = CmbZYBName.Text & JoinSymbol _
                & CmbDHMC.Text & JoinSymbol _
                & dtpJCRQ.Value & JoinSymbol _
                & dtpZDRQ & JoinSymbol _
                & TxtZDDW.Text & JoinSymbol _
                & "否" & JoinSymbol _
                & TxtZGL.Text & JoinSymbol _
                & TxtJHGL.Text
    End If
    Unload Me

End Sub

Private Sub Form_Load()
    ShowZD Me, CmbZYBName, "ZYBName"
    ShowZD Me, CmbDHMC, "DHMC"
End Sub

'被FrmQuery_C调用的函数
Public Function ShowZYBS(ByVal enuOperation As OperationType, Optional ByVal strZYBS As String) As String
On Error GoTo ErrMsg
    Dim Status
    Dim arrZYBS
    Dim i
    Dim blHave As Boolean     '标识各项列表框的列表中是否有传入的单位名称
    
    blHave = False
    
    menuOperation = enuOperation
    
    '判断是否更新
    If enuOperation = Modify Then
        arrZYBS = Split(strZYBS, JoinSymbol)
                
        '填入职业病名称
        For i = 0 To CmbZYBName.ListCount
            If arrZYBS(2) = CmbZYBName.List(0) Then
                CmbZYBName.ListIndex = i
                blHave = True
                Exit For
            End If
        Next i
        If blHave = False Then
            CmbZYBName.Text = arrZYBS(0)
        End If
        
        blHave = False
        '填入毒害名称
        For i = 0 To CmbDHMC.ListCount
            If arrZYBS(3) = CmbDHMC.List(i) Then
                CmbDHMC.ListIndex = i
                blHave = True
                Exit For
            End If
        Next i
        If blHave = False Then
            CmbDHMC.Text = arrZYBS(1)
        End If
        
        blHave = False
        '填入检查日期
        dtpJCRQ.Value = arrZYBS(2)
        
        '填入诊断日期
        dtpZDRQ.Value = arrZYBS(3)
        
        '填入诊断单位
        TxtZDDW.Text = arrZYBS(4)
        
        '填入是否痊愈
        If arrZYBS(5) = "是" Then
            OptYes.Value = True
        ElseIf arrZYBS(5) = "否" Then
            OptNo.Value = True
        End If
        
        '填入总工龄
        TxtZGL.Text = arrZYBS(6)
        
        '填入接害工龄
        TxtJHGL.Text = arrZYBS(7)
        
    End If
    
    '显示窗体
    Me.Show vbModal
    
    '查看返回值
    If mblnOK = True Then
        ShowZYBS = mstrRet
    End If
    
    Exit Function
ErrMsg:
    
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -