frmzhda.frm

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

   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()
x = bg.Row
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
Combo1.Text = bg.Text
bg.Col = 11
tone(5).Text = bg.Text
bg.Col = 12
tone(6).Text = bg.Text
bg.Col = 13
ttwo(3).Text = bg.Text
bg.Col = 14
ttwo(4).Text = bg.Text
bg.Col = 15
ttwo(5).Text = bg.Text
bg.Col = 16
ttwo(1).Text = bg.Text
bg.Col = 17
tone(7).Text = bg.Text
End Sub

Private Sub cmdAdd_Click()
whattodo = "cmdadd"
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
bgclear
tone(0).SetFocus
End Sub

Private Sub cmdClose_Click()
  bg.Enabled = True
bgclear
bglock
 ' Command1.Enabled = True
cmdAdd.Enabled = True
cmdedit.Enabled = True
cmdDelete.Enabled = True
Comsave.Enabled = False
cmdClose.Enabled = False
cmdquit.Enabled = True
twoadd.Enabled = True
'twoedit.Enabled = True
twoloca.Enabled = True
bgopen
bg_Click
Exit Sub
End Sub



Private Sub Cmdtc_Click()
  Unload frmzhda
End Sub

Private Sub cmdDelete_Click()
ss = MsgBox("确实要删除当前的记录吗？请确认！此项操作不可恢复", vbYesNo + vbQuestion, "售房管理系统")
If ss = vbYes Then
   s1 = LTrim(Str$(Val(tone(0).Text)))
   If Len(s1) < 2 Then s1 = "0" + s1
   s2 = LTrim(Str$(Val(tone(1).Text)))
   If Len(s2) < 2 Then s2 = "0" + s2
   s3 = LTrim(Str$(Val(tone(2).Text)))
   If Len(s3) < 2 Then s3 = "0" + s3
   s4 = LTrim(Str$(Val(tone(3).Text)))
   If Len(s4) < 2 Then s4 = "0" + s4
   xqk.Execute "delete * from xxb where kloud='" + s1 + "' and kloudy='" + s2 + "' and klouc='" + s3 + "' and klouhu='" + s4 + "'"
   
   MsgBox "此户位信息已删除！", vbOKOnly + vbExclamation, "售房管理系统"
   bg.RemoveItem (x)
   bg_Click
End If
End Sub

Private Sub cmdedit_Click()
whattodo = "cmdedit"
If tone(0).Text = "" Then
   MsgBox "必须有选择的对象才可进行修改", vbExclamation + vbOKOnly, "售房管理系统"
   Exit Sub
End If
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 cmdquit_Click()
Unload Me
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then Combo2.SetFocus Else KeyAscii = 0
End Sub



Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tone(5).SetFocus Else KeyAscii = 0
End Sub

Private Sub Combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then ttwo(0).SetFocus Else KeyAscii = 0
End Sub

Private Sub Command1_Click()
frmzhda.Enabled = False
End Sub

Private Sub Comsave_Click()
bg.Enabled = True
okyn = refresh1()
If Not okyn Then Exit Sub
s3 = LTrim(Str$(Val(tone(0).Text)))
If Len(s3) < 2 Then s3 = "0" + s3
s4 = LTrim(Str$(Val(tone(1).Text)))
If Len(s4) < 2 Then s4 = "0" + s4
s5 = LTrim(Str$(Val(tone(2).Text)))
If Len(s5) < 2 Then s5 = "0" + s5
s6 = LTrim(Str$(Val(tone(3).Text)))
If Len(s6) < 2 Then s6 = "0" + s6
Set xqtab = xqk.OpenRecordset("select * from xxb where kloud='" + s3 + "' and kloudy='" + s4 + "' and klouc='" + s5 + "' and klouhu='" + s6 + "'")
If whattodo = "cmdadd" Then
If Not xqtab.EOF Then
   MsgBox "对不起！第" + s3 + "栋" + s4 + "单元" + s5 + "层" + tone(3).Text + "户的用户信息已录入！", vbExclamation + vbOKOnly, "金风售房管理系统"
   Exit Sub
End If
Set xqtab = xqk.OpenRecordset("select * from husb where kloud='" + s3 + "' and kloudy='" + s4 + "' and klouc='" + s5 + "'")
If xqtab.EOF Then
   MsgBox "对不起！小区设定中没有第" + s3 + "栋" + s4 + "单元" + s5 + "层的用户，请设定后再加入用户！", vbExclamation + vbOKOnly, "金风售房管理系统"
   Exit Sub
