📄 sk_hj03.frm
字号:
TabIndex = 18
Top = 7440
Value = -1 'True
Visible = 0 'False
Width = 735
End
Begin VB.CommandButton Command6
Caption = "查 询"
Height = 375
Left = 7560
TabIndex = 19
Top = 7320
Visible = 0 'False
Width = 1095
End
Begin VB.OptionButton Option2
Caption = "母亲姓名"
Height = 255
Left = 1800
TabIndex = 20
Top = 7440
Visible = 0 'False
Width = 1095
End
Begin VB.TextBox v_bianma
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1800
TabIndex = 8
Text = "0000000"
Top = 7920
Visible = 0 'False
Width = 1455
End
Begin VB.ComboBox v_sex
Height = 300
ItemData = "sk_hj03.frx":0000
Left = 6720
List = "sk_hj03.frx":000A
TabIndex = 9
Text = "男"
Top = 7920
Visible = 0 'False
Width = 615
End
Begin VB.TextBox v_bumen
Height = 375
Left = 4320
TabIndex = 12
Top = 8520
Visible = 0 'False
Width = 1215
End
Begin VB.ComboBox v_ys
Height = 300
ItemData = "sk_hj03.frx":0016
Left = 1800
List = "sk_hj03.frx":0018
TabIndex = 11
Top = 8520
Visible = 0 'False
Width = 1455
End
Begin VB.CommandButton Command9
Caption = "生成编码"
Height = 375
Left = 6240
TabIndex = 34
Top = 7320
Visible = 0 'False
Width = 1095
End
Begin VB.ComboBox v_hk
Height = 300
ItemData = "sk_hj03.frx":001A
Left = 6480
List = "sk_hj03.frx":0045
TabIndex = 35
Text = "其它"
Top = 8520
Visible = 0 'False
Width = 975
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "卡号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 480
TabIndex = 37
Top = 840
Width = 420
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "划 价 收 款"
BeginProperty Font
Name = "黑体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 285
Left = 3720
TabIndex = 33
Top = 240
Width = 1695
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "姓 名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3720
TabIndex = 28
Top = 840
Width = 735
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "办事处"
Height = 180
Left = 5760
TabIndex = 36
Top = 8640
Visible = 0 'False
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "日 期"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 6360
TabIndex = 32
Top = 840
Width = 735
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "科 别"
Height = 180
Left = 3480
TabIndex = 31
Top = 8640
Visible = 0 'False
Width = 630
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "门诊医生"
Height = 180
Left = 960
TabIndex = 30
Top = 8640
Visible = 0 'False
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "性 别"
Height = 180
Left = 5760
TabIndex = 29
Top = 8040
Visible = 0 'False
Width = 630
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "编 码"
Height = 180
Left = 960
TabIndex = 27
Top = 8040
Visible = 0 'False
Width = 630
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "母亲姓名"
Height = 180
Left = 7560
TabIndex = 26
Top = 8640
Visible = 0 'False
Width = 720
End
End
End
Attribute VB_Name = "sk_hj03"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public v_session_id1 As String
Public Sub ShowErr()
c = MsgBox("打印机连接失败,请检查!", vbQuestion, "系统提示!")
End Sub
'*********************************************************
'* 名称:nNumber2Chinese
'* 功能:数值转换为人民币(汉字)
'* 用法:nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
Dim i, k As Integer
Dim NC, nd, ka, chrNum, strZheng As String
Dim c1, c2, c3 As String
Dim K1 As Integer
Dim Zheng As String
Dim Xiao As String
NC = Trim(Format(txtJE, "##0.00"))
c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
c2 = "角分"
c3 = "玖捌柒陆伍肆叁贰壹"
If NC = 0 Then
Num2Chi = "零元整"
Exit Function
End If
Num2Chi = ""
Zheng = Mid(NC, 1, (Len(NC) - 3))
Xiao = Mid(NC, (Len(Zheng) + 2))
If Val(Xiao) <> 0 Then
For i = Len(Xiao) To 1 Step -1
chrNum = Mid(Xiao, i, 1)
If chrNum <> 0 Then
Num2Chi = Mid(c2, i, 1) & Num2Chi
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Next i
End If
k = 0
If Val(Zheng) <> 0 Then
Num2Chi = "元" & Num2Chi
For i = Len(Zheng) To 1 Step -1
If (Len(Zheng) - i) = 4 Then
Num2Chi = "万" & Num2Chi
ElseIf (Len(Zheng) - i) = 8 Then
Num2Chi = "亿" & Num2Chi
ElseIf (Len(Zheng) - i) = 12 Then
Num2Chi = "万" & Num2Chi
End If
chrNum = Mid(Zheng, i, 1)
If chrNum <> 0 Then
If i = Len(Zheng) Then
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
Else
If (Len(Zheng) - i) <> 4 And (Len(Zheng) - i) <> 8 And (Len(Zheng) - i) <> 12 Then
Num2Chi = Mid(c1, (Len(c1) - k), 1) & Num2Chi
End If
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Else
If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
If Mid(Num2Chi, 1, 1) <> "零" Then
Num2Chi = "零" & Num2Chi
End If
End If
End If
k = k + 1
Next i
End If
If Right(Trim(Num2Chi), 1) <> "分" Then
Num2Chi = Num2Chi
End If
v_daxie.Caption = Num2Chi
End Function
Function strUCaseMoney(ByVal AlbMoney)
Dim strDecimal, i, J, strTemp
AlbMoney = Trim(AlbMoney & "")
i = InStr(AlbMoney, ".")
If i = 0 Then
i = Len(AlbMoney) + 1
Else
strDecimal = Mid(AlbMoney, i + 1)
End If
'转换小数点以前
strUCaseMoney = ""
J = 1
For i = i - 1 To 1 Step -1
Select Case Mid(AlbMoney, i, 1)
Case "0": strTemp = "零"
Case "1": strTemp = "壹"
Case "2": strTemp = "贰"
Case "3": strTemp = "叁"
Case "4": strTemp = "肆"
Case "5": strTemp = "伍"
Case "6": strTemp = "陆"
Case "7": strTemp = "柒"
Case "8": strTemp = "捌"
Case "9": strTemp = "玖"
End Select
'IF Int(Mid(AlbMoney,I,1))>0 Then
Select Case J
Case 1: strTemp = strTemp & "圆"
Case 2: strTemp = strTemp & "拾"
Case 3: strTemp = strTemp & "佰"
Case 4: strTemp = strTemp & "仟"
Case 5: strTemp = strTemp & "万"
Case 6: strTemp = strTemp & "拾"
Case 7: strTemp = strTemp & "佰"
Case 8: strTemp = strTemp & "仟"
Case 9: strTemp = strTemp & "亿"
End Select
'End IF
strUCaseMoney = strTemp & strUCaseMoney
J = J + 1
Next
'转换小数
If strDecimal <> "" Then
For i = 1 To Len(strDecimal)
Select Case Mid(strDecimal, i, 1)
Case "0": strTemp = "零"
Case "1": strTemp = "壹"
Case "2": strTemp = "贰"
Case "3": strTemp = "叁"
Case "4": strTemp = "肆"
Case "5": strTemp = "伍"
Case "6": strTemp = "陆"
Case "7": strTemp = "柒"
Case "8": strTemp = "捌"
Case "9": strTemp = "玖"
End Select
Select Case i
Case 1: strTemp = strTemp & "角"
Case 2: strTemp = strTemp & "分"
Case 3: strTemp = strTemp & "厘"
'Case 4: strTemp=strTemp & ""
End Select
strUCaseMoney = strUCaseMoney & strTemp
Next
ElseIf strUCaseMoney <> "" Then
strUCaseMoney = strUCaseMoney
End If
v_daxie.Caption = strUCaseMoney
End Function
Private Sub Command1_Click()
sk_erfujia1.Show
End Sub
Private Sub Command10_Click()
Dim rs As New ADODB.Recordset
Dim sql As String
sql = "select * from 患者信息 where 卡号='" + Trim(CStr(v_car.Text)) + "'"
rs.Open sql, db
If Not rs.EOF Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -