flexprinter.tcls

汽修厂管理软件

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
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

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

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"


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
                                     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
                 DrawText Obj.hDC, sCellText, Len(sCellText) + 2, rectBox, DT_Code ' code
                               
                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
Next lRows   'For lRows = lRowsFrom To lRowsTo

BorDx = rectBox.Right + lDrawWidth + (2 * TmpJustTohold2)
BorDy = rectBox.Bottom + (2 * TmpJustTohold2)

FinalX = BorDx: FinalY = BorDy

If bDrawBoarder Then
        
        lNewPen = CreatePen(BoarderStyle, BoarderWidth, BoarderColor)
        lOldPen = SelectObject(Obj.hDC, lNewPen)
        BoarderDistance = BoarderDistance * TmpJustTohold2
        BorX = BorX - BoarderDistance: BorY = BorY - BoarderDistance
        BorDx = BorDx + BoarderDistance: BorDy = BorDy + BoarderDistance
        
        MoveToEx Obj.hDC, BorDx, BorDy, opal  'Starting point Dx Dy
        LineTo Obj.hDC, BorX, BorDy        'MoveRight
        LineTo Obj.hDC, BorX, BorY          'MoveUp
        LineTo Obj.hDC, BorDx, BorY        'Moveleft
        LineTo Obj.hDC, BorDx, BorDy      'MoveDown to starting point
        SelectObject Obj.hDC, lOldPen
        DeleteObject lNewPen
        FinalX = BorDx: FinalY = BorDy
End If
objFlex.Redraw = True
Set cellFont = Nothing
BoarderWidth = TmpBoarderWidth: lDrawWidth = TmpDrawWidth
BoarderDistance = TmpBoarderDistance
PosLeft = BackupPosLeft:  PosTop = BackupPosTop
End Sub

Public Property Set FlexName(ByVal NewValue As Object)
If TypeName(NewValue) = "MSHFlexGrid" Or TypeName(NewValue) = "MSFlexGrid" Then
    Set objFlex = NewValue
Else
    MsgBox "Value to 'FlexName' property is invalid; it should be name of the MSHFlexGrid control or MSFlexGrid control. ", vbCritical, "Invalid Property"