frmhetonglogin.frm

来自「一个优秀的售楼系统,可供毕业生毕业设计参考」· FRM 代码 · 共 944 行 · 第 1/3 页

      MsgBox "销售人员编号不能为空！", vbOKOnly + vbExclamation, "出错啦！"
      combosaleid.SetFocus
      Exit Sub
   End If
sql = "select * from 合同 where 合同.Pct_ID = " & Val(Label22.Caption)
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.Fields(1) = combolounum.Text      '楼盘编号
rs_hetong.Fields(2) = combobuyerid.Text      '购买人身份证号
rs_hetong.Fields(3) = combosaleid.Text      '销售人员编号
If txtzhekou.Text <> "" Then
   rs_hetong.Fields(5) = CSng(txtzhekou.Text)      '折扣率
Else
   rs_hetong.Fields(5) = Null
End If
rs_hetong.Fields(6) = CCur(Val(txtzhekou.Text) * 1000)   '现金折扣
rs_hetong.Fields(7) = txtcheweinum.Text      '车位编号
rs_hetong.Fields(8) = CCur(txtcheweip.Text)    '楼盘价款
rs_hetong.Fields(9) = txtbasenum.Text      '地下室编号
rs_hetong.Fields(10) = txtbasep.Text    '地下室价款
rs_hetong.Fields(11) = combofukuan.Text    '还款方式
rs_hetong.Fields(12) = txtbank.Text    '贷款银行
rs_hetong.Fields(13) = DTPicker1.Value '认购日期
rs_hetong.Fields(14) = DTPicker2.Value '合同签订日期
rs_hetong.Update
rs_hetong.Close
sql = "select * from 预计付款 where 预计付款.Add_pactid = " & Val(Label22.Caption)
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.MoveFirst
For i = 1 To rs_hetong.RecordCount
    rs_hetong.Fields(0) = Val(Label22.Caption)
    gridhetong.Row = i
    gridhetong.Col = 0
    rs_hetong.Fields(1) = gridhetong.Text
    gridhetong.Col = 1
    rs_hetong.Fields(2) = CCur(gridhetong.Text)
    gridhetong.Col = 2
    rs_hetong.Fields(3) = gridhetong.Text
   rs_hetong.Update
    rs_hetong.MoveNext
Next i
'rs_hetong.Update
rs_hetong.Close
MsgBox "修改成功！", vbOKOnly + vbExclamation, ""
Exit Sub
modifyerror:
    MsgBox Err.Description
End Sub

Private Sub cmddel_Click()
Dim answer As String
Dim i As Integer
Dim sql As String
On Error GoTo delerror
   answer = MsgBox("确定要作废吗？", vbYesNo, "")
   If answer = vbYes Then
      sql = "select * from 合同 where 合同.Pct_ID = " & Val(Label22.Caption)
      rs_hetong.CursorLocation = adUseClient
      rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
      rs_hetong.Delete
      rs_hetong.Update
      rs_hetong.Close
      sql = "select * from 预计付款 where 预计付款.Add_pactid = " & Val(Label22.Caption)
      rs_hetong.CursorLocation = adUseClient
      rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
      rs_hetong.MoveFirst
      For i = 1 To rs_hetong.RecordCount
       rs_hetong.Delete
       rs_hetong.Update
       rs_hetong.MoveNext
      Next i
      rs_hetong.Close
      MsgBox "删除成功！", vbOKOnly + vbExclamation, ""
      gridhetong.Clear
      combofind.RemoveItem (combofind.ListIndex)
     Exit Sub
  Else
       Exit Sub
  End If
Exit Sub
delerror:
   MsgBox Err.Description

End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
Dim i As Integer
On Error GoTo loaderror
Dim rs_combo As New ADODB.Recordset
sql = "select * from 楼盘"
rs_combo.CursorLocation = adUseClient
rs_combo.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_combo.MoveFirst
Do While Not rs_combo.EOF
   combolounum.AddItem rs_combo.Fields(0)
   rs_combo.MoveNext
Loop
rs_combo.Close
sql = "select * from 客户资料"
rs_combo.CursorLocation = adUseClient
rs_combo.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_combo.MoveFirst
Do While Not rs_combo.EOF
   combobuyerid.AddItem rs_combo.Fields(0)
   rs_combo.MoveNext
Loop
rs_combo.Close
sql = "select * from 售楼人员"
rs_combo.CursorLocation = adUseClient
rs_combo.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_combo.MoveFirst
Do While Not rs_combo.EOF
   combosaleid.AddItem rs_combo.Fields(0)
   rs_combo.MoveNext
Loop
rs_combo.Close
combofukuan.AddItem "贷款"
combofukuan.AddItem "一次付清"
combofukuan.AddItem "分期付款"
sql = "select 合同.Pct_ID from 合同"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
rs_hetong.MoveFirst
For i = 0 To rs_hetong.RecordCount - 1
    combofind.AddItem rs_hetong.Fields(0)
    rs_hetong.MoveNext
Next i
rs_hetong.Close
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Public Sub displaymingxi()
Dim sql As String
sql = "select 合同.*,楼盘.* from 合同,楼盘 where 合同.Pct_ID = " & Val(selecthetong) & _
      " and 合同.Pct_houseID = 楼盘.hos_id"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