End If
If Val(s6) > Val(xqtab("klouhu")) Then
   MsgBox "对不起！第" + s3 + "栋" + s4 + "单元" + s5 + "层无此户号！", vbExclamation + vbOKOnly, "金风售房管理系统"
   Exit Sub
End If
End If
Set xqtab1 = xqk1.OpenRecordset("xiaoqu")
s1 = xqtab1("xname")
s2 = xqtab1("xqbh")
s7 = LeftB(Combo2.Text, 10)
If LeftB(ttwo(0).Text, 10) = "" Then s8 = " " Else s8 = LeftB(ttwo(0).Text, 10)
If LeftB(ttwo(2).Text, 40) = "" Then s9 = " " Else s9 = LeftB(ttwo(2).Text, 40)
If Combo3.Text = "已销售" Then s10 = "1" Else s10 = "0"
If s10 = "1" Then Combo3.Text = "已销售" Else Combo3.Text = "未销售"
If LeftB(tone(4).Text, 10) = "" Then s11 = " " Else s11 = LeftB(tone(4).Text, 10)
s12 = Combo1.Text
If LeftB(tone(5).Text, 8) = "" Then s13 = " " Else s13 = LeftB(tone(5).Text, 8)
If LeftB(tone(6).Text, 50) = "" Then s14 = " " Else s14 = LeftB(tone(6).Text, 50)
If LTrim(Str$(Val(ttwo(3).Text))) = "" Then s15 = " " Else s15 = LTrim(Str$(Val(ttwo(3).Text)))
If LTrim(Str$(Val(ttwo(4).Text))) = "" Then s16 = " " Else s16 = LTrim(Str$(Val(ttwo(4).Text)))
If LTrim(Str$(Val(ttwo(5).Text))) = "" Then s17 = " " Else s17 = LTrim(Str$(Val(ttwo(5).Text)))
If LTrim(Str$(Val(ttwo(1).Text))) = "" Then s18 = " " Else s18 = LTrim(Str$(Val(ttwo(1).Text)))
If LeftB(tone(7).Text, 100) = "" Then s19 = " " Else s19 = LeftB(tone(7).Text, 100)
If whattodo = "cmdadd" Then
xqk.Execute "insert into xxb (kxname,kxqh,kloud,kloudy,klouc,klouhu,kgj,kusername,kusertel,kxiaos,kxsmj,kfwlb,kck,kfjsb,kdj,kyfk,ksfk,kfkfs,kbz) values ('" + s1 + "','" + s2 + "','" + s3 + "','" + s4 + "','" + s5 + "','" + s6 + "','" + s7 + "','" + s8 + "','" + s9 + "','" + s10 + "','" + s11 + "','" + s12 + "','" + s13 + "','" + s14 + "','" + s15 + "','" + s16 + "','" + s17 + "','" + s18 + "','" + s19 + "')"
bg.Row = 1
bg.Col = 1
If bg.Text = "" Then
   bg.Col = 0: bg.Text = s1
   bg.Col = 1: bg.Text = s3
   bg.Col = 2: bg.Text = s4
   bg.Col = 3: bg.Text = s5
   bg.Col = 4: bg.Text = s6
   bg.Col = 5: bg.Text = s7
   bg.Col = 6: bg.Text = s8
   bg.Col = 7: bg.Text = s9
   bg.Col = 8: bg.Text = s10
   bg.Col = 9: bg.Text = s11
   bg.Col = 10: bg.Text = Combo3.Text
   bg.Col = 11: bg.Text = s13
   bg.Col = 12: bg.Text = s14
   bg.Col = 13: bg.Text = s15
   bg.Col = 14: bg.Text = s16
   bg.Col = 15: bg.Text = s17
   bg.Col = 16: bg.Text = s18
   bg.Col = 17: bg.Text = s19
Else

