flexprinter.cls

汽修厂管理软件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FlexPrinter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Member0" ,"Footer"
Attribute VB_Ext_KEY = "Member1" ,"Header"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
' MSHFlexGrid Printer class
' Author: Opal Raj Ghimire, [e-mail]
'------------------------------------------
' You are free to use this class in your
' projects.
' This project comes with absolutely NO
' warranty ! Use it at your own risk !!!
'Updated 16th Nov 2000
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long


Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Dim objFlex As Object
Dim lRowsFrom As Long, lRowsTo As Long
Dim FinalX As Long, FinalY As Long
'***********Publics***********
Public bGridPrint As Boolean
Public VSpace As Long, HSpace As Long
Public RoundCorX As Long, RoundCorY As Long
Public GridPenStyle As Long
Public FillColor As Long
Public bDrawBoarder As Boolean
Public BoarderStyle As Long, BoarderColor As Long, BoarderWidth As Long, BoarderDistance As Long
Public PosLeft As Long, PosTop As Long
'**********Const**************
Const DT_LEFT = 0
Const DT_TOP = 0
Const DT_CENTER = 1
Const DT_RIGHT = 2
Const DT_VCENTER = 4
Const DT_BOTTOM = 8
Const DT_WORDBREAK = 16
Const DT_SINGLELINE = 32
Const DT_NOPREFIX = 2048
Const DT_END_ELLIPSIS = 32768
Const DT_MODIFYSTRING = 65536
Const DT_WORD_ELLIPSIS = 262144
'Private mvarHeader As Header
'Private mvarFooter As Footer
'保持属性值的局部变量
Private mvarPages As Variant '局部复制
Private mvarRowsofPage As Integer '局部复制
Private mvarShowHead As Boolean '局部复制
Private mvarShowPageNum As Variant '局部复制
Private mvarShowFoot As Boolean '局部复制
Private mPages As Integer
Private mvarHeader As String
Private mvarFooter As String
Private mvarPaperHeight As Single
Private mvarCurPage As Integer
Public Sub Preview()
End Sub

Public Property Let PaperHeight(ByVal vData As Single)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ShowFoot = 5
    mvarPaperHeight = vData
End Property

Public Property Get TotalPages() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ShowFoot
    TotalPages = mvarPages
End Property

Public Property Let ShowFoot(ByVal vData As Boolean)
Attribute ShowFoot.VB_Description = "是否打印页脚"
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ShowFoot = 5
    mvarShowFoot = vData
End Property


Public Property Get ShowFoot() As Boolean
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ShowFoot
    ShowFoot = mvarShowFoot
End Property

Public Property Let CurPage(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ShowFoot = 5
    mvarCurPage = vData
End Property


Public Property Get CurPage() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ShowFoot
    CurPage = mvarCurPage
End Property



Public Property Let ShowPageNum(ByVal vData As Variant)
Attribute ShowPageNum.VB_Description = "是否打印页码"
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ShowPageNum = 5
    mvarShowPageNum = vData
End Property


Public Property Set ShowPageNum(ByVal vData As Variant)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.ShowPageNum = Form1
    Set mvarShowPageNum = vData
End Property


Public Property Get ShowPageNum() As Variant
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ShowPageNum
    If IsObject(mvarShowPageNum) Then
        Set ShowPageNum = mvarShowPageNum
    Else
        ShowPageNum = mvarShowPageNum
    End If
End Property



Public Property Let ShowHead(ByVal vData As Boolean)
Attribute ShowHead.VB_Description = "是否打印表头"
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ShowHead = 5
    mvarShowHead = vData
End Property


Public Property Get ShowHead() As Boolean
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ShowHead
    ShowHead = mvarShowHead
End Property



Public Property Get RowsofPage() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.RowsofPage
    RowsofPage = mvarRowsofPage
End Property









Public Property Get Footer() As String
    Footer = mvarFooter
End Property


Public Property Let Footer(vData As String)
     mvarFooter = vData
End Property



Public Property Get Header() As String
     Header = mvarHeader
End Property


Public Property Let Header(vData As String)
     mvarHeader = vData
End Property


Public Sub PrintOut(Obj As Object)
Dim lRows As Long, lCols As Long
Dim cellHeight As Long, cellWidth As Long
Dim tmpLeft As Long, rectBox As RECT
Dim lDrawWidth As Long
Dim sCellText As String, cellFont As StdFont
Dim lTextColor, iAlignment As Integer
Dim TmpJustToHold As Long, DT_Code As Long, bWordWrap As Boolean
Dim TmpJustTohold2 As Long
Dim lGridLineColor As Long
Dim lOldPen As Long, lNewPen As Long
Dim lOldBrush As Long, lNewBrush As Long
Dim BorX As Long, BorY As Long, BorDx As Long, BorDy As Long
Dim opal As POINTAPI, TmpDrawWidth As Long, TmpBoarderWidth As Long
Dim TmpBoarderDistance As Long
Dim BackupPosLeft As Long, BackupPosTop As Long
'*********************************************************

If Not ValidObj(Obj) Then Exit Sub
lRowsFrom = (mvarCurPage - 1) * mvarRowsofPage + 1
lRowsTo = lRowsFrom + mvarRowsofPage - 1
If lRowsTo > objFlex.Rows - 1 Then lRowsTo = objFlex.Rows - 1

Set cellFont = New StdFont
Obj.ScaleMode = vbPixels
'Obj.Print
With objFlex
    lDrawWidth = .GridLineWidth
    bWordWrap = .WordWrap
   .Redraw = False
    lGridLineColor = .GridColor
    
End With 'objFlex
BackupPosLeft = PosLeft: BackupPosTop = PosTop
BorX = PosLeft
BorY = PosTop

TmpBoarderWidth = BoarderWidth: TmpDrawWidth = lDrawWidth: TmpBoarderDistance = BoarderDistance
TmpJustTohold2 = 1
If TypeName(Obj) = "Printer" Then
       
    TmpJustToHold = Screen.TwipsPerPixelX / Printer.TwipsPerPixelX
    lDrawWidth = lDrawWidth * TmpJustToHold
    BoarderWidth = BoarderWidth * TmpJustToHold
    TmpJustTohold2 = TmpJustToHold
End If  'TypeName(obj) = "Printer"
'写标题
With Obj
If TypeName(Obj) = "Printer" Then
 
.CurrentX = Obj.Width / 2
.CurrentX = Obj.ScaleX(.CurrentX, vbTwips, vbPixels) - (CSng(Len(Trim(mvarHeader)))) * 150 / 2

.CurrentY = PosTop - 220
.FontSize = 18
.ForeColor = vbBlack

 
 Else
 
.CurrentX = Obj.Width / 2
.CurrentX = Obj.ScaleX(.CurrentX, vbTwips, vbPixels) - (CSng(Len(Trim(mvarHeader)))) * 30 / 2
.CurrentY = PosTop - 35
.FontSize = 18
.ForeColor = vbBlack


End If
End With
Obj.Print mvarHeader

'写第一行
    lRows = 0
    cellHeight = Obj.ScaleY(objFlex.RowHeight(lRows), vbTwips, vbPixels)
     
    tmpLeft = PosLeft
            For lCols = 0 To objFlex.Cols - 1
               With objFlex
                     .Col = lCols: .Row = lRows
                      sCellText = objFlex.Text
                                     cellFont.Name = .CellFontName: cellFont.Size = .CellFontSize
                                     cellFont.Bold = .CellFontBold: cellFont.Underline = .CellFontUnderline
                                     cellFont.Strikethrough = .CellFontStrikeThrough: cellFont.Italic = .CellFontItalic
                     lTextColor = .CellForeColor: TmpJustToHold = .CellAlignment
                    
                    If bWordWrap Then DT_Code = DT_WORDBREAK Or DT_NOPREFIX Or DT_END_ELLIPSIS Or DT_MODIFYSTRING Else DT_Code = DT_SINGLELINE Or DT_NOPREFIX
                            Select Case TmpJustToHold
                                    Case 0
                                    DT_Code = DT_Code Or DT_LEFT Or DT_TOP
                                    Case 1
                                    DT_Code = DT_Code Or DT_VCENTER Or DT_LEFT
                                    Case 2
                                    DT_Code = DT_Code Or DT_LEFT Or DT_BOTTOM
                                    Case 3
                                    DT_Code = DT_Code Or DT_CENTER Or DT_TOP
                                    Case 4
                                    DT_Code = DT_Code Or DT_VCENTER Or DT_CENTER
                                    Case 5
                                    DT_Code = DT_Code Or DT_CENTER Or DT_BOTTOM
                                    Case 6
                                    DT_Code = DT_Code Or DT_RIGHT Or DT_TOP
                                    Case 7
                                    DT_Code = DT_Code Or DT_RIGHT Or DT_VCENTER
                                    Case 8
                                    DT_Code = DT_Code Or DT_BOTTOM Or DT_RIGHT
                                    Case 9
                                            If IsNumeric(sCellText) Or IsDate(sCellText) Then DT_Code = DT_Code Or DT_RIGHT Or DT_VCENTER Else DT_Code = DT_Code Or DT_LEFT Or DT_VCENTER
                                           
                           End Select
                                                
                End With 'objFlex
             
                cellWidth = Obj.ScaleX(objFlex.ColWidth(lCols), vbTwips, vbPixels)
                
                   With rectBox
                        .Left = PosLeft: .Top = PosTop
                        .Right = PosLeft + cellWidth: .Bottom = PosTop + cellHeight
                         
                         If bGridPrint Then
                                lNewBrush = CreateSolidBrush(FillColor)
                                lNewPen = CreatePen(GridPenStyle, lDrawWidth, lGridLineColor)
                                lOldBrush = SelectObject(Obj.hDC, lNewBrush)
                                lOldPen = SelectObject(Obj.hDC, lNewPen)
                                
                                RoundRect Obj.hDC, .Left, .Top, .Right + lDrawWidth, .Bottom + lDrawWidth, Obj.ScaleX(RoundCorX, vbTwips, vbPixels), Obj.ScaleY(RoundCorY, vbTwips, vbPixels)
                                DeleteObject (lOldPen): DeleteObject (lOldBrush)
                         End If 'bGridPrint
                        'Making rectBox a bit smaller, so that the text should not touch the lines
                        .Left = .Left + (3 * TmpJustTohold2): .Right = .Right - (3 * TmpJustTohold2): .Top = .Top + (2 * TmpJustTohold2): .Bottom = .Bottom - (2 * TmpJustTohold2)
                   End With  ' rectBox
                Set Obj.Font = cellFont
                 
                 SetTextColor Obj.hDC, lTextColor
                 If IsNumeric(sCellText) = False Then
                  DrawText Obj.hDC, sCellText, Len(sCellText) * 2, rectBox, DT_Code
                  Else
                  DrawText Obj.hDC, sCellText, Len(sCellText), rectBox, DT_Code
                 End If
                
                PosLeft = PosLeft + cellWidth + (VSpace * TmpJustTohold2) 'VSpace = Vertical Spacing
        Next lCols    'For lCols = 1 To flex.cols

    PosTop = PosTop + cellHeight + (HSpace * TmpJustTohold2) 'Horizontal Spacing
    PosLeft = tmpLeft
    
 

For lRows = lRowsFrom To lRowsTo    '写主体部分
    
    cellHeight = Obj.ScaleY(objFlex.RowHeight(lRows), vbTwips, vbPixels)
     
    tmpLeft = PosLeft
            For lCols = 0 To objFlex.Cols - 1
               With objFlex
                     .Col = lCols: .Row = lRows
                      sCellText = objFlex.Text
                                     cellFont.Name = .CellFontName: cellFont.Size = .CellFontSize