Print Preview ActiveX Active Users: 20 / Visits Today: 20
Highest Active Users: 20
Print Preview ActiveX
Home | Profile | Register | Active Topics | Members | Search | FAQ | RSS
 All Forums
 Print Preview
 Tips & Tricks
 Generic Grid Preview

Note: You must be registered in order to post a reply.
To register, click here. Registration is FREE!

Screensize:
UserName:
Password:
Format Mode:
Format: BoldItalicizedUnderlineStrikethrough Align LeftCenteredAlign Right Horizontal Rule Insert HyperlinkInsert Email Insert CodeInsert QuoteInsert List
   
Message:

* HTML is OFF
* Forum Code is ON
Smilies
Smile [:)] Big Smile [:D] Cool [8D] Blush [:I]
Tongue [:P] Evil [):] Wink [;)] Clown [:o)]
Black Eye [B)] Eight Ball [8] Frown [:(] Shy [8)]
Shocked [:0] Angry [:(!] Dead [xx(] Sleepy [|)]
Kisses [:X] Approve [^] Disapprove [V] Question [?]

   Insert a File

Check here to subscribe to this topic.
   

T O P I C    R E V I E W
Waty Thierry Posted - 01/26/2004 : 23:14:09
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

Print Preview ActiveX © Mandix Go To Top Of Page
This page was generated in 0.12 seconds. Powered By: Snitz Forums 2000 Version 3.4.02