Print Preview ActiveX Active Users: 59 / Visits Today: 236
Highest Active Users: 99
Print Preview ActiveX
Home | Profile | Register | Active Topics | Members | Search | FAQ | RSS
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Print Preview
 Tips & Tricks
 Generic Grid Preview
 New Topic  Reply to Topic
 Printer Friendly
Author Previous Topic: Sample of Voucher in Print Preview Topic Next Topic: Generic Form Preview  

Waty Thierry
Forum Admin

Belgium
635 Posts

Posted - 01/26/2004 :  23:14:09  Show Profile  Visit Waty Thierry's Homepage  Reply with Quote
You can see a demo of this generic routine
by downloading the ImmoAssist application on http://www.immoassist.com

Public Sub DoPrintGrid(oPreview As PrintPreview5.Preview, oGrid As ImmoGrid, nCol As Long, Optional bEmpty As Boolean = False)
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : waty.thierry@vbdiamond.com
' * Date : 02/06/2003
' * Project Name : ImmoAssist
' * Module Name : Main_Module
' * Module Filename : Main.bas
' * Procedure Name : DoPrintGrid
' * Purpose :
' * Parameters :
' * oPreview As PrintPreview5.Preview
' * oGrid As ImmoGrid
' * nCol As Long
' * Optional bEmpty As Boolean = False
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * Screenshot :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************

' #VBIDEUtilsERROR#
On Error GoTo ERROR_DoPrintList

Dim nI As Integer
Dim nJ As Integer

Dim nWidth As Long

Dim oColHeader As New Collection
Dim oColRow As New Collection
Dim oColData As New Collection
Dim oColFormat As New Collection

Dim sFormat As String

Dim sOldFont As String
Dim nOldFontSize As Long

Dim nCurrentHeight As Long

Dim sTmp As String

nWidth = 0

With oPreview
sOldFont = .FontName
nOldFontSize = .FontSize

.FontSize = 8
.FontName = "Arial"
.FontBold = True
.FontUnderline = False
.CurrentX = nCol

' *** Get all the headers and set the formats
For nI = 1 To oGrid.Columns
If oGrid.ColumnVisible(nI) Then
oColHeader.Add oGrid.ColumnHeader(nI)
Else
oColHeader.Add ""
End If

sFormat = vbNullString

Select Case oGrid.ColumnAlign(nI)
Case ecgHdrTextALignCentre
sFormat = "c "

Case ecgHdrTextALignLeft
sFormat = "l "

Case ecgHdrTextALignRight
sFormat = "r "

End Select

sFormat = sFormat & .C_Twips(oGrid.ColumnWidth(nI) & " pt") & ";20"
nWidth = nWidth + .C_Twips(oGrid.ColumnWidth(nI) & " pt") + 20

oColFormat.Add sFormat
oColRow.Add sFormat

Next

If nWidth > .PageWidth Then
.Orientation = prORLandscape
End If

If .CurrentY >= .PageInsideHeight - .PageInsideTop - 300 Then
.AddPageTemplate
End If

' *** First add the headers
.FontBold = True
.Tabulate oColHeader, oColFormat, nCol, , prASCopypage
Set oColData = Nothing
.FontBold = False

' *** Get all data in the grid
For nI = 1 To oGrid.Rows
.FontSize = 8
.FontName = "Courier New"
.FontBold = False
.FontUnderline = False

Set oColData = New Collection
Set oColRow = New Collection
For nJ = 1 To oGrid.Columns
If Len(oGrid.CellFormattedText(nI, nJ)) > 0 Then
If nCurrentHeight < .TextHeight(oGrid.CellFormattedText(nI, nJ)) * (oGrid.EvaluateTextHeight(nI, nJ) / 13) Then
nCurrentHeight = .TextHeight(oGrid.CellFormattedText(nI, nJ)) * (oGrid.EvaluateTextHeight(nI, nJ) / 13)
End If
End If
If oGrid.ColumnVisible(nJ) And (oGrid.CellIcon(nI, nJ) = -1) Then
If oGrid.ColumnWidth(nJ) = 1 Then
sTmp = vbNullString
Else
sTmp = oGrid.CellFormattedText(nI, nJ)
End If

' *** Check if we need to add Carriage Return
sTmp = PrepareLine(sTmp, .C_Twips(oGrid.ColumnWidth(nJ) & " pt") / .TextWidth("A"))

oColData.Add sTmp
oColRow.Add oColFormat(nJ) & ";color=" & oGrid.CellForeColor(nI, nJ)
Else
' *** It is an Icon
If oGrid.CellIcon(nI, nJ) <> -1 Then
' *** Add if text anyway
On Error Resume Next

If oGrid.ColumnWidth(nJ) = 1 Then
sTmp = vbNullString
Else
sTmp = oGrid.CellFormattedText(nI, nJ)
End If

' *** Check if we need to add Carriage Return
sTmp = PrepareLine(sTmp, .C_Twips(oGrid.ColumnWidth(nJ) & " pt") / .TextWidth("A"))

oColData.Add Trim$(sTmp)
oColRow.Add oColFormat(nJ) & ";color=" & oGrid.CellForeColor(nI, nJ)
Err.Clear
On Error GoTo ERROR_DoPrintList
End If

End If
Next

' *** Check if we need to skip before
If .CurrentY + nCurrentHeight >= .PageInsideHeight - .PageInsideTop * 2 - 100 Then
If nI <= oGrid.Rows Then
.AddPageTemplate

' *** Add headers
.FontSize = 8
.FontName = "Arial"
.FontUnderline = False
.FontBold = True
.Tabulate oColHeader, oColFormat, nCol, , prASCopypage
.FontBold = False

End If
End If

.FontSize = 8
.FontName = "Courier New"
.FontBold = False
.FontUnderline = False
.Tabulate oColData, oColRow, nCol, , prASCopypage
Set oColData = Nothing

' *** Skip the page and add the headers
If .CurrentY >= .PageInsideHeight - .PageInsideTop * 2 - 100 Then
If nI < oGrid.Rows Then
.AddPageTemplate

' *** Add headers
.FontSize = 8
.FontName = "Arial"
.FontUnderline = False
.FontBold = True
.Tabulate oColHeader, oColFormat, nCol, , prASCopypage
.FontSize = 8
.FontName = "Courier New"
.FontBold = False
.FontUnderline = False

End If
End If
Set oColData = Nothing

nCurrentHeight = 0
Next

.FontName = sOldFont
.FontSize = nOldFontSize

End With

EXIT_DoPrintList:
On Error Resume Next

Exit Sub

' #VBIDEUtilsERROR#
ERROR_DoPrintList:
Select Case IAErrorHandler("Error " & Err.Number & ": " & Err.Description & vbCrLf & "in DoPrintList", vbAbortRetryIgnore + vbCritical, "Error")
Case vbAbort
Screen.MousePointer = vbDefault
Resume EXIT_DoPrintList
Case vbRetry
Resume
Case vbIgnore
Resume Next
End Select

Resume EXIT_DoPrintList

End Sub


Come and visit :
www.immoassist.com
www.ppreview.net
www.vbdiamond.com
www.d2dsources.com
www.mandix.com
Go to Bottom of Page
  Previous Topic: Sample of Voucher in Print Preview Topic Next Topic: Generic Form Preview  
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Print Preview ActiveX © Mandix Go To Top Of Page
This page was generated in 0.11 seconds. Powered By: Snitz Forums 2000 Version 3.4.02