frmzhda.frm

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

  Do While i < 10
     Text1(i).Locked = True
     i = i + 1
  Loop
  ttfields1.Locked = True
  Combo1.Locked = True
  If Data1.Recordset.RecordCount > 0 Then
     cmdedit.Enabled = True
     cmdDelete.Enabled = True
  Else
     cmdedit.Enabled = False
     cmdDelete.Enabled = False
  End If
     cmdAdd.Enabled = True
     Comsave.Enabled = False
     cmdClose.Enabled = False
     Cmdtc.Enabled = True
     Text1(0).SetFocus
End Sub



Private Sub cmdDelete_Click()
  bgrowbl = bg.Row
  k = MsgBox("您确实要删除" + Trim(Text1(5).Text) + "吗?", vbQuestion + vbYesNo, "系统信息")
  If k = vbYes And Data1.Recordset.RecordCount > 0 Then
     Data1.Recordset.FindFirst "bh+lh+dy+fh=" + "'" + Text1(0).Text + Text1(1).Text + Text1(2).Text + Text1(4).Text + "'"
     If Data1.Recordset.NoMatch = False Then Data1.Recordset.Delete
     
       If bg.Rows > 2 Then
          bg.RemoveItem (bgrowbl)
       Else
              bg.Col = 0
              i = 0
              bg.Row = 1
              Do While i < bg.Cols
                 bg.Col = i
                 bg.Text = ""
                 i = i + 1
              Loop

       End If
     If bgrowbl > bg.Rows - 1 Then bgrowbl = bgrowbl - 1
     sxbj = 0
     If Data1.Recordset.RecordCount < 1 Then
        cmdedit.Enabled = False
        cmdDelete.Enabled = False
     Else
        cmdedit.Enabled = True
        cmdDelete.Enabled = True
     End If
    bg.Col = 1
    bg.Row = bgrowbl
    Call bg_Click
    
End If
  Text1(0).SetFocus
End Sub

Private Sub Cmdtc_Click()
  Unload frmzhda
End Sub

Private Sub cmdedit_Click()
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()
winmenu512.Show
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 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

Set xqtab1 = xqk1.OpenRecordset("xiaoqu")
s1 = xqtab1("xname")
s2 = xqtab1("xqbh")
s7 = LeftB(tone(4).Text, 10)
If Combo3.Text = "已销售" Then s9 = "1" Else s9 = "0"
s10 = LTrim(Str$(Val(ttwo(4).Text)))
s11 = LTrim(Str$(Val(ttwo(5).Text)))
s12 = LTrim(Str$(Val(ttwo(3).Text)))
s13 = LeftB(tone(7).Text, 100)
s14 = LTrim(Str$(Val(tone(4).Text)))
s15 = LTrim(Str$(Val(ttwo(1).Text)))
s16 = LeftB(tone(6).Text, 50)
s17 = LeftB(tone(5).Text, 8)
xqk.Execute "insert into xxb (kxname,kxqh,kloud,kloudy,klouc,klouhu,kusername,kusertel,kxiaos,kyfk,ksfk,kdj,kbz,kxsmj,kfkfs,kfjsb,kck,kfwlb,kgj) values ('" + s1 + "','" + s2 + "','" + s3 + "','" + s4 + "','" + s5 + "','" + s6 + "','" + s7 + "','" + ttwo(2).Text + "','" + s9 + "','" + s10 + "','" + s11 + "','" + s12 + "','" + s13 + "','" + s14 + "','" + s15 + "','" + s16 + "','" + s17 + "','" + Combo1.Text + "','" + Combo2.Text + "')"
   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 = s11
   bg.Col = 9: bg.Text = s12
   bg.Col = 10: bg.Text = s13
   bg.Col = 11: bg.Text = s14
   bg.Col = 12: bg.Text = s15
   bg.Col = 13: bg.Text = s16
   bg.Col = 14: bg.Text = s17
   bg.Col = 15: bg.Text = s18
   bg.Col = 16: bg.Text = Combo1.Text
   bg.Col = 17: bg.Text = Combo2.Text
Else
bg.AddItem (s1 & vbTab & s3 & vbTab & s4 & vbTab & s5 & vbTab & s6 & vbTab & s7 & vbTab & ttwo(2).Text & vbTab & s9 & vbTab & s10 & vbTab & s11 & vbTab & s12 & vbTab & s13 & vbTab & s14 & vbTab & s15 & vbTab & s16 & vbTab & s17 & vbTab & Combo1.Text & vbTab & Combo2.Text)
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
',kxiaos,kyfk,ksfk,kdj,kbz,kjzmj,ksymj,kfjsb,kck,kfwlb,kgj) set ( + s5 + "','" + s6 + "','" + s7 + "','" + ttwo(2).Text + "','" + s9 + "','" + s10 + "','" + s11 + "','" + s12 + "','" + s13 + "','" + s14 + "','" + s15 + "','" + s16 + "','" + s17 + "','" + Combo1.Text + "','" + Combo2.Text + "')"
   
   bg.Enabled = True
   Command1.Enabled = True
   i = 0
   Do While i < 5
      If tone(i).Text = "" And Val(tone(4).Text) = 0 Then
           MsgBox lblLabels(i) + "是必填项。", vbExclamation + vbOKOnly, "系统信息", 0, 3
           tone(i).SetFocus
           Exit Sub
      End If
      i = i + 1
   Loop
   If Val(ttfields1.Text) = 0 Then
      MsgBox "住房面积是必填项。", vbExclamation + vbOKOnly, "系统信息", 0, 3
      ttfields1.SetFocus
      Exit Sub
   End If
   findzfc1 = "bh+lh=" + "'" + tone(0).Text + tone(1).Text + "'"
   Data3.Recordset.FindFirst findzfc1
   If Data3.Recordset.NoMatch = False Then
      If Val(tone(2).Text) <= Val(Data3.Recordset("dy")) Then
         If Data1.Recordset.RecordCount > 0 Then
            Data1.Recordset.FindFirst "bh+lh+fh=" + "'" + tone(0).Text + tone(1).Text + tone(4).Text + "'"
            If Not Data1.Recordset.NoMatch Then
               If adedbj <> 2 Or (adedbj = 2 And (tone(0).Text + tone(1).Text + tone(2).Text + tone(3).Text + tone(4).Text) <> editzbl) Then
                  MsgBox "此房号已经登记,不能重复。", vbExclamation + vbOKOnly, "系统信息", 0, 3
                  tone(4).SetFocus
                  Exit Sub
               End If
            End If
         End If
      Else
         MsgBox "单元号不能大于此楼单元数量。", vbExclamation + vbOKOnly, "系统信息", 0, 3
         tone(2).SetFocus
         Exit Sub
      End If
   Else
      Data3.Recordset.FindFirst "bh=" + "'" + tone(0).Text + "'"
      If Data3.Recordset.NoMatch Then
         MsgBox "无此小区信息,请重新输入。", vbExclamation + vbOKOnly, "系统信息", 0, 3
         tone(0).SetFocus
      Else
          MsgBox "无此楼信息,请重新输入。", vbExclamation + vbOKOnly, "系统信息", 0, 3
          tone(1).SetFocus
      End If
      Exit Sub
   End If
      If adedbj = 1 Then Data1.Recordset.AddNew
      If adedbj = 2 Then
         Data1.Recordset.FindFirst "bh+lh+dy+lc+fh=" + "'" + editzbl + "'"
         Data1.Recordset.Edit
      End If
       Data2.Recordset.FindFirst "bh=" + "'" + tone(0).Text + "'"
       If Data2.Recordset.NoMatch = False Then
          xqmc = Data2.Recordset("mc")
       Else
          MsgBox tone(0).Text + "号小区不存在,请重新输入。", vbExclamation + vbOKOnly, "系统信息"
          tone(0).SetFocus
          Exit Sub
       End If
       Data1.Recordset("bh") = tone(0).Text
       Data1.Recordset("mc") = Trim(xqmc)
       Data1.Recordset("lh") = tone(1).Text
       Data1.Recordset("dy") = tone(2).Text
       Data1.Recordset("lc") = tone(3).Text
       Data1.Recordset("fh") = tone(4).Text
       Data1.Recordset("xm") = Trim(tone(5).Text)
       Data1.Recordset("zjhm") = Trim(tone(6).Text)
       Data1.Recordset("zfmj") = Trim(ttfields1.Text)
       Data1.Recordset("rzrq") = tone(7).Text
       Data1.Recordset("lxdh") = Trim(tone(8).Text)
       Data1.Recordset("szdw") = Trim(tone(9).Text)
       Data1.Recordset("zflb") = Combo1.Text
       sb = adedbj
       Data1.Recordset.Update
       Data1.Refresh
       editzbl = tone(0).Text + tone(1).Text + tone(2).Text + tone(3).Text + tone(4).Text

       Data1.Recordset.FindFirst "bh+lh+dy+fh=" + "'" + tone(0).Text + tone(1).Text + tone(2).Text + tone(4).Text + "'"
       Comsave.Enabled = False
       cmdClose.Enabled = False
       cmdAdd.Enabled = True
       cmdedit.Enabled = True
       cmdDelete.Enabled = True
       Cmdtc.Enabled = True
       i = 0
       Do While i < 10
          tone(i).Locked = True
          i = i + 1
       Loop
       ttfields1.Locked = True
       Combo1.Locked = True
    sxbj = 0
    If bg.Rows > 3 And adedbj = 1 Then
       bh = ""
       mc = ""
       lh = ""
       dy = ""
       lc = ""
       fh = ""
       xm = ""
       zjhm = ""
       zfmj = ""
       rzrq = ""
       lxdh = ""
       szdw = ""
       zflb = ""
       If IsNull(Data1.Recordset.Fields("bh")) = False Then bh = Data1.Recordset.Fields("bh")
       If IsNull(Data1.Recordset.Fields("mc")) = False Then mc = Data1.Recordset.Fields("mc")
       If IsNull(Data1.Recordset.Fields("lh")) = False Then lh = Data1.Recordset.Fields("lh")
       If IsNull(Data1.Recordset.Fields("dy")) = False Then dy = Data1.Recordset.Fields("dy")
       If IsNull(Data1.Recordset.Fields("lc")) = False Then lc = Data1.Recordset.Fields("lc")
       If IsNull(Data1.Recordset.Fields("fh")) = False Then fh = Data1.Recordset.Fields("fh")
       If IsNull(Data1.Recordset.Fields("xm")) = False Then xm = Data1.Recordset.Fields("xm")
       If IsNull(Data1.Recordset.Fields("zjhm")) = False Then zjhm = Data1.Recordset.Fields("zjhm")
       If IsNull(Data1.Recordset.Fields("zfmj")) = False Then zfmj = Format(Val(Data1.Recordset.Fields("zfmj")), "###,#0.00")
       If IsNull(Data1.Recordset.Fields("zflb")) = False Then zflb = Data1.Recordset.Fields("zflb")
       If IsNull(Data1.Recordset.Fields("rzrq")) = False Then rzrq = Data1.Recordset.Fields("rzrq")
       If IsNull(Data1.Recordset.Fields("szdw")) = False Then szdw = Data1.Recordset.Fields("szdw")
       If IsNull(Data1.Recordset.Fields("lxdh")) = False Then lxdh = Data1.Recordset.Fields("lxdh")
      
      bg.AddItem (bh & vbTab & lh & vbTab & dy & vbTab & lc & vbTab & fh & vbTab & xm & vbTab & zjhm & vbTab & rzrq & vbTab & zfmj & vbTab & zflb & vbTab & lxdh & vbTab & szdw)
      'bg.Refresh
      bg.Row = bg.Rows - 1
 Else
    If adedbj = 1 Then bgsx
 End If
    adedbj = 0
    tone(0).SetFocus
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 "三室两厅"
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