📄 frmshoukuanlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmShoukuanLogin
BackColor = &H00C0FFFF&
BorderStyle = 3 'Fixed Dialog
Caption = "收款管理"
ClientHeight = 5310
ClientLeft = 45
ClientTop = 435
ClientWidth = 8490
Icon = "frmShoukuanLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5310
ScaleWidth = 8490
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
Height = 4335
Left = 0
Picture = "frmShoukuanLogin.frx":014A
ScaleHeight = 4275
ScaleWidth = 8475
TabIndex = 5
Top = 360
Width = 8535
Begin VB.ComboBox Combo2
Height = 300
Left = 3960
TabIndex = 9
Top = 1680
Width = 1335
End
Begin VB.TextBox txtloupannum
Height = 270
Left = 1560
TabIndex = 8
Top = 840
Width = 1095
End
Begin VB.TextBox txtskr
Height = 270
Left = 4680
TabIndex = 7
Top = 3840
Width = 975
End
Begin VB.TextBox txtjkr
Height = 270
Left = 6600
TabIndex = 6
Top = 3840
Width = 1335
End
Begin VB.Label Label2
BackColor = &H00FFFFFF&
Height = 255
Left = 4200
TabIndex = 15
Top = 840
Width = 615
End
Begin VB.Label Label3
BackColor = &H00FFFFFF&
Height = 255
Left = 5040
TabIndex = 14
Top = 840
Width = 255
End
Begin VB.Label Label4
BackColor = &H00FFFFFF&
Height = 255
Left = 5520
TabIndex = 13
Top = 840
Width = 255
End
Begin VB.Label Label5
BackColor = &H00FFFFFF&
ForeColor = &H000000FF&
Height = 255
Left = 7680
TabIndex = 12
Top = 840
Width = 735
End
Begin VB.Label Label6
BackColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 11
Top = 3360
Width = 4095
End
Begin VB.Label Label7
BackColor = &H00FFFFFF&
Height = 255
Left = 6600
TabIndex = 10
Top = 3360
Width = 1335
End
End
Begin VB.CommandButton cmdsave
Caption = "保 存"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2040
TabIndex = 4
Top = 4800
Width = 1215
End
Begin VB.CommandButton cdmprint
Caption = "打 印"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3720
TabIndex = 3
Top = 4800
Width = 1215
End
Begin VB.CommandButton cmdexit
Caption = "退 出"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5400
TabIndex = 2
Top = 4800
Width = 1215
End
Begin VB.TextBox txtprice
BorderStyle = 0 'None
BeginProperty DataFormat
Type = 1
Format = """￥""#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 2
EndProperty
Height = 270
Left = 6120
TabIndex = 1
Top = 2160
Width = 1695
End
Begin VB.ComboBox Combo1
Height = 300
Left = 1560
Style = 2 'Dropdown List
TabIndex = 0
Top = 0
Width = 1215
End
Begin VB.Label Label1
BackColor = &H00C0FFFF&
Caption = "请选择合同号："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 255
Left = 120
TabIndex = 16
Top = 0
Width = 1575
End
End
Attribute VB_Name = "frmShoukuanLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_shoufei As New ADODB.Recordset
Dim rs_hetong As New ADODB.Recordset
Private Sub cdmprint_Click()
Dim X%
X% = BitBlt(Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, _
Picture1.hDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Printer.PaintPicture Picture1.Picture, 0, 0
End Sub
Private Sub cmdsave_Click()
Dim i As Integer
If Trim(txtloupannum.Text) = "" Then
MsgBox "楼盘编号不能为空！", vbOKOnly + vbExclamation
txtloupannum.SetFocus
Exit Sub
End If
Label7.Caption = CStr(CCur(Trim(txtprice.Text)))
Label6.Caption = ChineseFormat(CCur(Trim(txtprice.Text)))
rs_shoufei.AddNew
rs_shoufei.Fields(0) = Val(Trim(Label5.Caption))
rs_shoufei.Fields(1) = Val(Trim(Combo1.Text))
rs_shoufei.Fields(2) = Trim(txtloupannum.Text)
rs_shoufei.Fields(3) = Date
rs_shoufei.Fields(4) = CCur(Trim(txtprice.Text))
rs_shoufei.Fields(5) = Trim(Combo2.Text)
rs_shoufei.Fields(6) = Trim(txtskr.Text)
rs_shoufei.Fields(7) = Trim(txtjkr.Text)
rs_shoufei.Update
MsgBox "保存成功！", vbOKOnly + vbExclamation
Exit Sub
End Sub
Private Sub cmdprint_Click()
Dim X%
X% = BitBlt(Picture1.hDC, 0, 0, Picture1.Width, Picture1.Height, _
Picture1.hDC, 0, 0, SRCCOPY)
Picture1.Picture = Picture1.Image
Printer.PaintPicture Picture1.Picture, 0, 0
End Sub
Private Sub cmdexit_Click()
rs_shoufei.Close
Unload Me
End Sub
Private Sub Form_Load()
Dim sql As String
Dim i As Integer
On Error GoTo loaderror
sql = "select * from 收款登记表"
If rs_shoufei.State <> 0 Then rs_shoufei.Close
rs_shoufei.CursorLocation = adUseClient
rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic
txtprice.Text = "0.00"
i = rs_shoufei.RecordCount
Label2.Caption = Year(Date) 'Date取得当前系统日期
Label3.Caption = Month(Date) 'Month函数取得日期的月数部分
Label4.Caption = Day(Date)
Label5.Caption = Format(i + 1, "000000") '系统中现有记录条数加1
Combo2.AddItem ("现金")
Combo2.AddItem ("刷卡")
Combo2.AddItem ("银行票据")
Combo2.ListIndex = 0
sql = "select * from 合同资料表"
If rs_hetong.State <> 0 Then rs_hetong.Close
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
If rs_hetong.RecordCount > 0 Then
rs_hetong.MoveFirst
Do While Not rs_hetong.EOF
Combo1.AddItem (Trim(rs_hetong.Fields(0)))
rs_hetong.MoveNext
Loop
Combo1.ListIndex = 0
End If
rs_hetong.Close
Exit Sub
loaderror:
MsgBox Err.Description
End Sub
Function ChineseFormat(n As Variant)
Dim s As String, sFormat As String
Dim i As Integer, c As String
Const sString = "分角元拾佰仟万拾佰仟亿拾佰仟万"
Const sNumber = "零壹贰叁肆伍陆柒捌玖"
s = Format(Int(n * 100))
sFormat = ""
For i = Len(s) To 1 Step -1
c = Mid(s, i, 1)
sFormat = Mid(sNumber, Val(c) _
+ 1, 1) + Mid(sString, Len(s) - i + 1, 1) _
+ sFormat
Next
ChineseFormat = sFormat
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -