frmin_voucherset.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmIN_VoucherSet 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "凭证设置"
   ClientHeight    =   3810
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4455
   Icon            =   "frmIN_VoucherSet.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3810
   ScaleWidth      =   4455
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame fraLocalMachine 
      Caption         =   "本机设置"
      ForeColor       =   &H8000000D&
      Height          =   735
      Left            =   135
      TabIndex        =   12
      Top             =   1845
      Width           =   2895
      Begin VB.OptionButton optCode 
         Caption         =   "科目默认显示代码"
         Height          =   420
         Left            =   360
         TabIndex        =   14
         Top             =   225
         Width           =   1140
      End
      Begin VB.OptionButton optName 
         Caption         =   "科目默认显示名称"
         Height          =   420
         Left            =   1665
         TabIndex        =   13
         Top             =   225
         Value           =   -1  'True
         Width           =   1140
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "样式"
      ForeColor       =   &H8000000D&
      Height          =   735
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   2895
      Begin VB.OptionButton optBack 
         Caption         =   "科目在后"
         Height          =   180
         Left            =   1665
         TabIndex        =   10
         Top             =   360
         Value           =   -1  'True
         Width           =   1095
      End
      Begin VB.OptionButton optFront 
         Caption         =   "科目在前"
         Height          =   180
         Left            =   405
         TabIndex        =   9
         Top             =   360
         Width           =   1100
      End
   End
   Begin VB.Frame frmVoucherNumber 
      Caption         =   "编号方式"
      ForeColor       =   &H8000000D&
      Height          =   735
      Left            =   120
      TabIndex        =   5
      Top             =   960
      Width           =   2895
      Begin VB.OptionButton optManual 
         Caption         =   "手工编号"
         Height          =   255
         Left            =   1665
         TabIndex        =   7
         Top             =   315
         Width           =   1095
      End
      Begin VB.OptionButton optAutomatic 
         Caption         =   "自动编号"
         Height          =   225
         Left            =   405
         TabIndex        =   6
         Top             =   360
         Value           =   -1  'True
         Width           =   1185
      End
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   345
      Left            =   3240
      TabIndex        =   1
      Top             =   1125
      Width           =   1065
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   345
      Left            =   3240
      TabIndex        =   0
      Top             =   495
      Width           =   1065
   End
   Begin VB.Frame fraVoucher 
      Caption         =   "打印方式"
      ForeColor       =   &H8000000D&
      Height          =   795
      Left            =   120
      TabIndex        =   2
      Top             =   2790
      Width           =   2940
      Begin VB.OptionButton optReal 
         Caption         =   "实打"
         Height          =   225
         Left            =   1680
         TabIndex        =   4
         Top             =   360
         Width           =   1095
      End
      Begin VB.OptionButton optVirtual 
         Caption         =   "套打"
         Height          =   225
         Left            =   360
         TabIndex        =   3
         Top             =   360
         Value           =   -1  'True
         Width           =   1095
      End
   End
   Begin VB.CheckBox chkSeparate 
      Caption         =   "是否用""-""号分隔科目代码"
      Height          =   375
      Left            =   4365
      TabIndex        =   11
      Top             =   225
      Visible         =   0   'False
      Width           =   2865
   End
End
Attribute VB_Name = "frmIN_VoucherSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim IsDisplaySubjectName As Boolean

Private Sub cmdCancel_Click()
    Unload Me
End Sub


Private Sub cmdOk_Click()
    Dim adoCmd As ADODB.Command
    
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = gloSys.cnnSYS
    adoCmd.CommandType = adCmdText
    adoCmd.CommandText = "Update tSYS_Account set" & _
            " VoucherPrintMode='" & IIf(optReal.Value, "实打", "套打") & _
            "', VoucherNumberMode=" & IIf(optAutomatic.Value, "-1", "0") & _
            ",SubjectOnFront=" & IIf(optFront.Value, "-1", "0") & _
            ",SeparateSubject=" & IIf(chkSeparate.Value = 1, "-1", "0") & _
            " where AccountID='" & glo.sAccountID & "'"
    adoCmd.Execute
    
    If glo.sSeparateSubject = "0" Then
        glo.bSeparateSubject = IIf(chkSeparate.Value = 1, True, False)
    End If
    glo.detailPrintMode = IIf(optReal.Value, "实打", "套打")
    IsDisplaySubjectName = optName.Value
    SaveSetting App.Title, "Settings", "DisplaySubjectName", CStr(IsDisplaySubjectName)
    Unload Me
    
End Sub


Private Sub form_load()
    Dim sSQL As String
    Dim rSt As ADODB.Recordset
    
    If glo.sSeparateSubject <> "0" Then
        chkSeparate.Visible = False
    End If
    IsDisplaySubjectName = GetSetting(App.Title, "Settings", "DisplaySubjectName", True)
    If IsDisplaySubjectName = True Then
        optName.Value = True
        optCode.Value = False
    Else
        optName.Value = False
        optCode.Value = True
    End If
    '读入设置
    sSQL = "select VoucherPrintMode,VoucherNumberMode,SubjectOnFront,separatesubject" & _
            " from tSYS_Account where" & _
            " AccountID='" & glo.sAccountID & "'"
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
        .Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        Select Case .Fields("VoucherPrintMode").Value
            Case "实打"
                optReal.Value = True
            Case "套打"
                optVirtual.Value = True
            Case Else
                Err.Raise 5
        End Select
        
        Select Case .Fields("VoucherNumberMode").Value
            Case True
                optAutomatic.Value = True
            Case Else
                optManual.Value = True
        End Select
        
        Select Case .Fields("SubjectOnFront").Value
            Case True
                optFront.Value = True
            Case Else
                optBack.Value = True
        End Select
        
        If glo.sSeparateSubject = "0" Then
            Select Case .Fields("SeparateSubject").Value
                Case True
                    chkSeparate.Value = 1
                Case Else
                    chkSeparate.Value = 0
            End Select
        End If
        .Close
    End With
    
End Sub