frmshoufeilogin.frm

一个优秀的售楼系统,可供毕业生毕业设计参考

VERSION 5.00
Begin VB.Form frmshoufeilogin 
   BackColor       =   &H00C0FFFF&
   Caption         =   "收费登记"
   ClientHeight    =   7350
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9210
   LinkTopic       =   "Form8"
   MaxButton       =   0   'False
   ScaleHeight     =   490
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   614
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   375
      Left            =   6360
      TabIndex        =   9
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton cmdprint 
      Caption         =   "打印"
      Height          =   375
      Left            =   4200
      TabIndex        =   8
      Top             =   5520
      Width           =   1095
   End
   Begin VB.CommandButton cmdsave 
      Caption         =   "保存"
      Height          =   375
      Left            =   2040
      TabIndex        =   7
      Top             =   5520
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   4575
      Left            =   120
      Picture         =   "FRMSHO~2.frx":0000
      ScaleHeight     =   4575
      ScaleWidth      =   8535
      TabIndex        =   0
      Top             =   480
      Width           =   8535
      Begin VB.TextBox txtskr 
         BorderStyle     =   0  'None
         Height          =   270
         Left            =   4560
         TabIndex        =   18
         Top             =   4200
         Width           =   1095
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   7
         Left            =   6360
         TabIndex        =   17
         Top             =   3720
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   6
         Left            =   6360
         TabIndex        =   16
         Top             =   3360
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   5
         Left            =   6360
         TabIndex        =   15
         Top             =   3000
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   4
         Left            =   6360
         TabIndex        =   14
         Top             =   2640
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   3
         Left            =   6360
         TabIndex        =   13
         Top             =   2280
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   2
         Left            =   6360
         TabIndex        =   12
         Top             =   2040
         Width           =   1695
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   300
         Index           =   1
         Left            =   6360
         TabIndex        =   11
         Top             =   1680
         Width           =   1695
      End
      Begin VB.TextBox txtjkr 
         BorderStyle     =   0  'None
         Height          =   270
         Left            =   6600
         TabIndex        =   6
         Top             =   4200
         Width           =   1215
      End
      Begin VB.TextBox txtmoney 
         BorderStyle     =   0  'None
         Height          =   270
         Index           =   0
         Left            =   1560
         TabIndex        =   1
         Top             =   840
         Width           =   1695
      End
      Begin VB.Label Label6 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   1560
         TabIndex        =   10
         Top             =   3720
         Width           =   4455
      End
      Begin VB.Label Label4 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   7680
         TabIndex        =   5
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Label3 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   5520
         TabIndex        =   4
         Top             =   840
         Width           =   255
      End
      Begin VB.Label Label2 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   5040
         TabIndex        =   3
         Top             =   840
         Width           =   255
      End
      Begin VB.Label Label1 
         BackColor       =   &H80000009&
         Height          =   255
         Left            =   3840
         TabIndex        =   2
         Top             =   840
         Width           =   975
      End
   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