frmhetongfind.frm

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

VERSION 5.00
Begin VB.Form frmhetongfind 
   BackColor       =   &H00C0FFFF&
   Caption         =   "合同查询"
   ClientHeight    =   7665
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9930
   LinkTopic       =   "Form14"
   MaxButton       =   0   'False
   ScaleHeight     =   7665
   ScaleWidth      =   9930
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Printgrid1 
      Height          =   480
      Left            =   4800
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   19
      Top             =   4920
      Width           =   1200
   End
   Begin VB.PictureBox gridshiji 
      Height          =   2175
      Left            =   5400
      ScaleHeight     =   2115
      ScaleWidth      =   4275
      TabIndex        =   18
      Top             =   5280
      Width           =   4335
   End
   Begin VB.PictureBox gridyuding 
      Height          =   2175
      Left            =   360
      ScaleHeight     =   2115
      ScaleWidth      =   4275
      TabIndex        =   17
      Top             =   5280
      Width           =   4335
   End
   Begin VB.PictureBox gridhetong 
      Height          =   2895
      Left            =   360
      ScaleHeight     =   2835
      ScaleWidth      =   9315
      TabIndex        =   14
      Top             =   1920
      Width           =   9375
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   375
      Left            =   8640
      TabIndex        =   13
      Top             =   1200
      Width           =   975
   End
   Begin VB.CommandButton cmdprint 
      Caption         =   "打印"
      Height          =   375
      Left            =   8640
      TabIndex        =   12
      Top             =   480
      Width           =   975
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0FFFF&
      Caption         =   "查询条件"
      Height          =   1575
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   7935
      Begin VB.CommandButton cmdfind 
         Caption         =   "查询"
         Height          =   375
         Left            =   6240
         TabIndex        =   11
         Top             =   840
         Width           =   1095
      End
      Begin VB.PictureBox DTPicker2 
         Height          =   255
         Left            =   3720
         ScaleHeight     =   195
         ScaleWidth      =   1635
         TabIndex        =   9
         Top             =   960
         Width           =   1695
      End
      Begin VB.PictureBox DTPicker1 
         Height          =   255
         Left            =   1320
         ScaleHeight     =   195
         ScaleWidth      =   1515
         TabIndex        =   8
         Top             =   960
         Width           =   1575
      End
      Begin VB.TextBox txtID 
         Height          =   270
         Left            =   6480
         TabIndex        =   7
         Top             =   360
         Width           =   1335
      End
      Begin VB.TextBox txtloupannum 
         Height          =   270
         Left            =   3720
         TabIndex        =   6
         Top             =   360
         Width           =   1215
      End
      Begin VB.TextBox txtnum 
         Height          =   270
         Left            =   1320
         TabIndex        =   5
         Top             =   360
         Width           =   1215
      End
      Begin VB.OptionButton Option4 
         BackColor       =   &H00C0FFFF&
         Caption         =   "签订时间"
         Height          =   375
         Left            =   240
         TabIndex        =   4
         Top             =   840
         Width           =   1095
      End
      Begin VB.OptionButton Option3 
         BackColor       =   &H00C0FFFF&
         Caption         =   "客户身份证号"
         Height          =   255
         Left            =   5040
         TabIndex        =   3
         Top             =   360
         Width           =   1455
      End
      Begin VB.OptionButton Option2 
         BackColor       =   &H00C0FFFF&
         Caption         =   "楼盘编号"
         Height          =   255
         Left            =   2640
         TabIndex        =   2
         Top             =   360
         Width           =   1095
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0FFFF&
         Caption         =   "合同编号"
         Height          =   255
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0FFFF&
         Caption         =   "_______"
         Height          =   180
         Left            =   3000
         TabIndex        =   10
         Top             =   960
         Width           =   630
      End
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0FFFF&
      Caption         =   "实际付款情况"
      Height          =   180
      Left            =   5400
      TabIndex        =   16
      Top             =   5040
      Width           =   1080
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00C0FFFF&
      Caption         =   "预定付款情况"
      Height          =   180
      Left            =   360
      TabIndex        =   15
      Top             =   5040
      Width           =   1080
   End
End
Attribute VB_Name = "frmhetongfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_hetong As New ADODB.Recordset
Dim rs_yushou As New ADODB.Recordset
Dim rs_yishou As New ADODB.Recordset
Dim getrow As Integer
Dim select_row As String
Dim select_house As String

Private Sub cmdfind_Click()
Dim sql As String
On Error GoTo loaderror
gridhetong.Clear
If Option1.Value = True Then
   sql = "select * from 合同 where 合同.Pct_ID = " & Val(txtnum.Text)
   rs_hetong.CursorLocation = adUseClient
   rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid1
   setgridhead
   displaygrid
   rs_hetong.Close
   Exit Sub
End If
If Option2.Value = True Then
   sql = "select * from 合同 where 合同.Pct_houseID = '" & txtloupannum.Text & "'"
   rs_hetong.CursorLocation = adUseClient
   rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid1
   setgridhead
   displaygrid
   rs_hetong.Close
   Exit Sub
