frmsalarybill.frm

金算盘软件代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Begin VB.Form frmSalaryBill 
   Caption         =   "工资条"
   ClientHeight    =   4965
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8400
   HelpContextID   =   60127
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4965
   ScaleWidth      =   8400
   StartUpPosition =   3  '窗口缺省
   Begin ComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   8400
      _ExtentX        =   14817
      _ExtentY        =   741
      AllowCustomize  =   0   'False
      Appearance      =   1
      _Version        =   327682
      BorderStyle     =   1
      Begin VB.CommandButton cmdPrint 
         Height          =   320
         Index           =   1
         Left            =   1350
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   30
         UseMaskColor    =   -1  'True
         Width           =   1215
      End
      Begin VB.CommandButton cmdPrint 
         Caption         =   "工资条设置"
         Height          =   320
         Index           =   0
         Left            =   60
         TabIndex        =   3
         Top             =   30
         UseMaskColor    =   -1  'True
         Width           =   1215
      End
   End
   Begin MSFlexGridLib.MSFlexGrid msgGrid1 
      Height          =   4365
      Left            =   90
      TabIndex        =   1
      Top             =   480
      Visible         =   0   'False
      Width           =   8175
      _ExtentX        =   14420
      _ExtentY        =   7699
      _Version        =   393216
      HighLight       =   0
      Appearance      =   0
   End
   Begin MSFlexGridLib.MSFlexGrid msgGrid 
      Bindings        =   "frmSalaryBill.frx":0000
      Height          =   4425
      Left            =   90
      TabIndex        =   0
      Top             =   450
      Width           =   8295
      _ExtentX        =   14631
      _ExtentY        =   7805
      _Version        =   393216
      Cols            =   8
      FixedCols       =   0
      FocusRect       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSRDC.MSRDC datPrint 
      Height          =   330
      Left            =   60
      Top             =   5010
      Visible         =   0   'False
      Width           =   1935
      _ExtentX        =   3413
      _ExtentY        =   582
      _Version        =   393216
      Options         =   0
      CursorDriver    =   0
      BOFAction       =   0
      EOFAction       =   0
      RecordsetType   =   1
      LockType        =   3
      QueryType       =   0
      Prompt          =   3
      Appearance      =   1
      QueryTimeout    =   30
      RowsetSize      =   100
      LoginTimeout    =   15
      KeysetSize      =   0
      MaxRows         =   0
      ErrorThreshold  =   -1
      BatchSize       =   15
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Enabled         =   -1  'True
      ReadOnly        =   0   'False
      Appearance      =   -1  'True
      DataSourceName  =   ""
      RecordSource    =   ""
      UserName        =   ""
      Password        =   ""
      Connect         =   ""
      LogMessages     =   ""
      Caption         =   "MSRDC1"
      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
End
Attribute VB_Name = "frmSalaryBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'工资条
'功能：查询、打印工资条
'输入接口：PrintClass
'
'msgGrid：显示用Grid（横向打印时用）
'msgGrid1：隐藏Grid （纵向打印时用）
'
'作者：   唐吉禹
'1998-7-20
Option Explicit
Private WithEvents mclsMainControl As MainControl   '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mlngSalarylistID As Long       '工资目录表ID
Private mintSalaryViewID As Integer    '工资视图ID
Private mstrSelect As String           '工资发放项目Sql
Private mrecRecordset As rdoResultset     '工资发放项目记录集
Private mblnWriteGrid As Boolean       '写Grid
Private mblnIsbyRow As Boolean         '横向否
Private mlngWidthMax As Long           '最大列宽
Private mblnIsPrint As Boolean         '打印否
Private mblnByRow As Boolean           '横向
Private mblnFormISRise As Boolean
Private mclsSalarySet As clsSalaryRptSet  '工资报表设置类
Private mstrBillSQL As String             '工资条记录SQL

Public Sub InitSalaryBill(ByVal lngReportID As Long, ByVal ViewId As Long, ByVal lngSalaryID As Long)
    Dim frmSalaryset As New frmSalaryBillWizard
    Dim blnIsOK As Boolean
    Set mclsSalarySet = New clsSalaryRptSet
    mlngSalarylistID = lngSalaryID
    blnIsOK = frmSalaryset.InitSalaryBill(mclsSalarySet, lngSalaryID)
    If blnIsOK = True Then
        Load Me
        getSalarybillRec        '生成新记录集
        RefreshGrid
        Me.Show vbModal
    End If
