Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/prtgrid/prtdemo.bas

BASIC Source File | 1995-09-06 | 6.5 KB | 264 lines

Option Explicit

' VB constants

Const DRAW_COPY_PEN = 13
Const DRAW_SOLID = 0

Const COLOR_BLACK = &H0&

Const FILL_SOLID = 0
Const FILL_TRANSPARENT = 1

' Windows API constants

Const WM_SETREDRAW = &HB

Const DT_WORDBREAK = &H10
Const DT_EXTERNALLEADING = &H200
Const DT_NOPREFIX = &H800

' Windows API structures

Type utRECT
    Left As Integer
    Top As Integer
    Right As Integer
    Bottom As Integer
End Type

' Windows API function declarations

Declare Function GetTextExtent Lib "GDI" (ByVal hDC As Integer, ByVal lpString As String, ByVal nCount As Integer) As Long
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function DrawText Lib "User" (ByVal hDC As Integer, ByVal lpStr As String, ByVal nCount As Integer, lpRect As utRECT, ByVal wFormat As Integer) As Integer
Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer

' module constants

Const RECT_OFFSET = 30

' module variables

Dim RC As Integer

Dim GridRowCount As Integer
Dim GridColCount As Integer
Dim GridFixRows As Integer
Dim GridFixCols As Integer

Dim PageStartX As Single
Dim PageStartY As Single
Dim PageEndX As Single
Dim PageEndY As Single

Dim PrintTwipsX As Single
Dim PrintTwipsY As Single
Dim PrintScaleX As Single
Dim PrintScaleY As Single
Dim PrintFontHeight As Single
Dim PrintX As Single
Dim PrintY As Single
Dim PrintWidth As Single
Dim PrintHeight As Single
Dim PrintText As String

Dim TextRect As utRECT

Dim ctlGrid As Control

' user-defined types

Type utPageInfo
    Margin As Single
    FontName As String
    FontSize As Integer
    FontBold As Integer
    FontItalic As Integer
    FixedShade As Integer
End Type

' global variables

Global PageInfo As utPageInfo

Private Sub CalcHeight (RowIndex As Integer)

    ' claculate PrintHeight for a given row using the RowHeight

    PrintHeight = (((ctlGrid.RowHeight(RowIndex) * PrintScaleY) \ PrintTwipsY) + 1) * PrintTwipsY

End Sub

Private Sub InitPage ()

    ' set Printer properties for a new page

    Printer.DrawMode = DRAW_COPY_PEN
    Printer.DrawStyle = DRAW_SOLID
    Printer.DrawWidth = 1
    Printer.ForeColor = COLOR_BLACK
    Printer.FillStyle = FILL_TRANSPARENT

    ' print something so DrawText uses our Printer properties

    Printer.Print " "

    PrintY = PageStartY

End Sub

Private Sub InitPrint ()

    Dim SrceExt As Long
    Dim DestExt As Long
    Dim Gutter As Single

    Printer.Scale

    PrintTwipsX = Printer.TwipsPerPixelX
    PrintTwipsY = Printer.TwipsPerPixelY

    ' set page variables based on print area and margins

    Gutter = (Printer.Width - Printer.ScaleWidth) / 2
    PageStartX = PageInfo.Margin - Gutter
    PageEndX = Printer.ScaleWidth - (PageInfo.Margin - Gutter)

    Gutter = (Printer.Height - Printer.ScaleHeight) / 2
    PageStartY = PageInfo.Margin - Gutter
    PageEndY = Printer.ScaleHeight - (PageInfo.Margin - Gutter)

    ' set Printer font and calcuate scale ratios based on FontSize + 2

    Printer.FontName = PageInfo.FontName
    Printer.FontSize = PageInfo.FontSize + 2
    Printer.FontBold = PageInfo.FontBold
    Printer.FontItalic = PageInfo.FontItalic

    SrceExt = GetTextExtent(GetDC(ctlGrid.hWnd), "GgIiWw ", 7)
    DestExt = GetTextExtent(Printer.hDC, "GgIiWw ", 7)
    PrintScaleX = ((DestExt And &HFFFF) * PrintTwipsX) / ((SrceExt And &HFFFF) * Screen.TwipsPerPixelX)
    PrintScaleY = ((DestExt \ &H10000) * PrintTwipsY) / ((SrceExt \ &H10000) * Screen.TwipsPerPixelY)

    Printer.FontSize = PageInfo.FontSize
    PrintFontHeight = Printer.TextHeight("Gg")

    ' set shading for fixed rows/cols

    Printer.FillColor = RGB(PageInfo.FixedShade, PageInfo.FixedShade, PageInfo.FixedShade)

