frmgrantbybank.frm

金算盘软件代码

            ShowMsg hwnd, "文件" & txtFile & _
            "已经被别的程序打开，请先关闭它再继续。", _
            vbInformation, Me.Caption
        Case 68, 71
            If ShowMsg(hwnd, "驱动器" & Left(txtFile, 1) & "未准备好。" _
                , vbInformation + vbRetryCancel, Me.Caption) = vbCancel Then
                MousePointer = vbHourglass
                Unload Me
                Me.Hide
                MousePointer = vbDefault
            Else
                With txtFile
                    .SelStart = 0
                    .SelLength = Len(.Text)
                    .SetFocus
                End With
                tabGrant.Tab = 0
            End If
        Case 75
            tabGrant.Tab = 0
            ShowMsg hwnd, "生成文件失败。请确认您是否有访问" & "网络路径" _
                & txtFile & "的权限", vbInformation, Me.Caption
            With txtFile
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
        Case 76
            tabGrant.Tab = 0
            ShowMsg hwnd, "路径未找到，请重新录入。", _
            vbInformation, Me.Caption
            With txtFile
                .SelStart = 0
                .SelLength = Len(.Text)
                .SetFocus
            End With
    End Select
    Err.Clear
End Sub

'判断文件是否已存在,存在返回true,否则返回false
Private Function FileExists() As Boolean
    On Error GoTo HandleErr
    If FileLen(txtFile) > 0 Then
        FileExists = True
    End If
    Exit Function
HandleErr:
    FileExists = False
    Err.Clear
End Function

'生成文件头/文件尾
'入口：lngFileNum 文件句柄
'      strHeadTail 取值为"head"时生成文件首记录；取值为"tail"时生成文件尾记录
Private Sub CreateFileHeadTail(ByVal lngFileNum As Long, ByVal strHeadTail As String)
    Dim strSql As String
    Dim strTmp As String
    Dim recTmp As rdoResultset
    Dim recTotal As rdoResultset
    Dim dblTmp As Double
    Dim strLeft As String
    Dim strRight As String
    Dim strZ As String
    Dim strA As String
    
    'strSQL = "SELECT strSource,blnIsDot,BankField.lngViewFieldID,strFieldName," _
    & "strDefault,strFieldDesc,BankField.bytFieldSize,BankField.bytFieldDec," _
    & "strFillChar,strFillStyle FROM BankField LEFT JOIN ViewField ON " _
    & "BankField.lngViewFieldID=ViewField.lngViewFieldID" _
    & " WHERE BankField.lngBankID=" & ltxtBank.ID & " AND "
    strSql = "SELECT strSource,blnIsDot,BankField.lngViewFieldID,strFieldName,strDefault," _
    & " strFieldDesc,BankField.bytFieldSize,BankField.bytFieldDec,strFillChar,strFillStyle,strCompartChar" _
    & " FROM BankField,ViewField " _
    & " WHERE BankField.lngViewFieldID=ViewField.lngViewFieldID(+)" _
    & " AND BankField.lngBankID=" & ltxtBank.ID & " AND "
    If strHeadTail = "head" Then
        strSql = strSql & "BankField.strFieldType='0'"
    Else
        strSql = strSql & "BankField.strFieldType='2'"
    End If
    strSql = strSql & " ORDER BY lngBankFieldNO"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTmp
        Do Until .EOF
            Select Case !strSource
                Case "0" '工资项目
                    strTmp = GetFormatStr(!bytFieldSize, !strFillStyle, _
                    !strFillChar, !strFieldDesc, !strFieldDesc)
                Case "1" '求合计
                    'strSQL = "SELECT " _
                    & " SUM(" & !strFieldName & ") as 合计 " _
                    & " FROM (Salary INNER JOIN SalaryList ON Salary.lngSalaryListID = SalaryList.lngSalaryListID) " _
                    & " INNER JOIN Employee ON Salary.lngEmployeeID = Employee.lngEmployeeID " _
                    & " WHERE SalaryList.lngSalaryListID=" & Me.SalaryListID _
                    & " AND SalaryList.lngSalaryListID=Salary.lngSalaryListID" _
                    & " AND Salary.lngEmployeeID=Employee.lngEmployeeID AND " _
                    & "Employee.lngBankID=" & ltxtBank.ID
                    strSql = "SELECT SUM(" & !strFieldName & ") as 合计 " _
                    & " FROM Salary,SalaryList,Employee " _
                    & " WHERE (Salary.lngSalaryListID = SalaryList.lngSalaryListID) " _
                    & " AND Salary.lngEmployeeID = Employee.lngEmployeeID " _
                    & " AND SalaryList.lngSalaryListID=" & Me.SalaryListID _
                    & " AND SalaryList.lngSalaryListID=Salary.lngSalaryListID" _
                    & " AND Salary.lngEmployeeID=Employee.lngEmployeeID AND " _
                    & "Employee.lngBankID=" & ltxtBank.ID
                    Set recTotal = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recTotal.EOF Then
                        dblTmp = recTotal!合计
                        strZ = Trim(CStr(dblTmp))
                        If InStr(strZ, ".") > 0 Then
                            If InStr(strZ, ".") = 1 Then
                                strLeft = "0"   '如为纯小数则整数位为"0"
                            Else
                                strLeft = Left(strZ, InStr(strZ, ".") - 1)  '取得整数位数
                            End If
                            strRight = Right(strZ, Len(strZ) - InStr(strZ, "."))  '取得小数位数
                        Else
                            strLeft = strZ
                            strRight = ""
                        End If
                        If !bytFieldDec > 0 Then  '有显示小数位数
                            'If !blnIsDot Then     '显示小数点
                            If !blnIsDot = 1 Then   '显示小数点
                                strA = Trim(strRight)
                                If strA = "" Then
                                    strA = "." & String(!bytFieldDec, "0")  '现有数据没有小数位则在其后补零
                                Else
                                    If Len(strA) > !bytFieldDec Then   '现有数据没有小数位大于显示小数位则取前面的作为显示小数位
                                        strA = Format("." & strA, "." & String(!bytFieldDec, "0"))
                                    Else   '现有数据没有小数位小于显示小数位则在现有数据小数位后补零
                                        strA = "." & strA & String(!bytFieldDec - Len(strA), "0")
                                    End If
                                End If
                                strTmp = strLeft & strA
                            Else      '不显示小数点
                                strA = Trim(strRight)
                                If strA = "" Then    '现有数据没有小数位则在其后补零
                                    strA = String(!bytFieldDec, "0")
                                Else
                                    If Len(strA) > !bytFieldDec Then  '现有数据没有小数位大于显示小数位则取前面的作为显示小数位
                                        strA = Format("." & strA, "." & String(!bytFieldDec, "0"))
                                        strA = Right(strA, Len(strA) - 1)
                                    Else   '现有数据没有小数位小于显示小数位则在现有数据小数位后补零
                                        strA = strA & String(!bytFieldDec - Len(strA), "0")
                                    End If
                                End If
                                strTmp = strLeft & strA
                            End If
                        Else   '没有显示小数位数
                            'If !blnIsDot Then   '显示小数点
                            If !blnIsDot = 1 Then '显示小数点
                                strTmp = Format(strZ, "#0.")
                            Else          '不显示小数点
                                strTmp = Format(strZ, "#0")
                            End If
                        End If
                        strTmp = GetFormatStr(!bytFieldSize, !strFillStyle, _
                        !strFillChar, strTmp, "求合计")
                        recTotal.Close
                        Set recTotal = Nothing
                    End If
                Case "2" '求人数
                    If mlngTotalPerson = 0 Then
                        mblnIsRefreshSon = True
                        SumEmployeeNO
                    End If
                    strTmp = CStr(mlngTotalPerson)
                    strTmp = GetFormatStr(recTmp!bytFieldSize, recTmp!strFillStyle, _
                            recTmp!strFillChar, strTmp, "求人数")
                Case "3" '常数
                    strTmp = GetFormatStr(!bytFieldSize, !strFillStyle, _
                            !strFillChar, !strDefault, !strFieldDesc)
            End Select
            If Not IsNull(!strCompartChar) Then
                strTmp = !strCompartChar & strTmp
            End If
            .MoveNext
            If .EOF Then
                Print #lngFileNum, strTmp
            Else
                Print #lngFileNum, strTmp;
            End If
        Loop
        .Close
    End With
    Set recTmp = Nothing
End Sub

'将strContent转换为指定格式(入口：bytFieldSize 栏目宽度,strFillStyle 补齐方式,
    'strFillChar 填充字符,strContent 待转换的字符串,strFieldDesc 项目说明 )
'出口：返回转换后的字符串。若栏目宽度小于strContent的实际宽度，将截去多出的字符
Private Function GetFormatStr(ByVal bytFieldSize As Byte, ByVal strFillStyle As String, _
        ByVal strFillChar As String, ByVal strContent As String, ByVal strFieldDesc As String) As String
    Dim lngFillLen As Long
    Dim lngActualLen As Long
    Dim strMsg As String
    Dim strTmp As String
    Dim intStart As Integer
    lngActualLen = ActualLen(strContent)
    If lngActualLen > bytFieldSize Then
        GetFormatStr = strLeft(strContent, bytFieldSize)
        If Not mblnIsTooLong Then
            strTmp = strFieldDesc
            intStart = InStr(strTmp, "(")
            If intStart > 0 Then
                If intStart = 1 Then
                    strTmp = Salary.Change_Text("(", "", strTmp)
                    strTmp = Salary.Change_Text(")", "", strTmp)
                Else
                    strTmp = Left(strTmp, intStart - 1)
                End If
            End If
            strMsg = "'" & strTmp & "'" & "等项目的显示宽度小于实际宽度,可能引起数据不正确," _
                     & Chr(13) & Chr(10) & "为保证数据的正确,请检查各项目的显示宽度."
            ShowMsg Me.hwnd, strMsg, vbInformation, Me.Caption
            mblnIsTooLong = True
        End If
        Exit Function
    End If
    
    If strFillStyle = "0" Then
        '左
        lngFillLen = bytFieldSize - lngActualLen
        GetFormatStr = String(lngFillLen, strFillChar) & strContent
    ElseIf strFillStyle = "1" Then
        '两边
        lngFillLen = bytFieldSize - lngActualLen
        If lngFillLen Mod 2 = 0 Then
            GetFormatStr = String(lngFillLen / 2, strFillChar) & _
            strContent & String(lngFillLen / 2, strFillChar)
        Else
            GetFormatStr = String(Int(lngFillLen / 2) + 1, strFillChar) & _
            strContent & String(Int(lngFillLen / 2), strFillChar)
        End If
    ElseIf strFillStyle = "2" Then
        '右
        lngFillLen = bytFieldSize - lngActualLen
        GetFormatStr = strContent & String(lngFillLen, strFillChar)
    End If
End Function

'计算strContent相当于多少个英文字符的宽度
'入口：strContent 待计算长度的字符串
Private Function ActualLen(ByVal strContent As String) As Long
    Dim lngCnt As Long
   
    ActualLen = 0
    For lngCnt = 1 To Len(strContent)
        If Me.TextWidth(Mid(strContent, lngCnt, 1)) > 1.5 * Me.TextWidth("A") Then
            ActualLen = ActualLen + 2
        Else
            ActualLen = ActualLen + 1
        End If
    Next lngCnt
End Function

'生成文件正文(入口：lngFileNum 文件句柄)
Private Sub CreateFileBody(ByVal lngFileNum As Long)
    Dim strSql As String
    Dim strTmp As String
    Dim strSalaryItem As String
    Dim strSpace As String
    Dim strSource As String
    Dim strTitle As String
    Dim lngCnt As Long
    Dim lngCol As Long
    Dim blnNoTitle As Boolean
    Dim blnIsNum As Boolean
    Dim recTmp As rdoResultset
    Dim recEmployee As rdoResultset
    Dim recViewField As rdoResultset
    Dim recBankField As rdoResultset
    Dim dblTmp As Double
    Dim strLeft As String
    Dim strRight As String
    Dim strZ As String
    Dim strA As String
    
    blnNoTitle = True
    strSalaryItem = ""
    '写项目标题
    'Set recViewField = gclsBase.BaseDB.OpenRecordset("ViewField", dbOpenSnapshot)
    strSql = "SELECT strFieldDesc ,bytFieldSize,strSource,strFillChar,strFillStyle," _
        & " lngViewFieldID,strDefault,strFieldDesc,strCompartChar FROM Bank,BankField " _
        & " WHERE Bank.lngBankID=" & ltxtBank.ID & " AND Bank.lngBankID=BankField.lngBankID " _
        & " AND strFieldType='1' ORDER BY lngBankFieldNO "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTmp
        If Not .EOF Then
            .MoveLast
            lngCol = .RowCount
            .MoveFirst
        End If
        Do Until .EOF
            strTmp = Left(!strFieldDesc, InStr(!strFieldDesc, "(") - 1)
            If Trim(strTmp) <> "" Then
                strTmp = GetFormatStr(!bytFieldSize, !strFillStyle, _
                !strFillChar, strTmp, !strFieldDesc)
                If Not IsNull(!strCompartChar) Then
                    strTmp = !strCompartChar & strTmp
                End If
                strTitle = strTitle & strTmp
                blnNoTitle = False
            Else
                strTmp = String(!bytFieldSize, " ")
                If Not IsNull(!strCompartChar) Then
                    strTmp = !strCompartChar & strTmp
                End If
                strTitle = strTitle & strTmp
            End If
            strSource = Mid(!strFieldDesc, InStr(!strFieldDesc, "(") + 1, _
            Len(!strFieldDesc) - (InStr(!strFieldDesc, "(") - 1) - 2)
            If !lngViewFieldID > 0 Then
                strSql = "SELECT ViewField.lngViewFieldID, ViewField.lngViewID, ViewField.strViewFieldDesc," & _
                         " ViewField.strTableName, ViewField.strFieldName FROM ViewField " & _
                         " WHERE ViewField.lngViewFieldID=" & !lngViewFieldID
                Set recViewField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recViewField.EOF Then
                    strSalaryItem = strSalaryItem & recViewField!strFieldName & ","
                End If
                recViewField.Close
                Set recViewField = Nothing
            ElseIf strSource = "职员姓名" Or strSource = "姓名" Then
                strSalaryItem = strSalaryItem & "Employee.strEmployeeName,"
            ElseIf strSource = "工资帐号" Or strSource = "卡号" Then
                strSalaryItem = strSalaryItem & "Salary.strBankCode,"
            ElseIf strSource = "部门名称" Then
                strSalaryItem = strSalaryItem & "Department.strDepartmentName,"
            ElseIf strSource = "职员类