frmset.frm

本程序源码是由vb编写的

         TabIndex        =   12
         Top             =   1965
         Width           =   1530
      End
      Begin VB.Shape speBackColor2 
         BorderColor     =   &H00000000&
         FillColor       =   &H00E0E0E0&
         FillStyle       =   0  'Solid
         Height          =   195
         Left            =   3885
         Top             =   1458
         Width           =   945
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "交差背景2"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   3
         Left            =   2910
         TabIndex        =   11
         Top             =   1465
         Width           =   810
      End
      Begin VB.Shape speBackColor1 
         FillColor       =   &H00FFFFFF&
         FillStyle       =   0  'Solid
         Height          =   195
         Left            =   1680
         Top             =   1458
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "3、交差背景1"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   2
         Left            =   495
         TabIndex        =   10
         Top             =   1465
         Width           =   1080
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "2、系统数据库路径："
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   1
         Left            =   495
         TabIndex        =   7
         Top             =   965
         Width           =   1710
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "1、是否以移动特效显示菜单"
         ForeColor       =   &H00000000&
         Height          =   180
         Index           =   0
         Left            =   495
         TabIndex        =   4
         Top             =   465
         Width           =   2250
      End
   End
   Begin Threed.SSCommand cmdOK 
      Height          =   420
      Left            =   4470
      TabIndex        =   1
      Top             =   3510
      Width           =   1140
      _Version        =   65536
      _ExtentX        =   2011
      _ExtentY        =   741
      _StockProps     =   78
      Caption         =   "确定(&O)"
      BevelWidth      =   1
   End
   Begin MSComctlLib.TabStrip TabStrip1 
      Height          =   3300
      Left            =   105
      TabIndex        =   0
      Top             =   135
      Width           =   6795
      _ExtentX        =   11986
      _ExtentY        =   5821
      HotTracking     =   -1  'True
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   3
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "常项"
            Key             =   "Option"
            Object.ToolTipText     =   "选项"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "配码"
            Key             =   "code"
            Object.ToolTipText     =   "配码"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "基本"
            Key             =   "product"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin Threed.SSCommand cmdCancel 
      Cancel          =   -1  'True
      Height          =   420
      Left            =   5730
      TabIndex        =   2
      Top             =   3510
      Width           =   1140
      _Version        =   65536
      _ExtentX        =   2011
      _ExtentY        =   741
      _StockProps     =   78
      Caption         =   "取消(&I)"
      BevelWidth      =   1
   End
   Begin Threed.SSCommand cmdDefault 
      Height          =   420
      Left            =   150
      TabIndex        =   14
      Top             =   3510
      Width           =   1140
      _Version        =   65536
      _ExtentX        =   2011
      _ExtentY        =   741
      _StockProps     =   78
      Caption         =   "缺省值(&D)"
      ForeColor       =   32768
      BevelWidth      =   1
   End
   Begin Threed.SSCommand cmdOperator 
      Height          =   420
      Left            =   1530
      TabIndex        =   29
      Top             =   3510
      Width           =   1530
      _Version        =   65536
      _ExtentX        =   2699
      _ExtentY        =   741
      _StockProps     =   78
      Caption         =   "操作员配置(&C)"
      ForeColor       =   16576
      BevelWidth      =   1
   End
End
Attribute VB_Name = "frmSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()

  Unload Me
  
End Sub

Private Sub cmdDefault_Click()

   optEffect(0).Value = True
   txtDataPath.Text = App.Path & "\Sys\SysData.Dat"
   speBackColor1.FillColor = &HFFFFFF
   speBackColor2.FillColor = &HE0E0E0
   speForeColor.FillColor = &HFF&
   speBackColor.FillColor = &HFFFF&
   
End Sub

Private Sub cmdOK_Click()
 
  SaveSet "Save"
  Unload Me
  
End Sub

Private Sub SaveSet(sType As String)

 '检测数据库是否完整
  On Error Resume Next
  If Dir(txtDataPath.Text) = "" Then
     MsgBox "对不起，数据文件不存在或不正确。   " & vbCrLf & vbCrLf & "  请修改后再继续......   ", vbCritical + vbOKOnly
     Exit Sub
  End If
  Dim sCODE() As String
        sCODE() = Split(txtCodeName.Text, "/", -1, vbTextCompare)
  Dim Con As Database
  Dim rRecord As Recordset
  Dim sSQL As String
  Set Con = OpenDatabase(ConData, 0, 0, ConStr)
  sSQL = "Select * From Code"
  Set rRecord = Con.OpenRecordset(sSQL, dbOpenDynaset)
 If sType = "Save" Then '保存时
    rRecord.Edit
    rRecord.Fields("CodeQua") = Val(txtCodeQua.Text)
    CodeQua = Val(txtCodeQua.Text)
    rRecord.Fields("CODE1") = sCODE(0)
    CodeName(1) = sCODE(0)
    rRecord.Fields("CODE2") = sCODE(1)
    CodeName(2) = sCODE(1)
    rRecord.Fields("CODE3") = sCODE(2)
    CodeName(3) = sCODE(2)
    rRecord.Fields("CODE4") = sCODE(3)
    CodeName(4) = sCODE(3)
    rRecord.Fields("CODE5") = sCODE(4)
    CodeName(5) = sCODE(4)
    rRecord.Fields("CODE6") = sCODE(5)
    CodeName(6) = sCODE(5)
    rRecord.Fields("CODE7") = sCODE(6)
    CodeName(7) = sCODE(6)
    rRecord.Fields("CODE8") = sCODE(7)
    CodeName(8) = sCODE(7)
    rRecord.Fields("CODE9") = sCODE(8)
    CodeName(9) = sCODE(8)
    rRecord.Fields("DataPath") = txtDataPath.Text
    ConData = txtDataPath.Text
    SaveSetting App.EXEName, "Option", "DataPath", ConData
    If optEffect(0).Value = True Then
       rRecord.Fields("IsEffect") = 0
       IsEffect = False
       Else
       IsEffect = True
       rRecord.Fields("IsEffect") = 1
    End If
    rRecord.Fields("BackColor1") = speBackColor1.FillColor
    BackColor1 = speBackColor1.FillColor
    rRecord.Fields("BackColor2") = speBackColor2.FillColor
    BackColor2 = speBackColor2.FillColor
    rRecord.Fields("SelectFore") = speForeColor.FillColor
    SelectForeColor = speForeColor.FillColor
    rRecord.Fields("SelectBack") = speBackColor.FillColor
    SelectBackColor = speBackColor.FillColor
    rRecord.Update
 Else  '给出
     txtCodeQua.Text = CodeQua
     If IsEffect = True Then
        optEffect(1).Value = True
      Else
        optEffect(0).Value = True
     End If
     txtDataPath.Text = ConData
     speBackColor1.FillColor = BackColor1
     speBackColor2.FillColor = BackColor2
     speForeColor.FillColor = SelectForeColor
     speBackColor.FillColor = SelectBackColor
     txtCodeName = CodeName(1) & "/" & CodeName(2) & "/" & CodeName(3) & "/" & CodeName(4) & "/" & CodeName(5) & "/" & CodeName(6) & "/" _
              & CodeName(7) & "/" & CodeName(8) & "/" & CodeName(9) & "/"
 End If
   rRecord.Close
   Con.Close
   Set rRecord = Nothing
   Set Con = Nothing
   
End Sub

Private Sub cmdOperator_Click()

  frmOperator.Show 1
  
End Sub

Private Sub cmdSelect1_Click()
 
  ColorDialog.CancelError = True
  On Error Resume Next
  ColorDialog.ShowColor

  If Err.Number = 32755 Then
     Exit Sub
     Else
     speBackColor1.FillColor = ColorDialog.Color
  End If
End Sub

Private Sub cmdSelect2_Click()
  ColorDialog.CancelError = True
  On Error Resume Next
  ColorDialog.ShowColor
  If Err.Number = 32755 Then
     Exit Sub
     Else
     speBackColor2.FillColor = ColorDialog.Color
  End If

End Sub

Private Sub cmdSelect3_Click()
  ColorDialog.CancelError = True
  On Error Resume Next
  ColorDialog.ShowColor

  If Err.Number = 32755 Then
     Exit Sub
     Else
     speForeColor.FillColor = ColorDialog.Color
  End If

End Sub

Private Sub cmdSelect4_Click()
  ColorDialog.CancelError = True
  On Error Resume Next
  ColorDialog.ShowColor

  If Err.Number = 32755 Then
     Exit Sub
     Else
     speBackColor.FillColor = ColorDialog.Color
  End If

End Sub

Private Sub cmdType_Click()

  Load frmGuestSet
  frmGuestSet.GuestManager1.sDatabaseFile = ConData
  frmGuestSet.GuestManager1.sDatabasePassword = ConStr
  frmGuestSet.GuestManager1.sTableName = "ProductType"
  frmGuestSet.Show 1
  
End Sub

Private Sub Form_Load()

 '给出数据
 SaveSet "Get"
 
End Sub

Private Sub SSCommand1_Click()

  ColorDialog.CancelError = True
  On Error Resume Next
  ColorDialog.DialogTitle = "请选择数据文件"
  If txtDataPath.Text = "" Then
     ColorDialog.FileName = App.Path
  Else
     ColorDialog.FileName = txtDataPath.Text
  End If
  ColorDialog.Filter = "POS数据文件(*.dat)|*.Dat|所有文件(*.*)|*.*"
  
  ColorDialog.ShowOpen
  If Err.Number = 32755 Then
     Exit Sub
     Else
     txtDataPath.Text = ColorDialog.FileName
  End If
End Sub

Private Sub SSCommand2_Click()

  Load frmGuestSet
  frmGuestSet.GuestManager1.sDatabaseFile = ConData
  frmGuestSet.GuestManager1.sDatabasePassword = ConStr
  frmGuestSet.GuestManager1.sTableName = "SupplerType"
  frmGuestSet.Show 1
  
End Sub

Private Sub SSCommand3_Click()


  MsgBox "对不起，请自行编写产品管理模块 ！  " & vbCrLf & vbCrLf & "  如果有困难：拨 0577-8269005 8269007   ", vbInformation
  
End Sub

Private Sub SSCommand4_Click()

  Load frmConfig1
  frmConfig1.GuestManager1.sDatabaseFile = ConData
  frmConfig1.GuestManager1.sDatabasePassword = ConStr
  frmConfig1.GuestManager1.sTableName = "Suppler"
  frmConfig1.GuestManager1.IsGuest = False
  frmConfig1.Show 1
  
End Sub

Private Sub SSCommand5_Click()

  Load frmGuestSet
  frmGuestSet.GuestManager1.sDatabaseFile = ConData
  frmGuestSet.GuestManager1.sDatabasePassword = ConStr
  frmGuestSet.GuestManager1.sTableName = "GuestType"
  frmGuestSet.Show 1
  
End Sub

Private Sub TabStrip1_Click()

  If TabStrip1.SelectedItem.Key = "Option" Then
     Picture1.Visible = True
     Picture2.Visible = False
     Picture3.Visible = False
   ElseIf TabStrip1.SelectedItem.Key = "product" Then
     Picture1.Visible = False
     Picture2.Visible = False
     Picture3.Visible = True
    Else
     Picture1.Visible = False
     Picture2.Visible = True
     Picture3.Visible = False
  End If
End Sub

Private Sub txtCodeQua_LostFocus()

  If Val(txtCodeQua.Text) = 0 Then
     txtCodeQua.Text = 1
  End If
End Sub

Private Sub txtDataPath_DblClick()
 Call SSCommand1_Click
End Sub