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

📄 dlgselfjyi.frm

📁 本系统可用于医院和专业体检中心的健康体检管理
💻 FRM
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form dlgSelfJYi 
   BackColor       =   &H80000018&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "建议选择"
   ClientHeight    =   5490
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   8265
   Icon            =   "dlgSelfJYi.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5490
   ScaleWidth      =   8265
   ShowInTaskbar   =   0   'False
   Begin XPControls.XPCommandButton cmdCancel 
      Cancel          =   -1  'True
      Height          =   405
      Left            =   4800
      TabIndex        =   0
      Top             =   4920
      Width           =   1035
      _ExtentX        =   1826
      _ExtentY        =   714
      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          =   405
      Left            =   2250
      TabIndex        =   1
      Top             =   4920
      Width           =   1035
      _ExtentX        =   1826
      _ExtentY        =   714
      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 MSComctlLib.ListView lvwJYi 
      Height          =   4695
      Left            =   90
      TabIndex        =   2
      Top             =   90
      Width           =   8085
      _ExtentX        =   14261
      _ExtentY        =   8281
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   12648384
      BorderStyle     =   1
      Appearance      =   1
      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
      NumItems        =   5
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "诊断结论"
         Object.Width           =   1834
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "建议名称"
         Object.Width           =   1834
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "建议内容"
         Object.Width           =   13124
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "是否疾病"
         Object.Width           =   0
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "是否常见病"
         Object.Width           =   0
      EndProperty
   End
End
Attribute VB_Name = "dlgSelfJYi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_strJYi As String

Private Sub cmdCancel_Click()
    Unload Me
End Sub

'被调函数
Public Function ShowSelfJYi(ByVal strJYID As String) As String
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim itmTemp As ListItem
    
    Screen.MousePointer = vbHourglass
    
    strSQL = "select DMValue,JYMC,JYNR from DM_ZJJY" _
            & " where KSID='S" & strJYID & "'"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    If Not rstemp.EOF Then
        Do While Not rstemp.EOF
            Set itmTemp = lvwJYi.ListItems.Add(, , rstemp("DMValue"))
            itmTemp.SubItems(1) = rstemp("JYMC")
            itmTemp.SubItems(2) = rstemp("JYNR")
            
            rstemp.MoveNext
        Loop
        rstemp.Close
    End If
    
    Screen.MousePointer = vbDefault
    Me.Show vbModal
    
    ShowSelfJYi = m_strJYi
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Function

Private Sub cmdOK_Click()
    If lvwJYi.SelectedItem Is Nothing Then
        MsgBox "请选择一种建议", vbInformation, "提示"
        GoTo ExitLab
    End If
    
    m_strJYi = lvwJYi.SelectedItem.SubItems(2)
    Unload Me
    GoTo ExitLab
ExitLab:
    '
End Sub

Private Sub lvwJYi_DblClick()
    If Not (lvwJYi.SelectedItem Is Nothing) Then
        cmdOK_Click
    End If
End Sub

⌨️ 快捷键说明

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