dlgauto.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
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 dlgAuto 
   BackColor       =   &H80000018&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "动态文本"
   ClientHeight    =   7065
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9720
   Icon            =   "dlgAuto.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7065
   ScaleWidth      =   9720
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.OptionButton optKShi 
      BackColor       =   &H80000018&
      Caption         =   "体检数据"
      ForeColor       =   &H00FF0000&
      Height          =   285
      Left            =   150
      TabIndex        =   8
      Top             =   150
      Value           =   -1  'True
      Width           =   1125
   End
   Begin VB.OptionButton optOther 
      BackColor       =   &H80000018&
      Caption         =   "其他"
      ForeColor       =   &H00FF0000&
      Height          =   285
      Left            =   5940
      TabIndex        =   7
      Top             =   150
      Width           =   1125
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "示例"
      Height          =   1515
      Left            =   5910
      TabIndex        =   3
      Top             =   1800
      Width           =   3645
      Begin VB.TextBox txtAuto 
         Enabled         =   0   'False
         Height          =   585
         Left            =   180
         Locked          =   -1  'True
         TabIndex        =   4
         Top             =   690
         Width           =   2595
      End
      Begin XPControls.XPCommandButton cmdFont 
         Height          =   315
         Left            =   2850
         TabIndex        =   5
         Top             =   840
         Width           =   705
         _ExtentX        =   1244
         _ExtentY        =   556
         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 Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "动态文本："
         Height          =   195
         Index           =   0
         Left            =   150
         TabIndex        =   6
         Top             =   300
         Width           =   900
      End
   End
   Begin VB.ListBox lstXJie 
      Height          =   6300
      Left            =   3300
      TabIndex        =   2
      Top             =   540
      Width           =   2385
   End
   Begin VB.OptionButton optXJie 
      BackColor       =   &H80000018&
      Caption         =   "科室结论"
      ForeColor       =   &H00FF0000&
      Height          =   285
      Left            =   3330
      TabIndex        =   1
      Top             =   150
      Width           =   1125
   End
   Begin VB.ComboBox cmbOther 
      Height          =   315
      ItemData        =   "dlgAuto.frx":0CCA
      Left            =   5940
      List            =   "dlgAuto.frx":0CCC
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   570
      Width           =   2925
   End
   Begin MSComctlLib.TreeView tvwKShi 
      Height          =   6360
      Left            =   150
      TabIndex        =   9
      Top             =   540
      Width           =   2925
      _ExtentX        =   5159
      _ExtentY        =   11218
      _Version        =   393217
      HideSelection   =   0   'False
      LabelEdit       =   1
      Style           =   7
      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
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   7920
      Top             =   4890
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin XPControls.XPCommandButton cmdCancel 
      Height          =   405
      Left            =   8130
      TabIndex        =   10
      Top             =   5700
      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 
      Default         =   -1  'True
      Height          =   405
      Left            =   6570
      TabIndex        =   11
      Top             =   5700
      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
End
Attribute VB_Name = "dlgAuto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mstrAuto As String
Dim mtypFont As FontType
Dim mstrRelation As String

'被调函数
Public Function ShowAutoText(ByVal strAuto As String, ByRef objControl As Object) As Boolean
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim nodTemp As Node
    Dim rsKShi As ADODB.Recordset
    Dim rsDX As ADODB.Recordset
    Dim rsXX As ADODB.Recordset
    Dim rsTemp As ADODB.Recordset
    Dim strTag As String
    Dim arrTag
    Dim intFlag As Integer
    Dim strID As String
    Dim i As Integer
    
    Screen.MousePointer = vbArrowHourglass
    
    '显示根节点
    tvwKShi.Nodes.Clear
    Set nodTemp = tvwKShi.Nodes.Add(, , "W", "所有项目")
    nodTemp.Expanded = True
    '显示所有科室
    strSQL = "select KSID,KSMC from SET_KSSZ"
    '按顺序号排序
    strSQL = strSQL & " order by SXH"
    Set rsKShi = New ADODB.Recordset
    rsKShi.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rsKShi.RecordCount > 0 Then
        rsKShi.MoveFirst
        Do
            '添加科室
            Set nodTemp = tvwKShi.Nodes.Add("W", tvwChild, "W" & rsKShi("KSID"), rsKShi("KSMC"))
'            nodTemp.Expanded = True
            
            strSQL = "select DXID,DXMC,DXSFYZX from SET_DX" _
                    & " where left(DXID,2)='" & rsKShi("KSID") & "'"
            '按顺序号排序
            strSQL = strSQL & " order by SXH"
            Set rsDX = New ADODB.Recordset
            rsDX.Open strSQL, GCon, adOpenStatic, adLockOptimistic
            If rsDX.RecordCount > 0 Then
                rsDX.MoveFirst
                Do
                    '添加大项
                    Set nodTemp = tvwKShi.Nodes.Add("W" & rsKShi("KSID"), tvwChild, "W" & rsDX("DXID"), rsDX("DXMC"))
'                    nodTemp.Expanded = True
                    
                    If rsDX("DXSFYZX") = 1 Then '有子项
                        strSQL = "select XXID,XXMC from SET_XX" _
                                & " where XXID in (" _
                                    & "select XXID from SET_ZH_Data" _
                                    & " where DXID='" & rsDX("DXID") & "'" _
                                & ")"
                        '按顺序号排序
                        strSQL = strSQL & " order by SXH"
                        Set rsXX = New ADODB.Recordset
                        rsXX.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
                        If rsXX.RecordCount > 0 Then
                            rsXX.MoveFirst
                            Do
                                tvwKShi.Nodes.Add "W" & rsDX("DXID"), tvwChild, "W" & rsDX("DXID") & rsXX("XXID"), rsXX("XXMC")
'                                nodTemp.Expanded = True
                                
                                rsXX.MoveNext
                            Loop Until rsXX.EOF
                            rsXX.Close
                        End If
                    End If
                     
                    rsDX.MoveNext
                Loop Until rsDX.EOF
                rsDX.Close
            End If
            
            '科室小结
            lstXJie.AddItem rsKShi("KSMC")
            lstXJie.ItemData(lstXJie.NewIndex) = rsKShi("KSID")
'
'            '科室建议
'            lstJYi.AddItem rsKShi("KSMC")
'            lstJYi.ItemData(lstJYi.NewIndex) = rsKShi("KSID")
            
            rsKShi.MoveNext
        Loop Until rsKShi.EOF
        rsKShi.Close
    End If
    
    '默认选择科室结构