📄 form1.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{826C7913-F2FA-4001-9902-5C755C3ABFC4}#1.0#0"; "XP窗体.ocx"
Begin VB.Form Form1
BackColor = &H00FFC0C0&
Caption = "Form1"
ClientHeight = 10695
ClientLeft = 25305
ClientTop = 37170
ClientWidth = 7065
LinkTopic = "Form1"
ScaleHeight = 10695
ScaleWidth = 7065
StartUpPosition = 3 '窗口缺省
Begin Xp窗体.Command Command3
Height = 495
Left = 4080
TabIndex = 9
Top = 3960
Width = 975
_ExtentX = 1720
_ExtentY = 873
Caption = "置空 "
按钮上的图标 = "Form1.frx":0000
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
按钮类型 = 3
End
Begin Xp窗体.Command Command2
Height = 495
Left = 5400
TabIndex = 8
Top = 3960
Width = 975
_ExtentX = 1720
_ExtentY = 873
Caption = "退出"
按钮上的图标 = "Form1.frx":001C
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
按钮类型 = 3
End
Begin Xp窗体.Command Command1
Height = 495
Left = 2760
TabIndex = 7
Top = 3960
Width = 1095
_ExtentX = 1931
_ExtentY = 873
Caption = "查找"
按钮上的图标 = "Form1.frx":0038
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
按钮类型 = 3
End
Begin VB.TextBox Text1
ForeColor = &H00C00000&
Height = 3495
Left = 2520
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 240
Width = 4095
End
Begin Xp窗体.XpCorona XpCorona1
Left = 2160
Top = 4800
_ExtentX = 4763
_ExtentY = 3466
End
Begin MSDataListLib.DataCombo DataCombo3
Height = 330
Left = 240
TabIndex = 0
Top = 4080
Width = 2055
_ExtentX = 3625
_ExtentY = 582
_Version = 393216
Text = ""
End
Begin MSDataListLib.DataCombo DataCombo2
Height = 330
Left = 240
TabIndex = 1
Top = 3360
Width = 2055
_ExtentX = 3625
_ExtentY = 582
_Version = 393216
Text = ""
End
Begin MSDataListLib.DataCombo DataCombo1
Height = 330
Left = 240
TabIndex = 2
Top = 2640
Width = 2055
_ExtentX = 3625
_ExtentY = 582
_Version = 393216
Text = ""
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Caption = "请选择查询的科室"
Height = 375
Left = 240
TabIndex = 5
Top = 3120
Width = 2175
End
Begin VB.Label Label2
BackColor = &H00FFC0C0&
Caption = "请选择医院名称"
Height = 375
Left = 240
TabIndex = 4
Top = 2400
Width = 1935
End
Begin VB.Label Label3
BackColor = &H00FFC0C0&
Caption = "请选择专家姓名"
Height = 255
Left = 240
TabIndex = 3
Top = 3840
Width = 1935
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 1695
Left = 240
Top = 480
Width = 1335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim pic As ADODB.Recordset
Dim Txt As ADODB.Recordset
Dim YiyuanCnn As String
Dim ZhuanyeCnn As String
Dim KeshiCnn As String
Dim ZhuanjiaCnn As String
Private Sub Command1_Click()
Dim vbresult As Integer
If DataCombo1.Text = "" And DataCombo2.Text = "" And DataCombo3.Text = "" Then '没有输入要查询信息的医院的名称
vbresult = MsgBox("请选择输入信息", vbOKCancel, "提示")
If vbresult = vbCancel Then '选择退出
Exit Sub
Else '输入医院的名称
DataCombo1.SetFocus
Exit Sub
End If
ElseIf DataCombo1.Text <> "" And DataCombo2.Text = "" And DataCombo3.Text = "" Then
vbresult = MsgBox("请选择输入专科类别名称或者专家姓名", vbOKCancel, "提示")
If vbresult = vbCancel Then '选择退出
Exit Sub
Else '输入专科类别名称
Exit Sub
End If
ElseIf DataCombo2.Text <> "" And DataCombo3.Text = "" Then
vbresult = MsgBox("请选择或者输入专家姓名", vbOKCancel, "提示")
If vbresult = vbCancel Then '选择退出
Exit Sub
Else '专家姓名
DataCombo3.SetFocus
Exit Sub
End If
End If
Dim PicStrCnn As String
Dim TxtStrCnn As String
Dim PicPath As String
Dim TxtPath As String
Dim pic As ADODB.Recordset
Dim Txt As ADODB.Recordset
PicStrCnn = "select 照片 from 专家信息索引表 where 专家姓名 = '" & Trim$(DataCombo3.Text) & "'"
Set pic = exesql(PicStrCnn)
PicPath = pic.Fields(0)
Image1.Picture = LoadPicture(App.Path & PicPath)
Text1.Text = ""
TxtStrCnn = "select 简介 from 专家信息索引表 where 专家姓名 = '" & Trim$(DataCombo3.Text) & "'"
Set Txt = exesql(TxtStrCnn)
TxtPath = (App.Path & Txt.Fields(0))
Dim nline
Open TxtPath For Input As #1
Do Until EOF(1)
Line Input #1, nline
Text1.Text = Text1.Text & nline & Chr(13) + Chr(10)
Loop
Close #1
ZhuanyeCnn = "select 医院名称 from 专家信息索引表 where 专家姓名='" & Trim$(DataCombo3.Text) & "'"
Set rst1 = exesql(ZhuanyeCnn)
Set DataCombo1.DataSource = rst1
Set DataCombo1.RowSource = rst1
DataCombo1.Refresh
DataCombo1.ReFill
DataCombo1.ListField = "医院名称"
DataCombo1.Text = rst1.Fields("医院名称")
Set rst1 = Nothing
ZhuanyeCnn = "select 专业 from 专家信息索引表 where 专家姓名='" & Trim$(DataCombo3.Text) & "'"
Set rst1 = exesql(ZhuanyeCnn)
Set DataCombo2.DataSource = rst1
Set DataCombo2.RowSource = rst1
DataCombo2.Refresh
DataCombo2.ReFill
DataCombo2.ListField = "专业"
DataCombo2.Text = rst1.Fields("专业")
Set rst1 = Nothing
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
DataCombo1.Text = ""
DataCombo2.Text = ""
DataCombo3.Text = ""
'加载医院名称
YiyuanCnn = "select 医院名称 from 专家信息索引表 group by 医院名称"
Set rst1 = exesql(YiyuanCnn)
Set DataCombo1.DataSource = rst1
Set DataCombo1.RowSource = rst1
DataCombo1.Refresh
DataCombo1.ReFill
DataCombo1.ListField = "医院名称"
Set rst1 = Nothing
KeshiCnn = "select 专业 from 专家信息索引表 group by 专业"
Set rst1 = exesql(KeshiCnn)
Set DataCombo2.DataSource = rst1
Set DataCombo2.RowSource = rst1
DataCombo2.Refresh
DataCombo2.ReFill
DataCombo2.ListField = "专业"
Set rst1 = Nothing
'加载专家姓名
ZhuanjiaCnn = "select 专家姓名 from 专家信息索引表 group by 专家姓名"
Set rst1 = exesql(ZhuanjiaCnn)
Set DataCombo3.DataSource = rst1
Set DataCombo3.RowSource = rst1
DataCombo3.Refresh
DataCombo3.ReFill
DataCombo3.ListField = "专家姓名"
Set rst1 = Nothing
End Sub
Private Sub DataCombo1_Click(Area As Integer)
If DataCombo1.Text <> "" Then
Set rst1 = New ADODB.Recordset
ZhuanyeCnn = "select 专业 from 专家信息索引表 where 医院名称='" & Trim$(DataCombo1.Text) & "'group by 专业 "
Set rst1 = exesql(ZhuanyeCnn)
Set DataCombo2.DataSource = rst1
Set DataCombo2.RowSource = rst1
DataCombo2.Refresh
DataCombo2.ReFill
DataCombo2.ListField = "专业"
End If
DataCombo2.Text = ""
DataCombo3.Text = ""
End Sub
Private Sub DataCombo2_Click(Area As Integer)
If DataCombo2.Text <> "" Then
If DataCombo1.Text <> "" Then
ZhuanjiaCnn = "select 专家姓名 from 专家信息索引表 where 医院名称='" & Trim$(DataCombo1.Text) & "' and 专业='" & Trim$(DataCombo2.Text) & "'group by 专家姓名"
Set rst1 = exesql(ZhuanjiaCnn)
Set DataCombo3.DataSource = rst1
Set DataCombo3.RowSource = rst1
DataCombo3.Refresh
DataCombo3.ReFill
DataCombo3.ListField = "专家姓名"
Set rst1 = Nothing
Else
ZhuanjiaCnn = "select 专家姓名 from 专家信息索引表 where 专业='" & Trim$(DataCombo2.Text) & "'group by 专家姓名"
Set rst1 = exesql(ZhuanjiaCnn)
Set DataCombo3.DataSource = rst1
Set DataCombo3.RowSource = rst1
DataCombo3.Refresh
DataCombo3.ReFill
DataCombo3.ListField = "专家姓名"
Set rst1 = Nothing
End If
End If
DataCombo3.Text = ""
End Sub
Private Sub DataCombo3_Click(Area As Integer)
If DataCombo1.Text <> "" And DataCombo2.Text = "" Then
ZhuanjiaCnn = "select 专家姓名 from 专家信息索引表 where 医院名称='" & Trim$(DataCombo1.Text) & "'group by 专家姓名"
Set rst1 = exesql(ZhuanjiaCnn)
Set DataCombo3.DataSource = rst1
Set DataCombo3.RowSource = rst1
DataCombo3.Refresh
DataCombo3.ReFill
DataCombo3.ListField = "专家姓名"
Set rst1 = Nothing
End If
End Sub
Private Sub Form_Load()
KeshiCnn = "select 专业 from 专家信息索引表 group by 专业"
Set rst1 = exesql(KeshiCnn)
Set DataCombo2.DataSource = rst1
Set DataCombo2.RowSource = rst1
DataCombo2.Refresh
DataCombo2.ReFill
DataCombo2.ListField = "专业"
Set rst1 = Nothing
'加载专家姓名
'加载医院名称
YiyuanCnn = "select 医院名称 from 专家信息索引表 group by 医院名称"
Set rst1 = exesql(YiyuanCnn)
Set DataCombo1.DataSource = rst1
Set DataCombo1.RowSource = rst1
DataCombo1.Refresh
DataCombo1.ReFill
DataCombo1.ListField = "医院名称"
Set rst1 = Nothing
'加载科室名称
ZhuanjiaCnn = "select 专家姓名 from 专家信息索引表 group by 专家姓名"
Set rst1 = exesql(ZhuanjiaCnn)
Set DataCombo3.DataSource = rst1
Set DataCombo3.RowSource = rst1
DataCombo3.Refresh
DataCombo3.ReFill
DataCombo3.ListField = "专家姓名"
Set rst1 = Nothing
' Image1属性设置
Image1.Stretch = True
'资料预设
Image1.Picture = LoadPicture(App.Path & "\照片库\专家\zj29.jpg")
Dim TxtPath As String
TxtPath = (App.Path & "\照片库\专家简介\zj27.txt")
Dim nline
Open TxtPath For Input As #1
Do Until EOF(1)
Line Input #1, nline
Text1.Text = Text1.Text & nline & Chr(13) + Chr(10)
Loop
Close #1
DataCombo1.Text = "市中心医院"
DataCombo2.Text = "麻醉学"
DataCombo3.Text = "姜丽华"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set rst1 = Nothing
Set pic = Nothing
Set Txt = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -