menu12.frm

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

Set xqfield(1) = xqsjt.CreateField("kloud", dbText, 2)
Set xqfield(2) = xqsjt.CreateField("kloudy", dbText, 2)
Set xqfield(3) = xqsjt.CreateField("klouc", dbText, 2)
Set xqfield(4) = xqsjt.CreateField("klouhu", dbText, 2)
For i = 1 To 4
   xqsjt.Fields.Append xqfield(i)
Next i
mydb.TableDefs.Append xqsjt
'第五个表,信息表
Set xqsjt = mydb.CreateTableDef("xxb")
Set xqfield(1) = xqsjt.CreateField("kloud", dbText, 2)
Set xqfield(2) = xqsjt.CreateField("kloudy", dbText, 2)
Set xqfield(3) = xqsjt.CreateField("klouc", dbText, 2)
Set xqfield(4) = xqsjt.CreateField("kxname", dbText, 22) '编号
Set xqfield(5) = xqsjt.CreateField("klouhu", dbText, 2) '户位
Set xqfield(6) = xqsjt.CreateField("kusername", dbText, 10) '用户名
Set xqfield(7) = xqsjt.CreateField("kusertel", dbText, 40) '用户电话
Set xqfield(8) = xqsjt.CreateField("kxiaos", dbBoolean) '是否销售
Set xqfield(9) = xqsjt.CreateField("kyfk", dbText, 10) '应付款
Set xqfield(10) = xqsjt.CreateField("ksfk", dbText, 10) '实付款
Set xqfield(11) = xqsjt.CreateField("kdj", dbText, 8) '单价
Set xqfield(12) = xqsjt.CreateField("kbz", dbText, 160) '备注
Set xqfield(13) = xqsjt.CreateField("kxsmj", dbText, 8) '建筑面积
Set xqfield(14) = xqsjt.CreateField("kfkfs", dbText, 8) '付款方式
Set xqfield(15) = xqsjt.CreateField("kfjsb", dbText, 50) '附加设备例如电话、有线、暖气
Set xqfield(16) = xqsjt.CreateField("kxqh", dbText, 4) '小区编号
Set xqfield(17) = xqsjt.CreateField("kck", dbText, 8) '车库
Set xqfield(18) = xqsjt.CreateField("kfwlb", dbText, 8) '房屋类别
Set xqfield(19) = xqsjt.CreateField("kgj", dbText, 16) '房屋格局
Set xqfield(20) = xqsjt.CreateField("hxt", dbText, 50) '户型图像来源

For i = 1 To 20
   xqsjt.Fields.Append xqfield(i)
Next i
mydb.TableDefs.Append xqsjt
mydb.Close
b:
End Sub
Private Sub cdreatek(ld As Integer, ldy As String, lc As Integer, lh As Integer)

End Sub
Private Sub ccancel_Click()
yn = MsgBox("您确定要取消本次的初始化工作并退出吗？", vbOKCancel + vbQuestion, "金风售房管理系统")

If yn = 1 Then Unload winmenu12

End Sub

Private Sub Check1_Click()
If Check1.Value = 1 Then
   For i = 1 To loudon - 1
    loudy(i).Enabled = False
    loudy(i).Text = loudy(0).Text
   Next i
Else
   For i = 1 To loudon - 1
    loudy(i).Enabled = True
   Next i

End If
End Sub

Private Sub cnext_Click()
Select Case jdzs
    Case 0
       If xiaoq <> "未初始化" Then MsgBox "小区已初始化完成，不能再进行此操作", vbOKOnly + vbExclamation, "金风售房管理系统": Exit Sub
       menuboot.xiaoquname = List1.Text
       jdzs = 1
       ffirst.Visible = False
       fone.Visible = True
       cprevious.Enabled = True
         fone.Left = 3120
         fone.Top = 120
         fone.Width = 4215
         fone.Height = 3875
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
        Label11.Caption = "您现在正在进行始化工作的是：" + menuboot.xiaoquname + Chr(13) + "请您输入目前本小区共建筑了多少栋楼？"
        Text1.SetFocus
       Case 1
         If Val(Text1.Text) < 1 Or Val(Text1.Text) > 10 Then MsgBox "小区内所建楼房栋数不能为空值（即零值）" + Chr(13) + "必须是1到10范围内的整数！", vbOKOnly + vbExclamation, "金风售房系统": Text1.SetFocus: Exit Sub
        jdzs = 2
         ReDim loudong(Val(Text1.Text))
         fone.Visible = False
         ftwo.Visible = True
         loudon = Val(Text1.Text)
         For i = 0 To loudon - 1
             loudy(i).Enabled = True
         Next i
         fone.Visible = False
         Label9.Caption = "您现在正在进行始化工作的是：" + menuboot.xiaoquname + Chr(13) + "本小区共建有" + Str$(loudon) + "栋楼" + Chr(13) + "请你依次输入每栋楼里共有几个单元！"
         For i = 9 To loudon Step -1
             loudy(i).Text = "无"
         Next i
         ftwo.Left = 3120
         ftwo.Top = 120
         ftwo.Width = 4215
         ftwo.Height = 3875
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
         loudy(0).SetFocus
       Case 2
         For i = 0 To loudon - 1
             If Val(loudy(i).Text) = 0 Then
                MsgBox "楼内单元数不能为空值（即零值）" + Chr(13) + "且必须是1到10范围内的整数！", vbOKOnly + vbExclamation, "金风售房系统"
                loudy(i).SetFocus
                Exit Sub
             End If
         Next i
         loudyS = 0
         loud = ""
         For i = 0 To loudon - 1
             loudyS = loudyS + Val(loudy(i))
             loud = loud + Chr(97 + i) + loudy(i)
         Next i
         ftwo.Visible = False
         fthree.Visible = True
         fthree.Left = 3120
         fthree.Top = 120
         fthree.Width = 4215
         fthree.Height = 3875
         Label21.Caption = "您现在正在进行始化工作的是：" + menuboot.xiaoquname + Chr(13) + "本小区共建有" + Str$(loudon) + "栋楼" + Chr(13) + Str$(loudon) + "栋楼共有" + Str$(loudyS) + "个单元，系统要求单元初始化时，各单元的楼层必须相同" + Chr(13) + "请您输入每个单元各有几层？"
         jdzs = 3
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
         Text2.SetFocus
      Case 3
         If Val(Text2.Text) < 1 Or Val(Text2.Text) > 10 Then MsgBox "小区内所建楼房栋数不能为空值（即零值）" + Chr(13) + "且必须是1到10范围内的整数！", vbOKOnly + vbExclamation, "金风售房系统": Text2.SetFocus: Exit Sub
        jdzs = 4
        loucen = Val(Text2.Text)
         Label23.Caption = "您现在正在进行始化工作的是：" + menuboot.xiaoquname + Chr(13) + "本小区共建有" + Str$(loudon) + "栋楼" + Chr(13) + Str$(loudon) + "栋楼" + "共有" + Str$(loudyS) + "个单元" + Chr(13) + Str$(loudyS) + "个单元内，每个单元各有" + Str$(loucen) + "层楼房" + Chr(13) + "请您输入每层楼内各有几间房间？"
         fthree.Visible = False
         ffour.Visible = True
         ffour.Left = 3120
         ffour.Top = 120
         ffour.Width = 4215
         ffour.Height = 3875
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
         Text3.SetFocus
     Case 4
         If Val(Text3.Text) < 1 Or Val(Text3.Text) > 3 Then MsgBox "每层楼所建户数不能为空值（即零值）" + Chr(13) + "且必须是1到3范围内的整数！", vbOKOnly + vbExclamation, "金风售房系统": Text3.SetFocus: Exit Sub
        Label24.Visible = False
        Text3.Visible = False
        loufj = Val(Text3.Text)
        Label23.Caption = "您现在正在进行始化工作的是：" + menuboot.xiaoquname + Chr(13) + "本小区共建有" + Str$(loudon) + "栋楼" + Chr(13) + Str$(loudon) + "栋楼" + "共有" + Str$(loudyS) + "个单元" + Chr(13) + Str$(loudyS) + "个单元各有" + Str$(loucen) + "层楼房" + Chr(13) + menuboot.xiaoquname + "所建筑的小区共有" + Str$(loufj * loucen * loudyS) + "个房间？"
       jdzs = 5
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
        cnext.Caption = "完  成"
    Case 5
         bta(jdzs).ForeColor = vbYellow
         bta(jdzs - 1).ForeColor = vbBlue
         yn = MsgBox("您确定以以上的信息进行对" + menuboot.xiaoquname + "进行初始化工作吗？", vbYesNo + vbQuestion, "金风售房管理系统")
         If yn = vbYes Then
            'Label23.Caption = "kadjfalkfdj"
            MousePointer = vbHourglass
            newxqname = LeftB(menuboot.xiaoquname, 8)
            createk
            s1 = LTrim(Str$(loudon))
            s3 = LTrim(Str$(loucen))
            s4 = LTrim(Str$(loufj))
            s5 = xiaoqutab.Fields("xqbh")
            xiaoquk.Execute "update xiaoqu  set sfcsh=true where xname='" + menuboot.xiaoquname + "' "
            Set newk = OpenDatabase(App.Path + "\data\" + newxqname + ".mdb")
          '开始向数据表中添加记录
             newk.Execute "insert into dongsb (kxqname,kxqbh,kloud) values ('" + menuboot.xiaoquname + "','" + s4 + "','" + s1 + "')"
            '一个小区有几栋楼
            For i = 1 To loudon
               d1 = LTrim(Str$(i))
               If Len(d1) < 2 Then d1 = "0" + d1
               d2 = LTrim(loudy(i - 1).Text)
               If Len(d2) < 2 Then d2 = "0" + d2
               newk.Execute "insert into dysb (kloud,kloudy) values('" + d1 + "','" + d2 + "')  "
            Next i
            '每栋楼有几个单元
            For i = 1 To loudon
               d1 = LTrim(Str$(i))
               If Len(d1) < 2 Then d1 = "0" + d1
               For j = 1 To Val(loudy(i - 1).Text)
                  d2 = LTrim(Str$(j))
                  If Len(d2) < 2 Then d2 = "0" + d2
                  'For k = 1 To loucen
                   d3 = LTrim(Str$(loucen))
                   If Len(d3) < 2 Then d3 = "0" + d3
                   newk.Execute "insert into lcsb (kloud,kloudy,klouc) values('" + d1 + "','" + d2 + "','" + d3 + "')  "
                'Next k
              Next j
            Next i
            '每单元有几层
            For i = 1 To loudon
              d1 = LTrim(Str$(i))
              If Len(d1) < 2 Then d1 = "0" + d1
              For j = 1 To Val(loudy(i - 1).Text)
                d2 = LTrim(Str$(j))
                If Len(d2) < 2 Then d2 = "0" + d2
                For k = 1 To loucen
                  d3 = LTrim(Str$(k))
                  If Len(d3) < 2 Then d3 = "0" + d3
                 ' For l = 1 To loufj
                     d4 = LTrim(Str$(loufj))
                     If Len(d4) < 2 Then d4 = "0" + d4
                     newk.Execute "insert into husb (kloud,kloudy,klouc,klouhu) values('" + d1 + "','" + d2 + "','" + d3 + "','" + d4 + "')  "
                  'Next l
                Next k
              Next j
            Next i
            '每层有几户
         MousePointer = dfault
         MsgBox menuboot.xiaoquname + "的初始化工作已完成,请退出后继续其他操作！", vbOKOnly + vbExclamation, "金风售房管理系统"
         Unload Me
         Else
            MsgBox "请你重新校对所输入的信息！", vbOKOnly + vbExclamation, "金风售房管理系统"
   cnext.Caption = "下一步"
   Text3.Visible = True
   Label24.Visible = True
            bta(jdzs).ForeColor = vbBlue
            jdzs = 0
            bta(jdzs).ForeColor = vbYellow
            ffour.Visible = False
            ffirst.Visible = True
            
        End If
    End Select
End Sub

Private Sub cprevious_Click()
Select Case jdzs
   Case 1
      fone.Visible = False
      ffirst.Visible = True
      cprevious.Enabled = False
   Case 2
      ftwo.Visible = False
      fone.Visible = True
   Case 3
      fthree.Visible = False
      ftwo.Visible = True
   Case 4
      fthree.Visible = True
      ffour.Visible = False
End Select
If jdzs > 0 Then
   jdzs = jdzs - 1
   bta(jdzs).ForeColor = vbYellow
   bta(jdzs + 1).ForeColor = vbBlue
   cnext.Caption = "下一步"
   Text3.Visible = True
   Label24.Visible = True
End If
End Sub

Private Sub Form_Load()
Set xiaoquk = OpenDatabase(App.Path + "\sfgl.mdb")
Set xiaoqutab = xiaoquk.OpenRecordset("xiaoqu")
List1.Clear
Do Until xiaoqutab.EOF
   List1.AddItem xiaoqutab("xname")
   xiaoqutab.MoveNext
Loop
If List1.ListCount > 0 Then List1.ListIndex = 0
Set xiaoqutab = xiaoquk.OpenRecordset("select   * from xiaoqu where xname='" + List1.Text + "'")
If xiaoqutab("sfcsh") Then xiaoq = "已初始化" Else xiaoq = "未初始化"
Label25.Caption = "当前所选择的小区是:" + List1.Text + Chr(13) + "状态:" + xiaoq
jdzs = 0
bta(jdzs).ForeColor = vbYellow
Dim loudong() As Integer
Dim loudon As Integer
winmenu12.Height = 5220
winmenu12.Left = 7635
winmenu12.Top = 300
winmenu12.Left = 800
ffirst.Left = 3120
ffirst.Top = 120
ffirst.Width = 4215
ffirst.Height = 3875
End Sub

Private Sub Label30_Click()
End Sub

Private Sub List1_Click()
Set xiaoqutab = xiaoquk.OpenRecordset("select   * from xiaoqu where xname='" + List1.Text + "'")
If xiaoqutab("sfcsh") Then xiaoq = "已初始化" Else xiaoq = "未初始化"
Label25.Caption = "当前所选择的小区是:" + List1.Text + Chr(13) + "状态:" + xiaoq
menuboot.xiaoquname = List1.Text
End Sub

Private Sub loudy_Change(Index As Integer)
If Index = 0 Then
If Check1.Value = 1 Then
   For i = 1 To loudon - 1
     loudy(i).Text = loudy(0).Text
   Next i
End If
End If
End Sub

Private Sub loudy_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then If cnext.Enabled = True Then cnext.SetFocus
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then If cnext.Enabled = True Then cnext.SetFocus
If KeyAscii < 48 Or KeyAscii > 57 Then If KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then If cnext.Enabled = True Then cnext.SetFocus
If KeyAscii < 49 Or KeyAscii > 51 Then If KeyAscii <> 8 Then KeyAscii = 0

End Sub