frmgrantbybank.frm

金算盘软件代码

      Width           =   1485
      _ExtentX        =   2619
      _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 = "frmGrantByBank"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''
'   银行代发向导窗体
'   作者：肖宇
'   时间：1998-11-16
'
''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private mlngSalarylistID As Long                        '工资表ID
Private mlngTotalPerson As Long                         '总人数
Private mblnIsRefreshSon As Boolean                     '是否刷新人数
Private mlngSelectRow As Long                           '列表当前行
Private mblnFirstLoad As Boolean                        '窗体第一次加载
Private mblnSalaryListSelected As Boolean               '工资表已选择
Private mltxtEdit As ListText                           '当前ListText
Private mgrdData As MSFlexGrid                          '当前Grid
Private WithEvents mclsGrid As Grid
Attribute mclsGrid.VB_VarHelpID = -1
Private WithEvents mclsMainControl As MainControl
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsSub320  As SubClass32.SubClass
Attribute mclsSub320.VB_VarHelpID = -1
Private WithEvents mclsSub321  As SubClass32.SubClass
Attribute mclsSub321.VB_VarHelpID = -1
Private WithEvents mclsSub322  As SubClass32.SubClass
Attribute mclsSub322.VB_VarHelpID = -1
Private Const ViewId = 678
Private Const CheckCol = 1
Private Const WindowHeight = 4425
Private Const WindowWidth = 7620
Private mblnIsTooLong As Boolean    '是否已经给出项目超长的提示
Private mblnDateIsChange As Boolean
Private mblnIsSave As Boolean
Private mintGrdDataIndex As Integer


'按选择的建表时间范围更新该时间段的起始日期
Private Sub cboDate_Click()
    Dim dteBegin As Date
    Dim dteEnd As Date
    
    If mblnDateIsChange Then
        If cboDate = "所有" Then
            cldDate(0).Text = ""
            cldDate(1).Text = ""
        ElseIf cboDate = "自定义" Then
            cldDate(0).Text = Format(Date$, "YYYY-MM-DD")
            cldDate(1).Text = Format(Date$, "YYYY-MM-DD")
        Else
            gclsBase.GetBeginAndEndDate cboDate, gclsBase.BaseDate, dteBegin, dteEnd
            cldDate(0).Text = Format(dteBegin, "YYYY-MM-DD")
            cldDate(1).Text = Format(dteEnd, "YYYY-MM-DD")
        End If
        RefreshSalaryList
    End If
End Sub

'时间范围改变时刷新工资表列表
Private Sub cldDate_LostFocus(Index As Integer)
    Dim dteBegin As Date
    Dim dteEnd As Date
    
    If Index = 0 Then
        If cldDate(0).Text <> "" And cldDate(1).Text <> "" Then
            If cldDate(0).Text > cldDate(1).Text Then
                ShowMsg Me.hwnd, "请输入一个小于截止时间的日期。", vbInformation, Me.Caption
                On Error Resume Next
                cldDate(1).Text = Format(cldDate(0).Text, "YYYY-MM-DD")
                cldDate(0).SetFocus
                On Error GoTo 0
                Exit Sub
            End If
        End If
    End If
    If cldDate(0).Text <> "" And cldDate(1).Text = "" Then
        mblnDateIsChange = False
        cboDate.Text = "所有"
    Else
        gclsBase.GetBeginAndEndDate cboDate, gclsBase.BaseDate, dteBegin, dteEnd
        If Format(cldDate(0).Text, "yyyy-mm-dd") <> Format(CStr(dteBegin), "yyyy-mm-dd") Or Format(cldDate(1).Text, "yyyy-mm-dd") <> Format(CStr(dteEnd), "yyyy-mm-dd") Then
            mblnDateIsChange = False
            cboDate.Text = "自定义"
        End If
    End If
    If IsDate(cldDate(Index).Text) Or cldDate(Index).Text = "" Then
        RefreshSalaryList
        cldDate(Index).ClosePanel
    End If
    mblnDateIsChange = True
End Sub

'更改Grid的项目顺序
Private Sub cmdChangList_Click(Index As Integer)
    Dim lngPos As Long
    Dim strTxt As String
    Dim i As Integer
    Dim j As Integer
    For lngPos = 0 To 2
        ltxtEdit(lngPos).Visible = False
        txtEdit(lngPos).Visible = False
    Next lngPos
    Select Case Index Mod 2
        Case 0 '上移
            lngPos = Index / 2
            With grdData(lngPos)
                If .Row > 0 Then
                    For i = 0 To .Cols - 1
                        strTxt = .TextMatrix(.Row, i)
                        .TextMatrix(.Row, i) = .TextMatrix(.Row - 1, i)
                        .TextMatrix(.Row - 1, i) = strTxt
                    Next i
                    .Row = .Row - 1
                End If
            End With
        Case 1 '下移
            lngPos = (Index - 1) / 2
            If grdData(lngPos).Row = 0 Then Exit Sub
            With grdData(lngPos)
                If .Row < .Rows - 1 Then
                    For i = 0 To .Cols - 1
                        strTxt = .TextMatrix(.Row, i)
                        .TextMatrix(.Row, i) = .TextMatrix(.Row + 1, i)
                        .TextMatrix(.Row + 1, i) = strTxt
                    Next i
                    .Row = .Row + 1
                End If
            End With
    End Select
    On Error Resume Next
    grdData(lngPos).SetFocus
    On Error GoTo 0