bg.AddItem (s1 & vbTab & s3 & vbTab & s4 & vbTab & s5 & vbTab & s6 & vbTab & s7 & vbTab & s8 & vbTab & s9 & vbTab & Combo3.Text & vbTab & s11 & vbTab & s12 & vbTab & s13 & vbTab & s14 & vbTab & s15 & vbTab & s16 & vbTab & s17 & vbTab & s18 & vbTab & s19)
End If
Else '修改
If whattodo = "cmdedit" Then
xqk.Execute "update xxb set kxname='" + s1 + "',kxqh='" + s2 + "',kgj='" + s7 + "',kusername='" + s8 + "',kusertel='" + s9 + "',kxiaos='" + Combo3.Text + "',kxsmj='" + s11 + "',kfwlb='" + s12 + "',kck='" + s13 + "',kfjsb='" + s14 + "',kdj='" + s15 + "',kyfk='" + s16 + "',ksfk='" + s17 + "',kfkfs='" + s18 + "',kbz='" + s19 + "' where kloud='" + s3 + "' and kloudy='" + s4 + "' and klouc='" + s5 + "' and klouhu='" + s6 + "' "
bg.Row = x
bg.Col = 1
   bg.Col = 0: bg.Text = s1
   bg.Col = 1: bg.Text = s3
   bg.Col = 2: bg.Text = s4
   bg.Col = 3: bg.Text = s5
   bg.Col = 4: bg.Text = s6
   bg.Col = 5: bg.Text = s7
   bg.Col = 6: bg.Text = s8
   bg.Col = 7: bg.Text = s9
   bg.Col = 8: bg.Text = Combo3.Text
   bg.Col = 9: bg.Text = s11
   bg.Col = 10: bg.Text = s12
   bg.Col = 11: bg.Text = s13
   bg.Col = 12: bg.Text = s14
   bg.Col = 13: bg.Text = s15
   bg.Col = 14: bg.Text = s16
   bg.Col = 15: bg.Text = s17
   bg.Col = 16: bg.Text = s18
   bg.Col = 17: bg.Text = s19
'bg.RemoveItem (x)

End If
End If
bglock
'xqk.Execute "insert into xxb (kxname,kxqh,kloud,kloudy,klouc,klouhu,kusername,kusertel,kxiaos ) values('" + s1 + "','" + s2 + "','" + s3 + "','" + s4 + "','" + s5 + "','" + s6 + "','" + s7 + "','" + ttwo(2).Text + "','" + s9 + "')"
cmdAdd.Enabled = True
cmdedit.Enabled = True
cmdDelete.Enabled = True
Comsave.Enabled = False
cmdClose.Enabled = False
cmdquit.Enabled = True
twoadd.Enabled = True
twoedit.Enabled = True
twoloca.Enabled = True

Exit Sub
End Sub

Private Sub Form_Activate()
Me.ZOrder 0
Set xqk1 = OpenDatabase(App.Path + "\sfgl.mdb")
Set xqtab1 = xqk1.OpenRecordset("cdcx")
name1 = LeftB(xqtab1("xname"), 8)
tj = xqtab1("tj")
Set xqk = OpenDatabase(App.Path + "\data\" + name1 + ".mdb")
Set xqtab = xqk.OpenRecordset(tj)
If changebj = 0 Then bgsx: changebj = 1
   bg_Click
End Sub

Private Sub Form_Load()
frmzhda.Left = 0
frmzhda.Top = 0
frmzhda.Width = 11930
frmzhda.Height = 7940

changebj = 0
Combo1.Clear
Combo1.AddItem "店铺"
Combo1.AddItem "住宅"
Combo2.Clear
Combo2.AddItem "一室一厅"
Combo2.AddItem "一室两厅"
Combo2.AddItem "两室一厅"
Combo2.AddItem "两室两厅"
Combo2.AddItem "三室两厅"

Combo3.Clear
Combo3.AddItem "已销售"
Combo3.AddItem "未销售"
bglock
End Sub

Private Sub Form_Resize()
  bg.Height = Me.Height - 300
  Frame1.Height = Me.Height - 300
End Sub

Private Sub Image3_Click()
  frmdate.Text1.Text = 2
  frmdate.Show vbModal
  ttfields1.SetFocus
End Sub
Private Sub ttfields1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
       Combo1.SetFocus
      
   Else
      If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 46 Or KeyAscii = 45 Or KeyAscii = 8 Then
      Else
         KeyAscii = 0
      End If
   End If
End Sub




Private Sub tone_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
   Case Is < 4
      If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then KeyAscii = 0
    Case 4
      If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then If KeyAscii <> 46 Then KeyAscii = 0
End Select
End Sub

Private Sub ttwo_Change(Index As Integer)
Select Case Index
   Case 2
      If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then KeyAscii = 0
    Case 1, 3, 4, 5
      If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then If KeyAscii <> 46 Then KeyAscii = 0
End Select

End Sub

Private Sub twoloca_Click()
cxkey = 1
Me.Enabled = False
menuask.Show
End Sub