⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 menu45.frm

📁 给售房作的,但还没有全完成,最好是只看看里面有用的东东就可以了
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    bg.Text = ""
  End If
  If Data1.Recordset.RecordCount > 0 Then
     Do While Data1.Recordset.EOF() = False
       bh = ""
       mc = ""
       zdmj = ""
       yhmj = ""
       lhmj = ""
       ls = ""
       dlwz = ""
       lxdh = ""
       qyrq = ""
       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("qyrq")) = False Then qyrq = Data1.Recordset.Fields("qyrq")
       If IsNull(Data1.Recordset.Fields("zdmj")) = False Then zdmj = Format(Val(Data1.Recordset.Fields("zdmj")), "###,#0.00")
       If IsNull(Data1.Recordset.Fields("yhmj")) = False Then yhmj = Format(Val(Data1.Recordset.Fields("yhmj")), "###,#0.00")
       If IsNull(Data1.Recordset.Fields("lhmj")) = False Then lhmj = Format(Val(Data1.Recordset.Fields("lhmj")), "###,#0.00")
       If IsNull(Data1.Recordset.Fields("ls")) = False Then ls = Data1.Recordset.Fields("ls")
       If IsNull(Data1.Recordset.Fields("dlwz")) = False Then dlwz = Data1.Recordset.Fields("dlwz")
       If IsNull(Data1.Recordset.Fields("lxdh")) = False Then lxdh = Data1.Recordset.Fields("lxdh")
       bg.Row = 1
       bg.Col = 0
       If bg.Text = "" Then
          bg.Col = 0
          bg.Text = bh
          bg.Col = 1
          bg.Text = mc
          bg.Col = 2
          bg.Text = qyrq
          bg.Col = 3
          bg.Text = zdmj
          bg.Col = 4
          bg.Text = yhmj
          bg.Col = 5
          bg.Text = lhmj
          bg.Col = 6
          bg.Text = ls
          bg.Col = 7
          bg.Text = dlwz
          bg.Col = 8
          bg.Text = lxdh
       Else
          bg.AddItem (bh & vbTab & mc & vbTab & qyrq & vbTab & zdmj & vbTab & yhmj & vbTab & lhmj & vbTab & ls & vbTab & dlwz & vbTab & lxdh)
       End If
       Data1.Recordset.MoveNext
    Loop
    i = 1
    Do While i < bg.Rows
       bg.Row = i
       bg.Col = 0
       If bg.Text = text1(0).Text Then
          bg.Col = 1
          Call bg_Click
       End If
       i = i + 1
    Loop
 End If
    text1(0).SetFocus
End Sub
Private Sub bg_Click()
    i = bg.Col
    bg.Col = 0
    text1(0).Text = bg.Text
    bg.Col = 1
    text1(1).Text = bg.Text
    bg.Col = 2
    text1(2).Text = bg.Text
    bg.Col = 3
    If Val(bg.Text) = 0 Then
       ttFields(0).Text = ""
    Else
       ttFields(0).Text = Format(Val(bg.Text), "##,##0.00")
    End If
    bg.Col = 4
    If Val(bg.Text) = 0 Then
       ttFields(1).Text = ""
    Else
       ttFields(1).Text = Format(Val(bg.Text), "##,##0.00")
    End If
    bg.Col = 5
    If Val(bg.Text) = 0 Then
       ttFields(2).Text = ""
    Else
       ttFields(2).Text = Format(Val(bg.Text), "##,##0.00")
    End If
    bg.Col = 6
    text1(3).Text = bg.Text
    bg.Col = 7
    text1(4).Text = bg.Text
    bg.Col = 8
    text1(5).Text = bg.Text
    bg.Col = i
End Sub

Private Sub cmdAdd_Click()
  bg.Enabled = False
  cmdAdd.Enabled = False
  cmdedit.Enabled = False
  cmdDelete.Enabled = False
  Comsave.Enabled = True
  cmdClose.Enabled = True
  Cmdtc.Enabled = False
  Command1.Enabled = False
  editbl = text1(0).Text
  i = 0
  Do While i < 6
     text1(i).Locked = False
     text1(i).Text = ""
     i = i + 1
  Loop
  i = 0
  Do While i < 3
     ttFields(i).Locked = False
     ttFields(i).Text = ""
     i = i + 1
  Loop
  adedbj = 1
  text1(0).SetFocus
End Sub

Private Sub cmdClose_Click()
  bg.Enabled = True
  bg.Row = 1
  bg.Col = 0
  i = 1
  Do While i < bg.Rows
     bg.Row = i
     If bg.Text = editbl Then
        bg.Col = 1
        Call bg_Click
        Exit Do
     End If
     i = i + 1
  Loop
  adedbj = 0
  i = 0
  Do While i < 6
     text1(i).Locked = True
     i = i + 1
  Loop
  i = 0
  Do While i < 3
     ttFields(i).Locked = True
     i = i + 1
  Loop
  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
     Command1.Enabled = True
     text1(0).SetFocus
End Sub



Private Sub cmdDelete_Click()
  k = MsgBox("您确实要删除" + text1(1).Text + "吗?", vbQuestion + vbYesNo, "系统信息")
  If k = vbYes And Data1.Recordset.RecordCount > 0 Then
     Data1.Recordset.FindFirst "bh=" + "'" + text1(0).Text + "'"
     If Data1.Recordset.NoMatch = False Then Data1.Recordset.Delete
     Data1.Recordset.MoveNext
     If Len(text1(0).Text) < 1 Then
        Data1.Recordset.MovePrevious
     End If
     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 = 0
     bg.Row = 1
     i = 1
        Do While bg.Text <> text1(0).Text
           If bg.Rows > 2 Then
              i = i + 1
              bg.Row = i
           End If
        Loop
       If bg.Text = text1(0).Text And bg.Rows > 2 Then
          bg.RemoveItem (i)
       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
    bg.Col = 1
    Call bg_Click
End If
  text1(0).SetFocus
End Sub

Private Sub cmdedit_Click()
  bg.Enabled = False
  cmdedit.Enabled = False
  cmdAdd.Enabled = False
  cmdDelete.Enabled = False
  Comsave.Enabled = True
  cmdClose.Enabled = True
  Cmdtc.Enabled = False
  Command1.Enabled = False
  editbl = text1(0).Text
  i = 0
  Do While i < 6
     text1(i).Locked = False
     i = i + 1
  Loop
  i = 0
  Do While i < 3
     ttFields(i).Locked = False
     i = i + 1
  Loop
  adedbj = 2
  text1(0).SetFocus
End Sub

Private Sub Cmdlw_Click()
  If lh <= Val(Text4.Text) Then
         Data1.Recordset.AddNew
         Data1.Recordset("bh") = Text2.Text
         Data1.Recordset("mc") = Text3.Text
         Data1.Recordset("lh") = text1(0).Text
         Data1.Recordset("dy") = text1(1).Text
         Data1.Recordset("lc") = text1(2).Text
         Data1.Recordset("mczh") = text1(3).Text
         If Check1.Value = 1 Then Data1.Recordset("sfrz") = "Y" Else Data1.Recordset("sfrz") = "N"
         Data1.Recordset("hh") = Trim$(Str(Val(text1(2).Text) * Val(text1(3).Text)) * Val(text1(1)))
         Data1.Recordset.Update
         lh = lh + 1
       If Len(Trim$(Str(lh))) < 2 Then text1(0).Text = "0" + Trim$(Str(lh)) Else text1(0).Text = Trim$(Str(lh))
   Else
      Unload frmlwda
   End If
End Sub

Private Sub Cmdtc_Click()
  Unload frmwyda
End Sub

Private Sub Command1_Click()
   Command1.MousePointer = 11
   bgsx
   Command1.MousePointer = 0
End Sub

Private Sub Command2_Click()
  
End Sub

Private Sub Command3_Click()
 If bg.Enabled = False And Val(text1(3)) > 0 Then
  frmlwda.text1(0).Text = "01"
  frmlwda.Text2.Text = text1(0).Text
  frmlwda.Text3.Text = text1(1).Text
  frmlwda.Text4.Text = text1(3).Text
  frmlwda.Text5.Text = adedbj
  frmlwda.Top = 4020
  frmlwda.Left = 6570
  frmlwda.Show vbModal
 End If
End Sub

Private Sub Comsave_Click()
   bg.Enabled = True
   If text1(0).Text = "" And Val(text1(0).Text) = 0 Then
      MsgBox "小区编号是必填项,且不能重复。", vbExclamation + vbOKOnly, "系统信息", 0, 3
      text1(0).SetFocus
   Else
      If text1(1).Text = "" And Val(text1(1).Text) = 0 Then
          MsgBox "小区名称是必填项。", vbExclamation + vbOKOnly, "系统信息", 0, 3
          text1(1).SetFocus
          Exit Sub
      End If
      If Data1.Recordset.RecordCount > 0 Then
         Data1.Recordset.FindFirst "bh=" + "'" + text1(0).Text + "'"
         If Not Data1.Recordset.NoMatch Then
            If adedbj <> 2 Or (adedbj = 2 And text1(0).Text <> editbl) Then
               MsgBox "小区编号不能重复。", vbExclamation + vbOKOnly, "系统信息", 0, 3
               text1(0).SetFocus
               Exit Sub
            End If
         End If
      End If
      If adedbj = 1 Then Data1.Recordset.AddNew
      If adedbj = 2 Then
         Data1.Recordset.FindFirst "bh=" + "'" + editbl + "'"
         Data1.Recordset.Edit
      End If
       Data1.Recordset("bh") = Trim(text1(0).Text)
       Data1.Recordset("mc") = Trim(text1(1).Text)
       Data1.Recordset("qyrq") = Trim(text1(2).Text)
       Data1.Recordset("zdmj") = Trim(ttFields(0).Text)
       Data1.Recordset("yhmj") = Trim(ttFields(1).Text)
       Data1.Recordset("lhmj") = Trim(ttFields(2).Text)
       Data1.Recordset("ls") = Trim(text1(3).Text)
       Data1.Recordset("dlwz") = Trim(text1(4).Text)
       Data1.Recordset("lxdh") = Trim(text1(5).Text)
       sb = adedbj
       adedbj = 0
       Data1.Recordset.Update
       Comsave.Enabled = False
       cmdClose.Enabled = False
       cmdAdd.Enabled = True
       cmdedit.Enabled = True
       cmdDelete.Enabled = True
       Cmdtc.Enabled = True
       Command1.Enabled = True
       i = 0
       Do While i < 6
          text1(i).Locked = True
          i = i + 1
       Loop
       i = 0
       Do While i < 3
          ttFields(i).Locked = True
          i = i + 1
       Loop
   End If
   sxbj = 0
  If bg.Rows > 3 And adedbj = 1 Then
           bh = ""
           mc = ""
           zdmj = ""
           yhmj = ""
           lhmj = ""
           ls = ""
           dlwz = ""
           lxdh = ""
           qyrq = ""
           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("qyrq")) = False Then qyrq = Data1.Recordset.Fields("qyrq")
           If IsNull(Data1.Recordset.Fields("zdmj")) = False Then zdmj = Format(Val(Data1.Recordset.Fields("zdmj")), "###,#0.00")
           If IsNull(Data1.Recordset.Fields("yhmj")) = False Then yhmj = Format(Val(Data1.Recordset.Fields("yhmj")), "###,#0.00")
           If IsNull(Data1.Recordset.Fields("lhmj")) = False Then lhmj = Format(Val(Data1.Recordset.Fields("lhmj")), "###,#0.00")
           If IsNull(Data1.Recordset.Fields("ls")) = False Then ls = Data1.Recordset.Fields("ls")
           If IsNull(Data1.Recordset.Fields("dlwz")) = False Then dlwz = Data1.Recordset.Fields("dlwz")
           If IsNull(Data1.Recordset.Fields("lxdh")) = False Then lxdh = Data1.Recordset.Fields("lxdh")
           bg.Row = 1
           bg.Col = 0
           bg.AddItem (bh & vbTab & mc & vbTab & qyrq & vbTab & zdmj & vbTab & yhmj & vbTab & lhmj & vbTab & ls & vbTab & dlwz & vbTab & lxdh)
    Else
       If adedbj = 1 Then bgsx
    End If
    Data1.Refresh
    text1(0).SetFocus
End Sub

Private Sub Form_Activate()
  If adedbj = 0 Then bgsx
End Sub

Private Sub Form_Load()
winmenu45.Left = 0
winmenu45.Top = 0
winmenu45.Width = 9540
winmenu45.Height = 6144
End Sub

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

Private Sub Image3_Click()
  frmdate.text1.Text = 1
  frmdate.Show vbModal
  ttFields(0).SetFocus
End Sub



Private Sub text1_GotFocus(Index As Integer)
   text1(Index).SelStart = 0
   text1(Index).SelLength = Len(Trim(text1(Index).Text))
   If Index > 2 And text1(2).Text = "" Then text1(2).Text = Format(Date, "yyyy-mm-dd")
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
  If KeyAscii = 13 Then
     If Index = 2 Then
        ttFields(0).SetFocus
     Else
        If Index = 5 Then
           If Comsave.Enabled = False Then Cmdtc.SetFocus Else Comsave.SetFocus
        Else
           text1(Index + 1).SetFocus
        End If
     End If
  End If
  If Index = 3 Then
     If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 45 Or KeyAscii = 8) Then KeyAscii = 0
  End If
End Sub

Private Sub Text1_LostFocus(Index As Integer)
  If Index = 0 And text1(0).Text <> "" Then
     If Len(Trim(text1(0).Text)) < 2 Then text1(0).Text = "0" + Trim(text1(0).Text)
  End If
  If Index = 2 And Len(text1(2).Text) < 1 Then
        text1(2).Text = Format(Date, "YYYY-MM-DD")
  Else
     text1(2).Text = Format(text1(2).Text, "YYYY-MM-DD")
  End If
  If Index = 3 And (cmdAdd.Enabled = False Or cmdedit.Enabled = False) Then Call Command3_Click
  
  
End Sub

Private Sub ttFields_GotFocus(Index As Integer)
   ttFields(Index).SelStart = 0
   ttFields(Index).SelLength = Len(Trim(ttFields(Index).Text))
   If text1(2).Text = "" Then text1(2).Text = Format(Date, "yyyy-mm-dd")
End Sub

Private Sub ttFields_KeyPress(Index As Integer, KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Index = 2 Then
         text1(3).SetFocus
      Else
         ttFields(Index + 1).SetFocus
      End If
      
   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 ttFields_LostFocus(Index As Integer)
      If Val(ttFields(Index).Text) = 0 Then
         ttFields(Index).Text = ""
      End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -