frmshoufeilogin.frm

一款非常不错的售楼管理系统

VERSION 5.00
Begin VB.Form Frmshoufeilogin 
   BackColor       =   &H00C0FFC0&
   Caption         =   "收费登记"
   ClientHeight    =   5940
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9120
   LinkTopic       =   "Form1"
   ScaleHeight     =   5940
   ScaleWidth      =   9120
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   4575
      Left            =   240
      Picture         =   "Frmshoufeilogin.frx":0000
      ScaleHeight     =   4575
      ScaleWidth      =   8535
      TabIndex        =   13
      Top             =   360
      Width           =   8535
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   0
         Left            =   1560
         TabIndex        =   0
         Top             =   840
         Width           =   1695
      End
      Begin VB.TextBox txtjkr 
         BorderStyle     =   0  'None
         Height          =   270
         Left            =   6600
         TabIndex        =   10
         Top             =   4200
         Width           =   1215
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   1
         Left            =   6360
         TabIndex        =   1
         Top             =   1750
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   2
         Left            =   6360
         TabIndex        =   2
         Top             =   2050
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   3
         Left            =   6360
         TabIndex        =   3
         Top             =   2340
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   4
         Left            =   6360
         TabIndex        =   4
         Top             =   2640
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   5
         Left            =   6360
         TabIndex        =   5
         Top             =   3000
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   6
         Left            =   6360
         TabIndex        =   6
         Top             =   3360
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   200
         Index           =   7
         Left            =   6480
         TabIndex        =   7
         Top             =   3750
         Width           =   1575
      End
      Begin VB.TextBox txtskr 
         BorderStyle     =   0  'None
         Height          =   270
         Left            =   4560
         TabIndex        =   9
         Top             =   4200
         Width           =   1095
      End
      Begin VB.Label Label1 
         BackColor       =   &H80000009&
         Height          =   180
         Left            =   4440
         TabIndex        =   18
         Top             =   900
         Width           =   450
      End
      Begin VB.Label Label2 
         BackColor       =   &H80000009&
         Height          =   180
         Left            =   5100
         TabIndex        =   17
         Top             =   900
         Width           =   200
      End
      Begin VB.Label Label3 
         BackColor       =   &H80000009&
         Height          =   180
         Left            =   5550
         TabIndex        =   16
         Top             =   900
         Width           =   200
      End
      Begin VB.Label Label4 
         BackColor       =   &H80000009&
         Height          =   180
         Left            =   7680
         TabIndex        =   15
         Top             =   880
         Width           =   855
      End
      Begin VB.Label Label6 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   1560
         TabIndex        =   8
         Top             =   3720
         Width           =   4455
      End
   End
   Begin VB.CommandButton cmdsave 
      Caption         =   "保存"
      Height          =   375
      Left            =   1560
      TabIndex        =   11
      Top             =   5280
      Width           =   1215
   End
   Begin VB.CommandButton cmdprint 
      Caption         =   "打印"
      Height          =   375
      Left            =   3840
      TabIndex        =   12
      Top             =   5280
      Width           =   1095
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   375
      Left            =   6240
      TabIndex        =   14
      Top             =   5280
      Width           =   1215
   End
End
Attribute VB_Name = "Frmshoufeilogin"
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

Private Sub cmdsave_Click()
Dim i As Integer
If Trim(txtmoney(0).Text) = "" Then
   MsgBox "楼盘编号不能为空！", vbOKOnly + vbExclamation, "系统提示！"
   txtmoney(0).SetFocus
   Exit Sub
End If
Dim fee As Currency
fee = 0
For i = 1 To 6
    fee = fee + CCur(txtmoney(i).Text)
Next i
txtmoney(7).Text = CStr(fee)
Label6.Caption = ChineseFormat(fee)
rs_shoufei.AddNew
rs_shoufei.Fields(0) = Label4
rs_shoufei.Fields(1) = txtmoney(0).Text
rs_shoufei.Fields(2) = Date
For i = 1 To 6
    rs_shoufei.Fields(i + 2) = txtmoney(i).Text
Next i
rs_shoufei.Fields(9) = txtskr.Text
rs_shoufei.Fields(10) = 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 收费"
rs_shoufei.CursorLocation = adUseClient
rs_shoufei.Open sql, conn, adOpenKeyset, adLockPessimistic
For i = 1 To 7
    txtmoney(i).Text = "0.00"
Next i
i = rs_shoufei.RecordCount
Label1.Caption = Year(Date)
Label2.Caption = Month(Date)
Label3.Caption = Day(Date)
Label4.Caption = Format(i + 1, "000000")
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