End Sub
'生成新记录集
Private Sub getSalarybillRec()
    Dim recZ As rdoResultset
    
    mstrBillSQL = mclsSalarySet.SalaryBillSQL
    If Trim(mstrBillSQL) <> "" Then
        Set recZ = gclsBase.BaseDB.OpenResultset(mstrBillSQL, rdOpenStatic)
        Set datPrint.Resultset = recZ
        recZ.Close
        Set recZ = Nothing
    End If
    InitCmdPrint
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    Set cmdPrint(0).Picture = Utility.GetFormResPicture(1003, 0)
    Set cmdPrint(1).Picture = Utility.GetFormResPicture(1012, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    Me.Height = 5325
    Me.width = 8490
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    msgGrid.Height = 4405
    msgGrid1.Height = 4405
    mblnWriteGrid = True
    mblnIsbyRow = True
    mlngWidthMax = 0
    msgGrid.Row = 1
    msgGrid.col = 0
    msgGrid.ColSel = msgGrid.Cols - 1
    mblnWriteGrid = False
    msgGrid.Row = msgGrid.Rows - 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1003)
    Utility.RemoveFormResPicture (1012)
    Utility.RemoveFormResPicture (139)
    gclsSys.MainControls.Remove Me                   '清除主控对象
    Set mclsMainControl = Nothing
    Set mclsSalarySet = Nothing
    Set frmSalaryBill = Nothing
End Sub
'横向刷新Grid（显示用Grid)
Private Sub RefreshGrid()
    Dim strSql As String
    Dim lngCol As Integer
    Dim i As Long
    Dim j As Long
    Dim lngWidth As Long
    Dim dblTmp As Double
    
    On Error Resume Next
    msgGrid.Redraw = False
    '设置列宽
    With msgGrid
        For j = 0 To .Cols - 1
            lngWidth = 0
            For i = 0 To .Rows - 1
                lngWidth = Utility.GetDisplayWidth(Trim(.TextMatrix(i, j)), StrLen(.TextMatrix(i, j)) + 2)
                If .ColWidth(j) < lngWidth Then
                    .ColWidth(j) = lngWidth
                End If
            Next
        Next
    End With
    '设置对齐方式
    With msgGrid
        .Row = 0
        '固定行中间对齐
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next
        InitCellAlignment msgGrid
        If .Rows > 1 Then
            .Row = 1
        End If
    End With
    msgGrid.Refresh
    msgGrid.Redraw = True
End Sub

'修改为纵向Grid（隐藏Grid）
Private Sub ChangeGrid()
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim lngCol As Integer
    Dim fidField As rdoColumn
    Dim i As Long
    Dim j As Long
    Dim lngWidth As Long
    
    i = 0
    '取最宽大列
    With msgGrid
        Do While i < .Cols
            If .ColWidth(i) > mlngWidthMax Then
                mlngWidthMax = .ColWidth(i)
            End If
            i = i + 1
        Loop
    End With
    mlngWidthMax = mlngWidthMax + 200
    mblnWriteGrid = True
    msgGrid1.Clear
    msgGrid1.Cols = 2
    msgGrid1.FixedCols = 1
    msgGrid1.FixedRows = 0
    msgGrid1.col = 0
    msgGrid1.Row = 0
    msgGrid1.Rows = 1
    msgGrid1.Cols = 1
    Set recRecordset = gclsBase.BaseDB.OpenResultset(mstrBillSQL, rdOpenStatic)
    With recRecordset
        For Each fidField In recRecordset.rdoColumns
            If msgGrid1.Row = 0 And msgGrid1.TextMatrix(0, 0) = "" Then
            Else
                msgGrid1.Rows = msgGrid1.Rows + 1
            End If
            '取字段名称作为第一列
            msgGrid1.col = 0
            msgGrid1.Row = msgGrid1.Rows - 1
            msgGrid1.TextMatrix(msgGrid1.Row, msgGrid1.col) = fidField.Name
            .MoveFirst
            Do While Not .EOF
                '列+1
                If msgGrid1.col = msgGrid1.Cols - 1 Then
                    msgGrid1.Cols = msgGrid1.Cols + 1
                    msgGrid1.col = msgGrid1.Cols - 1
                Else
                    msgGrid1.col = msgGrid1.col + 1
                End If
                '取值作为当前列
                msgGrid1.TextMatrix(msgGrid1.Row, msgGrid1.col) = IIf(IsNull(fidField.Value), "", fidField.Value)
                .MoveNext
            Loop
        Next fidField
        msgGrid1.FixedRows = 1
    End With
    '设置列宽
    With msgGrid1
        For j = 1 To .Cols - 1
            .ColWidth(j) = mlngWidthMax
        Next
    End With
    '设置对齐
    With msgGrid1
        .col = 0
        '固定列左对齐
        For i = 1 To .Rows - 1
            .Row = i
            .CellAlignment = 1
        Next i
        InitCellAlignment msgGrid1
    End With
    recRecordset.Close
    Set recRecordset = Nothing
    mblnWriteGrid = False
End Sub
'打印
Public Sub PrintSalaryGrid()
    Dim clsPrint As PrintClass
    mblnByRow = True
    If frmSalaryBillModal.BillModalIsShow(mblnByRow) Then
        Set clsPrint = New PrintClass
        If mblnByRow Then
            Call RefreshGrid
            msgGrid.FixedCols = 1
            clsPrint.PrintSalaryTable gclsBase.BaseDB, msgGrid, 1, Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
            msgGrid.FixedCols = 0
            msgGrid.Refresh
        Else
            Call ChangeGrid
            clsPrint.PrintSalaryTable gclsBase.BaseDB, msgGrid1, 2, Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        End If
    End If
End Sub
'打印否
Public Property Let ShouldPrint(ByVal IsPrint As Boolean)
    mblnIsPrint = IsPrint
End Property
'是否横向打印
Public Property Let ByRowPrint(ByVal ByRow As Boolean)
    mblnByRow = ByRow
End Property

Private Sub Form_Resize()
    On Error Resume Next
    With msgGrid
        If Me.Height < 2500 Then
            Me.Height = 2500
        End If
        If Me.width < 4500 Then
            Me.width = 4500
        End If
        .top = Toolbar1.top + Toolbar1.Height + 60
        .Left = 30
        .Height = Me.Height - Toolbar1.top - Toolbar1.Height - 500
        .width = Me.width - 180
    End With
End Sub
Private Sub CmdPrint_Click(Index As Integer)
    With msgGrid
        Select Case Index
        Case 0  '工资条设置
            Dim frmSalaryset As New frmSalaryBillWizard
            Dim blnIsOK As Boolean
            blnIsOK = frmSalaryset.InitSalaryBill(mclsSalarySet, mlngSalarylistID, True)
            If blnIsOK = True Then
                getSalarybillRec
                RefreshGrid
            End If
        Case 1 '打印
            Call PrintSalaryGrid
        End Select
        '设置按扭
        InitCmdPrint
    End With
End Sub
'设置按扭
Private Sub InitCmdPrint()
    With msgGrid
        .SelectionMode = flexSelectionByRow
        .col = 0
        If .Rows = 1 Then
            .ColSel = .col
            cmdPrint(1).Enabled = False
        Else
            cmdPrint(1).Enabled = True
            .ColSel = .Cols - 1
        End If
    End With
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID Me.HelpContextID
End Sub

'设置数据对齐方式
Private Sub InitCellAlignment(ByRef msgTmpgrid As MSFlexGrid)
    Dim i As Long
    Dim j As Long
    Dim strName As String
    Dim strItem As String
    Dim strSql As String
    Dim recZ As rdoResultset
    
    With msgTmpgrid
        For i = 0 To .Cols - 1
            strName = .TextMatrix(0, i)
            strSql = "SELECT ViewField.lngViewID, ViewField.strViewFieldDesc, ViewField.strFieldType" _
                & " FROM ViewField where ViewField.lngViewID=63 AND  Upper(ViewField.strViewFieldDesc)= '" & UCase(strName) & "'"
            Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recZ.EOF Then
                strItem = UCase(recZ!strFieldType)
            Else
                strItem = UCase("string")
            End If
            recZ.Close
            Set recZ = Nothing
            If strItem = "DOUBLE" Or strItem = "DATE" Then
                .ColAlignment(i) = 7
            Else
                .ColAlignment(i) = 1
            End If
        Next
    End With
End Sub