frmitemdetail.frm

VB6.0编写的医院影像系统

VERSION 5.00
Begin VB.Form frmItemDetail 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "*"
   ClientHeight    =   5535
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3900
   Icon            =   "frmItemDetail.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5535
   ScaleWidth      =   3900
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   1080
      Left            =   105
      TabIndex        =   4
      Top             =   3705
      Width           =   3690
      Begin VB.Label lblTip 
         Caption         =   "提示内容"
         Height          =   735
         Left            =   840
         TabIndex        =   6
         Top             =   240
         Width           =   2715
      End
      Begin VB.Label Label2 
         Caption         =   "提示:"
         Height          =   195
         Left            =   165
         TabIndex        =   5
         Top             =   240
         Width           =   510
      End
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定 [ENTER]"
      Default         =   -1  'True
      Height          =   375
      Left            =   1050
      TabIndex        =   2
      Tag             =   "确定"
      Top             =   4995
      Width           =   1320
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消 [ESC]"
      Height          =   375
      Left            =   2505
      TabIndex        =   1
      Tag             =   "取消"
      Top             =   4995
      Width           =   1320
   End
   Begin VB.ListBox lstDetail 
      Height          =   2985
      Left            =   120
      TabIndex        =   0
      Top             =   540
      Width           =   3675
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "代码:    内容:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   300
      Width           =   3555
   End
End
Attribute VB_Name = "frmItemDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public ClassName As String          '类别名
Public SelString As String          '选择的内容
Public bCancel As Boolean           '取消标志

Private Sub cmdCancel_Click()
    
    '取消
    Unload Me
    
End Sub

Private Sub cmdOK_Click()
    Dim strText As String
    Dim iPlace As Integer
    
    '确定键
    strText = lstDetail.Text
    iPlace = InStr(1, strText, vbTab)
    '如果没有需要的结果,则视同取消
    If iPlace = 0 Then
        Unload Me
    Else
        SelString = Mid(strText, iPlace + 1)
        bCancel = False
        Unload Me
    End If
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    '-----------------
    '快捷键处理
    '-----------------
    Select Case KeyCode
        Case vbKeyReturn
            cmdOK_Click
        Case US_KEY_CANCEL
            cmdCancel_Click
        Case Else
    End Select
    
End Sub

Private Sub Form_Load()
    
    '------------------------------------------------
    '加载与ClassName相对应的列表
    '------------------------------------------------
    
    Dim strSQL As String
    Dim rsTemp As ADODB.Recordset
    Dim i As Integer
    
    '设置标题和缺省的取消标志
    Me.Caption = "[" & ClassName & "] 的可选内容:"
    bCancel = True
    
    '填充内容列表
    strSQL = "SELECT ITEMDATA, ITEMINDEX FROM US_REPORT_ITEM_DETAIL WHERE CLASS_NAME = '" & ClassName & "' " & "ORDER BY FREQUENCY DESC, ITEMINDEX"
    Set rsTemp = OpenRSClient(strSQL)
    
    With rsTemp
        Do While Not .EOF
            lstDetail.AddItem !ITEMINDEX & vbTab & !ItemData
            i = i + 1
            If !ItemData = SelString Then lstDetail.ListIndex = i - 1
            .MoveNext
        Loop
    End With
    
     
    '如果没有与已有内容匹配的项目,则设置第一条列表
    If lstDetail.ListCount > 1 And lstDetail.ListIndex = -1 Then lstDetail.ListIndex = 0
    
    '设置提示内容
    lblTip.Caption = "利用[↑]和[↓]按键选择条目; [F2]或[ENTER]确认; [ESC]退出。"
    
    '释放对象
    rsTemp.Close
    Set rsTemp = Nothing
        
End Sub

Private Sub lstDetail_DblClick()
    
    '------------------------
    '双击列表框触发确认事件
    '------------------------
    cmdOK_Click
    
End Sub