sysparam.frm

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

         End
         Begin VB.CheckBox Check8 
            Caption         =   "自动编码"
            Enabled         =   0   'False
            Height          =   225
            Left            =   225
            TabIndex        =   41
            Top             =   900
            Width           =   1170
         End
         Begin VB.CheckBox Check7 
            Caption         =   "Logo动画"
            Enabled         =   0   'False
            Height          =   210
            Left            =   225
            TabIndex        =   39
            Top             =   585
            Width           =   1665
         End
         Begin VB.CheckBox Check4 
            Caption         =   "自动记录上次工作"
            Enabled         =   0   'False
            Height          =   255
            Left            =   225
            TabIndex        =   7
            Top             =   270
            Width           =   1935
         End
      End
   End
End
Attribute VB_Name = "SysParam"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ReadSetup As String
Dim qx As Boolean
Dim NewBColor As Long, NewFColor As Long


Private Sub Command4_KeyPress(KeyAscii As Integer)
      If KeyAscii = 13 Then
         Command2.SetFocus
      End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim BackPic As String
    On Error Resume Next
   '是否初次使用
    If GetSetting(App.EXEName, "SysStart", "Start", "") = "One" Then
       SSTab1.Tab = 1
       Text1.Locked = False
       Text2.Locked = False
       Label5.Visible = True
       Command1.Enabled = False
       Command4.Enabled = False
    Else
       SSTab1.Tab = 0
       Label5.Visible = False
    End If
    If Screen.Width \ Screen.TwipsPerPixelX = 800 And Screen.Height \ Screen.TwipsPerPixelY = 600 Then
       Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 1 - 900
    Else
       Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    End If
    OpenMdb
    If pbDw = "" Then
       Set MdbR = NdMd.OpenRecordset("系统信息")
       If MdbR.eof Then
          Command4.Caption = "增加(&A)"
          Command4.Tag = "ZJ"
       Else
          Text1 = MdbR.Fields!使用单位
          Text2 = MdbR.Fields!信用代码
          Command4.Caption = "修改(&E)"
          Command4.Tag = "XG"
       End If
    Else
       Text1 = pbDw
       Text2 = pbDwBm
       Command4.Caption = "修改(&E)"
       Command4.Tag = "XG"
    End If
    If GetSetting(App.EXEName, "SysSetup", "AutoCode", "") = "1" Then
       Check8.Value = 1
    Else
       Command5.Enabled = False
    End If

  '动画
    If GetSetting(App.EXEName, "SysSetup", "logo", "") = "1" Then Check7.Value = 1
    '台区
    If GetSetting(App.EXEName, "SysSetup", "TqInfo", "") = "0" Then Option5.Value = True
    If GetSetting(App.EXEName, "SysSetup", "TqInfo", "") = "1" Then Option3.Value = True
    If GetSetting(App.EXEName, "SysSetup", "TqInfo", "") = "2" Then Option4.Value = True
    BackPic = GetSetting(App.EXEName, "SysSetup", "BackPictureSetup", "")
    CC = BackPic
    
    '检测系统背景 1=渐变 Option2.Value=True  2=图片  Option1.Value=1
    ReadSetup = GetSetting(App.EXEName, "SysSetup", "BackGroundSetup", "")
    If ReadSetup = "1" Then
       Option2.Value = True
    Else
       Option1.Value = True
    End If
    CC.Enabled = False
    shpUp.FillStyle = 0
    ShpDn.FillStyle = 0
    For i = 0 To 2
        With hsUp(i)
            .Min = 0
            .Max = 255
            .LargeChange = 10
            .SmallChange = 1
        End With
        With hsDn(i)
            .Min = 0
            .Max = 255
            .LargeChange = 10
            .SmallChange = 1
        End With
    Next i
    ReadSetup = GetSetting(App.EXEName, "SysSetup", "DefaultBackGround", "")
    If ReadSetup = "0" Then   '用户
       Check5.Value = 0
       ReadSetup = GetSetting(App.EXEName, "SysSetup", "ShadeColor", "")
       hsUp(0).Value = Val(Mid(ReadSetup, 1, 3))
       hsUp(1).Value = Val(Mid(ReadSetup, 4, 3))
       hsUp(2).Value = Val(Mid(ReadSetup, 7, 3))
       hsDn(0).Value = Val(Mid(ReadSetup, 10, 3))
       hsDn(1).Value = Val(Mid(ReadSetup, 13, 3))
       hsDn(2).Value = Val(Mid(ReadSetup, 16, 3))
       Call FormPaintColor(picShow, Val(Mid(ReadSetup, 1, 3)), Val(Mid(ReadSetup, 4, 3)), Val(Mid(ReadSetup, 7, 3)), _
                    Val(Mid(ReadSetup, 10, 3)), Val(Mid(ReadSetup, 13, 3)), Val(Mid(ReadSetup, 16, 3)))
    Else                      '系统默认
       Check5.Value = 1
       hsUp(0).Value = 122
       hsUp(1).Value = 215
       hsUp(2).Value = 255
       hsDn(0).Value = 0
       hsDn(1).Value = 0
       hsDn(2).Value = 0
       Call FormPaintColor(picShow, 173, 180, 153, 71, 159, 80) '222, 239, 245 170, 180, 126,    2.173,180,153,71,159,80  1.122, 215, 255, 0, 0, 0
    End If
    picShow.Refresh
End Sub

Private Sub Check7_Click()
    If Check7.Value Then
       SaveSetting App.EXEName, "SysSetup", "Logo", "1"
    Else
       SaveSetting App.EXEName, "SysSetup", "Logo", "0"
    End If
End Sub

Private Sub Check8_Click()
    If Check8.Value = 1 Then
       Command5.Enabled = True
    Else
       Command5.Enabled = False
    End If
End Sub

Private Sub Command4_Click()
    On Error Resume Next
   If Command4.Tag = "ZJ" Then  '增加
       If GetSetting(App.EXEName, "SysStart", "Start", "") = "One" Then
          Call AddData
       Else
          If pbUserPermission <> "" Then
             If pbUserPermission <> "系统管理员" Then
                MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
                Exit Sub
                End If
             End If
             Call AddData
          End If
   Else
          '修改
       If Command4.Tag = "QR" Then
          If Len(Text1) = 0 And Len(Text2) < 2 And Len(Text2) > 3 Then
             MsgBox "数据输入有误，请参照示例!", vbCritical
             Text2.SelStart = 0
             Text2.SelLength = Len(Text2)
             Text2.SetFocus
             Exit Sub
          Else
             Set MdbR = NdMd.OpenRecordset("系统信息")
             If MdbR.RecordCount <> 0 Then
                With MdbR
                     .Edit
                     .Fields!使用单位 = Trim(Text1)
                     .Fields!信用代码 = Mid(Trim(Text2), 1, 2)
                     .Update
                End With
             End If
             pbDw = Trim(Text1)
             pbDwBm = Trim(Text2)
             Text1.Locked = True
             Text2.Locked = True
             Command4.Caption = "修改(&E)"
             Command4.Tag = "XG"
             MdbR.Close
             Command2.SetFocus
          End If
       Else
          If pbUserPermission <> "" Then
             If pbUserPermission <> "系统管理员" Then
                MsgBox "您的权限不够，请于系统管理员联系!", vbInformation
                Exit Sub
             End If
          End If
          Text1.Locked = False
          Text2.Locked = False
          Command4.Caption = "确认(&O)"
          Command4.Tag = "QR"
       End If
   End If
End Sub

Private Sub Check5_Click()
    If Check5.Value Then
       Frame3.Enabled = False
       Frame4.Enabled = False
    Else
       Frame3.Enabled = True
       Frame4.Enabled = True
    End If
End Sub

Private Sub Command1_Click()
    On Error Resume Next
    If Option1.Value = False Then  '系统渐变色
        If Check5 <> 0 Then '默认渐变色
           Call FormPaintColor(frmMain.FormColor, 173, 180, 153, 71, 159, 80) '222, 239, 245 170, 180, 126,1.122, 215, 255, 0, 0, 0
           frmMain.FormColor.Refresh
        Else                '自定义渐变色
           Call FormPaintColor(frmMain.FormColor, hsUp(0).Value, hsUp(1).Value, hsUp(2).Value, _
                        hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
           frmMain.FormColor.Refresh
        End If
    Else
       '立即显示图片，尚未加入自适应大小功能
       If CC.Text <> "" Then
          frmMain.FormColor.Picture = LoadPicture(CC.Text)
          'frmMain.FormColor.Move 0, 0, ScaleWidth, ScaleHeight
       Else
          MsgBox "您未选择背景图片!", vbCritical
          Option2.Value = True
          Exit Sub
       End If
    End If
    qx = True
    Call SaveED
    Unload Me
End Sub

Private Sub Command2_Click()
    qx = False
    Unload Me
    Call SaveED
End Sub

Private Sub Command3_Click()
    Load SelectFile
    SelectFile.Show 1
End Sub

Sub SaveED()
    On Error Resume Next
    If qx Then
        Dim ColorValue As String
        '保存背景何中设置
        If Option1.Value = True Then '使用图片
           SaveSetting App.EXEName, "SysSetup", "BackGroundSetup", "2"   '值2图片
           '背景图片位置
           SaveSetting App.EXEName, "SysSetup", "BackPictureSetup", CC.Text
           '否渐变
        Else                         'option2 渐变色
           SaveSetting App.EXEName, "SysSetup", "BackGroundSetup", "1" '值1渐变
           '存渐变颜色值
           ColorValue = Right("000" + Str(hsUp(0).Value), 3) & Right("000" + Str(hsUp(1).Value), 3) & Right("000" + Str(hsUp(2).Value), 3) & Right("000" + Str(hsDn(0).Value), 3) & Right("000" + Str(hsDn(1).Value), 3) & Right("000" + Str(hsDn(2).Value), 3)
           SaveSetting App.EXEName, "SysSetup", "ShadeColor", ColorValue
           SaveSetting App.EXEName, "SysSetup", "DefaultBackGround", Check5.Value
        End If
    End If
    '自动编码
    SaveSetting App.EXEName, "SysSetup", "AutoCode", Check8.Value
   
    Set MdbR = NdMd.OpenRecordset("电价档案")
    If MdbR.RecordCount = 0 Then
         ElectPrice.Show vbModal, Me
    Else
        If GetSetting(App.EXEName, "SysStart", "Start", "") = "One" Then
           OperatorManager.Show vbModal
        End If
    End If
End Sub

Private Sub Option1_Click()
   Command3.Enabled = True
   Frame3.Enabled = False
   Frame4.Enabled = False
   Check5.Enabled = False
End Sub

Private Sub Option2_Click()
   Frame3.Enabled = True
   Frame4.Enabled = True
   Check5.Enabled = True
   Command3.Enabled = False
   CC.Enabled = False
   Command3.Enabled = False
   picShow.Enabled = False
End Sub

Private Sub hsUp_Change(Index As Integer)
    Dim StrTemp As String
    shpUp.FillColor = RGB(hsUp(0).Value, hsUp(1).Value, hsUp(2).Value)
    Select Case Index
        Case 0
            labUp(0).Caption = "红: " & hsUp(0).Value
        Case 1
            labUp(1).Caption = "绿: " & hsUp(1).Value
        Case 2
            labUp(2).Caption = "蓝: " & hsUp(2).Value
    End Select
End Sub

Private Sub hsDn_Change(Index As Integer)
    ShpDn.FillColor = RGB(hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
    Select Case Index
        Case 0
            labDn(0).Caption = "红: " & hsDn(0).Value
        Case 1
            labDn(1).Caption = "绿: " & hsDn(1).Value
        Case 2
            labDn(2).Caption = "蓝: " & hsDn(2).Value
    End Select
    Call FormPaintColor(picShow, hsUp(0).Value, hsUp(1).Value, hsUp(2).Value, _
                    hsDn(0).Value, hsDn(1).Value, hsDn(2).Value)
End Sub

Private Sub Option3_Click()
     SaveSetting App.EXEName, "SysSetup", "TqInfo", "1"
End Sub

Private Sub Option4_Click()
     SaveSetting App.EXEName, "SysSetup", "TqInfo", "2"
End Sub

Private Sub Option5_Click()
     SaveSetting App.EXEName, "SysSetup", "TqInfo", "0"
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
     Select Case SSTab1.Tab
            Case 2
                Dim i As Integer
                Dim h As Integer
                Dim w As Integer
                Dim xx As Integer
                Dim j As Integer
                Dim yy As Integer
                h = 15
                w = 15
                Picture1.Refresh
                Picture1.AutoRedraw = False
                xx = Int(Picture1.ScaleWidth / w)
                yy = Int(Picture1.ScaleHeight / h)
                For i = 1 To h + 1
                    Picture1.Line (xx * i, 0)-(xx * i, Picture1.Height - 1)
                    Picture1.Line (0, yy * i)-(Picture1.Width - 1, yy * i)
                Next
    End Select
End Sub

Sub AddData()
    On Error Resume Next
    Text1.Locked = False
    Text2.Locked = False
    Set MdbR = NdMd.OpenRecordset("系统信息")
    With MdbR
         .AddNew
         .Fields!使用单位 = Trim(Text1)
         .Fields!信用代码 = Mid(Trim(Text2), 1, 2)
         .Update
    End With
    Command4.Caption = "修改(&E)"
    Command4.Tag = "XG"
    Command2.Caption = "关闭(&Q)"
    Text1.Locked = True
    Text2.Locked = True
    MdbR.Close
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       If Text1 = "" Then
          MsgBox "单位信息必须输入！", vbInformation
          Text1.SetFocus
       Else
          Text2.SetFocus
       End If
    End If
End Sub

Private Sub Text2_Change()
   If Len(Text2) = 2 Then
      Command4.Enabled = True
   Else
      Command4.Enabled = False
   End If
End Sub

Private Sub Text2_keyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
      If Len(Text2) = 2 Then
         Command4.SetFocus
      Else
         MsgBox "请输入代码！", vbCritical
         Text2.SetFocus
         Exit Sub
      End If
   End If
End Sub