Label25.Caption = "已签订"          '合同状态
Label22.Caption = selecthetong      '合同编号
combolounum.Text = rs_hetong.Fields(1)    '楼盘编号
combobuyerid.Text = rs_hetong.Fields(2)    '购买人身份证号
combosaleid.Text = rs_hetong.Fields(3)    '销售人员编号
txtprice.Text = rs_hetong.Fields(4)    '合同单价
txtzhekou.Text = rs_hetong.Fields(5)    '折扣率
txtcashzhekou.Text = rs_hetong.Fields(6)    '现金折扣
txtcheweinum.Text = rs_hetong.Fields(7)    '车位编号
txtcheweip.Text = rs_hetong.Fields(8)    '楼盘价款
txtbasenum.Text = rs_hetong.Fields(9)    '地下室编号
txtbasep.Text = rs_hetong.Fields(10)    '地下室价款
combofukuan.Text = rs_hetong.Fields(11)  '还款方式
txtbank.Text = rs_hetong.Fields(12)    '贷款银行
DTPicker1.Value = rs_hetong.Fields(13) '认购日期
DTPicker2.Value = rs_hetong.Fields(14) '合同签订日期
rs_hetong.Close
sql = "select 客户资料.* ,合同.* ,售楼人员.* from 客户资料, 合同,售楼人员 where " & _
    " 合同.Pct_ID = " & Val(selecthetong) & _
    " and 合同.pct_buyerid = 客户资料.Hon_ID and " & _
    "合同.Pct_salesID = 售楼人员.Sal_ID"
rs_kehu.CursorLocation = adUseClient
rs_kehu.Open sql, conn, adOpenKeyset, adLockPessimistic
Label27.Caption = rs_kehu.Fields(1)     '购买人姓名
Label28.Caption = rs_kehu.Fields(30)    '销售人员姓名
rs_kehu.Close
sql = "select 合同.*,楼盘.*,户型.* from 合同,楼盘,户型 where " & _
     " 合同.Pct_ID = " & Val(selecthetong) & _
     " and 合同.Pct_houseID = 楼盘.hos_id " & _
     " and 楼盘.hos_hstid = 户型.Hst_ID"
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
Label26.Caption = "面积：" & rs_hetong.Fields(20) & "；户型：" & _
                rs_hetong.Fields(22) & "；报价：" & rs_hetong.Fields(18)
Label23.Caption = rs_hetong.Fields(18)
Label24.Caption = CStr(rs_hetong.Fields(18) * rs_hetong.Fields(20))
rs_hetong.Close
setgrid
setgridhead
displaygrid
End Sub

Public Sub setgrid()
Dim i As Integer
Dim sql As String
On Error GoTo seterror
sql = "select 预计付款.* from 预计付款 where 预计付款.Add_pactid = " & Val(selecthetong)
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
With gridhetong
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 0
    .Rows = rs_hetong.RecordCount + 1
    .Cols = 3
    .SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
    .RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
    .ColWidth(i) = 1300
Next i
End With
rs_hetong.Close
Exit Sub
seterror:
     MsgBox Err.Description
End Sub

Public Sub setgridhead()
gridhetong.Row = 0
gridhetong.Col = 0
gridhetong.Text = "日期"
gridhetong.Col = 1
gridhetong.Text = "金额"
gridhetong.Col = 2
gridhetong.Text = "是否已付款"
End Sub

Public Sub displaygrid()
Dim i As Integer
On Error GoTo seterror
Dim sql As String
sql = "select 预计付款.* from 预计付款 where 预计付款.Add_pactid = " & Val(selecthetong)
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
If Not rs_hetong.EOF Then
rs_hetong.MoveFirst
For i = 0 To rs_hetong.RecordCount - 1
    With gridhetong
         .Row = i + 1
         .Col = 0
         .Text = rs_hetong.Fields(1)
         .Col = 1
         .Text = rs_hetong.Fields(2)
         .Col = 2
         .Text = rs_hetong.Fields(3)
    End With
    rs_hetong.MoveNext
Next i
End If
rs_hetong.Close
Exit Sub
seterror:
   MsgBox Err.Description
End Sub

Public Sub savegrid()
Dim sql As String
Dim i As Integer
sql = "select * from 预计付款 "
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
For i = 1 To gridhetong.Row - 1
    rs_hetong.AddNew
    rs_hetong.Fields(0) = Label22.Caption
    rs_hetong.Fields(1) = gridhetong.TextMatrix(i, 0)
    rs_hetong.Fields(2) = gridhetong.TextMatrix(i, 1)
    rs_hetong.Fields(3) = "否"
    rs_hetong.Update
    DoEvents
Next i
rs_hetong.Close
End Sub

Private Sub gridhetong_Click()
   nextposition gridhetong.Row, gridhetong.Col
End Sub

Public Sub nextposition(ByVal r As Integer, ByVal c As Integer)
On Error GoTo nexterror
txtinput.Width = gridhetong.CellWidth
txtinput.Height = gridhetong.CellHeight
txtinput.Left = gridhetong.Left + gridhetong.ColPos(c)
txtinput.Top = gridhetong.Top + gridhetong.RowPos(r)
txtinput.Text = gridhetong.Text
txtinput.Visible = True
txtinput.SetFocus
Exit Sub
nexterror:
     MsgBox Err.Description
End Sub

Private Sub txtinput_Change()
On Error GoTo texterror
gridhetong.Text = txtinput.Text
Exit Sub
texterror:
     MsgBox Err.Description
End Sub

Private Sub txtinput_KeyPress(KeyAscii As Integer)
On Error GoTo texterror
If KeyAscii = keyenter Then
   If gridhetong.Col = gridhetong.Cols - 1 Then
         If gridhetong.Row = gridhetong.Rows - 1 Then
            gridhetong.Rows = gridhetong.Rows + 1
         End If
         gridhetong.Row = gridhetong.Row + 1
         gridhetong.Col = 0
   Else
      gridhetong.Col = gridhetong.Col + 1
   End If
KeyAscii = 0
nextposition gridhetong.Row, gridhetong.Col
End If
Exit Sub
texterror:
    MsgBox Err.Description
End Sub