module1.bas

VB的图书馆管理系统

Attribute VB_Name = "Module1"
Option Explicit

Global Const pIP As String = "amymax"
Global Const pConn As String = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=Documents;Data Source=" & pIP

Dim Dxsgx(40, 1 To 4) As Variant    '*****PrintNum——要打印的字段的个数*****


Public Sub EXEPrint(ByVal PrintSource As String, ByVal PrintString As String)
    '打印施工单
    On Error GoTo cmdPrint_err
    Dim strContent() As String
    Dim strPrint As String                      '为要打印的字符串
    Dim i As Long
    Dim j As Long
    
    Printer.ScaleMode = vbMillimeters      '设置打印精度为毫米
    Printer.Font = "宋体"                  '定义字体
    '初始化打印位置
    Init_Print PrintSource
    
    strContent = Split(PrintString, Chr(255))        '用Chr(255)分隔
    For j = 0 To UBound(strContent, 1) - 1           '打印项数
        If Trim(strContent(j)) <> "" Then            '该项传入了非空字符时才打印
            If Dxsgx(j, 1) = 0 Then
                Printer.CurrentX = (Printer.ScaleWidth - Printer.ScaleLeft - Len(strContent(j)) * Dxsgx(j, 3) * 20 / 56.7) / 2
            Else
                Printer.CurrentX = Dxsgx(j, 1)
            End If
            Printer.CurrentY = Dxsgx(j, 2)
            Printer.FontSize = Dxsgx(j, 3)
            Printer.FontBold = Dxsgx(j, 4)
            '用一个中文全角空格替换两个英文半角空格
            strPrint = Replace(strContent(j), "  ", "　")
            Select Case PrintSource
                Case "FaWenGaoZhi"
                    Select Case j              '*****j——需要换行的字段的序号*****
                        Case 3
                            FormatStr strPrint, 9, 6, Printer.CurrentX, Printer.CurrentY, False            '*****9——每行几个汉字*****
                        Case 4
                            FormatStr strPrint, 8, 6, Printer.CurrentX, Printer.CurrentY, False            '*****6——行距*****
                        Case 5
                            FormatStr strPrint, 12, 6, Printer.CurrentX, Printer.CurrentY, False           '*****Printer.CurrentX——打印的起始位置X*****
                        Case 6
                            FormatStr strPrint, 10, 6, Printer.CurrentX, Printer.CurrentY, False           '*****Printer.CurrentX——打印的起始位置Y*****
                        Case 21
                            FormatStr strPrint, 28, 15, Printer.CurrentX, Printer.CurrentY, True, 7, 16    '*****True——是否需要换页*****
                        Case Else                                                                          '*****7——第一页要打印的行数*****
                            Printer.Print strPrint                                                         '*****16——第二页要打印的行数*****
                    End Select
                Case "QianBao"
                    Select Case j
                        Case 1
                            FormatStr strPrint, 32, 15, Printer.CurrentX, Printer.CurrentY, True, 5, 16
                        Case Else
                            Printer.Print strPrint
                    End Select
                Case "BianHan"
                    Select Case j
                        Case 1
                            FormatStr strPrint, 30, 12, Printer.CurrentX, Printer.CurrentY, True, 18, 22
                        Case Else
                            Printer.Print strPrint
                    End Select
                Case "FaWen"
                    Select Case j
                        Case 3
                            FormatStr strPrint, 30, 10, Printer.CurrentX, Printer.CurrentY, True, 12, 22
                        Case Else
                            Printer.Print strPrint
                    End Select
            End Select
        End If
    Next
    Printer.EndDoc                '发送到打印机
    Exit Sub
cmdPrint_err:
    Select Case Err.Number
        Case 482
            MsgBox "出错，请确定打印连接是否正常！", vbOKOnly + vbExclamation, "提示信息"
        Case Else
            MsgBox "出错：" & Chr(13) & "错误号=" & Err.Number & "；错误描述：" & Err.Description, vbOKOnly + vbInformation, "提示信息"
    End Select
