villagedoss.frm

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

      Width           =   720
   End
End
Attribute VB_Name = "VillageDoss"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public PD As Boolean

Private Sub Command1_Click()
       On Error GoTo Ferr
       If PD = True Then    '修改
          If Len(convert_string(Trim(Text2))) = 0 Then
             MsgBox "名称不能用数字标识!", vbCritical
             Text2.SelStart = 0
             Text2.SelLength = Len(Text2)
             Text2.SetFocus
             Exit Sub
          End If
          
          If MsgBox("确定修改" & ListView1.SelectedItem.SubItems(2) & "档案？", vbYesNo + vbQuestion, Me.Caption) = vbYes Then
             Set MdbR = NdMd.OpenRecordset("村档案")
             MdbR.Index = "乡村代码"
             MdbR.Seek "=", ListView1.SelectedItem
             If MdbR.NoMatch Then
                MsgBox ListView1.SelectedItem.SubItems(2) & "纪录未找到！", vbCritical
                PD = False
                Exit Sub
             Else
                With MdbR
                   .Delete
                   .MoveNext
                   .AddNew
                   .Fields("镇代码") = Left(List1.Text, 3)
                   .Fields("镇村代码") = Left(List1.Text, 3) + Trim(Text1.Text)
                   .Fields("村代码") = Format(Text1.Text, "000")
                   .Fields("简称") = Text2.Text
                   .Fields("抄表员") = Text3.Text
                   .Fields("建立日期") = Format(Now, "yyyy年mm月dd日")
                   .Fields("备注") = "已修改!!"
                   .Update
                End With
                ListView1.ListItems.Remove ListView1.SelectedItem.Index
                Dim Lli As ListItem
                Set Lli = ListView1.ListItems.Add(, , Left(List1.Text, 3) + Trim(Text1.Text), , 1)
                With Lli
                    .SubItems(1) = Text1.Text
                    .SubItems(2) = Text2.Text
                    .SubItems(3) = Text3.Text
                    .SubItems(6) = Text4.Text
                    .SubItems(4) = Format(Now, "yyyy年mm月dd日")
                End With
                Set ListView1.SelectedItem = Lli
                PD = False
                Frame1.Visible = False
                ListView1.Visible = True
                Toolbar1.Buttons.Item(3).Enabled = True
                Toolbar1.Buttons.Item(5).Enabled = True
                Toolbar1.Buttons.Item(7).Enabled = True
             End If
          End If
       Else   '增加
          If Len(convert_string(Trim(Text2))) = 0 Then
             MsgBox "名称不能用数字标识!", vbCritical
             Text2.SelStart = 0
             Text2.SelLength = Len(Text2)
             Text2.SetFocus
             Exit Sub
          End If
          
          Set MdbR = NdMd.OpenRecordset("SELECT * FROM 村档案 WHERE 镇村代码='" & Trim(Left(List1.Text, 3)) & Trim(Text1) & "'")
          If MdbR.RecordCount Then
             MsgBox "数据代码出现重复，请重新输入！", vbCritical
             Text1.SelStart = 0
             Text1.SelLength = Len(Text1)
             Text1.SetFocus
             Exit Sub
          End If
          With MdbR
               .AddNew
               .Fields("镇代码") = Left(List1.Text, 3)
               .Fields("镇村代码") = Left(List1.Text, 3) + Trim(Text1.Text)
               .Fields("村代码") = Text1.Text
               .Fields("简称") = Mid(Text2.Text, 1, 10)
               .Fields("抄表员") = Text3.Text
               .Fields("建立日期") = Format(Now, "yyyy年mm月dd日")
               If Not IsNull(.Fields("备注")) Then
                 .Fields("备注") = Text4.Text
               End If
              .Update
          End With
          Frame1.Visible = False
          List1.Enabled = True
          ListView1.Icons = ImageList2
          ListView1.Visible = True
          Dim Lii1 As ListItem
          Set Lii1 = ListView1.ListItems.Add(, , Left(List1.Text, 3) + Trim(Text1.Text), , 1)
          With Lii1
               .SubItems(1) = Text1.Text
               .SubItems(2) = Text2.Text
               .SubItems(3) = Text3.Text
               .SubItems(4) = Format(Now, "yyyy年mm月dd日")
               .SubItems(6) = Text4.Text
          End With
          Set ListView1.SelectedItem = Lii1
          Toolbar1.Buttons.Item(1).Enabled = False
          Toolbar1.Buttons.Item(3).Enabled = True
          Toolbar1.Buttons.Item(5).Enabled = True
          Toolbar1.Buttons.Item(7).Enabled = True
       End If
       frmMain.PopDataTree
       Exit Sub
Ferr:
     MsgBox Err.Description, vbCritical
     Exit Sub
End Sub

Private Sub Command2_Click()
    On Error Resume Next
    Frame1.Visible = False
    Toolbar1.Buttons.Item(1).Enabled = False
    Toolbar1.Buttons.Item(3).Enabled = True
    Toolbar1.Buttons.Item(5).Enabled = True
    Toolbar1.Buttons.Item(7).Enabled = True
    ListView1.Visible = True
    List1.Enabled = True
    ListView1.SetFocus
End Sub

Private Sub Form_Load()
    On Error Resume Next
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    OpenMdb
    If GetSetting(App.EXEName, "SysStart", "Start", "") = "One" Then
       Toolbar1.Buttons(1).Enabled = True
       Toolbar1.Buttons(3).Enabled = True
       Toolbar1.Buttons(5).Enabled = False
    End If
    Set MdbR = NdMd.OpenRecordset("乡镇档案")
    If MdbR.RecordCount <> 0 Then
        While Not MdbR.eof
            List1.AddItem MdbR!镇代码 & Space(2) & MdbR!全称
            MdbR.MoveNext
        Wend
        List1.ListIndex = 0
    Else
        MsgBox "无数据", vbCritical
        Toolbar1.Buttons(1).Enabled = False
        Toolbar1.Buttons(5).Enabled = False
        Toolbar1.Buttons(6).Enabled = False
        Exit Sub
    End If
End Sub

Private Sub List1_Click()
    On Error GoTo Errp
    Set MdbR = NdMd.OpenRecordset("select 乡镇档案.镇代码,村档案.村代码,村档案.镇村代码,村档案.简称,村档案.抄表员,村档案.建立日期,村档案.抄表密码,村档案.备注  from 村档案,乡镇档案 where 乡镇档案.镇代码=村档案.镇代码 and 村档案.镇代码 ='" & Trim(Left(List1.Text, 3)) & "'")
    Dim itm As ListItem
    ListView1.Icons = ImageList2
    ListView1.ListItems.Clear
    ListView1.Sorted = True
    If MdbR.RecordCount = 0 Then
        MsgBox "二级档案无数据，请单击增加按钮建立！", vbInformation
        'Toolbar1.Buttons(1).Enabled = False
        Toolbar1.Buttons(5).Enabled = False
        Toolbar1.Buttons(7).Enabled = False
        Exit Sub
    End If
    While Not MdbR.eof
        Set itm = ListView1.ListItems.Add(, , CStr(MdbR!镇村代码), , 1)
        If Not IsNull(MdbR!村代码) Then
           itm.SubItems(1) = CStr(MdbR!村代码)
        End If
        If Not IsNull(MdbR!简称) Then
           itm.SubItems(2) = CStr(MdbR!简称)
        End If
        If Not IsNull(MdbR!抄表员) Then
            itm.SubItems(3) = MdbR!抄表员
        End If
        If Not IsNull(MdbR!建立日期) Then
            itm.SubItems(4) = Format(MdbR!建立日期, "yyyy年mm月dd日")
        End If
        If Not IsNull(MdbR!抄表密码) Then
            '此考虑权限是否显示密码
            If pbUserPermission <> "系统管理员" Then
               itm.SubItems(5) = IIf(Not IsNull(MdbR.Fields!抄表密码), "****", "")
            Else
               itm.SubItems(5) = MdbR!抄表密码
            End If
        End If
        If Not IsNull(MdbR!备注) Then
            itm.SubItems(6) = MdbR!备注
        End If
        MdbR.MoveNext
    Wend
    Toolbar1.Buttons.Item(1).Enabled = False
    Toolbar1.Buttons(5).Enabled = True
    Toolbar1.Buttons(7).Enabled = True
    Exit Sub
Errp:
    MsgBox Err.Description, vbCritical
    Exit Sub
End Sub

Private Sub List1_DblClick()
    On Error Resume Next
    Toolbar1.Buttons.Item(1).Enabled = True
    Set MdbR = NdMd.OpenRecordset("乡镇档案")
    List1.Enabled = False
    ListView1.Visible = False
    Frame1.Visible = True
    Command1.Enabled = False
    Text1 = ""
    Text2 = ""
    Text3 = ""
    Text4 = ""
    With Toolbar1
        .Buttons.Item(1).Enabled = False
        .Buttons.Item(3).Enabled = False
    End With
End Sub

Private Sub Text1_Change()
   If Len(Trim(Text1)) = 3 Then
      Command1.Enabled = True
   Else
      Command1.Enabled = False
   End If
End Sub

Private Sub Text1_GotFocus()
   Text1.BackColor = &HFFFF80
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Len(Trim(Text1)) = 3 Then
           SendKeys "{tab}"
      Else
          MsgBox "代码有误,为3位!", vbCritical
          Text1.SetFocus
          Exit Sub
      End If
   End If
End Sub


Private Sub Text2_keyPress(KeyAscii As Integer)
   On Error Resume Next
   If KeyAscii = 13 Then
      If Trim(Text2) <> "" Then
         If Len(convert_string(Trim(Text2))) = 0 Then
           MsgBox "名称不能用数字标识!", vbCritical
           Text2.SelStart = 0
           Text2.SelLength = Len(Text2)
           Text2.SetFocus
           Exit Sub
         Else
           SendKeys "{tab}"
         End If
      Else
         MsgBox "名称不能空!", vbCritical
         Text2.SetFocus
         Exit Sub
      End If
   End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      SendKeys "{tab}"
   End If
End Sub

Private Sub Text4_keyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      SendKeys "{tab}"
   End If
End Sub

Private Sub Text1_LostFocus()
   Text1.BackColor = vbWhite
End Sub

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

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

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

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

Private Sub Text4_GotFocus()
   Text4.BackColor = &HFFFF80
End Sub

Private Sub Text4_LostFocus()
   Text4.BackColor = vbWhite
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error GoTo Errpp
    Select Case Button.Key
       Case "浏"
            List1.Enabled = True
            ListView1.Visible = True
            Frame1.Visible = False
            With Toolbar1
                    .Buttons.Item(3).Enabled = True
            End With
       Case "增"
            With Toolbar1
                 .Buttons.Item(1).Enabled = True
                 .Buttons.Item(3).Enabled = False
            End With
            ListView1.Visible = False
            Frame1.Visible = True
            List1.Enabled = False
            Text1 = ""
            Text2 = ""
            Text3 = ""
            Text4 = ""
            Text1.Visible = True
            Text1.Enabled = True
            Text1.SetFocus
            Command1.Enabled = False
            
       Case "删"
            Set MdbR = NdMd.OpenRecordset("村档案")
            MdbR.Index = "镇村代码"
            MdbR.Seek "=", ListView1.SelectedItem
            If MdbR.NoMatch Then
               MsgBox ListView1.SelectedItem.SubItems(2) & "纪录未找到！", vbCritical
             Else
               Dim yynn As Integer
               yynn = MsgBox("如果删除" & ListView1.SelectedItem.SubItems(2) & "档案,将删除该单位所有信息,确定吗？", vbYesNo + vbQuestion, Me.Caption)
               If yynn = vbYes Then
                  MdbR.Delete
                  MdbR.MoveNext
                  NdMd.Execute "delete 用户电费.* from 用户电费 where 用户电费.镇村代码='" & ListView1.SelectedItem & "'"
                  ListView1.ListItems.Remove ListView1.SelectedItem.Index
                  frmMain.PopDataTree
               End If
            End If
       
       Case "修"
            PD = True
            ListView1.Visible = False
            Frame1.Visible = True
            With Toolbar1
                .Buttons.Item(1).Enabled = False
                .Buttons.Item(3).Enabled = False
                .Buttons.Item(5).Enabled = False
                .Buttons.Item(7).Enabled = False
            End With
            Text1 = ListView1.SelectedItem.SubItems(1)
            Text2 = ListView1.SelectedItem.SubItems(2)
            Text3 = ListView1.SelectedItem.SubItems(3)
            Text2.SetFocus
       Case "退"
               Unload Me
               Set MdbR = NdMd.OpenRecordset("系统信息")
               If MdbR.RecordCount = 0 Then
                  SysParam.Show vbModal, Me
               End If
    End Select
    Exit Sub

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

Private Sub Text2_click()
      If Text2 <> "" Then
         Command1.Enabled = True
'         Text2.IMEMode = 1
      End If
End Sub

Private Sub Text3_Click()
      If Text2 = "" Then
         MsgBox "必须输入建档名称！", vbCritical, Me.Caption
         Text2.SetFocus
      End If
End Sub