frmzhda.frm

给售房作的,但还没有全完成,最好是只看看里面有用的东东就可以了

         Width           =   660
      End
      Begin VB.Label Label10 
         Caption         =   "付款方式"
         Height          =   255
         Left            =   120
         TabIndex        =   46
         Top             =   5160
         Width           =   735
      End
      Begin VB.Label Label9 
         BackStyle       =   0  'Transparent
         Caption         =   "平方米"
         Height          =   255
         Left            =   2200
         TabIndex        =   43
         Top             =   1500
         Width           =   735
      End
      Begin VB.Label Label8 
         Caption         =   "备    注"
         Height          =   255
         Left            =   120
         TabIndex        =   41
         Top             =   2290
         Width           =   735
      End
      Begin VB.Label Label7 
         Caption         =   "附加设备"
         Height          =   255
         Left            =   120
         TabIndex        =   39
         Top             =   2040
         Width           =   855
      End
      Begin VB.Label Label6 
         Caption         =   "车    库"
         Height          =   255
         Left            =   120
         TabIndex        =   37
         Top             =   1770
         Width           =   735
      End
      Begin VB.Label Label5 
         Caption         =   "住房类别"
         Height          =   255
         Left            =   120
         TabIndex        =   35
         Top             =   910
         Width           =   735
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "销售单价"
         Height          =   180
         Index           =   8
         Left            =   120
         TabIndex        =   34
         Top             =   4680
         Width           =   720
      End
      Begin VB.Line Line1 
         X1              =   0
         X2              =   3240
         Y1              =   3480
         Y2              =   3480
      End
      Begin VB.Label Label4 
         Caption         =   "销售面积"
         Height          =   255
         Left            =   120
         TabIndex        =   32
         Top             =   1500
         Width           =   735
      End
      Begin VB.Label Label3 
         Caption         =   "应 付 款"
         Height          =   255
         Left            =   120
         TabIndex        =   30
         Top             =   5640
         Width           =   855
      End
      Begin VB.Label Label2 
         Caption         =   "实 付 款"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   6000
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "是否销售"
         Height          =   255
         Left            =   120
         TabIndex        =   27
         Top             =   2580
         Width           =   735
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "楼    层"
         Height          =   180
         Index           =   3
         Left            =   120
         TabIndex        =   12
         Top             =   555
         Width           =   720
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "单  元"
         Height          =   180
         Index           =   2
         Left            =   1680
         TabIndex        =   11
         Top             =   285
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "楼    号"
         Height          =   180
         Index           =   1
         Left            =   120
         TabIndex        =   10
         Top             =   285
         Width           =   720
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "房  号"
         Height          =   180
         Index           =   4
         Left            =   1680
         TabIndex        =   9
         Top             =   555
         Width           =   540
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "户主姓名"
         Height          =   180
         Index           =   5
         Left            =   120
         TabIndex        =   8
         Top             =   3720
         Width           =   720
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "房屋格局"
         Height          =   180
         Index           =   9
         Left            =   120
         TabIndex        =   7
         Top             =   1215
         Width           =   720
      End
      Begin VB.Label lblLabels 
         AutoSize        =   -1  'True
         Caption         =   "联系电话"
         Height          =   180
         Index           =   10
         Left            =   120
         TabIndex        =   6
         Top             =   4200
         Width           =   720
      End
   End
   Begin MSFlexGridLib.MSFlexGrid bg 
      Height          =   7815
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   8445
      _ExtentX        =   14896
      _ExtentY        =   13785
      _Version        =   393216
      Cols            =   18
      RowHeightMin    =   300
      ForeColor       =   12615680
      ForeColorFixed  =   8421376
      BackColorBkg    =   16777215
      GridColor       =   16777215
      TextStyleFixed  =   4
      GridLines       =   3
      GridLinesFixed  =   3
      MergeCells      =   2
      AllowUserResizing=   1
      FormatString    =   $"frmzhda.frx":0014
   End
End
Attribute VB_Name = "frmzhda"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xqk As Database
Dim xqtab As Recordset
Dim xqk1 As Database
Dim xqtab1 As Recordset
Public changebj As Integer  '如果内容被修改则为0，否则为1
Public cxkey As Integer
'Dim editzbl As String '修改时存放原来小区编号
Public Sub bgsx()
If xqtab.EOF Then
   Exit Sub
End If
If bg.Rows > 2 Then
  Do While bg.Rows - 1 > 1
     bg.RemoveItem (1)
  Loop
End If
bg.Col = 0
bg.Row = 0
If xqtab.RecordCount > 0 Then
  Do Until xqtab.EOF
    b1 = xqtab1("xname")
    If xqtab("kloud") = Empty Then b2 = " " Else b2 = xqtab("kloud")
    If xqtab("kloudy") = Empty Then b3 = " " Else b3 = xqtab("kloudy")
    If xqtab("klouc") = Empty Then b4 = " " Else b4 = xqtab("klouc")
    If xqtab("klouhu") = Empty Then b5 = " " Else b5 = xqtab("klouhu")
    If xqtab("kgj") = Empty Then b51 = " " Else b51 = xqtab("kgj")
    If xqtab("kusername") = Empty Then b6 = " " Else b6 = xqtab("kusername")
    If xqtab("kusertel") = Empty Then b7 = " " Else b7 = xqtab("kusertel")
    If xqtab("kxiaos") = True Then b8 = "已销售" Else b8 = "未销售"
    If xqtab("kxsmj") = Empty Then b9 = " " Else b9 = xqtab("kxsmj")
    If xqtab("kfkfs") = Empty Then b10 = " " Else b10 = xqtab("kfkfs")
    If xqtab("kfwlb") = Empty Then b11 = " " Else b11 = xqtab("kfwlb")
    If xqtab("kck") = Empty Then b12 = " " Else b12 = xqtab("kck")
    If xqtab("kfjsb") = Empty Then b13 = " " Else b13 = xqtab("kfjsb")
    If xqtab("kdj") = Empty Then b14 = " " Else b14 = xqtab("kdj")
    If xqtab("kyfk") = Empty Then b15 = " " Else b15 = xqtab("kyfk")
    If xqtab("ksfk") = Empty Then b16 = " " Else b16 = xqtab("ksfk")
    If xqtab("kbz") = Empty Then b17 = " " Else b17 = xqtab("kbz")
        
    If bg.Row = 0 Then
       bg.Row = 1
       bg.Col = 0: bg.Text = b1
       bg.Col = 1: bg.Text = b2
       bg.Col = 2: bg.Text = b3
       bg.Col = 3: bg.Text = b4
       bg.Col = 4: bg.Text = b5
       bg.Col = 5: bg.Text = b51
       bg.Col = 6: bg.Text = b6
       bg.Col = 7: bg.Text = b7
       bg.Col = 8: bg.Text = b8
       bg.Col = 9: bg.Text = b9
       bg.Col = 10: bg.Text = b10
       bg.Col = 11: bg.Text = b11
       bg.Col = 12: bg.Text = b12
       bg.Col = 13: bg.Text = b13
       bg.Col = 14: bg.Text = b14
       bg.Col = 15: bg.Text = b15
       bg.Col = 16: bg.Text = b16
       bg.Col = 17: bg.Text = b17
    Else
    bg.AddItem (b1 & vbTab & b2 & vbTab & b3 & vbTab & b4 & vbTab & b5 & vbTab & b6 & vbTab & b7 & vbTab & b8 & vbTab & b9 & vbTab & b10 & vbTab & b11 & vbTab & b12 & vbTab & b13 & vbTab & b14 & vbTab & b15 & vbTab & b16 & vbTab & b17)
    End If
    xqtab.MoveNext
  Loop
Else
bg.Row = 1
bg.Col = 0
End If
End Sub
Private Sub bglock()
For i = 0 To 7
   tone(i).Locked = True
Next i
For i = 0 To 5
   ttwo(i).Locked = True
Next i
Combo1.Locked = True
Combo2.Locked = True
Combo3.Locked = True
End Sub
Private Sub bgopen()
For i = 0 To 7
   tone(i).Locked = False
Next i
For i = 0 To 5
   ttwo(i).Locked = False
Next i
Combo1.Locked = False
Combo2.Locked = False
Combo3.Locked = False

End Sub
Private Sub bgclear()
For i = 0 To 7
   tone(i).Text = ""
Next i
For i = 0 To 5
   ttwo(i).Text = ""
Next i
Combo1.Text = ""
Combo2.Text = ""
Combo3.Text = ""

End Sub
Private Function refresh1() As Boolean
For i = 0 To 4
 If tone(i).Text = "" Then
   MsgBox "不能为空", vbOKOnly + vbExclamation, "金风售房管理系统"
   refresh1 = False
   Exit Function
 End If
Next i
If Combo1.Text = "" Or Combo2.Text = "" Or Combo3.Text = "" Then
   MsgBox "不能为空", vbOKOnly + vbExclamation, "金风售房管理系统"
   refresh1 = False
   Exit Function
End If
If tone(4).Text = "" Then
   MsgBox "销售面积不能为空", vbOKOnly + vbExclamation, "金风售房管理系统"
   refresh1 = False
   Exit Function
End If
refresh1 = True

End Function
Private Sub bg_Click()
i = bg.Col
For j = 1 To 4
    bg.Col = j
    tone(j - 1).Text = bg.Text
Next j
bg.Col = 5
Combo2.Text = bg.Text
bg.Col = 6
ttwo(0).Text = bg.Text
bg.Col = 7
ttwo(2).Text = bg.Text
bg.Col = 8
Combo3.Text = bg.Text
bg.Col = 9
tone(4).Text = bg.Text
bg.Col = 10
ttwo(1).Text = bg.Text
bg.Col = 11
Combo1.Text = bg.Text
bg.Col = 12
tone(5).Text = bg.Text
bg.Col = 13
tone(6).Text = bg.Text
bg.Col = 14
ttwo(3).Text = bg.Text
bg.Col = 15
ttwo(4).Text = bg.Text
bg.Col = 16
ttwo(5).Text = bg.Text
bg.Col = 17
tone(7).Text = bg.Text
End Sub

Private Sub cmdAdd_Click()
bg.Enabled = False
cmdAdd.Enabled = False
cmdedit.Enabled = False
cmdDelete.Enabled = False
Comsave.Enabled = True
cmdClose.Enabled = True
cmdquit.Enabled = False
twoadd.Enabled = False
twoedit.Enabled = False
twoloca.Enabled = False
bgopen
tone(0).SetFocus
End Sub

Private Sub cmdClose_Click()
  bg.Enabled = True
bgclear
bglock
  Command1.Enabled = True
  bg.Row = 1
  bg.Col = 0
  i = 1
  Do While i < bg.Rows
      bg.Row = i
      j = 0
      bgtext = ""
      Do While j < 5
         bg.Col = j
         bgtext = bgtext + bg.Text
         j = j + 1
      Loop
      If bgtext = editzbl Then
         bg.Col = 1
         Call bg_Click
      End If
      i = i + 1
  Loop
  adedbj = 0
  i = 0