End Sub

'*****初始化打印数组，确定打印位置X、打印位置Y、字号*****
Private Sub Init_Print(ByVal PrtSource As String)
    Select Case PrtSource
        Case "FaWenGaoZhi"
            '发文标题
            Dxsgx(0, 1) = 105
            Dxsgx(0, 2) = 9
            Dxsgx(0, 3) = 20
            Dxsgx(0, 4) = False
            '密级
            Dxsgx(1, 1) = 60
            Dxsgx(1, 2) = 19
            Dxsgx(1, 3) = 13
            Dxsgx(1, 4) = False
            '缓急
            Dxsgx(2, 1) = 138
            Dxsgx(2, 2) = 19
            Dxsgx(2, 3) = 13
            Dxsgx(2, 4) = False
            '签发
            Dxsgx(3, 1) = 28
            Dxsgx(3, 2) = 30
            Dxsgx(3, 3) = 13
            Dxsgx(3, 4) = False
            '复核
            Dxsgx(4, 1) = 78
            Dxsgx(4, 2) = 30
            Dxsgx(4, 3) = 13
            Dxsgx(4, 4) = False
            '核稿
            Dxsgx(5, 1) = 122
            Dxsgx(5, 2) = 30
            Dxsgx(5, 3) = 13
            Dxsgx(5, 4) = False
            '主办单位和拟稿人
            Dxsgx(6, 1) = 138
            Dxsgx(6, 2) = 48
            Dxsgx(6, 3) = 13
            Dxsgx(6, 4) = False
            '相关文件
            Dxsgx(7, 1) = 140
            Dxsgx(7, 2) = 62
            Dxsgx(7, 3) = 13
            Dxsgx(7, 4) = False
            '会签
            Dxsgx(8, 1) = 40
            Dxsgx(8, 2) = 73
            Dxsgx(8, 3) = 13
            Dxsgx(8, 4) = False
            '事由
            Dxsgx(9, 1) = 40
            Dxsgx(9, 2) = 87
            Dxsgx(9, 3) = 13
            Dxsgx(9, 4) = False
            '主送机关
            Dxsgx(10, 1) = 50
            Dxsgx(10, 2) = 101
            Dxsgx(10, 3) = 13
            Dxsgx(10, 4) = False
            '主送附件
            Dxsgx(11, 1) = 140
            Dxsgx(11, 2) = 101
            Dxsgx(11, 3) = 13
            Dxsgx(11, 4) = False
            '抄送机关
            Dxsgx(12, 1) = 50
            Dxsgx(12, 2) = 115
            Dxsgx(12, 3) = 13
            Dxsgx(12, 4) = False
            '抄送附件
            Dxsgx(13, 1) = 140
            Dxsgx(13, 2) = 115
            Dxsgx(13, 3) = 13
            Dxsgx(13, 4) = False
            '主题词
            Dxsgx(14, 1) = 50
            Dxsgx(14, 2) = 129
            Dxsgx(14, 3) = 13
            Dxsgx(14, 4) = False
            '发文字
            Dxsgx(15, 1) = 43
            Dxsgx(15, 2) = 140
            Dxsgx(15, 3) = 13
            Dxsgx(15, 4) = False
            '发文号
            Dxsgx(16, 1) = 81
            Dxsgx(16, 2) = 140
            Dxsgx(16, 3) = 13
            Dxsgx(16, 4) = False
            '打印份数
            Dxsgx(17, 1) = 165
            Dxsgx(17, 2) = 140
            Dxsgx(17, 3) = 13
            Dxsgx(17, 4) = False
            '打字人
            Dxsgx(18, 1) = 40
            Dxsgx(18, 2) = 152
            Dxsgx(18, 3) = 13
            Dxsgx(18, 4) = False
            '校对人
            Dxsgx(19, 1) = 89
            Dxsgx(19, 2) = 152
            Dxsgx(19, 3) = 13
            Dxsgx(19, 4) = False
            '封发日期
            Dxsgx(20, 1) = 137
            Dxsgx(20, 2) = 152
            Dxsgx(20, 3) = 13
            Dxsgx(20, 4) = False
            '内容
            Dxsgx(21, 1) = 25
            Dxsgx(21, 2) = 170
            Dxsgx(21, 3) = 16
            Dxsgx(21, 4) = False
        Case "QianBao"
            '标题
            Dxsgx(0, 1) = 50
            Dxsgx(0, 2) = 180
            Dxsgx(0, 3) = 14
            Dxsgx(0, 4) = False
            '内容
            Dxsgx(1, 1) = 28
            Dxsgx(1, 2) = 196
            Dxsgx(1, 3) = 14
            Dxsgx(1, 4) = False
        Case "BianHan"
            '标题
            Dxsgx(0, 1) = 0
            Dxsgx(0, 2) = 56
            Dxsgx(0, 3) = 16
            Dxsgx(0, 4) = True
            '内容
            Dxsgx(1, 1) = 26
            Dxsgx(1, 2) = 66
            Dxsgx(1, 3) = 14
            Dxsgx(1, 4) = False
        Case "FaWen"
            '文件编号
            Dxsgx(0, 1) = 70
            Dxsgx(0, 2) = 116
            Dxsgx(0, 3) = 14
            Dxsgx(0, 4) = False
            '签发人
            Dxsgx(1, 1) = 142
            Dxsgx(1, 2) = 116
            Dxsgx(1, 3) = 14
            Dxsgx(1, 4) = False
            '标题
            Dxsgx(2, 1) = 0
            Dxsgx(2, 2) = 138
            Dxsgx(2, 3) = 16
            Dxsgx(2, 4) = True
            '内容
            Dxsgx(3, 1) = 26
            Dxsgx(3, 2) = 148
            Dxsgx(3, 3) = 14
            Dxsgx(3, 4) = False
    End Select
End Sub

Private Sub FormatStr(ByVal InputStr As String, _
                      ByVal LineLength As Integer, _
                      ByVal LineHeight As Integer, _
                      BeginX As Integer, _
                      BeginY As Integer, _
                      blnPage As Boolean, _
                      Optional FirstN As Integer = 0, _
                      Optional SecondN As Integer = 0)
    Dim tmpX As Integer
    Dim tmpY As Integer
    Dim i, p As Integer
    Dim iPos As Integer
    Dim tempStr As String
    tmpX = BeginX
    tmpY = BeginY
    tempStr = Left(InputStr, LineLength)
    iPos = InStr(1, tempStr, Chr(13))
    If Len(InputStr) > LineLength Then
        Do While Len(InputStr) > LineLength Or iPos > 0
            If iPos > 0 Then
                If Len(InputStr) > LineLength Then
                    InputStr = Right(tempStr, Len(tempStr) - iPos - 1) & Right(InputStr, Len(InputStr) - LineLength)
                Else
                    InputStr = Right(tempStr, Len(tempStr) - iPos - 1)
                End If
                tempStr = Left(tempStr, iPos - 1)
            Else
                InputStr = Right(InputStr, Len(InputStr) - LineLength)
            End If
            Printer.CurrentX = tmpX
            Printer.CurrentY = tmpY + i * LineHeight
            Printer.Print tempStr
            i = i + 1
            If blnPage And p = 0 And i = FirstN Then            '*****p——第几页*****
                Printer.NewPage                                 '*****6——第一页打印行数*****
                p = 1
                i = 0
                tmpX = tmpX
                tmpY = 30
            End If
            If blnPage And p > 0 And i = SecondN Then           '*****15——后续页打印行数*****
                Printer.NewPage
                p = p + 1
                i = 0
                tmpX = tmpX
                tmpY = 30
            End If
            tempStr = Left(InputStr, LineLength)
            iPos = InStr(1, tempStr, Chr(13))
        Loop
    End If
    Printer.CurrentX = tmpX
    Printer.CurrentY = tmpY + i * LineHeight
    Printer.Print InputStr
End Sub