📄 frmsick_tnb_list.frm
字号:
BorderStyle = 1 'Fixed Single
Caption = "超声"
Height = 270
Left = 90
TabIndex = 111
Top = 5505
Width = 1620
End
Begin VB.Label Label34
BorderStyle = 1 'Fixed Single
Caption = "肌电图"
Height = 270
Left = 90
TabIndex = 110
Top = 5790
Width = 1620
End
Begin VB.Label Label35
BorderStyle = 1 'Fixed Single
Caption = "心电图"
Height = 270
Left = 90
TabIndex = 109
Top = 6090
Width = 1620
End
Begin VB.Label Label36
BorderStyle = 1 'Fixed Single
Caption = "微循环"
Height = 270
Left = 90
TabIndex = 108
Top = 6375
Width = 1620
End
Begin VB.Label Label38
BorderStyle = 1 'Fixed Single
Caption = "X线"
Height = 270
Left = 90
TabIndex = 107
Top = 6660
Width = 1620
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "空腹"
Height = 270
Left = 1710
TabIndex = 106
Top = 450
Width = 960
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "2小时"
Height = 270
Left = 3630
TabIndex = 105
Top = 450
Width = 960
End
Begin VB.Label Label5
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "3小时"
Height = 270
Left = 4590
TabIndex = 104
Top = 450
Width = 960
End
Begin VB.Label LabNum
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "3.9-6.1"
Height = 270
Index = 0
Left = 1710
TabIndex = 103
Top = 1020
Width = 960
End
Begin VB.Label LabNum
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "<7.2"
Height = 270
Index = 2
Left = 3630
TabIndex = 102
Top = 1020
Width = 960
End
Begin VB.Label Label10
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "<6.1"
Height = 270
Index = 1
Left = 4590
TabIndex = 101
Top = 1020
Width = 960
End
Begin VB.Label Label12
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "12.7±7.1"
Height = 270
Left = 1710
TabIndex = 100
Top = 1575
Width = 960
End
Begin VB.Label Label14
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "46.9±26.7"
Height = 270
Left = 3630
TabIndex = 99
Top = 1575
Width = 960
End
Begin VB.Label Label15
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "14.9±9.9"
Height = 270
Left = 4590
TabIndex = 98
Top = 1575
Width = 960
End
Begin VB.Label Label17
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "0.38±0.15"
Height = 270
Left = 1710
TabIndex = 97
Top = 2145
Width = 960
End
Begin VB.Label Label19
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "1.06±0.58"
Height = 270
Left = 3630
TabIndex = 96
Top = 2145
Width = 960
End
Begin VB.Label Label20
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "0.25±0.25"
Height = 270
Left = 4590
TabIndex = 95
Top = 2145
Width = 960
End
Begin VB.Label Label18
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "1.38±0.47"
Height = 270
Left = 2670
TabIndex = 94
Top = 2145
Width = 960
End
Begin VB.Label Label13
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "71.6±33.8"
Height = 270
Left = 2670
TabIndex = 93
Top = 1575
Width = 960
End
Begin VB.Label LabNum
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "<10.5"
Height = 270
Index = 1
Left = 2670
TabIndex = 92
Top = 1020
Width = 960
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H80000004&
BorderStyle = 1 'Fixed Single
Caption = "1小时"
Height = 270
Index = 0
Left = 2670
TabIndex = 91
Top = 450
Width = 960
End
Begin VB.Label Label1
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Caption = "项目"
Height = 270
Left = 90
TabIndex = 90
Top = 450
Width = 1620
End
End
End
Attribute VB_Name = "FrmSick_Tnb_List"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FStrDaID As String
Private Sub CmdCzSave_Click()
Dim IntTmp As Integer
'数据校验
For IntTmp = 0 To TxtNum.Count - 1
If Trim(TxtNum(IntTmp)) = "" Then
TxtNum(IntTmp) = "0"
Else
If Not IsNumeric(TxtNum(IntTmp)) Then
MsgBox "请您输入正确的数据!", vbInformation, "提示"
TxtNum(IntTmp).SetFocus
Exit Sub
End If
End If
Next IntTmp
'数据提交
PCnnHisDB.BeginTrans
'清除数据
PCnnHisDB.Execute " DELETE FROM jkda_sick_tnb_check_list_num WHERE daid='" + FStrDaID + "' "
PCnnHisDB.Execute " DELETE FROM jkda_sick_tnb_check_list_char WHERE daid='" + FStrDaID + "' "
'添加数据
For IntTmp = 0 To TxtNum.Count - 1
PCnnHisDB.Execute " INSERT INTO jkda_sick_tnb_check_list_num(daid, xmid, CheckValue) VALUES( " _
& " '" + FStrDaID + "','" + TxtNum(IntTmp).Tag + "', " + Trim(TxtNum(IntTmp)) + ") "
Next IntTmp
For IntTmp = 0 To TxtChar.Count - 1
PCnnHisDB.Execute " INSERT INTO jkda_sick_tnb_check_list_char(daid, xmid, CheckValue) VALUES( " _
& " '" + FStrDaID + "','" + TxtChar(IntTmp).Tag + "', '" + Trim(TxtChar(IntTmp)) + "') "
Next IntTmp
'判断事务状态
If CBool(PCnnHisDB.State And adStateExecuting) Then
PCnnHisDB.Cancel
PCnnHisDB.RollbackTrans
MsgBox "操作失败，请重试。", vbCritical, "提示"
Exit Sub
Else
PCnnHisDB.CommitTrans
MsgBox "保存成功，请继续。", vbInformation, "提示"
Call ProcEditTable
End If
End Sub
Private Sub Form_Load()
Me.Move 0, 1150
Call ProcEditTable
End Sub
Private Sub CmdExit_Click(Index As Integer)
Unload Me
End Sub
Private Sub ProcEditTable()
Dim IntTmp As Integer
Dim AdoRsSeek As ADODB.Recordset
Set AdoRsSeek = New ADODB.Recordset
FStrDaID = FrmSick_Tnb_main.PStrDaID
'数值型 内容输出
AdoRsSeek.Open "SELECT daid, xmid, CheckValue FROM jkda_sick_tnb_check_list_num WHERE daid='" + FStrDaID + "' ORDER BY xmid ", PCnnHisDB, adOpenKeyset
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then
For IntTmp = 0 To TxtNum.Count - 1
AdoRsSeek.MoveLast: AdoRsSeek.MoveFirst
AdoRsSeek.Find " xmid = '" + Trim(TxtNum(IntTmp).Tag) + "' "
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then TxtNum(IntTmp) = AdoRsSeek.Fields("CheckValue")
Next IntTmp
End If
'颜色变换
AdoRsSeek.Close
AdoRsSeek.Open "SELECT xmid, vale_max, vale_min FROM jkda_sick_tnb_base_item WHERE useflag='1' ORDER BY xmid ", PCnnHisDB, adOpenKeyset
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then
For IntTmp = 0 To TxtNum.Count - 1
AdoRsSeek.MoveLast: AdoRsSeek.MoveFirst
AdoRsSeek.Find " xmid = '" + Trim(TxtNum(IntTmp).Tag) + "' "
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then
If TxtNum(IntTmp) < AdoRsSeek.Fields("vale_min") Or TxtNum(IntTmp) > AdoRsSeek.Fields("vale_max") Then
TxtNum(IntTmp).ForeColor = vbRed
Else
TxtNum(IntTmp).ForeColor = vbBlack
End If
End If
Next IntTmp
End If
'字符型 内容输出
AdoRsSeek.Close
AdoRsSeek.Open "SELECT daid, xmid, CheckValue FROM jkda_sick_tnb_check_list_char WHERE daid='" + FStrDaID + "' ORDER BY xmid ", PCnnHisDB, adOpenKeyset
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then
For IntTmp = 0 To TxtChar.Count - 1
AdoRsSeek.MoveLast: AdoRsSeek.MoveFirst
AdoRsSeek.Find " xmid = '" + Trim(TxtChar(IntTmp).Tag) + "' "
If Not (AdoRsSeek.EOF Or AdoRsSeek.BOF) Then TxtChar(IntTmp) = AdoRsSeek.Fields("CheckValue")
Next IntTmp
End If
AdoRsSeek.Close: Set AdoRsSeek = Nothing
End Sub
Private Sub TxtChar_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index < TxtChar.Count - 1 Then
TxtChar(Index + 1).SetFocus
TxtChar(Index + 1).SelLength = Len(TxtChar(Index + 1))
Else
CmdCzSave.SetFocus
End If
End If
End Sub
Private Sub TxtNum_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index < TxtNum.Count - 1 Then
TxtNum(Index + 1).SetFocus
TxtNum(Index + 1).SelLength = Len(TxtNum(Index + 1))
Else
TxtChar(0).SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -