📄 dlgautobak.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 = 7260
ClientLeft = 45
ClientTop = 435
ClientWidth = 10185
Icon = "dlgAuto.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7260
ScaleWidth = 10185
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.TextBox TxtHeight
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6810
TabIndex = 15
Top = 3480
Width = 1125
End
Begin VB.TextBox TxtWidth
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 6810
TabIndex = 13
Top = 3000
Width = 1125
End
Begin VB.ComboBox cmbOther
Height = 315
Left = 6360
Style = 2 'Dropdown List
TabIndex = 11
Top = 600
Width = 2925
End
Begin VB.OptionButton optXJie
BackColor = &H80000018&
Caption = "科室结论"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 3390
TabIndex = 10
Top = 180
Width = 1125
End
Begin VB.ListBox lstXJie
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6180
Left = 3480
TabIndex = 9
Top = 570
Width = 2385
End
Begin VB.Frame Frame1
BackColor = &H80000018&
Caption = "示例"
Height = 1515
Left = 6090
TabIndex = 5
Top = 1140
Width = 3645
Begin VB.TextBox txtAuto
Enabled = 0 'False
Height = 585
Left = 180
Locked = -1 'True
TabIndex = 6
Top = 690
Width = 2715
End
Begin XPControls.XPCommandButton cmdFont
Height = 315
Left = 2940
TabIndex = 7
Top = 840
Width = 615
_ExtentX = 1085
_ExtentY = 556
Caption = "字体..."
Font = "dlgAuto.frx":0CCA
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "动态文本："
Height = 195
Index = 0
Left = 150
TabIndex = 8
Top = 300
Width = 900
End
End
Begin VB.OptionButton optOther
BackColor = &H80000018&
Caption = "其他"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 6030
TabIndex = 4
Top = 180
Width = 1125
End
Begin VB.OptionButton optKShi
BackColor = &H80000018&
Caption = "体检数据"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 285
Left = 90
TabIndex = 3
Top = 180
Value = -1 'True
Width = 1125
End
Begin MSComctlLib.TreeView tvwKShi
Height = 6300
Left = 240
TabIndex = 2
Top = 570
Width = 2925
_ExtentX = 5159
_ExtentY = 11113
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Style = 7
Appearance = 1
Font = "dlgAuto.frx":0CF6
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 8100
Top = 4980
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin XPControls.XPCommandButton cmdCancel
Height = 375
Left = 8430
TabIndex = 0
Top = 5790
Width = 975
_ExtentX = 1720
_ExtentY = 661
Caption = "取消(&C)"
Font = "dlgAuto.frx":0D19
End
Begin XPControls.XPCommandButton cmdOK
Height = 375
Left = 6870
TabIndex = 1
Top = 5790
Width = 975
_ExtentX = 1720
_ExtentY = 661
Caption = "确定(&O)"
Font = "dlgAuto.frx":0D3C
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "毫米"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 4
Left = 8070
TabIndex = 17
Top = 3540
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "毫米"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 3
Left = 8070
TabIndex = 16
Top = 3090
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "宽度："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 2
Left = 6150
TabIndex = 14
Top = 3540
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "长度："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 1
Left = 6150
TabIndex = 12
Top = 3060
Width = 540
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 = 11
'显示根节点
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 left(XXID,4)='" & rsDX("DXID") & "'"
'按顺序号排序
strSQL = strSQL & " order by SXH"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -