electprice.frm

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

    On Error GoTo NotSeleItem
    Select Case Button.Key
       Case "增"
            If pbUserPermission <> "" Then
                If pbUserPermission <> "系统管理员" Then
                    MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
                    Exit Sub
                End If
            End If
            If TreeView1.SelectedItem <> "" Then
                Me.Height = 7335
                Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
                Call TbSata(4, "取消", "Cancel", True)
                Option2(0).Value = True
                Option1(1).Value = True
                TreeView1.Enabled = False
                Toolbar1.Buttons.Item(1).Enabled = False
                Toolbar1.Buttons.Item(2).Enabled = False
                Toolbar1.Buttons.Item(3).Enabled = False
                If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
                   Label1.Caption = "电价代码："
                   Label2.Caption = "电价名称："
                Else
                   Label1.Caption = "类别代码："
                   Label2.Caption = "类别名称："
                End If
            End If
       Case "Saved"
            Call DataUpdata(0)
       Case "Cancel"
             Me.Height = 5445
             Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
             Call TbSata(1, "增加", "增", True)
             Call TbSata(3, "修改", "修", True)
             Call TbSata(4, "退出", "退", True)
             Toolbar1.Buttons.Item(2).Enabled = True
             Toolbar1.Buttons.Item(3).Enabled = True
             TreeView1.Enabled = True
       Case "删"
            If pbUserPermission <> "" Then
                If pbUserPermission <> "系统管理员" Then
                   MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
                   Exit Sub
                End If
            End If
            If MsgBox("真的要删除当前信息，请仔细考虑！", vbQuestion + vbYesNo, Caption) = vbYes Then
                If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
                   Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 电价ID='" & Mid(TreeView1.SelectedItem.Parent, 2, 2) & Mid(TreeView1.SelectedItem, 2, 2) & "'")
                Else
                   Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 电价ID='" & Mid(TreeView1.SelectedItem, 2, 2) & "01" & "'")
                End If
                Dim Seleitm As ListItem
    'End If
                Set Seleitm = ListView1.FindItem(Mid(TreeView1.SelectedItem.Parent, 2, 2) & Mid(TreeView1.SelectedItem, 2, 2), lvwText, , 1)
                If Not (Seleitm Is Nothing) Then
                   Seleitm.EnsureVisible
                   Seleitm.Selected = True
                   ListView1.ListItems.Remove ListView1.SelectedItem.Index
                End If
                MdbR.Delete
                TreeView1.Nodes.Remove TreeView1.SelectedItem.Index

            End If
       Case "修"
            If pbUserPermission <> "" Then
                If pbUserPermission <> "系统管理员" Then
                   MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
                   Exit Sub
                End If
            End If
            If TreeView1.SelectedItem.Parent <> "" Then
                Call TbSata(3, "取消", "Cancel", True)
                Toolbar1.Buttons.Item(1).Enabled = False
                Toolbar1.Buttons.Item(2).Enabled = False
                Me.Height = 7335
                Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
            End If
       Case "退"
             Unload Me
             Set MdbR = NdMd.OpenRecordset("口令权限")
              If MdbR.RecordCount = 0 Then
                   OperatorManager.Show vbModal, Me
              End If
    End Select
    Exit Sub
    
NotSeleItem:
      If Err.Number = 91 Then
         MsgBox "请用选择电价的类型!", vbInformation
         TreeView1.SetFocus
         TreeView1.SelectedItem.Selected = True
         Exit Sub
      Else
         'Resume Next
         Exit Sub
      End If
End Sub

Sub DataUpdata(Prval As Integer)
    Dim cou As Integer
    Dim LiV As ListItem
    Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String, s7 As String, s8 As String, s9 As String, s10 As String, s11 As String, s12 As String, s13 As String, s14 As String, s15 As String, s16 As String
    Dim s(50) As String
    '保存老电价
    'On Error Resume Next
    If pbUserPermission <> "" Then
        If pbUserPermission <> "系统管理员" Then
           MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
           Exit Sub
        End If
    End If
    If Prval <> 0 Then
    s1 = ListView1.SelectedItem  '代码
    s2 = ListView1.SelectedItem.SubItems(1) '名称
    s3 = ListView1.SelectedItem.SubItems(2) '电价
    s4 = ListView1.SelectedItem.SubItems(3) '附加项目1
    s5 = ListView1.SelectedItem.SubItems(4) '附加电价1
    s6 = ListView1.SelectedItem.SubItems(5) '附加项目2
    s7 = ListView1.SelectedItem.SubItems(6) '附加电价2
    s8 = ListView1.SelectedItem.SubItems(7) '附加项目3
    s9 = ListView1.SelectedItem.SubItems(8) '附加电价3
    s10 = ListView1.SelectedItem.SubItems(9) '4
    s11 = ListView1.SelectedItem.SubItems(10) '4
    s12 = ListView1.SelectedItem.SubItems(11) '5
    s13 = ListView1.SelectedItem.SubItems(12) '5
    s14 = ListView1.SelectedItem.SubItems(13) '日前
    s15 = ListView1.SelectedItem.SubItems(14) '备注
    s16 = ListView1.SelectedItem.SubItems(15) '操作员
    End If
    If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
       Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 电价ID='" & Mid(TreeView1.SelectedItem.Parent, 2, 2) & Trim(Text1(0)) & "'AND  状态=true")
    Else
       Set MdbR = NdMd.OpenRecordset("SELECT distinct 电价代码 FROM 电价档案 WHERE 电价代码='" & Trim(Text1(0)) & "'AND  状态=true")
    End If
    If Prval = 0 Then
        If MdbR.RecordCount > 0 Then
           If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
               MsgBox FF & "电价代码已存在,请重新输入!", vbInformation
           Else
               MsgBox FF & "价区代码已存在,请重新输入!", vbInformation
           End If
           Text1(0).SetFocus
           Exit Sub
        End If
        If Val(Text1(2)) = 0 Or Len(Text1(2)) = 0 Then
           MsgBox "电价不能为零或为空!", vbCritical
           Text1(2).SetFocus
           Exit Sub
        End If
        If Len(Text1(1)) = 0 Then
           If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
               MsgBox FF & "电价名称不能空,请输入!", vbInformation
           Else
               MsgBox FF & "价区名称不能空,请输入!", vbInformation
           End If
           Text1(1).SetFocus
           Exit Sub
        End If
    End If
    Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案")
    If Option1(0).Value = False Then
        With MdbR
            If Prval = 0 Then  '=0增加
            .AddNew
            Else               '=1修改
            .Edit
            End If
            If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
            .Fields!电价ID = Mid(TreeView1.SelectedItem.Parent, 2, 2) & Trim(Text1(0))
            .Fields!电价代码 = Mid(TreeView1.SelectedItem.Parent, 2, 2)
            .Fields!电价类别 = Trim(Mid(TreeView1.SelectedItem.Parent, 5, 18))
            .Fields!价区代码 = Trim(Text1(0))
            Else
            .Fields!电价ID = Trim(Text1(0)) & "01"
            .Fields!电价代码 = Trim(Text1(0))
            .Fields!电价类别 = Trim(Text1(1))
            .Fields!价区代码 = "01"
            End If
            .Fields!价区类别 = Trim(Text1(1))
            .Fields!电价 = Format(Val(Text1(2)), "0.000")
            .Fields!建立日期 = Format(Now, "yyyy年mm月dd日")
            .Fields!操作员 = Operator
            .Fields!是否附加 = Option1(0).Value
            .Fields!状态 = Option2(0).Value
            .Update
            If Prval = 1 Then   '修改后保存
                Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 电价代码='" & s1 & "旧" & "'AND 标记='历史电价'")
                If MdbR.RecordCount = 0 Then
                   .AddNew '保存旧电价
                   .Fields("电价代码") = s1 & "旧"
                   .Fields("电价名称") = s2
                   .Fields("历史电价") = s3
                   .Fields("更改日期") = Format(Now, "yyyy年mm月dd日")
                   .Fields("备注") = "历史电价"
                   .Fields("标记") = "历史电价"
                   .Fields("操作员") = Operator
                   .Update
                End If
            End If
        End With
        If Prval = 0 Then  '添加到litsv treev
            If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
                Set LiV = ListView1.ListItems.Add(, , Mid(TreeView1.SelectedItem.Parent, 2, 2) & Trim(Text1(0)), , 2)
                LiV.SubItems(4) = Trim(Mid(TreeView1.SelectedItem.Parent, 5, 18))
            Else
                Set LiV = ListView1.ListItems.Add(, , Trim(Text1(0)) & "01", , 2)
                LiV.SubItems(4) = Trim(Text1(1))
            End If
            LiV.SubItems(1) = Trim(Text1(1))
            LiV.SubItems(2) = Format(Text1(2).Text, "0.000")
            LiV.SubItems(3) = Trim(Combo1.Text)
            LiV.SubItems(5) = IIf(Option1(0).Value = True, "有", "没有")
            If Option1(0).Value = True Then
               LiV.SubItems(6) = Format(Text2(0).Text, "0.000")
               LiV.SubItems(7) = Format(Text2(1).Text, "0.000")
               LiV.SubItems(8) = Format(Text2(2).Text, "0.000")
            End If
            LiV.SubItems(9) = IIf(Option2(0).Value = True, "启用", "停用")
            
            LiV.SubItems(10) = Format(Now, "yyyy年mm月dd日")
            LiV.SubItems(11) = Operator
            '此处假如tree
            Dim nodX As node
            Dim nodX1 As node
            If InStr(TreeView1.SelectedItem.FullPath, "\") > 0 Then
               Set nodX = TreeView1.Nodes.Add(TreeView1.SelectedItem.Parent.Index, tvwChild, , "(" & Text1(0) & ")" & Text1(1) & "  " & Format(Text1(2), "0.00"), 1, 2)
            Else
               Set nodX = TreeView1.Nodes.Add(, , , "(" & Text1(0) & ")" & Text1(1), 1, 2)
               '怎样加入子项
               Set nodX = TreeView1.Nodes.Add(TreeView1.Nodes.Count, tvwChild, , "(" & "01" & ")" & Text1(1) & "  " & Format(Text1(2), "0.00"), 2)
            End If
        Else
            ListView1.SelectedItem.SubItems(1) = Text1(0).Text
            ListView1.SelectedItem.SubItems(2) = Format(Text1(2), "0.0000") '电价
            ListView1.SelectedItem.SubItems(13) = Format(Now, "yyyy年mm月dd日")
            ListView1.SelectedItem.SubItems(15) = Operator
        End If
    Else
        With MdbR
            If Prval = 0 Then  '=0增加
            .AddNew
            .Fields("电价代码") = Text1(0)
            .Fields("电价名称") = Text1(2)
            Else               '=1修改
            .Edit
            End If
            .Fields!电价名称 = Text1(0)
            .Fields("当前电价") = Format(Text1(0).Text, "0.0000")
            
            .Fields("建立日期") = Format(Now, "yyyy年mm月dd日")
            .Fields("操作员") = Operator
            .Fields("备注") = "当前电价"
            .Fields("标记") = "当前电价"
            .Update
            If Prval = 1 Then   '修改后保存
                Set MdbR = NdMd.OpenRecordset("SELECT * FROM 电价档案 WHERE 电价代码='" & s1 & "旧" & "'AND 标记='历史电价'")
                If MdbR.RecordCount = 0 Then
                    .AddNew '保存旧电价
                    .Fields("电价代码") = s1 & "旧"
                    .Fields("电价名称") = s2
                    .Fields("当前电价") = s3
                    .Fields("附加名称1") = s4
                    .Fields("附加电价1") = s5 & 0
                    .Fields("附加名称2") = s6
                    .Fields("附加电价2") = s7 & 0
                    .Fields("附加名称3") = s8
                    .Fields("附加电价3") = s9 & 0
                    .Fields("附加名称4") = s10
                    .Fields("附加电价4") = s11 & 0
                    .Fields("附加名称5") = s12
                    .Fields("附加电价5") = s13 & 0
                    .Fields("更改日期") = Format(Now, "yyyy年mm月dd日")
                    .Fields("备注") = "历史电价"
                    .Fields("标记") = "历史电价"
                    .Fields("操作员") = Operator
                    .Update
                End If
            End If
        
        End With
        Frame2.Visible = False
        ListView1.Visible = True
        If Prval = 0 Then
           Set LiV = ListView1.ListItems.Add(, , Text1(0), , 3)
           LiV.SubItems(1) = Text1(1)
           LiV.SubItems(2) = Text1(2)
           LiV.SubItems(3) = Text1(3)
           LiV.SubItems(4) = Text1(4)
            
           LiV.SubItems(13) = Format(Now, "yyyy年mm月dd日")    'FormatDateTime(Date, vbLongDate)
           LiV.SubItems(14) = "当前电价"
           LiV.SubItems(15) = Operator
        Else
            ListView1.SelectedItem.SubItems(1) = Text1(0)
            ListView1.SelectedItem.SubItems(2) = Text1(0)
            ListView1.SelectedItem.SubItems(3) = Text1(0)
            ListView1.SelectedItem.SubItems(13) = Format(Now, "yyyy年mm月dd日")    'FormatDateTime(Date, vbLongDate)
            ListView1.SelectedItem.SubItems(14) = "当前电价"
            ListView1.SelectedItem.SubItems(15) = Operator
        End If
    End If
    'Call TbStaEF(True)
End Sub

Sub TbStaEF(EFsta As Boolean)
    Dim i As Integer
    For i = 1 To 3
        Toolbar1.Buttons(i).Enabled = EFsta
    Next
End Sub