libprint.bas

本系统是给大庆油田做的一个示例程序

Attribute VB_Name = "LibPrint"
Option Explicit
Public Print_Fig As Boolean
Public Print_Director As Integer
Public Print_XLeftPercent As Single, Print_YTopPercent  As Single
Private Print_XLeft As Single, Print_YTop As Single, AfterPrintTileY As Single
Public Print_Zoom As Single, PrintPict_Zoom As Integer
Rem 打印设置
Public Sub PrintSet(read As Boolean, ByRef LeftX As Single, ByRef TopY As Single, ByRef Director As Integer)
  If read Then
        LeftX = GetSetting(App.EXEName, "Print", "LeftX", LeftX)
        TopY = GetSetting(App.EXEName, "Print", "TopY", TopY)
        Director = GetSetting(App.EXEName, "Print", "Director", Director)
  Else
        SaveSetting App.EXEName, "Print", "LeftX", LeftX
        SaveSetting App.EXEName, "Print", "TopY", TopY
        SaveSetting App.EXEName, "Print", "Director", Director
  End If
End Sub
Rem 推荐打印方式
Public Sub PrintStyle(dirct As Integer)
  Dim ReturnVal As Integer
   If Print_Director = dirct Then Exit Sub
   If dirct = 2 Then
      ReturnVal = MsgBox("提醒：本次打印适合横向打印，是否横向打印？", vbYesNo, "推荐打印方式")
      If ReturnVal = vbYes Then Print_Director = 2
   ElseIf dirct = 1 Then
      ReturnVal = MsgBox("提醒：本次打印适合纵向打印，是否纵向打印？", vbYesNo, "推荐打印方式")
      If ReturnVal = vbYes Then Print_Director = 1
   End If
   If ReturnVal = vbYes Then PrintSet False, Print_XLeftPercent, Print_YTopPercent, Print_Director
End Sub
Rem 打印标题
Public Sub Print_TitleBox(MyTitle As String)
Dim X As Single
  Printer.Font.Size = 14
  X = Printer.ScaleWidth - Printer.TextWidth(MyTitle)
  Printer.CurrentX = X / 2
  Printer.CurrentY = Print_YTop
  Printer.Print MyTitle
  AfterPrintTileY = Printer.CurrentY + Printer.TextHeight("A") * 0.2
  Printer.DrawWidth = 2
  Printer.Line (Print_XLeft, AfterPrintTileY)-(Printer.ScaleWidth - Print_XLeft, Printer.ScaleHeight - Print_YTop), , B
  Printer.DrawWidth = 1
End Sub
Public Sub SetY_Print()
  Printer.CurrentY = AfterPrintTileY
End Sub
Rem 打印脚注
Public Sub Print_FooterDate()
Dim X As Single, PrintData As String
  PrintData = Format(Now, "燕山大学   " & "yy年mm月dd日")
  Printer.Font.Size = 10
  X = Printer.ScaleWidth - Printer.TextWidth(PrintData) - Printer.ScaleWidth * Print_XLeftPercent - Printer.TextWidth(Space(4))
  Printer.CurrentX = X
  Printer.CurrentY = Printer.ScaleHeight - Print_YTop + Printer.TextWidth("A") * 0.1
  Printer.Print PrintData
End Sub
Rem 初始化打印机
Public Sub InitPrinter()
  Print_Director = Print_Director
  Print_XLeftPercent = Print_XLeftPercent
  Print_YTopPercent = Print_YTopPercent
  Printer.Orientation = Print_Director
  Print_XLeft = Print_XLeftPercent * Printer.ScaleWidth
  Print_YTop = Print_YTopPercent * Printer.ScaleHeight
  AfterPrintTileY = Print_YTop
  Printer.DrawWidth = 1
  Printer.FontName = "宋体"
  Print_Zoom = 1
End Sub
Rem 打印区域的放缩
Public Sub PrintZoomPict(obj As Object)
    If (obj.Width / obj.Height) >= ((Printer.ScaleWidth - Print_XLeft * 2) / (Printer.ScaleHeight - Print_YTop * 2)) Then
      Print_Zoom = (Printer.ScaleWidth - Print_XLeft * 2) / obj.Width
    Else
      Print_Zoom = (Printer.ScaleHeight - Print_YTop * 2) / obj.Height
    End If
End Sub
Rem 在中心打印
Public Sub CenterPrint(obj As Object)
Dim Tmp As Single
    If (obj.Width / obj.Height) >= ((Printer.ScaleWidth - Print_XLeft * 2) / (Printer.ScaleHeight - Print_YTop * 2)) Then
      Tmp = AfterPrintTileY + (Printer.ScaleHeight - AfterPrintTileY - Print_YTop - Print_Zoom * obj.Height) / 2
      If Tmp > 0 Then AfterPrintTileY = Tmp
    Else
      Tmp = Print_XLeft + (Printer.ScaleWidth - Print_XLeft * 2 - Print_Zoom * obj.Width) / 2
      If Tmp > 0 Then Print_XLeft = Tmp
    End If
End Sub
Rem 打印2级容器内的控件（标签、单选筐）
Public Sub CtlSpecialPrint(Frm As Form, obj As Object, str As String)
 Dim i As Integer, OffsetZoom As Single, OffsetPrintX As Single
    OffsetZoom = Print_Zoom
    For i = 0 To Frm.Controls.count - 1
        If TypeOf Frm.Controls(i) Is Label Then
           If Frm.Controls(i).Tag = str Then
              Printer.Font.Bold = Frm.Controls(i).Font.Bold
              If Frm.Controls(i).Font.Size > 12 Then
                    Printer.Font.Size = 12
              Else
                    Printer.Font.Size = Frm.Controls(i).Font.Size
              End If
              Printer.Font.Italic = Frm.Controls(i).Font.Italic
              Printer.CurrentX = (Frm.Controls(i).Left + Frm.Controls(i).Container.Left) * OffsetZoom + Print_XLeft
              Printer.CurrentY = (Frm.Controls(i).Top + Frm.Controls(i).Container.Top) * OffsetZoom + AfterPrintTileY
              Printer.Print Frm.Controls(i).Caption
           End If
        End If
        If TypeOf Frm.Controls(i) Is OptionButton Then
           If Frm.Controls(i).Tag = str Then
              Printer.CurrentX = (Frm.Controls(i).Left + Frm.Controls(i).Container.Left) * OffsetZoom + Print_XLeft
              Printer.CurrentY = (Frm.Controls(i).Top + Frm.Controls(i).Container.Top) * OffsetZoom + AfterPrintTileY
              Printer.Font.Bold = Frm.Controls(i).Font.Bold
              If Frm.Controls(i).Value Then
               Printer.Print "⊙ " & Frm.Controls(i).Caption
              Else
               Printer.Print "○ " & Frm.Controls(i).Caption
              End If
              Printer.Font.Bold = False
           End If
        End If
   Next i
