📄 病历.frm
字号:
Key = ""
EndProperty
EndProperty
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "病历.frx":BA428
Height = 8535
Left = 120
TabIndex = 23
Top = 240
Width = 10335
_ExtentX = 18230
_ExtentY = 15055
_Version = 393216
AllowUpdate = 0 'False
AllowArrows = 0 'False
Appearance = 0
HeadLines = 1
RowHeight = 15
TabAction = 1
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
End
Begin VB.Frame Frame1
Caption = " 选项 "
Height = 975
Left = 120
TabIndex = 0
Top = 360
Width = 14775
Begin VB.ComboBox Combo1
Height = 300
ItemData = "病历.frx":BA43D
Left = 600
List = "病历.frx":BA43F
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 32
ToolTipText = "精确查询..暂不支持模糊查询."
Top = 480
Width = 1575
End
Begin VB.CommandButton Command5
Caption = "重新加载"
Height = 375
Left = 13320
TabIndex = 6
Top = 360
Width = 975
End
Begin VB.CommandButton Command4
Caption = "刷新"
Height = 375
Left = 11880
TabIndex = 5
Top = 360
Width = 975
End
Begin VB.CommandButton Command3
Caption = "删除"
Height = 375
Left = 10200
TabIndex = 4
Top = 360
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "新增"
Height = 375
Left = 8520
TabIndex = 3
Top = 360
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "查询"
Height = 375
Left = 6240
TabIndex = 2
ToolTipText = "精确查询..暂不支持模糊查询."
Top = 360
Width = 1095
End
Begin VB.TextBox Text1
Height = 285
Left = 3120
TabIndex = 1
ToolTipText = "精确查询..暂不支持模糊查询."
Top = 450
Width = 2775
End
Begin VB.Label Label2
Caption = "关键字:"
Height = 255
Index = 0
Left = 2400
TabIndex = 22
ToolTipText = "精确查询..暂不支持模糊查询."
Top = 480
Width = 735
End
Begin VB.Label Label1
Caption = "字段:"
Height = 255
Left = 120
TabIndex = 21
ToolTipText = "精确查询..暂不支持模糊查询."
Top = 480
Width = 495
End
End
Begin MSAdodcLib.Adodc Adodc1
Height = 495
Left = 3840
Top = 5520
Visible = 0 'False
Width = 4215
_ExtentX = 7435
_ExtentY = 873
ConnectMode = 3
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Database1.dat;Persist Security Info=False"
OLEDBString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Database1.dat;Persist Security Info=False"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "main"
Caption = "病历管理"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If Combo1.Text = "" Or Text1.Text = "" Then
MsgBox "你在查什么???选(填)一下呀!!", , "温馨提示!"
Exit Sub
Else
Dim name, ff As String
name = Text1.Text
ff = Combo1.Text
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from main where " & ff & " = '" & name & "';"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox ff & Chr(58) & Chr(34) & name & Chr(34) & "不存在,请查正!!", , "错误??"
End If
End If
End Sub
Private Sub Command10_Click()
Adodc1.Recordset.MoveFirst
End Sub
Private Sub Command11_Click()
Adodc1.Recordset.MoveLast
End Sub
Private Sub Command2_Click()
Form2.Show
End Sub
Private Sub Command3_Click()
msg$ = MsgBox("是否确认删除当前选择的记录?", vbYesNo + vbQuestion, "询问?")
If msg$ = vbYes Then
On Error GoTo delerrer
Adodc1.Recordset.Delete
Adodc1.Recordset.MoveNext
Exit Sub
delerrer:
MsgBox "信息不完整或有错误.,请察正后(有没有选择要删除的项呀!)再点!!", vbCritical, "温馨提示"
Else
End If
End Sub
Private Sub Command4_Click()
Adodc1.Refresh
End Sub
Private Sub Command5_Click()
Unload Me
Form1.Show
End Sub
Private Sub Command6_Click()
Command7.Enabled = True
Text2(0).Enabled = True
Text2(1).Enabled = True
Text2(2).Enabled = True
Text2(3).Enabled = True
Text2(4).Enabled = True
Text2(5).Enabled = True
Text2(6).Enabled = True
End Sub
Private Sub Command7_Click()
On Error GoTo adderrer
Adodc1.Recordset.UpdateBatch
MsgBox "修改成功", , "恭喜!"
Text2(0).Enabled = False
Text2(1).Enabled = False
Text2(2).Enabled = False
Text2(3).Enabled = False
Text2(4).Enabled = False
Text2(5).Enabled = False
Text2(6).Enabled = False
Command7.Enabled = False
Exit Sub
adderrer:
MsgBox "信息不完整或有错误.,请察正后(看看帮助.)再点确定!!", vbCritical, "温馨提示"
Text2(0).Enabled = False
Text2(1).Enabled = False
Text2(2).Enabled = False
Text2(3).Enabled = False
Text2(4).Enabled = False
Text2(5).Enabled = False
Text2(6).Enabled = False
Command7.Enabled = False
End Sub
Private Sub Command8_Click()
Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF = True Then
Adodc1.Recordset.MoveLast
End If
End Sub
Private Sub Command9_Click()
Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF = True Then
Adodc1.Recordset.MoveFirst
End If
End Sub
Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
Unload Me
End Sub
Private Sub Form_Load()
Combo1.List(0) = "姓名"
Combo1.List(1) = "性别"
Combo1.List(2) = "年龄"
Combo1.List(3) = "入院时间"
Combo1.List(4) = "病史"
Combo1.List(5) = "备注"
Command7.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 3 Then
If KeyAscii < 48 Or KeyAscii > 57 Then
MsgBox "不要告诉我你用" & Chr(34) + Chr(KeyAscii) + Chr(34) & "代表别人的年龄", vbExclamation, "温馨提示"
KeyAscii = 0
End If
End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "查询"
Command1_Click
Case "新增"
Command2_Click
Case "刷新"
Command4_Click
Case "删除"
Command3_Click
Case "上一条"
Command8_Click
Case "下一条"
Command9_Click
Case "最前"
Command10_Click
Case "最后"
Command11_Click
Case "修改"
Command6_Click
Case "退出"
Unload Me
Case "帮助"
Form3.Show
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -