towndossier.frm

适合乡镇供电所使用电费处理系统v3 软件

   End
End
Attribute VB_Name = "TownDossier"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click(Index As Integer)
   If Index = 1 Then
        Frame2.Visible = False
        Toolbar1.Buttons.Item(1).Enabled = True
        Toolbar1.Buttons.Item(2).Enabled = True
        Toolbar1.Buttons.Item(4).Caption = "退出"
        Toolbar1.Buttons.Item(3).Caption = "修改"
        Toolbar1.Buttons.Item(3).Key = "修"
        Toolbar1.Buttons.Item(4).Key = "退"
   Else
     Call Text3_KeyPress(13)
   End If

End Sub

Private Sub Form_Load()
    On Error Resume Next
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    If GetSetting(App.EXEName, "SysStart", "Start", "") = "One" Then
       Frame2.Visible = False
       Label4.Visible = True
       Toolbar1.Buttons(2).Enabled = False
       Toolbar1.Buttons(3).Enabled = False
       Toolbar1.Buttons(4).Enabled = False
    Else
       Label4.Visible = False
    End If
    OpenMdb
    DatView
End Sub

Private Sub Text2_GotFocus()
      Text2.BackColor = &HFFFF80
End Sub

Private Sub Text3_GotFocus()
     Text3.BackColor = &HFFFF80
End Sub

Private Sub Text2_LostFocus()
     Text2.BackColor = vbWhite
End Sub

Private Sub Text3_LostFocus()
     Text3.BackColor = vbWhite
End Sub

Sub Text2_keyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Text2.Text = "" Then
         MsgBox "一级单位名称必须输入!", vbCritical, Me.Caption
       Else
         SendKeys "{tab}"
      End If
   End If
  If KeyAscii = 27 Then
     Frame2.Visible = False
     Toolbar1.Buttons.Item(1).Enabled = True
     Toolbar1.Buttons.Item(2).Enabled = True
     Toolbar1.Buttons.Item(3).Enabled = True
     Toolbar1.Buttons.Item(3).Caption = "修改"
     Toolbar1.Buttons.Item(4).Caption = "退出"
     Toolbar1.Buttons.Item(3).Key = "修"
     Toolbar1.Buttons.Item(4).Key = "退"
  End If
End Sub

Sub Text3_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = 13 Then
        If Toolbar1.Buttons.Item(3).Caption = "保存" Then
            SaveDat
            DatView
            Toolbar1.Buttons.Item(3).Caption = "修改"
            Toolbar1.Buttons.Item(4).Caption = "退出"
            Toolbar1.Buttons.Item(3).Key = "修"
            Toolbar1.Buttons.Item(4).Key = "退"
            Frame2.Visible = False
            Toolbar1.Buttons.Item(1).Enabled = True
            Toolbar1.Buttons.Item(2).Enabled = True
            Toolbar1.Buttons.Item(3).Enabled = True
        Else
            If Text3 = "" Then
               MsgBox "全称要输入,因为后面的工作需此标识！", vbCritical
               Text3.SelStart = 0
               Text3.SelLength = Len(Text2)
               Text3.SetFocus
               Exit Sub
            Else
                Dim Li As ListItem
                MdbR.AddNew
                MdbR.Fields!建档日期 = Date
                MdbR.Fields!镇代码 = Format(Text1.Text, "000")
                MdbR.Fields!简称 = Text2.Text
                MdbR.Fields!全称 = Text3.Text & ""
                MdbR.Fields!操作员 = Operator
                MdbR.Update
                LiV.Icons = ImageList1
                LiV.Refresh
                LiV.Sorted = True
                Set Li = LiV.ListItems.Add(, , Text1.Text, , 5)
                Li.SubItems(1) = Text3.Text
                Li.SubItems(2) = Text2.Text
                Li.SubItems(3) = Format(Date, "yyyy年mm月dd日")
                Li.SubItems(4) = Operator
                Set LiV.SelectedItem = Li
                Frame2.Visible = False
                Toolbar1.Buttons.Item(1).Enabled = True
                Toolbar1.Buttons.Item(2).Enabled = True
                Toolbar1.Buttons.Item(3).Enabled = True
                Toolbar1.Buttons.Item(4).Enabled = True
                LiV.SetFocus
            End If
        End If
    End If
  If KeyAscii = 27 Then
     Frame2.Visible = False
     Toolbar1.Buttons.Item(1).Enabled = True
     Toolbar1.Buttons.Item(2).Enabled = True
     Toolbar1.Buttons.Item(3).Enabled = True
     Toolbar1.Buttons.Item(3).Caption = "修改"
     Toolbar1.Buttons.Item(4).Caption = "退出"
     Toolbar1.Buttons.Item(3).Key = "修"
     Toolbar1.Buttons.Item(4).Key = "退"
  End If

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   On Error GoTo errB
    Select Case Button.Key
           Case "增"
                Toolbar1.Buttons.Item(1).Enabled = False
                Toolbar1.Buttons.Item(2).Enabled = False
                Toolbar1.Buttons.Item(3).Enabled = False
                Frame2.Visible = True
                Text1.Text = ""
                Text2.Text = ""
                Text3.Text = ""
                Text1.Enabled = False
                MdbR.Index = "乡镇代码"
                MdbR.Seek "=", Format(IIf(MdbR.RecordCount = 0, 1, MdbR.RecordCount), "000")
                If Not MdbR.NoMatch Then
                   Text1.Text = Format(MdbR.RecordCount + 1, "000")
                Else
                   Text1.Text = Format(IIf(MdbR.RecordCount = 0, 1, MdbR.RecordCount), "000")
                End If
                Text2.SetFocus
                
           Case "删"
                If Not LiV.SelectedItem Is Nothing Then
                    If MsgBox("如果删除当前选中的纪录,将删除该单位的所有信息,确定吗?", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
                       If MdbR.eof And MdbR.BOF Then
                           Exit Sub
                       Else
                           MdbR.Index = "乡镇代码"
                           MdbR.Seek "=", LiV.SelectedItem
                           MdbR.Delete
                           MdbR.MoveNext
                           NdMd.Execute "delete 村档案.* from 村档案 where 村档案.镇代码='" & LiV.SelectedItem & "'"
                           NdMd.Execute "delete 用户电费.* from 用户电费 where 用户电费.镇代码='" & LiV.SelectedItem & "'"
                           frmMain.PopDataTree
                       End If
                       LiV.ListItems.Remove LiV.SelectedItem.Index
                       If LiV.ListItems.Count > 0 Then
                          Set LiV.SelectedItem = LiV.ListItems(1)
                       End If
                       LiV.SetFocus
                    End If
                End If
           Case "修"
                Frame2.Visible = True
                Toolbar1.Buttons.Item(1).Enabled = False
                Toolbar1.Buttons.Item(2).Enabled = False
                Toolbar1.Buttons.Item(4).Caption = "取消"
                Toolbar1.Buttons.Item(3).Caption = "保存"
                Toolbar1.Buttons.Item(3).Key = "保"
                Toolbar1.Buttons.Item(4).Key = "取"
                Text1.Enabled = False
                Text1.Text = LiV.SelectedItem.Text
                Text3.Text = LiV.SelectedItem.ListSubItems.Item(1)
                Text2.Text = LiV.SelectedItem.ListSubItems.Item(2)
                Text2.SetFocus
           Case "保"
                SaveDat
                Frame2.Visible = False
                Toolbar1.Buttons.Item(1).Enabled = True
                Toolbar1.Buttons.Item(2).Enabled = True
                Toolbar1.Buttons.Item(4).Caption = "退出"
                Toolbar1.Buttons.Item(3).Caption = "修改"
                Toolbar1.Buttons.Item(3).Key = "修"
                Toolbar1.Buttons.Item(4).Key = "退"
                DatView
           Case "取"
                Frame2.Visible = False
                Toolbar1.Buttons.Item(1).Enabled = True
                Toolbar1.Buttons.Item(2).Enabled = True
                Toolbar1.Buttons.Item(4).Caption = "退出"
                Toolbar1.Buttons.Item(3).Caption = "修改"
                Toolbar1.Buttons.Item(3).Key = "修"
                Toolbar1.Buttons.Item(4).Key = "退"
           Case "退"
                If Toolbar1.Buttons.Item(4).Caption = "取消" Then
                   Toolbar1.Buttons.Item(4).Caption = "退出"
                'Else
                End If
                 Unload TownDossier
                 Set TownDossier = Nothing   '释放该对象
                 Set MdbR = NdMd.OpenRecordset("村档案")
                 If MdbR.RecordCount = 0 Then
                    VillageDoss.Show vbModal, Me
                 End If
    End Select
    Exit Sub

errB:
    MsgBox Err.Description, vbCritical
    Exit Sub
End Sub

Sub DatView()
    On Error Resume Next
    Set MdbR = NdMd.OpenRecordset("乡镇档案")
    Dim itmX As ListItem
    LiV.Icons = ImageList1
    LiV.View = lvwReport
    LiV.ListItems.Clear
    LiV.SortKey = 0
    LiV.Sorted = True
    While Not MdbR.eof
        Set itmX = LiV.ListItems.Add(, , CStr(MdbR!镇代码), , 5)
        If Not IsNull(MdbR!全称) Then
            itmX.SubItems(1) = MdbR!全称
        End If
        If Not IsNull(MdbR!简称) Then
           itmX.SubItems(2) = CStr(MdbR!简称)
        End If
        If Not IsNull(MdbR!建档日期) Then
            itmX.SubItems(3) = Format(MdbR!建档日期, "yyyy年mm月dd日")
        End If
        If Not IsNull(MdbR!操作员) Then
            itmX.SubItems(4) = MdbR!操作员
        End If
        MdbR.MoveNext
    Wend
End Sub

Sub SaveDat()
    On Error GoTo AllNameErr
    MdbR.Index = "乡镇代码"
    MdbR.Seek "=", Text1.Text
    MdbR.Edit
    If Not MdbR.NoMatch Then
       MdbR.Fields("镇代码") = Format(Text1.Text, "000")
       MdbR.Fields("简称") = Text2.Text
       MdbR.Fields("全称") = Text3.Text
       MdbR.Update
    End If
    Dim Li As ListItem
    LiV.ListItems.Clear
    Set Li = LiV.ListItems.Add(, , Text1.Text)
    Li.SubItems(1) = Text3.Text
    Li.SubItems(2) = Text2.Text
    Li.SubItems(3) = Format(Date, "yyyy年mm月dd日")
    Li.SubItems(4) = Operator
    Exit Sub

AllNameErr:
       If Err = 3315 Then
          MsgBox "全称不能为空！", vbCritical
          Exit Sub
       End If
End Sub