End Sub
Rem 打印容器内的控件（文本框、标签、单选筐、图片、划线等）
Public Sub CtlPrint(Frm As Form, obj As Object, str As String)
Dim i As Integer, OffsetZoom As Single, OffsetPrintX As Single
Dim X1 As Single, X2 As Single, Y1 As Single, Y2 As Single
    OffsetZoom = Print_Zoom
    For i = 0 To Frm.Controls.count - 1
        If TypeOf Frm.Controls(i) Is Label Then
           If Frm.Controls(i).Tag = str Then
             If Frm.Controls(i).Visible Then
              Printer.Font.Bold = Frm.Controls(i).Font.Bold
              If Frm.Controls(i).Font.Size > 12 Then
                    Printer.Font.Size = 12
              Else
                    Printer.Font.Size = Frm.Controls(i).Font.Size
              End If
              Printer.Font.Italic = Frm.Controls(i).Font.Italic
              Printer.CurrentX = Frm.Controls(i).Left * OffsetZoom + Print_XLeft
              Printer.CurrentY = Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY
              Printer.Print Frm.Controls(i).Caption
            End If
           End If
        End If
        If TypeOf Frm.Controls(i) Is TextBox Then
           If Frm.Controls(i).Tag = str Then
               Printer.Font.Bold = Frm.Controls(i).Font.Bold
              If Frm.Controls(i).Font.Size > 12 Then
                    Printer.Font.Size = 12
              Else
                    Printer.Font.Size = Frm.Controls(i).Font.Size
              End If
              If Frm.Controls(i).Alignment = 2 Then
                OffsetPrintX = (Frm.Controls(i).Width - Printer.TextWidth(Frm.Controls(i).Text)) / 2
              Else
                OffsetPrintX = 0
              End If
              Printer.Font.Italic = Frm.Controls(i).Font.Italic
              Printer.CurrentX = (Frm.Controls(i).Left + OffsetPrintX) * OffsetZoom + Print_XLeft
              Printer.CurrentY = Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY
              Printer.Print Frm.Controls(i).Text
           End If
        End If
        If TypeOf Frm.Controls(i) Is Line Then
           If Frm.Controls(i).Tag = str Then
              Printer.DrawWidth = 2
              Printer.Line (Frm.Controls(i).X1 * OffsetZoom + Print_XLeft, Frm.Controls(i).Y1 * OffsetZoom + AfterPrintTileY)- _
                           (Frm.Controls(i).X2 * OffsetZoom + Print_XLeft, Frm.Controls(i).Y2 * OffsetZoom + AfterPrintTileY), Frm.Controls(i).BorderColor
              Printer.DrawWidth = 1
           End If
        End If
        If TypeOf Frm.Controls(i) Is OptionButton Then
           If Frm.Controls(i).Tag = str Then
               Printer.CurrentX = (Frm.Controls(i).Left + OffsetPrintX) * OffsetZoom + Print_XLeft
               Printer.CurrentY = Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY
               Printer.Print Frm.Controls(i).Caption
           End If
        End If
        If TypeOf Frm.Controls(i) Is Picture Then
           If LCase(Left(Frm.Controls(i).Tag, Len(str) + 1)) = LCase(str & "p") Then
               Printer.PaintPicture LoadPicture(App.Path & "\Pic\" & Frm.Controls(i).Tag), _
                    Frm.Controls(i).Left * OffsetZoom + Print_XLeft, Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY, _
                    Frm.Controls(i).Width * OffsetZoom, Frm.Controls(i).Height * OffsetZoom
           End If
        End If
        If (TypeOf Frm.Controls(i) Is SSPanel) Then
           If Frm.Controls(i).Tag = str Then
              Printer.Line (Frm.Controls(i).Left * OffsetZoom + Print_XLeft, Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY)- _
                           ((Frm.Controls(i).Left + Frm.Controls(i).Width) * OffsetZoom + Print_XLeft, (Frm.Controls(i).Top + Frm.Controls(i).Height) * OffsetZoom + AfterPrintTileY), , B
           End If
        End If
        If (TypeOf Frm.Controls(i) Is Shape) Then
           If Frm.Controls(i).Tag = str Then
              X1 = Frm.Controls(i).Left * OffsetZoom + Print_XLeft
              X2 = (Frm.Controls(i).Left + Frm.Controls(i).Width) * OffsetZoom + Print_XLeft
              Y1 = Frm.Controls(i).Top * OffsetZoom + AfterPrintTileY
              Y2 = (Frm.Controls(i).Top + Frm.Controls(i).Height) * OffsetZoom + AfterPrintTileY
              Printer.Line (X1, Y1)-(X2, Y1)
              Printer.Line (X1, Y1)-(X1, Y2)
              Printer.Line (X2, Y1)-(X2, Y2)
              Printer.Line (X1, Y2)-(X2, Y2)
           End If
        End If
   Next i
End Sub
Rem 打印暂存目录的建立
Public Sub MKSubDir(SubFolder As String)
    On Error Resume Next
    MkDir App.Path & "\" & Trim(SubFolder)
End Sub