frmsalarymonneyset.frm

金算盘软件代码

      End
      Begin ListRefer.ListText litSalarySource 
         Height          =   315
         Left            =   3030
         TabIndex        =   3
         Top             =   2085
         Width           =   2985
         _ExtentX        =   5265
         _ExtentY        =   556
         Locked          =   -1  'True
         BackColor       =   -2147483643
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin ListRefer.ListText litMonneySet 
         Height          =   315
         Left            =   -71910
         TabIndex        =   5
         Top             =   660
         Width           =   2985
         _ExtentX        =   5265
         _ExtentY        =   556
         Locked          =   -1  'True
         BackColor       =   -2147483643
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label lblMonneySet 
         BackStyle       =   0  'Transparent
         Caption         =   "配款项目(&K)"
         Height          =   195
         Index           =   0
         Left            =   -73110
         TabIndex        =   4
         Top             =   690
         Width           =   1215
      End
      Begin ComctlLib.ImageList ImageList1 
         Left            =   -73110
         Top             =   2730
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   13
         ImageHeight     =   13
         MaskColor       =   12632256
         _Version        =   327682
         BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
            NumListImages   =   3
            BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
               Picture         =   "frmSalaryMonneySet.frx":01E3
               Key             =   "open"
            EndProperty
            BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
               Picture         =   "frmSalaryMonneySet.frx":02DD
               Key             =   "closed"
            EndProperty
            BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
               Picture         =   "frmSalaryMonneySet.frx":03D7
               Key             =   "book"
            EndProperty
         EndProperty
      End
      Begin VB.Label lblMonneySet 
         BackStyle       =   0  'Transparent
         Caption         =   "报表名称(&N)"
         Height          =   195
         Index           =   2
         Left            =   1830
         TabIndex        =   0
         Top             =   1230
         Width           =   1215
      End
      Begin VB.Label lblMonneySet 
         BackStyle       =   0  'Transparent
         Caption         =   "来源工资表(&G)"
         Height          =   195
         Index           =   1
         Left            =   1830
         TabIndex        =   2
         Top             =   2130
         Width           =   1215
      End
      Begin VB.Image imgSalarySet 
         BorderStyle     =   1  'Fixed Single
         Height          =   3525
         Index           =   1
         Left            =   -74880
         Stretch         =   -1  'True
         Top             =   450
         Width           =   1455
      End
      Begin VB.Image imgSalarySet 
         BorderStyle     =   1  'Fixed Single
         Height          =   3555
         Index           =   0
         Left            =   120
         Stretch         =   -1  'True
         Top             =   450
         Width           =   1440
      End
   End
End
Attribute VB_Name = "frmSalaryMonneySet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资分钱清单设置
'
'作者：唐吉禹
'
'功能：设置工资配款表的面额，扣零项目不允许设置小于扣零级别的项目。
'
'1998-7-10
'
Option Explicit
Private WithEvents mclsMainControl As MainControl   '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsFilter As FormCond         '查询条件类
Private mlngViewID As Long             '工资视图ID
Private mlngSalarylistID As Long       '工资表ID
Private mdblDeductLevel As Double      '扣零级别
Private mstrZeroItemName As String     '扣零项目名称
Private mblnDmSalarySet As Boolean     '配款情况表分类(True部门配款情况表,False职员配款情况表)
Private Const mlngSalaryReportID = 1429  '工资配款表ID
Private Const mlngReportViewID = 671     '工资配款条件视图ID

Private Sub cmdOK_Click()
    Dim Strsql As String
    'Dim recSetting As Recordset
    Dim recSetting As rdoResultset
    Dim i As Integer
    Dim strWhere As String
    Dim strReportName As String
    
    '检查配款项目
    If Val(litMonneySet.TextMatrix(litMonneySet.ReferRow, 2)) = 0 Then
        ShowMsg Me.hwnd, "配款项目不能为空。", vbInformation, Me.Caption
        SSTab1.Tab = 1
        Exit Sub
    End If
    '检查报表名称
    If Trim(txtReportName.Text) = "" Then
        ShowMsg Me.hwnd, "报表名称不能为空。", vbInformation, Me.Caption
        SSTab1.Tab = 0
        Exit Sub
    End If
    strReportName = Trim(txtReportName.Text)
    '检查来源工资表
    If Trim(litSalarySource.Text) = "" Then
        ShowMsg Me.hwnd, "来源工资表不能为空。", vbInformation, Me.Caption
        SSTab1.Tab = 0
        Exit Sub
    End If
    '检查配款面额
    For i = 0 To 11 Step 1
        If chkMonneySet(i).Value = True Then
            Exit For
        End If
    Next i
    If i > 11 Then
        ShowMsg Me.hwnd, "至少应有一个配款面额。", vbInformation, Me.Caption
        SSTab1.Tab = 1
        Exit Sub
    End If
    '取得配款类别
    If optSalarySet(0).Value = True Then
        mblnDmSalarySet = True
    Else
        mblnDmSalarySet = False
    End If
    '存回配款项目
    frmSalaryList.MonneyOK = True
    Strsql = "UPDATE Setting SET strSetting=" _
        & litMonneySet.TextMatrix(litMonneySet.ReferRow, 2) & " WHERE lngModuleID=9" _
        & " AND strKey='配款项目ID'"
    gclsBase.BaseDB.Execute Strsql
    '存回零级别
    Strsql = "UPDATE Setting SET strSetting=" _
        & mdblDeductLevel & " WHERE lngModuleID=9" _
        & " AND strKey='扣零级别'"
    gclsBase.BaseDB.Execute Strsql
    '根据面额排序，对应面额选择框存回设置
    'strSql = "SELECT Val(Left(strKey,Len(strKey)-1)) AS Denomination,strSetting" _
        & " FROM Setting WHERE lngModuleID=9 AND Right(strKey,1)='元' ORDER BY " _
        & "(200-Val(Left(strKey,Len(strKey)-1)))"
    'Set recSetting = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenDynaset)
    
    Strsql = "SELECT TO_NUMBER(SUBSTR(strKey,1,Len(strKey)-1)) AS Denomination,strSetting" _
        & " FROM Setting WHERE lngModuleID=9 AND SUBSTR(strKey,LENGTH(strKey),LENGTH(strKey))='元' ORDER BY " _
        & "(200-TO_NUMBER(SUBSTR(strKey,1,LENGTH(strKey)-1)))"
    Set recSetting = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenDynamic, rdConcurRowVer, 64)
    'recSetting.MoveLast
    'recSetting.MoveFirst
    i = 0
    Do While Not recSetting.EOF
        recSetting.Edit
        If chkMonneySet(i).Value = True Then
            recSetting!strSetting = "True"
        Else
            recSetting!strSetting = "False"
        End If
        recSetting.Update
        i = i + 1
        recSetting.MoveNext
    Loop
    recSetting.Close
    Set recSetting = Nothing
    '取得筛选条件
    strWhere = mclsFilter.GetCond
    '工资配款处理
    Salary.MonneyType = mblnDmSalarySet
    Salary.MonneyWhereSQL = strWhere
    Salary.MonneyReportName = strReportName
    Salary.MonneySourceID = mlngSalarylistID
    Call Salary.MonneyToGrid(litMonneySet.TextMatrix(litMonneySet.ReferRow, 2))
    Unload Me
End Sub
Private Sub cmdArr_Click(Index As Integer)
    Select Case Index
        Case 0   '取消
            Unload Me
        Case 1   '上一步
            If SSTab1.Tab > 0 Then
                SSTab1.Tab = SSTab1.Tab - 1
            End If
        Case 2   '下一步
            If SSTab1.Tab < 2 Then
                SSTab1.Tab = SSTab1.Tab + 1
            End If
        Case 3   '完成
            cmdOK_Click
    End Select
End Sub

Private Sub Form_Load()
    'Dim recViewField As Recordset
    Dim recViewField As rdoResultset
    Dim Strsql As String
    Dim strText As String
    Dim i As Integer
    'Dim recSalaryList As Recordset
    'Dim recSetting As Recordset
    'Dim recDepartment As Recordset
    
    Dim recSalaryList As rdoResultset
    Dim recSetting As rdoResultset
    Dim recDepartment As rdoResultset
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.top = (Screen.Height - Me.Height) \ 2
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '初始化查询条件类
    Set mclsFilter = New FormCond
    mclsFilter.InitCondArr mlngSalaryReportID, mlngReportViewID, 2
    mclsFilter.ShowFilter Me, mlngSalaryReportID, 2
    tvwFilter.Nodes(1).Expanded = True
    '初始化报表名称
    txtReportName.Text = "工资配款表"
    '默认为部门配款情况表
    optSalarySet(0).Value = True
    mblnDmSalarySet = True
    
    imgSalarySet(0).Picture = Utility.GetFormResPicture(140, 0)
    imgSalarySet(1).Picture = Utility.GetFormResPicture(140, 0)
    SSTab1.Tab = 0
    ''设置命令按钮是否可用
    InitCmdarrState
    mlngViewID = frmSalaryList.SalaryViewID
    mlngSalarylistID = frmSalaryList.SalaryID
    '初始化配款项目列表
    'strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc  FROM ViewField INNER JOIN SalaryField ON " & _
             " ViewField.lngViewFieldID = SalaryField.lngViewFieldID  Where " & _
             " ViewField.strTableName='Salary' AND ViewField.strFieldType='Double' AND ViewField.lngViewID=" & mlngViewID & _
             " AND ViewField.strFieldName<>'Salary.dblNowZero' AND ViewField.strFieldName" & _
             " <>'Salary.dblNowTax' AND ViewField.strFieldName<>'Salary.dblLastZero' " & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID
    'Set recViewField = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)

    Strsql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc  FROM ViewField , SalaryField  " & _
             " WHERE ViewField.lngViewFieldID = SalaryField.lngViewFieldID  AND " & _
             " ViewField.strTableName='Salary' AND UPPER(ViewField.strFieldType)='NUMBER' AND ViewField.lngViewID=" & mlngViewID & _
             " AND ViewField.strFieldName<>'Salary.dblNowZero' AND ViewField.strFieldName" & _
             " <>'Salary.dblNowTax' AND ViewField.strFieldName<>'Salary.dblLastZero' " & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID
    Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)

    '取出配款项目
    Strsql = "SELECT strSetting FROM Setting WHERE lngModuleID=9 AND strKey='配款项目ID'"
    'Set recSetting = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Set recSetting = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    If Not recViewField.EOF Then
        'recViewField.MoveLast
        'recViewField.MoveFirst