flexprinter.cls

汽修厂管理软件

                                     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
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
'写页脚
With Obj

.CurrentX = Obj.Width / 2
.CurrentX = Obj.ScaleX(.CurrentX, vbTwips, vbPixels) - (CSng(Len(Trim(mvarFooter)))) * 10 / 2
.CurrentY = BorDy + 10
.FontSize = 8
.ForeColor = vbBlack
End With
Obj.Print mvarFooter

With Obj
'写页吗
Obj.ScaleMode = vbTwips
.CurrentX = Obj.Width / 2 - 1000
'.CurrentX = Obj.ScaleX(.CurrentX, vbTwips, vbPixels) - 8 * 8
.CurrentY = .Height - 1000 'Obj.ScaleY(Obj.Height, vbTwips, vbPixels) - 40
.FontSize = 8

.ForeColor = vbBlack
End With
Obj.Print CStr(mvarCurPage) & "/" & CStr(mvarPages) & "    [该页共 " & CStr(lRowsTo - lRowsFrom + 1) & "行]"

Obj.ScaleMode = vbPixels


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
    mvarRowsofPage = CalRowsofPage(Printer.Height - 3400, objFlex.RowHeight(0))
    mvarPages = CalPages(mvarRowsofPage, objFlex.Rows - 1)
Else
    MsgBox "Value to 'FlexName' property is invalid; it should be name of the MSHFlexGrid control or MSFlexGrid control. ", vbCritical, "Invalid Property"
End If
End Property
Public Property Let RowsTo(ByVal NewValue As Long)
lRowsTo = NewValue
End Property

Public Property Let RowsFrom(ByVal NewValue As Long)
lRowsFrom = NewValue
End Property

Public Property Get RowsTo() As Long
RowsTo = lRowsTo
End Property

Public Property Get RowsFrom() As Long
RowsFrom = lRowsFrom
End Property


Private Sub Class_Initialize()
lRowsFrom = 0: lRowsTo = 1
bGridPrint = True
VSpace = 0: HSpace = 0   'V=Vertical  H=Horizontal
RoundCorX = 10: RoundCorY = 10: GridPenStyle = 0
FillColor = vbWhite: bDrawBoarder = True
BoarderStyle = 0: BoarderColor = vbBlack: BoarderWidth = 1: BoarderDistance = 5
PosLeft = 10: PosTop = 10
  '当创建 FlexPrinter 类时，创建 mHeader 对象
 ' Set mvarHeader = New Header
  '当创建 FlexPrinter 类时，创建 mFooter 对象
  'Set mvarFooter = New Footer


End Sub
Public Property Get CurX() As Long
CurX = FinalX
End Property
Public Property Get CurY() As Long
CurY = FinalY
End Property
Private Function ValidObj(objOP As Object) As Boolean
Dim Msg As String
If TypeOf objOP Is Form Or TypeOf objOP Is PictureBox Or TypeOf objOP Is Printer Then
ValidObj = True
Else
ValidObj = False
End If
If Not ValidObj Then
Msg = "Invalid object " + vbCrLf
Msg = Msg + vbCrLf + vbCrLf
Msg = Msg + "The valid objects are Printer, PictureBox and Form" + vbCrLf
MsgBox Msg, vbCritical, "Invalid Object"
End If
End Function

Private Sub Class_Terminate()
 ' Set mvarFooter = Nothing
 ' Set mvarHeader = Nothing
Set objFlex = Nothing
End Sub
Public Sub DrawRulerH(Obj As Object, X As Long, Y As Long, Length As Long, sUnit As String)

Dim Height As Long, Devide As Long
Dim SmallSteps  As Long, bSwitch As Boolean
Dim h1 As Long, TwpPerUnit As Long
Dim TmpK1 As Long
Dim K1 As Long, K2 As Long, N As Long
Dim BuFore As Long
Dim BuDrawStyle As Long, BuDrawWidth As Long, BuDrawMode As Long, BuScaleMode As Long
Dim BuFontS As Long
If Not ValidObj(Obj) Then Exit Sub

'Back Up
BuDrawStyle = Obj.DrawStyle: BuDrawWidth = Obj.DrawWidth
BuDrawMode = Obj.DrawMode: BuFontS = Obj.FontSize
BuScaleMode = Obj.ScaleMode
BuFore = Obj.ForeColor
'Set
Obj.DrawStyle = vbSolid: Obj.DrawWidth = 1: Obj.DrawMode = vbCopyPen
Obj.ScaleMode = vbTwips: Obj.FontSize = 8
Obj.FontBold = False: Obj.FontItalic = False
Obj.FontStrikethru = False
Obj.FontUnderline = False
SetTextColor Obj.hDC, vbBlack
X = X * Screen.TwipsPerPixelX
Y = Y * Screen.TwipsPerPixelY

Height = 400

If UCase(sUnit) = "INCH" Then
TwpPerUnit = 1440
Devide = 20
Else
'CM
TwpPerUnit = 567
Devide = 6
End If

SmallSteps = TwpPerUnit / Devide
If bDrawBoarder Then
Y = Y - Height - ((BoarderDistance * Screen.TwipsPerPixelX) + 50) 'Top position and borDis leftposition and Bordis
X = X - BoarderDistance * Screen.TwipsPerPixelY

Else
Y = Y - (Height + 50)
End If

Obj.Line (X, Y)-(X + Length, Y)
Obj.Line (X, Y + Height)-(X + Length, Y + Height)
N = -1
For K1 = 0 To Length Step TwpPerUnit
bSwitch = True: N = N + 1
Obj.Line (X + K1, Y)-(X + K1, Y + Height + 50), vbRed
''''''
Obj.Line (X + K1, Y + Height + 50)-(X + K1 - 50, Y + Height + 50 - 100), vbRed
Obj.Line (X + K1, Y + Height + 50)-(X + K1 + 50, Y + Height + 50 - 100), vbRed