End Sub

Private Function OutputRow (RowIndex As Integer) As Integer

    Dim ColIndex As Integer

    ctlGrid.Row = RowIndex
    PrintX = PageStartX

    CalcHeight RowIndex

    ' output the text in each cell for a row

    For ColIndex = 0 To GridColCount

        ctlGrid.Col = ColIndex
        PrintWidth = (((ctlGrid.ColWidth(ColIndex) * PrintScaleX) \ PrintTwipsX) + 1) * PrintTwipsX
        PrintText = ctlGrid.Text

        OutputText ((RowIndex < GridFixRows) Or (ColIndex < GridFixCols))

        PrintX = PrintX + PrintWidth
        If PrintX >= PageEndX Then Exit For

    Next

    PrintY = PrintY + PrintHeight

    ' return True if the next row falls on a new page

    If RowIndex < GridRowCount Then
        CalcHeight RowIndex + 1
        OutputRow = ((PrintY + PrintHeight) >= PageEndY)
    Else
        OutputRow = False
    End If

End Function

Private Sub OutputText (FillState As Integer)

    ' set output rectangle for DrawText

    TextRect.Left = (PrintX + RECT_OFFSET) / PrintTwipsX
    TextRect.Top = (PrintY + RECT_OFFSET) / PrintTwipsY
    TextRect.Right = (PrintX + PrintWidth - RECT_OFFSET) / PrintTwipsX
    TextRect.Bottom = (PrintY + ((PrintHeight \ PrintFontHeight) * PrintFontHeight) - RECT_OFFSET) / PrintTwipsY

    ' send text to Printer using API function

    RC = DrawText(Printer.hDC, PrintText, Len(PrintText), TextRect, DT_WORDBREAK Or DT_NOPREFIX Or DT_EXTERNALLEADING)

    ' border the cell area

    Printer.FillStyle = IIf(FillState, FILL_SOLID, FILL_TRANSPARENT)
    Printer.Line (PrintX, PrintY)-Step(PrintWidth, PrintHeight), , B

End Sub

Sub PrintGrid (grdCtl As Control)

    Dim NewState As Integer
    Dim RowIndex As Integer
    Dim FixIndex As Integer

    ' initialize module variables and disable grid redraw

    Set ctlGrid = grdCtl

    InitPrint
    SetRedraw False

    GridRowCount = ctlGrid.Rows - 1
    GridColCount = ctlGrid.Cols - 1
    GridFixRows = ctlGrid.FixedRows
    GridFixCols = ctlGrid.FixedCols

    NewState = True

    ' output all rows starting with the first non-fixed row

    For RowIndex = GridFixRows To GridRowCount

        If NewState Then

            ' output fixed rows for each new page

            InitPage
            For FixIndex = 0 To (GridFixRows - 1)
                NewState = OutputRow(FixIndex)
            Next

        End If

        NewState = OutputRow(RowIndex)
        If NewState Then Printer.NewPage

    Next

    ' send document and enable grid redraw

    Printer.EndDoc
    SetRedraw True

End Sub

Private Sub SetRedraw (State As Integer)

    If SendMessage(ctlGrid.hWnd, WM_SETREDRAW, State, 0) Then
    End If

End Sub