End If
If Option3.Value = True Then
   sql = "select * from 合同 where 合同.pct_buyerid = '" & txtID.Text & "'"
   rs_hetong.CursorLocation = adUseClient
   rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid1
   setgridhead
   displaygrid
   rs_hetong.Close
   Exit Sub
End If
If Option4.Value = True Then
   sql = "select * from 合同 where 合同.Pct_pactdate between #" & DTPicker1.Value & _
        "# and #" & DTPicker2.Value & "#"
   rs_hetong.CursorLocation = adUseClient
   rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid1
   setgridhead
   displaygrid
   rs_hetong.Close
   Exit Sub
End If
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Private Sub cmdprint_Click()
Printgrid1.Unit = Centimeter
Printgrid1.PrintObject = gridhetong
Printgrid1.DoPreView
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 合同"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
setgrid1
setgridhead
displaygrid
rs_hetong.Close
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub
Public Sub displaygrid()
Dim i As Integer
On Error GoTo displayerror
gridhetong.Row = 0
If Not rs_hetong.EOF Then
   rs_hetong.MoveFirst
   Do While Not rs_hetong.EOF
            gridhetong.Row = gridhetong.Row + 1
            For i = 0 To 14
                gridhetong.Col = i
                If Not IsNull(rs_hetong.Fields(i)) Then
                   gridhetong.Text = rs_hetong.Fields(i)
                Else
                   gridhetong.Text = ""
                End If
            Next i
            rs_hetong.MoveNext
   Loop
End If
displayerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub setgrid1()
Dim i As Integer
On Error GoTo seterror
With gridhetong
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_hetong.RecordCount + 1
    .Cols = 15
    .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
Exit Sub
seterror:
     MsgBox Err.Description
End Sub

Public Sub setgridhead()
On Error GoTo setheaderror
With gridhetong
     .Row = 0
     .Col = 0
     .Text = "合同编号"
     .Col = 1
     .Text = "楼盘编号"
     .Col = 2
     .Text = "身份证号"
     .Col = 3
     .Text = "销售员编号"
     .Col = 4
     .Text = "单位价格"
     .Col = 5
     .Text = "折扣率"
     .Col = 6
     .Text = "现金折扣"
     .Col = 7
     .Text = "车位号"
     .Col = 8
     .Text = "车位价格"
     .Col = 9
     .Text = "地下室号"
     .Col = 10
     .Text = "地下室价格"
     .Col = 11
     .Text = "付款方式"
     .Col = 12
     .Text = "付款银行"
     .Col = 13
     .Text = "预签日期"
     .Col = 14
     .Text = "合同日期"
End With
Exit Sub
setheaderror:
   MsgBox Err.Description
End Sub

Public Sub setgrid2()
Dim i As Integer
With gridyuding
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_yushou.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
With gridshiji
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_yishou.RecordCount + 1
    .Cols = 2
    .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

With gridyuding
     .Row = 0
     .Col = 0
     .Text = "付款日期"
     .Col = 1
     .Text = "付款金额"
     .Col = 2
     .Text = "是否已付款"
End With
With gridshiji
     .Row = 0
     .Col = 0
     .Text = "付款日期"
     .Col = 1
     .Text = "付款金额"
End With

End Sub

Private Sub gridhetong_Click()
On Error GoTo griderror
getrow = gridhetong.Row
If gridhetong.Rows = 1 Then
   MsgBox "无相关纪录", vbOKOnly + vbExclamation, ""
Else
select_row = gridhetong.TextMatrix(getrow, 0)
select_house = gridhetong.TextMatrix(getrow, 1)
displaymingxi
End If
griderror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub displaymingxi()
Dim sql As String
Dim i As Integer
sql = "select * from 预计付款 where 预计付款.Add_pactid = " & Val(select_row)
rs_yushou.CursorLocation = adUseClient
rs_yushou.Open sql, conn, adOpenKeyset, adLockPessimistic
sql = "select * from 收款登记 where 收款登记.icm_houseID = '" & select_house & "'"
rs_yishou.CursorLocation = adUseClient
rs_yishou.Open sql, conn, adOpenKeyset, adLockPessimistic
setgrid2
gridyuding.Row = 0
If Not rs_yushou.EOF Then
   rs_yushou.MoveFirst
   Do While Not rs_yushou.EOF
            gridyuding.Row = gridyuding.Row + 1
            For i = 0 To 2
                gridyuding.Col = i
                If Not IsNull(rs_yushou.Fields(i + 1)) Then
                   gridyuding.Text = rs_yushou.Fields(i + 1)
                Else
                   gridyuding.Text = ""
                End If
            Next i
            rs_yushou.MoveNext
   Loop
End If
gridshiji.Row = 0
If Not rs_yishou.EOF Then
   rs_yishou.MoveFirst
   Do While Not rs_yishou.EOF
            gridshiji.Row = gridshiji.Row + 1
            For i = 0 To 1
                gridshiji.Col = i
                If Not IsNull(rs_yishou.Fields(i + 2)) Then
                   gridshiji.Text = rs_yishou.Fields(i + 2)
                Else
                   gridshiji.Text = ""
                End If
            Next i
            rs_yishou.MoveNext
   Loop
End If
rs_yushou.Close
rs_yishou.Close
End Sub