Obj.CurrentY = Y + 30
Obj.CurrentX = Obj.CurrentX + 20 - Obj.TextWidth(Str(N)) / 2
If K1 = 0 Then Obj.Print "0 " + Mid(sUnit, 1, 2) + "." Else Obj.Print N

Obj.Line (X + K1 + TwpPerUnit / 2, Y)-(X + K1 + TwpPerUnit / 2, Y + Height)
    
    For K2 = TmpK1 + SmallSteps To K1 - SmallSteps Step SmallSteps
     bSwitch = Not bSwitch
    
     If bSwitch Then
     Obj.Line (X + K2, Y + Height - 200)-(X + K2, Y + Height)
     Else
     Obj.Line (X + K2, Y + Height - 100)-(X + K2, Y + Height)
     End If
     Next K2
    TmpK1 = K1

Next K1
'restore the things
   SetTextColor Obj.hDC, BuFore
Obj.DrawStyle = BuDrawStyle: Obj.DrawWidth = BuDrawWidth: Obj.DrawMode = BuDrawMode
Obj.ScaleMode = BuScaleMode: Obj.FontSize = BuFontS
End Sub
Public Sub DrawRulerV(Obj As Object, X As Long, Y As Long, Length As Long, sUnit As String)
Dim Height As Long, Devide As Long
Dim SmallSteps  As Long, bSwitch As Boolean
Dim h1 As Long, TwpPerUnit As Long
Dim TmpK1 As Long
Dim K1 As Long, K2 As Long, N As Long

Dim BuDrawStyle As Long, BuDrawWidth As Long, BuDrawMode As Long, BuScaleMode As Long
Dim BuFontS As Long
Dim BuFore As Long
If Not ValidObj(Obj) Then Exit Sub
'Back Up
BuDrawStyle = Obj.DrawStyle: BuDrawWidth = Obj.DrawWidth
BuDrawMode = Obj.DrawMode: BuScaleMode = Obj.ScaleMode
BuFontS = Obj.FontSize
BuFore = Obj.ForeColor
'Set New
Obj.DrawStyle = vbSolid: Obj.DrawWidth = 1: Obj.DrawMode = vbCopyPen
Obj.ScaleMode = vbTwips: Obj.FontSize = 8: Obj.FontBold = False: Obj.FontItalic = False
Obj.FontStrikethru = False
Obj.FontUnderline = False

SetTextColor Obj.hDC, vbBlack
X = X * Screen.TwipsPerPixelX: Y = Y * Screen.TwipsPerPixelY
Height = 400
Length = Obj.Height

If UCase(sUnit) = "INCH" Then
TwpPerUnit = 1440
Devide = 20
Else
'CM
TwpPerUnit = 567
Devide = 6
End If

SmallSteps = TwpPerUnit / Devide
If bDrawBoarder Then
X = X - Height - ((BoarderDistance * Screen.TwipsPerPixelX) + 50) 'Top position and borDis leftposition and Bordis
Y = Y - BoarderDistance * Screen.TwipsPerPixelY
Else
X = X - (Height + 50)
End If

Obj.Line (X, Y)-(X, Y + Length)
Obj.Line (X + Height, Y)-(X + Height, Y + Length)
N = -1
For K1 = 0 To Length Step TwpPerUnit
bSwitch = True: N = N + 1
Obj.Line (X, Y + K1)-(X + Height + 50, Y + K1), vbRed
'Aero Heads
Obj.Line (X + Height + 50, Y + K1)-(X + Height - 50, Y + K1 - 50), vbRed
Obj.Line (X + Height + 50, Y + K1)-(X + Height - 50, Y + K1 + 50), vbRed

Obj.CurrentX = X - 30 + Obj.TextWidth(Str(N)) / 2
If K1 = 0 Then Obj.Print "0 " + Mid(sUnit, 1, 2) + "." Else Obj.Print N

Obj.Line (X, Y + K1 + TwpPerUnit / 2)-(X + Height, Y + K1 + TwpPerUnit / 2)
    
    For K2 = TmpK1 + SmallSteps To K1 - SmallSteps Step SmallSteps
     bSwitch = Not bSwitch
    
     If bSwitch Then
     Obj.Line (X + Height - 200, Y + K2)-(X + Height, Y + K2)
     Else
     Obj.Line (X + Height - 100, Y + K2)-(X + Height, Y + K2)
     End If
     Next K2
    TmpK1 = K1

Next K1
Obj.DrawStyle = BuDrawStyle: Obj.DrawWidth = BuDrawWidth: Obj.DrawMode = BuDrawMode
Obj.ScaleMode = BuScaleMode: Obj.FontSize = BuFontS
SetTextColor Obj.hDC, BuFore
End Sub
Public Sub ColSetupCode()
'Code Generator
Dim C As Long, R As Long
Dim cd As String

cd = cd + "'You can place this code in Form's load event" + vbCrLf + vbCrLf
cd = cd + "'MSFlex Grid Control does not require these code but MSHFlex does" + vbCrLf + vbCrLf
cd = cd + "With " + objFlex.Name + vbCrLf

For C = 0 To objFlex.Cols - 1
R = objFlex.ColWidth(C)
If R < 1 Then cd = cd + "'You must set positive value to follwing line" + vbCrLf
cd = cd + ".ColWidth(" + Str(C) + ")  =" + Str(R) + vbCrLf
Next C
cd = cd + "End With"
Clipboard.Clear ' Clear Clipboard.
Clipboard.SetText cd
MsgBox "Column setup code has been copied to cilipboard"

End Sub