winmenu0.frm

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

For i = 1 To num1
   If lvone.ListItems(i).Checked Then
       ' II = II + 1
       'dataa(II) = lvone.ListItems(i).key
   Select Case key
    Case 0, 2
        tj = Right(lvone.ListItems(i).key, 2)
        condition = condition + " kloud='" + tj + "' or"
    Case 3
        tj1 = Mid$(lvone.ListItems(i).key, 2, 2) '栋号
        tj = Right(lvone.ListItems(i).key, 2)
        condition = condition + "kloudy='" + tj + "' or "
    Case 6
        tj1 = Mid$(lvone.ListItems(i).key, 2, 2) '栋号
        tj2 = Mid$(lvone.ListItems(i).key, 5, 2) '单元号
        tj = Right(lvone.ListItems(i).key, 2)
        condition = condition + "klouc='" + tj + "' or "
    Case 9
        tj1 = Mid$(lvone.ListItems(i).key, 2, 2) '栋号
        tj2 = Mid$(lvone.ListItems(i).key, 5, 2) '单元号
        tj3 = Mid$(lvone.ListItems(i).key, 8, 2) '层号
        tj = Right(lvone.ListItems(i).key, 2)
        condition = condition + "klouhu='" + tj + "' or "
   End Select
   ii = ii + 1
    End If
Next i
If ii = 0 Then
   If key <> 12 Then
   MsgBox "无选择项目，不能进行信息管理！", vbOKOnly + vbExclamation, "金风售房管理系统"
   Exit Sub
   End If
End If
Select Case key
 Case 0, 2
   condition = "select * from xxb where" + Left(condition, Len(condition) - 3)
 Case 3
   condition = "select * from xxb where" + " kloud='" + tj1 + "' and (" + Left(condition, Len(condition) - 3) + ")"
 Case 6
   condition = "select * from xxb where" + " kloud='" + tj1 + "' and kloudy='" + tj2 + "' and (" + Left(condition, Len(condition) - 3) + ")"
 Case 9
   condition = "select * from xxb where" + " kloud='" + tj1 + "' and kloudy='" + tj2 + "'and klouc='" + tj3 + "' and (" + Left(condition, Len(condition) - 3) + ")"
 Case 12
   ll = Len(tvone.SelectedItem.key)
   tj = Right(tvone.SelectedItem.key, 2)
   tj1 = Mid$(tvone.SelectedItem.key, ll - 4, 2) '层号
   tj2 = Mid$(tvone.SelectedItem.key, ll - 7, 2) '层号
   tj3 = Mid$(tvone.SelectedItem.key, ll - 10, 2) '层号
   condition = "select * from xxb where klouhu='" + tj + "' and klouc='" + tj1 + "' and kloudy='" + tj2 + "'and kloud='" + tj3 + "' "
   
End Select
key = tvone.SelectedItem.key
s = InStrRev(key, "B")
If s > 0 Then
kkname = Mid(key, 2, s - 2)
Else
kkname = Mid(key, 2, Len(key) - 1)
End If
Set xiaoqut = xiaoquk.OpenRecordset("select * from xiaoqu where xqbh='" + kkname + "'")
cxqname = xiaoqut("xname")
cxqbh = xiaoqut("xqbh")
Set xiaoqut1 = xiaoquk.OpenRecordset("cdcx")
xiaoqut1.Edit
xiaoqut1("xname") = cxqname
xiaoqut1("tj") = condition
xiaoqut1("xqbh") = cxqbh
xiaoqut1.Update
menuboot.menunum = "winmenu11"
winser.Show
'frmzhda.Show
'Unload Me
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub crefresh_Click()
Set xiaoquk = OpenDatabase(App.Path + "\sfgl.mdb")
Set xiaoqut = xiaoquk.OpenRecordset("xiaoqu")
Dim tempnode As Node
tvone.Nodes.Clear
xqyesno = False
Do Until xiaoqut.EOF
   Set tempnode = tvone.Nodes.Add(, , "A" + LTrim(xiaoqut("xqbh")), xiaoqut("xname"), 1)
   xiaoqut.MoveNext
Loop
Dim ld As Recordset '楼栋表
Dim ldy As Recordset
Dim lc As Recordset
Dim lh As Recordset
xiaoqut.MoveFirst
Do Until xiaoqut.EOF
  If xiaoqut("sfcsh") Then
     xqyesno = True
     Set xqk = OpenDatabase(App.Path + "\data\" + LeftB(xiaoqut("xname"), 8) + ".mdb")
     Set ld = xqk.OpenRecordset("dongsb")
     ls = "A" + LTrim(xiaoqut("xqbh"))
     For i = 1 To Val(ld("kloud"))
         ii = LTrim(Str$(i))
         If Len(ii) < 2 Then ii = "0" + ii
         ls1 = ls + "B" + ii
         Set tempnode = tvone.Nodes.Add(ls, tvwChild, ls1, ii + "栋", 2)
         Set ldy = xqk.OpenRecordset(" select * from dysb where kloud= '" + ii + "'  ")
         For k = 1 To Val(ldy("kloudy"))
            kk = LTrim(k)
            If Len(kk) < 2 Then kk = "0" + kk
            ls2 = ls1 + "C" + kk
            Set tempnode = tvone.Nodes.Add(ls1, tvwChild, ls2, kk + "单元", 3)
            Set lc = xqk.OpenRecordset(" select * from lcsb where kloud='" + ii + "' and kloudy='" + kk + "'  ")
            For l = 1 To Val(lc("klouc"))
               ll = LTrim(l)
               If Len(ll) < 2 Then ll = "0" + ll
              ls3 = ls2 + "D" + ll
              Set tempnode = tvone.Nodes.Add(ls2, tvwChild, ls3, ll + "层", 4)
              Set lh = xqk.OpenRecordset(" select * from husb  where  kloud='" + ii + "' and kloudy='" + kk + "' and klouc='" + ll + "' ")
              For m = 1 To Val(lh("klouhu"))
                mm = LTrim(m)
                If Len(mm) < 2 Then mm = "0" + mm
                ls4 = ls3 + "E" + mm
                If Val(lh("klouhu") = 2) Then
                If m = 1 Then lls = "左" Else lls = "右"
                Else
                If m = 1 Then lls = "左" Else If m = 2 Then lls = "中" Else lls = "右"
                End If
                Set tempnode = tvone.Nodes.Add(ls3, tvwChild, ls4, lls + "户", 5)
                Next m
            Next l
         Next k
     Next i
 End If
xiaoqut.MoveNext
Loop
If tvone.Nodes.Count > 0 And xqyesno = True Then
   tvone.Nodes.Item(Val(keyretu)).Selected = True
   displaylv tvone.SelectedItem.key, tvone.SelectedItem.Index
End If
keyretu = 1
If xqyesno = False Then
   cappe.Enabled = False
   cdelete.Enabled = False
   cgoto.Enabled = False
Else
   cappe.Enabled = True
   cdelete.Enabled = True
   cgoto.Enabled = True
End If
End Sub

Private Sub Form_Activate()
Me.ZOrder 0
If xqyesno = False Then
   cappe.Enabled = False
   cdelete.Enabled = False
   cgoto.Enabled = False
Else
   cappe.Enabled = True
   cdelete.Enabled = True
   cgoto.Enabled = True
End If
If nowretuyn = 0 Then Exit Sub
'MousePointer = vbHourglass
key = tvone.SelectedItem.key
keyretu = tvone.SelectedItem.Index
s = InStrRev(key, "B")
If s > 0 Then
   kkname = Mid(key, 2, s - 2)
Else
   kkname = Mid(key, 2, Len(key) - 1)
End If
Set xiaoqut = xiaoquk.OpenRecordset("select * from xiaoqu where xqbh='" + kkname + "'")
xqkname = LeftB(xiaoqut("xname"), 8)
Set xqk = OpenDatabase(App.Path + "\data\" + xqkname + ".mdb")
Select Case nowretuyn
  Case 2 '表示增加楼栋
    '要在当前库中增加两条记录，即两栋房，默认，其下逐次为一
    Dim ld As Recordset '楼栋表
    Set ld = xqk.OpenRecordset("dongsb")
    oldld = Val(ld("kloud")) '原来的栋数
    newld = oldld + nowretu
    newld = LTrim(Str$(newld))
    If Len(newld) < 2 Then newld = "0" + newld
    xqk.Execute "update dongsb set kloud='" + newld + "'"
    For i = oldld + 1 To Val(newld)
      ii = LTrim(Str$(i))
      If Len(ii) < 2 Then ii = "0" + ii
      xqk.Execute "insert into dysb (kloud,kloudy) values ('" + ii + "','01')"
    Next i
    For i = oldld + 1 To Val(newld)
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
       xqk.Execute "insert into lcsb (kloud,kloudy,klouc) values ('" + ii + "','01','01')"
    Next i
    For i = oldld + 1 To Val(newld)
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
       xqk.Execute "insert into husb (kloud,kloudy,klouc,klouhu) values ('" + ii + "','01','01','03')"
    Next i
  Case 3 '增加单元
    Dim ldy As Recordset
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    Set ldy = xqk.OpenRecordset("select * from dysb where kloud='" + kkloud + "'")
    oldldy = Val(ldy("kloudy")) '原来的单元数
    newldy = oldldy + nowretu
    newldy = LTrim(Str$(newldy))
    If Len(newldy) < 2 Then newldy = "0" + newldy
    xqk.Execute "update dysb set kloudy='" + newldy + "'where kloud='" + kkloud + "' "
    For i = oldldy + 1 To Val(newldy)
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
       xqk.Execute "insert into lcsb (kloud,kloudy,klouc) values ('" + kkloud + "','" + ii + "','01')"
    Next i
    For i = oldldy + 1 To Val(newldy)
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
       xqk.Execute "insert into husb (kloud,kloudy,klouc,klouhu) values ('" + kkloud + "','" + ii + "','01','03')"
    Next i
  Case 6 '增加层
    Dim lc As Recordset
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    kkloudy = Mid(key, s + 4, 2) '单元号
    Set lc = xqk.OpenRecordset("select * from lcsb where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' ")
    oldlc = Val(lc("klouc")) '原来的层数
    newlc = oldlc + nowretu
    newlc = LTrim(Str$(newlc))
    If Len(newlc) < 2 Then newlc = "0" + newlc
    xqk.Execute "update lcsb set klouc='" + newlc + "' where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' "
    For i = oldlc + 1 To Val(newlc)
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
       xqk.Execute "insert into husb (kloud,kloudy,klouc,klouhu) values ('" + kkloud + "','" + kkloudy + "','" + ii + "','03')"
    Next i
  Case 9 '增加户
    Dim lh As Recordset
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    kkloudy = Mid(key, s + 4, 2) '单元号
    kklouc = Mid(key, s + 7, 2) '层号
    Set lh = xqk.OpenRecordset("select * from husb where kloud='" + kkloud + "'and kloudy='" + kkloudy + "'and klouc='" + kklouc + "' ")
    oldhu = Val(lh("klouhu")) '原来的户数
    newhu = oldhu + nowretu
    newhu = LTrim(Str$(newhu))
    If Len(newhu) < 2 Then newhu = "0" + newhu
    xqk.Execute "update husb set klouhu='" + newhu + "' where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' and klouc='" + kklouc + "' "
  Case 22
    Set ld = xqk.OpenRecordset("dongsb")
    oldld = Val(ld("kloud")) '原来的栋数
    newld = oldld - nowretu
    newld = LTrim(Str$(newld))
    If Len(newld) < 2 Then newld = "0" + newld
    xqk.Execute "update dongsb set kloud='" + newld + "'"
    For i = Val(newld) + 1 To oldld
      ii = LTrim(Str$(i))
      If Len(ii) < 2 Then ii = "0" + ii
      xqk.Execute "delete * from  dysb  where kloud='" + ii + "'"
      xqk.Execute "delete * from  lcsb  where kloud='" + ii + "'"
      xqk.Execute "delete * from  husb  where kloud='" + ii + "'"
    Next i
  Case 23
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    Set ldy = xqk.OpenRecordset("select * from dysb where kloud='" + kkloud + "'")
    oldldy = Val(ldy("kloudy")) '原来的单元数
    newldy = oldldy - nowretu
    newldy = LTrim(Str$(newldy))
    If Len(newldy) < 2 Then newldy = "0" + newldy
    xqk.Execute "update dysb set kloudy='" + newldy + "'where kloud='" + kkloud + "' "
    For i = Val(newldy) + 1 To oldldy
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
      xqk.Execute "delete * from  lcsb  where kloudy='" + ii + "'and kloud='" + kkloud + "' "
      xqk.Execute "delete * from  husb  where kloudy='" + ii + "'and kloud='" + kkloud + "' "
    Next i
  Case 26
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    kkloudy = Mid(key, s + 4, 2) '单元号
    Set lc = xqk.OpenRecordset("select * from lcsb where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' ")
    oldlc = Val(lc("klouc")) '原来的层数
    newlc = oldlc - nowretu
    newlc = LTrim(Str$(newlc))
    If Len(newlc) < 2 Then newlc = "0" + newlc
    xqk.Execute "update lcsb set klouc='" + newlc + "' where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' "
    For i = Val(newlc) + 1 To oldlc
       ii = LTrim(Str$(i))
       If Len(ii) < 2 Then ii = "0" + ii
      xqk.Execute "delete * from  husb  where klouc='" + ii + "'and kloud='" + kkloud + "' "
    Next i
  Case 29
    s = InStrRev(key, "B")
    kkloud = Mid(key, s + 1, 2) '楼栋号
    kkloudy = Mid(key, s + 4, 2) '单元号
    kklouc = Mid(key, s + 7, 2) '层号
    Set lh = xqk.OpenRecordset("select * from husb where kloud='" + kkloud + "'and kloudy='" + kkloudy + "'and klouc='" + kklouc + "' ")
    oldhu = Val(lh("klouhu")) '原来的户数
    newhu = oldhu - nowretu
    newhu = LTrim(Str$(newhu))
    If Len(newhu) < 2 Then newhu = "0" + newhu
    xqk.Execute "update husb set klouhu='" + newhu + "' where kloud='" + kkloud + "'and kloudy='" + kkloudy + "' and klouc='" + kklouc + "' "
End Select
lvone.ListItems.Clear
crefresh_Click
nowkey = 0
nowretuyn = 0
End Sub

Private Sub Form_Load()
keyretu = 1
nowretuyn = 0
nowretu = 0
winmenu0.Left = 0
winmenu0.Top = 0
winmenu0.Width = 11930
winmenu0.Height = 7950
crefresh_Click
MousePointer = Default
End Sub

Private Sub iscr_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
      tvwidth = tvone.Width
      lvleft = lvone.Left
      lvwidth = lvone.Width
      tvMoving = True
End Sub

Private Sub iscr_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
   If tvMoving = True Then
      If tvwidth + x <= 1500 Then
         tvone.Width = 1500
         lvone.Left = tvone.Width + 120 + 55
         lvone.Width = Me.Width - tvone.Width - 150
      Else
        If lvwidth - x <= 5500 Then
           lvone.Width = 5500
           tvone.Width = Me.Width - lvone.Width - 150 - 55
           lvone.Left = tvone.Width + 120
        Else
           tvone.Width = tvwidth + x
           lvone.Left = lvleft + x
           lvone.Width = lvwidth - x
        End If
      End If
      Label1.Width = tvone.Width
      Label2.Width = lvone.Width
      Label2.Left = lvone.Left
   End If
End Sub

Private Sub iscr_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
   If tvMoving = True Then
    iscr.Left = tvone.Width + 110
    tvMoving = False
   End If
End Sub

Private Sub lvone_DblClick()
If Left(lvone.SelectedItem.key, 1) = "a" Then
   Select Case Right(lvone.SelectedItem.key, 1)
       Case 1
        winmenu51.Show
       Case 2
        winmenu52.Show
        'Exit Sub
       Case 3
        winmenu53.Show
       Case 4
        winmenu54.Show
       Case 5
        winmenu55.Show
       Case 6
        winmenu56.Show
End Select
Me.Hide
End If

End Sub

Private Sub lvone_ItemClick(ByVal Item As MSComctlLib.ListItem)
'MsgBox "kjaf"
End Sub

Private Sub tvone_Collapse(ByVal Node As MSComctlLib.Node)
If xqyesno = False Then Exit Sub
lvone.ListItems.Clear
displaylv tvone.SelectedItem.key, tvone.SelectedItem.Index
End Sub

Private Sub tvone_NodeClick(ByVal Node As MSComctlLib.Node)
If xqyesno = False Then Exit Sub
lvone.ListItems.Clear
displaylv tvone.SelectedItem.key, tvone.SelectedItem.Index
End Sub