frmselorgan.frm

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

VERSION 5.00
Begin VB.Form frmSelOrgan 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "[检查部位] 选择内容:"
   ClientHeight    =   5355
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4950
   Icon            =   "frmSelOrgan.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5355
   ScaleWidth      =   4950
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Height          =   1095
      Left            =   300
      TabIndex        =   3
      Top             =   3360
      Width           =   4335
      Begin VB.Label Label2 
         Caption         =   "提示:"
         Height          =   195
         Left            =   240
         TabIndex        =   10
         Top             =   240
         Width           =   510
      End
      Begin VB.Label lblTip 
         Caption         =   "提示内容"
         Height          =   735
         Left            =   915
         TabIndex        =   9
         Top             =   240
         Width           =   3015
      End
   End
   Begin VB.PictureBox picCmd 
      Align           =   2  'Align Bottom
      BorderStyle     =   0  'None
      Height          =   870
      Left            =   0
      ScaleHeight     =   870
      ScaleWidth      =   4950
      TabIndex        =   2
      Top             =   4485
      Width           =   4950
      Begin VB.CommandButton cmdCancel 
         Cancel          =   -1  'True
         Caption         =   "取消 [ESC]"
         Height          =   375
         Left            =   3390
         TabIndex        =   6
         Top             =   300
         Width           =   1260
      End
      Begin VB.CommandButton cmdOK 
         Caption         =   "确定 [ENTER]"
         Default         =   -1  'True
         Height          =   375
         Left            =   2070
         TabIndex        =   5
         Top             =   300
         Width           =   1260
      End
      Begin VB.CommandButton cmdHelp 
         Caption         =   "帮助 [F1]"
         Height          =   375
         Left            =   300
         TabIndex        =   4
         Top             =   300
         Visible         =   0   'False
         Width           =   1260
      End
   End
   Begin VB.ListBox lstOrgan 
      Height          =   2400
      Left            =   2280
      TabIndex        =   1
      Top             =   660
      Width           =   2355
   End
   Begin VB.ListBox lstRegion 
      Height          =   2400
      Left            =   300
      TabIndex        =   0
      Top             =   660
      Width           =   1815
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "部位:"
      Height          =   255
      Index           =   1
      Left            =   2280
      TabIndex        =   8
      Top             =   360
      Width           =   915
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "部位大类:"
      Height          =   255
      Index           =   0
      Left            =   300
      TabIndex        =   7
      Top             =   360
      Width           =   915
   End
End
Attribute VB_Name = "frmSelOrgan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Region As String
Public Organ As String
Public Cancel As Boolean

Private Sub cmdCancel_Click()
    Cancel = True
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Cancel = False
    Organ = lstOrgan.Text
    Unload Me
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
        
    '-------------------------------
    '处理键盘事件
    '-------------------------------
            
    Select Case KeyCode
        Case US_KEY_CANCEL
            cmdCancel_Click
        
    End Select
    
End Sub

Private Sub Form_Load()
    
    '-----------------------
    '初始化
    '-----------------------
    
    FillRegion
    Cancel = True
    
    '设置提示内容
    lblTip.Caption = "利用[↑]和[↓]按键选择条目; [TAB]键和[SHIFT]+[TAB]键切换选择区域; [F2]或[ENTER]确认; [ESC]退出。"

End Sub


Private Sub lstOrgan_DblClick()
    
    '----------------------
    '双击相当于点击“确认”
    '----------------------
    
    cmdOK_Click
    
End Sub

Private Sub lstRegion_Click()
    
    FillOrgan (lstRegion.Text)
    
End Sub


Private Sub FillRegion()
    
    '-----------------
    '填充部位集合
    '-----------------
    
    Dim rsTemp As ADODB.Recordset
    lstRegion.Clear
    Set rsTemp = OpenRSClient("SELECT * FROM US_ORGAN_REGION")
    With rsTemp
        Do While Not .EOF
            lstRegion.AddItem !REGION_NAME
            .MoveNext
        Loop
    End With
    
    Set rsTemp = Nothing
    
End Sub


Public Sub FillOrgan(RegionName As String)
    
    '----------------
    '填充器官集合
    '----------------
    
    Dim rsTemp As ADODB.Recordset
    
    lstOrgan.Clear
    Set rsTemp = OpenRSClient("SELECT * FROM US_ORGAN_COMB WHERE REGION_NAME ='" & RegionName & "' ORDER BY COMB_FREQUENCY DESC, COMB_INDEX")
    With rsTemp
        Do While Not .EOF
            lstOrgan.AddItem !COMB_NAME
            .MoveNext
        Loop
    End With
    
    Set rsTemp = Nothing
    
End Sub