basprint.bas

中专学校的学生操行分管理系统,包含了网络查询的功能

Attribute VB_Name = "modQueryPrint"
'打印数据网格控件   黄敬东
'查询结果集的打印
Option Explicit

'自定义结构，用于存储打印时所必须的一些信息
Public Type PrintInfo
    Font As New StdFont          '字体
    Text As String      '打印的文本
    CurX As Integer     '开始打印点的X轴
    curY As Integer     '开始打印点的Y轴
    Height As Integer   '打印框的高度
    Width As Integer    '打印框的宽度
    percent As Integer  '打印的缩放比例
    style As String     '表示从表中取出的字符串的类型
    Align   As PrintAlign  '表示打印时的对齐方式，1---居左，2---居中，3---居右
    FieldType As Integer '数据类型
End Type

Public Type LabelInfo
    band As String              '所属区域，“head”“foot”
    curY As Integer
    Font As New StdFont         '字体
    ForeColor As Long           '颜色
    LineAlign   As PrintAlign   '表示在行中的位置
    LineNum As Integer          '行号
    Name As String              '名称
    Height As Integer           '高度
    Text As String              '文本
    Width As Integer            '字体串的宽度
End Type

Public intGridRowHeight As Integer      'DATAGRID行高
Public itemInfo() As PrintInfo          '上层列标头结构数组
Public liPrint() As LabelInfo

Public iCount As Integer           'liPrint数组的长度

Dim row As Integer, num As Integer, i As Integer
Dim strText As String
Dim intRowNum As Integer

'******************************************
'   打印表头表尾信息
'******************************************
Public Sub PrintHeader(obj As Object, myInfo As PrintInfo)
'   保存原字体，并按缩放比例设置字体大小
    CopyFont myInfo.Font, obj.Font
    obj.Font.Size = obj.Font.Size * myInfo.percent / 100
'   Style为L时，不打印边框，在一行打印
    If Mid$(myInfo.style, 1, 1) = "L" Then
        strText = myInfo.Text
        obj.CurrentX = myInfo.CurX
        obj.CurrentY = myInfo.curY
        obj.Print strText
    Else
'       Style为E时，按Height、Width打印边框，并计算当前需打印的字符串的要折成几行，每行打印几个字符
        obj.Line (myInfo.CurX, myInfo.curY)-(myInfo.CurX + myInfo.Width, myInfo.curY + myInfo.Height), , B
        
        If myInfo.Width > 0 Then
            row = Round(obj.TextWidth(myInfo.Text) / myInfo.Width + 0.5)    '需打印的行
            num = Round(Len(myInfo.Text) / row)                             '每行打印的字符
            intRowNum = IIf(row >= 2, 2, row)
            For i = 0 To intRowNum - 1
    '           得到当前行应打印的字符串
                strText = Mid$(myInfo.Text, num * i + 1, num)
                obj.CurrentX = myInfo.CurX + (myInfo.Width - obj.TextWidth(strText)) / 2
                obj.CurrentY = myInfo.curY + (myInfo.Height / intRowNum) * i + (myInfo.Height / intRowNum - obj.TextHeight(myInfo.Text)) / 2
                obj.Print strText
            Next i
        End If
    End If
End Sub

'******************************************
'   打印记录信息
'******************************************
Public Sub PrintRecord(obj As Object, myInfo As PrintInfo)
'   保存原字体，并按缩放比例设置字体大小
    CopyFont myInfo.Font, obj.Font
    obj.Font.Size = obj.Font.Size * myInfo.percent / 100
    
'   打印边框,按Height、Width打印边框，当需打印的字符串过长时按Width的值截取
    If myInfo.Width > 0 Then
        obj.Line (myInfo.CurX, myInfo.curY)-(myInfo.CurX + myInfo.Width, myInfo.curY + myInfo.Height), , B
        Do While (obj.TextWidth(myInfo.Text) >= (myInfo.Width - 1) And myInfo.Text <> "")
            myInfo.Text = Mid$(myInfo.Text, 1, Len(myInfo.Text) - 1)
        Loop
        '   根据对齐方式计算打印内容的当前位置
        Select Case myInfo.Align
            Case 1
                obj.CurrentX = myInfo.CurX + 2
            Case 2
                obj.CurrentX = myInfo.CurX + (myInfo.Width - obj.TextWidth(myInfo.Text)) / 2
            Case 3
                obj.CurrentX = myInfo.CurX + (myInfo.Width - obj.TextWidth(myInfo.Text)) - 1
        End Select
        obj.CurrentY = myInfo.curY + (myInfo.Height - obj.TextHeight(myInfo.Text)) / 2
        obj.Print myInfo.Text
    End If
End Sub

'******************************************
'   判断两条线的包含关系
'******************************************
Public Function LineContain(Left1 As Integer, Width1 As Integer, ByVal Left2 As Integer, ByVal Right2 As Integer) As Boolean
'共有六种情况
    Dim Right1 As Integer
    Right1 = Left1 + Width1
'1、第一条线在第二条线的左边
    If Left1 < Left2 And Right1 <= Left2 Then
        LineContain = False
        Exit Function
    End If
'2、第一条线起点在第二条线的左边，第一条线末点在第二条线内
    If Left1 < Left2 And Right1 > Left2 And Right1 <= Right2 Then
        Left1 = Left2
        Width1 = Right1 - Left1
        LineContain = True
        Exit Function
    End If
'3、第一条线起点在第二条线的左边，第一条线末点在第二条线右边
    If Left1 < Left2 And Right1 > Left2 And Right1 > Right2 Then
        Left1 = Left2: Right1 = Right2
        Width1 = Right1 - Left1
        LineContain = True
        Exit Function
    End If
        
'4、第一条线在第二条线内
    If Left1 >= Left2 And Left1 < Right2 And Right1 <= Right2 Then
        Width1 = Right1 - Left1
        LineContain = True
        Exit Function
    End If
        
'5、第一条线起点在第二条线内，第一条线末点在第二条线右边
    If Left1 >= Left2 And Left1 < Right2 And Right1 > Right2 Then
        Right1 = Right2
        Width1 = Right1 - Left1
        LineContain = True
        Exit Function
    End If
        
'6、第一条线在第二条线的右边
    If Left1 >= Right2 Then LineContain = False
End Function

Public Sub SetliPrintInfo(liArr() As LabelInfo, ByVal Index As Integer, ByVal aBand As String, _
    ByVal acurY As Integer, ByVal aHeight As Integer, _
    ByVal aAlign As PrintAlign, ByVal aNum As Integer, ByVal aName As String, _
    ByVal aText As String, aFont As StdFont, Optional aColor As Long = vbBlack)
        With liArr(Index)
            .band = aBand
            .curY = acurY
            .Font.Name = aFont.Name
            .Font.Size = aFont.Size
            .Font.Bold = aFont.Bold
            .Font.Italic = aFont.Italic
            .Font.Strikethrough = aFont.Strikethrough
            .Font.Underline = aFont.Underline
            .ForeColor = aColor
            .Height = aHeight
            .LineAlign = aAlign
            .LineNum = aNum
            .Name = aName
            .Text = aText
'            CopyFont .Font, Printer.Font
'            .Width = Printer.TextWidth(aText)
        End With
End Sub