End Sub
'插入新行
Private Sub InsertRow(ByVal Index As Integer)
    Dim i, j As Integer
    Dim blnIsEndRow As Boolean
    With grdData(Index)
        If IsEmpty(Index, .Row) Then
            .SetFocus
            Exit Sub
        End If
        If .Row = .Rows - 1 Then
            blnIsEndRow = True
        End If
        If Not IsEmpty(Index, .Rows - 1) Then
            .Rows = .Rows + 1
        End If
        If blnIsEndRow Then
            .Row = .Rows - 1
            Exit Sub
        End If
        '向后移
        For i = .Rows - 1 To .Row + 1 Step -1
            For j = 0 To .Cols - 1
                .TextMatrix(i, j) = .TextMatrix(i - 1, j)
            Next j
        Next i
        '清空当前行
        For i = 0 To .Cols - 1
            .TextMatrix(.Row, i) = ""
        Next i
        SetCommandButton Index, Index
    End With
End Sub
'判断是否为空行
Private Function IsEmpty(ByVal Index As Integer, ByVal intRow As Integer) As Boolean
    Dim i As Integer
    With grdData(Index)
        For i = 0 To .Cols - 1
            If .TextMatrix(intRow, i) <> "" Then
                Exit For
            End If
        Next i
        If i = .Cols Then
            IsEmpty = True
        Else
            IsEmpty = False
        End If
    End With
End Function
'向Grid中插入新行或删除当前行
Private Sub cmdEdit_Click(Index As Integer)
    Dim lngPos As Long
    Dim intCol As Integer
    Dim intNo As Integer
    
    Select Case Index Mod 2
        Case 0 '插入
            lngPos = Index / 2
            If txtEdit(lngPos).Visible = True Or ltxtEdit(lngPos).Visible = True Then
                intCol = grdData(lngPos).col
                grdData(lngPos).col = 0
                grdData(lngPos).col = intCol
                txtEdit(lngPos).Visible = False
                ltxtEdit(lngPos).Visible = False
            End If
            InsertRow (lngPos)
            intNo = 0
            intNo = grdData(lngPos).Row - grdData(lngPos).Height \ grdData(lngPos).RowHeight(0) + 4
            If intNo > 0 Then
                grdData(lngPos).TopRow = intNo
            End If
            If grdData(lngPos).Rows > 1 Then
                cmdEdit(Index + 1).Enabled = True
            End If
            SetGridRowHeight lngPos
        Case 1 '删除
            lngPos = (Index + 1) / 2 - 1
            txtEdit(lngPos).Visible = False
            ltxtEdit(lngPos).Visible = False
            DeleteRow grdData(lngPos), grdData(lngPos).Row
            If grdData(lngPos).Rows = 1 Then
                cmdEdit(Index).Enabled = False
            End If
    End Select
    SetCommandButton lngPos, lngPos * 2
    grdData(lngPos).SetFocus
    mblnIsSave = True
End Sub

'删除当前行(入口：grdTmp 当前Grid ,lngCurrRow 待删除的当前行)
Private Sub DeleteRow(grdTmp As MSFlexGrid, ByVal lngCurrRow As Long)
    Dim lngRow As Long
    Dim lngCol As Long
    With grdTmp
        If .Rows = 1 Then Exit Sub
        If .Rows = 2 Then
            .Rows = 1
            Exit Sub
        End If
        For lngRow = lngCurrRow To .Rows - 2
            For lngCol = 1 To .Cols - 1
                .TextMatrix(lngRow, lngCol) = .TextMatrix _
                (lngRow + 1, lngCol)
            Next lngCol
        Next lngRow
        .Rows = .Rows - 1
    End With
    For lngRow = 0 To 2
        ltxtEdit(lngRow).Visible = False
        txtEdit(lngRow).Visible = False
    Next lngRow
End Sub

'显示保存文件对话框
Private Sub cmdFile_Click()
    With cdlFile
         .Flags = cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNCreatePrompt + cdlOFNHideReadOnly
        .DialogTitle = Me.Caption
        .CancelError = True '如果用户按下"取消"键，将不更新文件名文本框
        .InitDir = App.Path
        .Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
        On Error GoTo HandleErr
        .ShowSave
    End With
    txtFile = cdlFile.FileName
    mblnIsSave = True
HandleErr:
End Sub

'按钮数组的click事件处理
Private Sub cmdWizard_Click(Index As Integer)
    Select Case Index
        Case 0 '取消
            Me.Hide
            Unload Me
        Case 1 '上一步
            cmdWizard(2).Enabled = True
            cmdWizard(3).Enabled = False
            If tabGrant.Tab > 0 Then
                tabGrant.Tab = tabGrant.Tab - 1
            Else
                cmdWizard(1).Enabled = False
            End If
        Case 2 '下一步
            cmdWizard(1).Enabled = True
            If tabGrant.Tab < 5 Then
                tabGrant.Tab = tabGrant.Tab + 1
            Else
                cmdWizard(2).Enabled = False
                cmdWizard(3).Enabled = True
                SaveFileFormat
                CreateFile True
            End If
        Case 3 '完成
            MousePointer = vbHourglass