Date: 02-16-2022
Return to Index
created by gbSnippets
'Print Preview Include by Gary Beene ver 1.0 10 May 2012
'Features:
' - hidden image (buffer)
' - autosize image to available space
' - pixel to physical dimension conversion
' - word wrap
' - tooltips on buttons
' - second level dialog (page setup)
' - header/footer
' - determine no-print area of a printer
' - printer selection
'This code assumes the vertical page consists of these sections:
' no-print zone : header : margin : body : margin : footer : no-print zone
'This code assumes the horizontal page consists of these sections:
' no-print zone : margin : body : margin : no-print zone
#Resource Icon ppprint, "print.ico"
#Resource Icon ppleft, "left.ico"
#Resource Icon ppright, "right.ico"
#Resource Icon pprefresh, "refresh.ico"
#Resource Icon ppprops, "props.ico"
#Resource Icon ppmargin, "margin.ico"
'Print Preview Equates =====================================
%IDC_PrintAll = 851 : %IDC_PrintHeader = 862
%IDC_PrintClose = 852 : %IDC_PrintFooter = 863
%IDC_PrintGraphicHidden = 853 : %IDC_PrintBackGround = 864
%IDC_PrintGraphicVisible = 854 : %IDC_PrintPage = 865
%IDC_PrintToolTip = 855 : %IDC_PrintPages = 866
%IDC_PrintLineLabel = 856 : %IDC_PrintPageSetup = 867
%IDC_PrintLeft = 857 : %IDC_PrintMinPage = 868
%IDC_PrintRight = 858 : %IDC_PrintMaxPage = 869
%IDC_PrintShowMargins = 859 : %IDC_PrintRange = 870
%IDC_PrintProperties = 860 : %IDC_PrinterSelect = 871
%IDC_PrintOrientation = 861 : %IDC_PrintZoom = 872
%IDC_PrintRangeLabel = 874 : %IDC_PrintPageLabel = 875
'PrintPreview Global Variables =================================================================
Global PPFontName, PPPrintArray(), PPText, PPImage, PPFooterText As String
Global PPDeadZoneLeft, PPDeadZoneTop, PPDeadZoneRight, PPDeadZoneBottom As Single
Global PPMarginLeft, PPMarginRight, PPMarginTop, PPMarginBottom As Single
Global PPHeader, PPFooter, PPMaxWidth, PPPaperX, PPPaperY As Single
Global PPMaxPages, PPCurrentPage, PPLinesPerPage, PPScrollBarsVisible As Long
Global PPScreenPPIx, PPScreenPPIy, PPPrinterPPIx, PPPrinterPPIy As Long
Global PPShowFooter, PPShowHeader, PPFontPoints, PPFontStyle As Long
Global PPOrientation, PPShowMargins, PPZoom, PPWordWrap As Long
Global PPSmallImageX, PPSmallImageY, PPScrollSizeX, PPScrollSizeY As Long
Global hParent, hPPFont, hPPDialog, hPPPageSetupDlg, hPPToolTip, hPPViewPort As Dword
Global PPhs,PPvs,PPwMax,PPhMax As Long
Sub gbPrintPreview(ByVal hWin As Dword, _ 'handle to parent dialog
ByVal FN As String, _ 'font name
ByVal FP As Long, _ 'font size (points)
ByVal FS As Long, _ 'font style 0=normal 1=bold
ByVal pTxt As String, _ 'text to display
FT As String, _ 'footer text (bottom left)
Img As String, _ 'image file name, *.bmp, 100x100
SF As Long, _ 'display footer 0=no 1=yes
SH As Long, _ 'display header 0=no 1=yes
WW As Long) 'wordwrap
hParent = hWin
PPFontName = FN
PPFontPoints = FP
PPFontStyle = FS
PPText = pTxt
PPFooterText = FT
PPImage = Img
PPShowFooter = SF
PPShowHeader = SH
PPWordWrap = WW
DisplayPrintPreviewDialog
End Sub
Sub DisplayPrintPreviewDialog()
Dialog New Pixels, hParent, "Print Preview", 100, 100, 675, 500, %WS_OverlappedWindow Or %WS_ClipChildren To hPPDialog
Dialog Set Icon hPPDialog, "ppprint"
Dialog New Pixels, hPPDialog, "", 0, 40, 50, 50, %DS_Control Or %WS_Child Or %WS_ClipChildren, 0 To hPPViewPort
Dialog Set Color hPPViewPort, %Black, %rgb_LightGray
Control Add Graphic, hPPViewPort, %IDC_PrintGraphicVisible, "", 0,0,50,50 ', %WS_Border Or %WS_TabStop
Graphic Attach hPPViewPort, %IDC_PrintGraphicVisible
Control Add Label, hPPDialog, %IDC_PrintLineLabel, "print", 0,37,50,1, %WS_Border
Control Add ImgButton, hPPDialog, %IDC_PrinterSelect, "ppprint", 5,5,25,25
Control Add ImgButton, hPPDialog, %IDC_PrintPageSetup, "ppprops", 35,5,25,25
Control Add ImgButton, hPPDialog, %IDC_PrintLeft, "ppleft", 75,5,25,25
Control Add Label, hPPDialog, %IDC_PrintPageLabel, "01", 102,5,25,25, %WS_Border Or %SS_Center Or %SS_CenterImage Or %SS_Notify
Control Set Color hPPDialog, %IDC_PrintPageLabel, %Black, %White
Control Add ImgButton, hPPDialog, %IDC_PrintRight, "ppright", 129,5,25,25
Control Add Button, hPPDialog, %IDC_PrintAll, "Print All", 170,5,50,25
Control Add Button, hPPDialog, %IDC_PrintPage, "Print Page", 225,5,60,25
Control Add Button, hPPDialog, %IDC_PrintRange, "Print", 295,5,35,25
Control Add TextBox, hPPDialog, %IDC_PrintMinPage, "1", 335,5,25,25
Control Add Label, hPPDialog, %IDC_PrintRangeLabel, "to", 360,5,15,25, %SS_Center Or %SS_CenterImage Or %SS_Notify
Control Add TextBox, hPPDialog, %IDC_PrintMaxPage, "1", 380,5,25,25
Dim cmbData(7) As String
Array Assign cmbData() = "Page", "Width", "25%", "50%", "75%", "100%", "200%", "400%"
Control Add ComboBox, hPPDialog, %IDC_PrintZoom, cmbData() , 415,5,75,150, %CBS_DropDownList
ComboBox Select hPPDialog, %IDC_PrintZoom, 1
Control Add ImgButton, hPPDialog, %IDC_PrintOrientation, "pprefresh", 495,5,25,25
Control Add ImgButton, hPPDialog, %IDC_PrintShowMargins, "ppmargin", 525,5,25,25
Control Add CheckBox, hPPDialog, %IDC_PrintHeader, "Header", 555,5,55,10
Control Add CheckBox, hPPDialog, %IDC_PrintFooter, "Footer", 555,20,55,10
Control Add Button, hPPDialog, %IDC_PrintClose, "Cancel", 620,5,50,25
'values needed for initialization
Control Set Check hPPDialog, %IDC_PrintHeader, PPShowHeader
Control Set Check hPPDialog, %IDC_PrintFooter, PPShowFooter
PPCurrentPage = 1 : PPOrientation = 1
PPMarginLeft = 1 : PPMarginRight = 1 : PPMarginTop = 1 : PPMarginBottom = 1
PPZoom = 1 : PPwMax = 500 : PPhMax = 500 : PPhs=5 : PPvs=5
'initialize properties and display content to be printed
SetPrintPreviewProperties
CreateHiddenGraphicControl 'create graphic controls according to orientation 1=portrait 0=landscape
CreatePrintContent 'format all output text, place in PPPrintArray()
PrintToHiddenGraphic 'display PPCurrentPage on the full size hidden graphic control
PrintToVisibleGraphic 'shrink image from the hidden graphic control to the visible graphic control
Dialog Show Modeless hPPViewPort, Call ViewPortProc
Dialog Show Modal hPPDialog Call PreviewProc()
End Sub
CallBack Function PreviewProc() As Long
'this is the Callback function for the Print Preview dialog.
Select Case Cb.Msg
Case %WM_InitDialog
CreateToolTipControl hPPDialog 'create handle hPPToolTip
CreateToolTips
Case %WM_Size
'ScrollBarDisplay
ResizeControls
PrintToVisibleGraphic
Case %WM_HScroll : ScrollBarRespond %SB_Horz, Cb.WParam 'respond to horizontal scroll
Case %WM_VScroll : ScrollBarRespond %SB_Vert, Cb.WParam 'respond to vertical scroll
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_PrinterSelect : XPrint Attach Choose : If Len(XPrint$) > 0 Then PrintRefresh
Case %IDC_PrintPageSetup : PrintPageSetup
Case %IDC_PrintPageLabel : PrintProperties
Case %IDC_PrintAll : SendToPrinter(0) : Dialog End hPPDialog
Case %IDC_PrintPage : SendToPrinter(1) : Dialog End hPPDialog
Case %IDC_PrintRange : SendToPrinter(2) : Dialog End hPPDialog
Case %IDC_PrintClose : Dialog End hPPDialog
Case %IDC_PrintLeft
Decr PPCurrentPage
If PPCurrentPage < 1 Then PPCurrentPage = 1
PrintToHiddenGraphic : PrintToVisibleGraphic
Case %IDC_PrintRight
Incr PPCurrentPage
If PPCurrentPage > PPMaxPages Then PPCurrentPage = PPMaxPages
PrintToHiddenGraphic : PrintToVisibleGraphic
Case %IDC_PrintZoom
If Cb.CtlMsg = %LBN_SelChange Then
ComboBox Get Select hPPDialog, %IDC_PrintZoom To PPZoom '0-whole 1-pagewidth 2-.25 3-.50 4-.75 5-1.0 6-2.0 7-4.0
ResizeControls
PrintToVisibleGraphic
End If
Case %IDC_PrintShowMargins
PPShowMargins = PPShowMargins Xor 1
PrintToHiddenGraphic : PrintToVisibleGraphic
Case %IDC_PrintOrientation
PPOrientation = PPOrientation Xor 1
PrintRefresh
Case %IDC_PrintHeader
PrintRefresh 'overkill. resizecontrols, CreateHiddenGraphicControl are not necessary
Case %IDC_PrintFooter
PrintRefresh 'overkill. resizecontrols, CreateHiddenGraphicControl are not necessary
End Select
End Select
End Function
CallBack Function ViewPortProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
ScrollBarInitialize
' ShowScrollBar hPPViewPort, %SB_Both, PPScrollBarsVisible
Case %WM_HScroll : ScrollBarRespond %SB_Horz, Cb.WParam 'respond to horizontal scroll
Case %WM_VScroll : ScrollBarrespond %SB_Vert, Cb.WParam 'respond to vertical scroll
End Select
End Function
Sub PrintRefresh
SetPrintPreviewProperties : ResizeControls
CreateHiddenGraphicControl : CreatePrintContent
PrintToHiddenGraphic : PrintToVisibleGraphic
End Sub
Sub ResizeControls
Local w,h As Long, sFactor As Single
Dialog Send hPPDialog, %WM_SetRedraw, 0,0 'turn off draw to prevent flickering
'resize label (line) and ViewPort dialog
Dialog Get Client hPPDialog To w,h : h = h - 60
Control Set Size hPPDialog, %IDC_PrintLineLabel, w,1
'resize hPPViewPort physical size to match hPPDialog
Dialog Set Size hPPViewPort, w,h 'physical size of hPPViewPort
'get scroll size of hPPViewPort/ size of the visible graphic (both will be the same)
Select Case PPZoom
Case 1
sFactor = Max(PPPaperX*PPScreenPPIx/w, PPPaperY*PPScreenPPIy/h)
PPSmallImageX = (PPPaperX * PPScreenPPIx) / sFactor * 0.9
PPSmallImageY = (PPPaperY * PPScreenPPIx) / sFactor * 0.9
PPScrollSizeX = w : PPScrollSizeY = h
Case 2
PPSmallImageX = w - 60
PPSmallImageY = PPSmallImageX * PPPaperY / PPPaperX
PPScrollSizeX = w
PPScrollSizeY = PPSmallImageY + 60 'w * PPPaperY / PPPaperX 'PPSmallImageY + 60
Case Else
PPSmallImageX = PPPaperX * PPScreenPPIx * Choose(PPZoom, 1, 1, 0.25, 0.5, 0.75, 1.0, 2.0, 4.0)
PPSmallImageY = PPPaperY * PPScreenPPIy * Choose(PPZoom, 1, 1, 0.25, 0.5, 0.75, 1.0, 2.0, 4.0)
PPScrollSizeX = PPSmallImageX + 60
PPScrollSizeY = PPSmallImageY + 60
If PPScrollSizeX < w Then PPScrollSizeX = w
If PPScrollSizeY < h Then PPScrollSizeY = h
End Select
PPwMax = PPScrollSizeX : PPhMax = PPScrollSizeY
ScrollBarInitialize 'set scroll area of hPPViewPort to scaled size of image
'kill/recreate visible graphic - set to size of scrollable area
Control Kill hPPViewPort, %IDC_PrintGraphicVisible 'kill visible graphic
Control Add Graphic, hPPViewPort, %IDC_PrintGraphicVisible, "", 0,0,PPScrollSizeX, PPScrollSizeY
Graphic Attach hPPViewPort, %IDC_PrintGraphicVisible
Graphic Color %Black, %rgb_LightGray : Graphic Clear
End Sub
Sub SetPrintPreviewProperties
Local tmi As TextMetric, hDC As Dword
'PPPrinterPPIx, PPPrinterPPIy
If Len(XPrint$) = 0 Then XPrint Attach Default 'a printer is needed. use the default if one not selected
XPrint Get PPI To PPPrinterPPIx,PPPrinterPPIy
'PPScreenPPIx, PPScreenPPIy
Graphic Get PPI To PPScreenPPIx,PPScreenPPIy
'PPPaperX, PPPaperY
If PPOrientation Then
PPPaperX = 8.5 : PPPaperY = 11.0 'vertical / portrait
Else
PPPaperX = 11 : PPPaperY = 8.5 'horizontal / landscape
End If
'PPDeadZone
XPrint Get Margin To PPDeadZoneLeft, PPDeadZoneTop, PPDeadZoneRight, PPDeadZoneBottom
PPDeadZoneLeft = PPDeadZoneLeft / PPPrinterPPIx
PPDeadZoneTop = PPDeadZoneTop / PPPrinterPPIy
PPDeadZoneRight = PPDeadZoneRight / PPPrinterPPIx
PPDeadZoneBottom = PPDeadZoneBottom / PPPrinterPPIy
'PPFooter/PPHeader
Control Get Check hPPDialog, %IDC_PrintHeader To PPShowHeader
If PPShowHeader Then PPHeader = 1.1 Else PPHeader = 0 'depends on custom code that prints the header
Control Get Check hPPDialog, %IDC_PrintFooter To PPShowFooter
If PPShowFooter Then PPFooter = 1.1 Else PPFooter = 0 'depends on custom code that prints the footer
'PPMaxWidth
PPMaxWidth = PPPaperX - PPDeadZoneLeft - PPDeadZoneRight - PPMarginLeft - PPMarginRight
'PPLinesPerPage
Graphic Font PPFontName, PPFontPoints, PPFontStyle
Graphic Clear
Graphic Get DC To hDC
GetTextMetrics hDC, tmi
PPLinesPerPage = (PPPaperY - PPDeadZoneTop - PPDeadZoneBottom - PPHeader - PPFooter - PPMarginTop - PPMarginBottom) * PPScreenPPIy / (tmi.tmExternalLeading + tmi.tmHeight)
End Sub
Sub CreateHiddenGraphicControl
Control Kill hPPDialog, %IDC_PrintGraphicHidden
Control Add Graphic, hPPDialog, %IDC_PrintGraphicHidden, "", 500,0,PPPaperX*PPScreenPPIx,PPPaperY*PPScreenPPIy, %WS_Border
Control Show State hPPDialog, %IDC_PrintGraphicHidden, %SW_Hide
End Sub
Sub CreatePrintContent
'this routine would be custom for every application
Local w,h As Long
Graphic Attach hPPDialog, %IDC_PrintGraphicHidden
Graphic Font PPFontName, PPFontPoints, PPFontStyle
Graphic Clear
'put text into array for printing
Control Get Size hPPDialog, %IDC_PrintGraphicHidden To w,h
If PPWordWrap Then PPText = WordWrap(PPText, %True)
ReDim PPPrintArray(ParseCount(PPText, $CrLf)-1)
Parse PPText, PPPrintArray(), $CrLf
PPMaxPages = (UBound(PPPrintArray)\PPLinesPerPage)
If UBound(PPPrintArray) Mod PPLinesPerPage Then PPMaxPages = PPMaxPages + 1
End Sub
Function WordWrap (temp As String, Flag As Long) As String
'this routine would be custom for every application
Local i As Long
'wordwrap each line individually
If Flag Then
'get array of lines of text ($crlf is line separator)
ReDim PPPrintArray(ParseCount(temp, $CrLf)-1) As String
Parse temp, PPPrintArray(), $CrLf
For i = 0 To UBound(PPPrintArray)
PPPrintArray(i) = SingleLineWordWrap (PPPrintArray(i))
Next i
Function = Join$(PPPrintArray(), $CrLf)
Else
Replace $CrLf With " " In Temp
Function = SingleLineWordWrap (temp)
End If
End Function
Function SingleLineWordWrap(temp As String) As String 'WL=WordList() mw=MaxWidth (pixel)
Local i As Long, CL, Rtn As String, w,h As Single
Dim WL(ParseCount(temp," ")-1) As String
Parse temp, WL(), " "
For i = 0 To UBound(WL)
Graphic Text Size (CL + " " + WL(i)) To w,h 'returns pixels
w = w / PPScreenPPIx 'convert to inches
If w >= PPMaxWidth Or i=UBound(WL) Then
Rtn = Rtn+IIf$(Len(Rtn),$CrLf,"")+ CL + IIf$(i=UBound(WL), IIf$(w<PPMaxWidth," ",$CrLf)+WL(i),"")
CL = WL(i)
Else
CL = CL + IIf$(i=0,""," ") + WL(i)
End If
Next i
Function = Rtn
End Function
Sub PrintToHiddenGraphic
'confirm current page exists
If PPCurrentPage > PPMaxPages Then PPCurrentPage = 1
'display page number being printed
Control Set Text hPPDialog, %IDC_PrintPageLabel, Str$(PPCurrentPage)
'select the hidden graphic control
Graphic Attach hPPDialog, %IDC_PrintGraphicHidden
Graphic Font PPFontName, PPFontPoints, PPFontStyle
Graphic Color %Black, %White
Graphic Clear
If PPShowHeader Then PrintHeader 'print header
PrintText 'print text
If PPShowFooter Then PrintFooter 'print footer
If PPShowMargins Then PrintMarginOutline 'print outline
End Sub
Sub PrintText
'print only the lines for the specified page
Local FirstLine, LastLine, i, j As Long
Graphic Set Pos (0,PPScreenPPIx * (PPDeadZoneTop + PPMarginTop + PPHeader))
FirstLine = (PPCurrentPage-1)*PPLinesPerPage 'zero based array
LastLine = PPCurrentPage * PPLinesPerPage - 1 'zero based array
If LastLine > UBound(PPPrintArray) Then LastLine = UBound(PPPrintArray)
j = PPScreenPPIx*(PPDeadZoneLeft + PPMarginLeft)
For i = FirstLine To LastLine
Graphic Set Pos Step (j,0)
Graphic Print PPPrintArray(i)
Next i
End Sub
Sub PrintMarginOutline
Local x,y As Long
x = PPPaperX * PPScreenPPIx
y = (PPDeadZoneTop + PPHeader + PPMarginTop)* PPScreenPPIy
Graphic Style 4
Graphic Line (0,y)-(x,y) 'top margin left-right line
y = (PPPaperY - PPDeadZoneBottom - PPFooter - PPMarginBottom)* PPScreenPPIx
Graphic Line (0,y)-(x,y) 'bottom margin, left-right line
y = (PPDeadZoneTop + PPHeader)* PPScreenPPIy
Graphic Line (0,y)-(x,y) 'header, left-right line
y = (PPPaperY - PPDeadZoneBottom - PPFooter)* PPScreenPPIx
Graphic Line (0,y)-(x,y) 'footer, left-right line
y = (PPPaperY - PPDeadZoneBottom)* PPScreenPPIx
Graphic Line (0,y)-(x,y) 'bottom deadzone, left-right line
y = (PPDeadZoneTop)* PPScreenPPIy
Graphic Line (0,y)-(x,y) 'top deadzone, left-right line
x = (PPDeadZoneLeft + PPMarginLeft) * PPScreenPPIx
y = PPPaperY * PPScreenPPIy
Graphic Line (x,0)-(x,y) 'left margin, top-bottom line
x = (PPPaperX - PPDeadZoneRight - PPMarginRight) * PPScreenPPIx
Graphic Line (x,0)-(x,y) 'right margin, top-bottom line
x = (PPPaperX - PPDeadZoneRight) * PPScreenPPIx
Graphic Line (x,0)-(x,y) 'right deadzone, top-bottom line
x = (PPDeadZoneLeft) * PPScreenPPIx
Graphic Line (x,0)-(x,y) 'left deadzone, top-bottom line
End Sub
Sub PrintHeader
'print header, if desired. can be more complicated than this, hence the SUB
'must be outside the PPDeadZoneY area at bottom of page
Local w,h,i,j As Long
Graphic Attach hPPDialog, %IDC_PrintGraphicHidden
Graphic Font PPFontName, PPFontPoints, PPFontStyle
Control Get Size hPPDialog, %IDC_PrintGraphicHidden To w,h
Graphic Render PPImage, ((w-100)/2,PPDeadZoneTop*PPScreenPPIy)-((w-100)/2+99,PPDeadZoneTop*PPScreenPPIy+99) 'PPImage is 100x100
Graphic Text Size "Page" + Str$(PPCurrentPage) + " of " + Str$(PPMaxPages) To i,j
Graphic Set Pos (w-(PPDeadZoneRight+PPMarginRight)*PPScreenPPIx -i-5,PPDeadZoneTop*PPScreenPPIy+5)
Graphic Print "Page" + Str$(PPCurrentPage) + " of " + Str$(PPMaxPages)
End Sub
Sub PrintFooter
'print footer, if desired. can be more complicated than this, hence the SUB
'must be outside the PPDeadZoneY area at top of page
Local w,h,i,j As Long
Graphic Attach hPPDialog, %IDC_PrintGraphicHidden
Graphic Font PPFontName, PPFontPoints, PPFontStyle
Control Get Size hPPDialog, %IDC_PrintGraphicHidden To w,h
Graphic Render PPImage, ((w-100)/2,h-(PPDeadZoneBottom+PPFooter)*PPScreenPPIy)-((w-100)/2+99,h-(PPDeadZoneBottom+PPFooter)*PPScreenPPIy+99) 'image is 100x100
Graphic Set Pos ((PPDeadZoneLeft+PPMarginLeft)*PPScreenPPIx,h-PPDeadZoneBottom*PPScreenPPIy-30)
Graphic Print PPFooterText
Graphic Text Size Date$ + " " + Time$ To i,j
Graphic Set Pos (w-(PPDeadZoneRight+PPMarginRight)*PPScreenPPIx - i,h-PPDeadZoneBottom*PPScreenPPIy-30)
Graphic Print Date$ + " " + Time$
End Sub
Sub PrintToVisibleGraphic
Local whidden,hhidden,w,h As Long
Local x,y,wNew,hNew As Single
Dialog Send hPPDialog, %WM_SetRedraw, 0,0 'turn off draw to prevent flickering
Graphic Attach hPPViewPort, %IDC_PrintGraphicVisible
Graphic Color %Black, %rgb_LightGray : Graphic Clear
'get the size/location to which the image will be sized
Select Case PPZoom
Case 1 'display whole page sized to fit within the dialog
ShowScrollBar hPPViewPort, %SB_Both, 0 'both not visible
Control Get Client hPPViewPort, %IDC_PrintGraphicVisible To w,h
wNew = PPSmallImageX : hNew = PPSmallImageY
x = (w-wNew)/2 : y = (h-hNew)/2
Case 2 'display page size to fit width of dialog
ShowScrollBar hPPViewPort, %SB_Vert, 1 'vertical visible
wNew = PPSmallImageX : hNew = PPSmallImageY
x = 20 : y = 20
Case Else 'display page at UL postion of 20,20 '3-.25 4-.50 5-.75 6-1.0 7-2.0 8-4.0
ShowScrollBar hPPViewPort, %SB_Both, 1 'both visible
wNew = PPSmallImageX : hNew = PPSmallImageY
x = (PPScrollSizeX - PPSmallImageX) / 2
y = (PPScrollSizeY - PPSmallImageY) / 2
If (2*x + wNew) < w Then x = (w-wNew)/2
If (2*y + hNew) < h Then y = (h-hNew)/2
End Select
'draw shadow boxes
Graphic Box (x+10,y+10)-(x+wNew+10,y+hNew+10), 0, %rgb_DimGray, %rgb_DimGray, 0
Graphic Box (x-1,y-1)-(x+wNew,y+hNew), 0, %Black, %White, 0
'draw content directly from hidden graphic control
Control Get Size hPPDialog, %IDC_PrintGraphicHidden To whidden,hhidden
Graphic Stretch hPPDialog, %IDC_PrintGraphicHidden, (0,0)-(whidden-1,hhidden-1) To (x,y)-(x+wNew-1,y+hNew-1)
'put the page number on the dialog
Dialog Set Text hPPDialog, "Print Preview" + Space$(10) + Str$(PPcurrentPage) + " of " + Str$(PPMaxPages) + " Page(s)"
Dialog Send hPPDialog, %WM_SetRedraw, 1,0
Dialog ReDraw hPPDialog
Graphic ReDraw
End Sub
Sub SendToPrinter(Flag As Long)
'0=all 1=current 2=range
Local x,y,w, h, MinPage, MaxPage As Long
Local temp As String
Local RatioX, RatioY As Single
XPrint Set Font hPPFont
PPShowMargins = 0
Control Get Size hPPDialog, %IDC_PrintGraphicHidden To w,h
x = PPDeadZoneLeft * PPScreenPPIx
y = PPDeadZoneTop * PPScreenPPIy
w = w - (PPDeadZoneLeft + PPDeadZoneRight) * PPScreenPPIx
h = h - (PPDeadZoneTop + PPDeadZoneBottom) * PPScreenPPIy
Graphic Attach hPPDialog, %IDC_PrintGraphicHidden
If Len(XPrint$) = 0 Then XPrint Attach Default
If PPOrientation Then XPrint Set Orientation 1 Else XPrint Set Orientation 2
RatioX = PPPrinterPPIx / PPScreenPPIx
RatioY = PPPrinterPPIy / PPScreenPPIy
Select Case Flag
Case 0 'all pages
For PPCurrentPage = 1 To PPMaxPages
PrintToHiddenGraphic
XPrint Stretch hPPDialog, %IDC_PrintGraphicHidden, (x,y)-(w-1,h-1) To _
(RatioX*x,RatioY*y)-(RatioX*w - 1,RatioY*h - 1)
XPrint FormFeed
Next PPCurrentPage
Case 1 'current page only
PrintToHiddenGraphic
XPrint Stretch hPPDialog, %IDC_PrintGraphicHidden, (x,y)-(w-1,h-1) To _
(RatioX*x,RatioY*y)-(RatioX*w - 1,RatioY*h - 1)
XPrint FormFeed
Case 2 'range
Control Get Text hPPDialog, %IDC_PrintMinPage To temp : MinPage = Val(temp)
Control Get Text hPPDialog, %IDC_PrintMaxPage To temp : MaxPage = Val(temp)
If MinPage < 1 Then MinPage = 1
If MinPage > PPMaxPages Then MinPage = PPMaxPages
If MaxPage < MinPage Then MaxPage = MinPage
If MaxPage > PPMaxPages Then MaxPage = PPMaxPages
For PPCurrentPage = MinPage To MaxPage
PrintToHiddenGraphic
XPrint Stretch hPPDialog, %IDC_PrintGraphicHidden, (x,y)-(w-1,h-1) To _
(RatioX*x,RatioY*y)-(RatioX*w - 1,RatioY*h - 1)
XPrint FormFeed
Next PPCurrentPage
End Select
XPrint Close 'print paper
End Sub
Sub PrintProperties
'popup MsgBox with current Print Preview parameters
Local temp, fmt As String
fmt = "0.00"
temp = "PPPaperX " + Str$(PPPaperX)
temp = temp + $CrLf + "PPPaperY " + Format$(PPPaperY,fmt$)
temp = temp + $CrLf
temp = temp + $CrLf + "PPMarginLeft " + Format$(PPMarginLeft)
temp = temp + $CrLf + "PPMarginRight " + Format$(PPMarginRight)
temp = temp + $CrLf + "PPMarginTop " + Format$(PPMarginTop)
temp = temp + $CrLf + "PPMarginBottom " + Format$(PPMarginBottom)
temp = temp + $CrLf
temp = temp + $CrLf + "PPDeadZoneLeft " + Format$(PPDeadZoneLeft,fmt$)
temp = temp + $CrLf + "PPDeadZoneTop " + Format$(PPDeadZoneTop,fmt$)
temp = temp + $CrLf + "PPDeadZoneRight " + Format$(PPDeadZoneRight,fmt$)
temp = temp + $CrLf + "PPDeadZoneBottom " + Format$(PPDeadZoneBottom,fmt$)
temp = temp + $CrLf
temp = temp + $CrLf + "PPFooter " + Format$(PPFooter,fmt$)
temp = temp + $CrLf + "PPHeader " + Format$(PPHeader,fmt$)
temp = temp + $CrLf
temp = temp + $CrLf + "PPScreenPPIx " + Str$(PPScreenPPIx)
temp = temp + $CrLf + "PPScreenPPIy " + Str$(PPScreenPPIy)
temp = temp + $CrLf + "PPPrinterPPIx " + Str$(PPPrinterPPIx)
temp = temp + $CrLf + "PPPrinterPPIy " + Str$(PPPrinterPPIy)
temp = temp + $CrLf
temp = temp + $CrLf + "PPMaxPages " + Str$(PPMaxPages)
temp = temp + $CrLf + "PPCurrentPage " + Str$(PPCurrentPage)
temp = temp + $CrLf + "PPOrientation " + Str$(PPOrientation)
temp = temp + $CrLf + "PPLinesPerPage " + Str$(PPLinesPerPage)
temp = temp + $CrLf + "PPMaxWidth " + Format$(PPMaxWidth,fmt$)
temp = temp + $CrLf
temp = temp + $CrLf + "PPSmallImageX" + Str$(PPSmallImageX)
temp = temp + $CrLf + "PPSmallImageY" + Str$(PPSmallImageY)
temp = temp + $CrLf + "PPScrollSizeX" + Str$(PPScrollSizeX)
temp = temp + $CrLf + "PPScrollSizeY" + Str$(PPScrollSizeY)
MsgBox temp, %MB_Ok, "Print Preview Properties"
End Sub
Sub PrintPageSetup
Local Style As Long
Dialog New Pixels, hPPDialog, "Page Setup",100,100,300,165, %WS_OverlappedWindow To hPPPageSetupDlg
Dialog Set Icon hPPPageSetupDlg, "props"
Style = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll _
Or %ES_AutoVScroll Or %ES_WantReturn Or %WS_TabStop Or %WS_Border
Control Add Label, hPPPageSetupDlg, 200, "Orientation", 10, 10, 60, 20
Control Add Label, hPPPageSetupDlg, 201, "Margins", 175, 10, 60, 20
Control Add TextBox, hPPPageSetupDlg, 202, Str$(PPMarginTop), 180, 48, 40, 20, %ES_Center Or %WS_TabStop Or %WS_Border, %WS_Ex_ClientEdge
Control Add TextBox, hPPPageSetupDlg, 203, Str$(PPMarginLeft), 145, 68, 40, 20, %ES_Center Or %WS_TabStop Or %WS_Border, %WS_Ex_ClientEdge
Control Add TextBox, hPPPageSetupDlg, 204, Str$(PPMarginRight), 215, 68, 40, 20, %ES_Center Or %WS_TabStop Or %WS_Border, %WS_Ex_ClientEdge
Control Add TextBox, hPPPageSetupDlg, 205, Str$(PPMarginBottom), 180, 90, 40, 20, %ES_Center Or %WS_TabStop Or %WS_Border, %WS_Ex_ClientEdge
Control Add Label, hPPPageSetupDlg, 206, "Top", 188, 30, 40, 20
Control Add Label, hPPPageSetupDlg, 207, "Left", 120, 70, 25, 20
Control Add Label, hPPPageSetupDlg, 208, "Right", 260, 70, 40, 20
Control Add Label, hPPPageSetupDlg, 209, "Bottom", 183, 110, 40, 20
Control Add Button, hPPPageSetupDlg, 210,"Ok", 90,135,60,20
Control Add Button, hPPPageSetupDlg, 211,"Apply", 160,135,60,20
Control Add Button, hPPPageSetupDlg, 212,"Cancel", 230,135,60,20
Control Add Option, hPPPageSetupDlg, 213, "Portrait", 15, 30, 60,20
Control Add Option, hPPPageSetupDlg, 214, "Landscape", 15, 50, 75, 20
Dialog Show Modal hPPPageSetupDlg Call SetupDlgProc
End Sub
CallBack Function SetupDlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
Control Set Text hPPPageSetupDlg, 202, Trim$(Str$(PPMarginTop))
Control Set Text hPPPageSetupDlg, 203, Trim$(Str$(PPMarginLeft))
Control Set Text hPPPageSetupDlg, 204, Trim$(Str$(PPMarginRight))
Control Set Text hPPPageSetupDlg, 205, Trim$(Str$(PPMarginBottom))
If PPOrientation Then Control Set Check hPPPageSetupDlg, 213, 1
If IsFalse(PPOrientation) Then Control Set Check hPPPageSetupDlg, 214, 1
Case %WM_Command
Select Case Cb.Ctl
Case 210 : PrintSaveSetup : PrintRefresh : Dialog End hPPPageSetupDlg
Case 211 : PrintSaveSetup : PrintRefresh
Case 212 : Dialog End hPPPageSetupDlg
End Select
Case %WM_Destroy
End Select
End Function
Sub PrintSaveSetup
Local temp As String
Control Get Check hPPPageSetupDlg, 213 To PPOrientation
Control Get Text hPPPageSetupDlg, 202 To temp : PPMarginTop = Val(temp)
Control Get Text hPPPageSetupDlg, 203 To temp : PPMarginLeft = Val(temp)
Control Get Text hPPPageSetupDlg, 204 To temp : PPMarginRight = Val(temp)
Control Get Text hPPPageSetupDlg, 205 To temp : PPMarginBottom = Val(temp)
End Sub
Sub CreateToolTipControl (hWnd As Dword)
hPPToolTip = CreateWindowEx(ByVal 0, "tooltips_class32", "", %TTS_ALWAYSTIP, _
0, 0, 0, 0, ByVal hWnd, ByVal 0, GetModuleHandle(ByVal %NULL), ByVal 0)
' Dialog Send hPPToolTip, %TTM_SETMAXTIPWIDTH, 0, 200 '200 seems appropriate
' Dialog Send hPPToolTip, %TTM_SETDELAYTIME, %TTDT_AUTOPOP, 3000 '3000 = 3 seconds
End Sub
Sub CreateToolTips
SetToolTipText %IDC_PrinterSelect, "Select Printer"
SetToolTipText %IDC_PrintPageSetup, "Page Setup"
SetToolTipText %IDC_PrintLeft, "Display Previous Page"
SetToolTipText %IDC_PrintRight, "Display Next Page"
SetToolTipText %IDC_PrintAll, "Print All Pages"
SetToolTipText %IDC_PrintPage, "Print Current Page"
SetToolTipText %IDC_PrintRange, "Print Page Range"
SetToolTipText %IDC_PrintOrientation, "Change Orientation"
SetToolTipText %IDC_PrintShowMargins, "Show Margins"
SetToolTipText %IDC_PrintClose, "Close Without Applying"
End Sub
Sub SetToolTipText(Id As Long, ByVal Txt As String)
Local hLocalDlg As Dword
Local ti As TOOLINFO
Local aToolTipText As AsciiZ * 256
aToolTipText = Txt
hLocalDlg = GetParent(hPPToolTip)
ti.cbSize = SizeOf(ti)
ti.uFlags = %TTF_SUBCLASS Or %TTF_IDISHWND
ti.hWnd = hLocalDlg
ti.uId = GetDlgItem(hLocalDlg, Id)
ti.lpszText = VarPtr(aToolTipText)
SendMessage hPPToolTip, %TTM_ADDTOOL, 0, VarPtr(ti)
End Sub
Sub ScrollBarInitialize
Local si As ScrollInfo, wClient,hClient As Long
Dialog Get Client hPPViewPort To wClient, hClient 'w/o scrollbars (called from WM_InitDialog)
wClient -= GetSystemMetrics(%SM_CXVSCROLL) 'less vertical scrollbar
hClient -= GetSystemMetrics(%SM_CXHSCROLL) 'less horizontal scrollbar
si.cbSize=Len(si) : si.fMask=%SIF_All 'preset values before using SetScrollInfo
si.nMax=PPhMax : si.nPage=hClient : SetScrollInfo hPPViewPort, %SB_Vert, si, 1 'set Vert scrollbar properties
si.nMax=PPwMax : si.nPage=wClient : SetScrollInfo hPPViewPort, %SB_Horz, si, 1 'set Horz scrollbar properties
End Sub
Sub ScrollBarRespond(HorzVert As Long, wParam As Long)
Local si As ScrollInfo, oldPos As Long
si.cbSize=SizeOf(si) : si.fMask=%SIF_All
GetScrollInfo hPPViewPort, HorzVert, si
oldPos=si.nPos
Select Case Lo(Word, wParam)
Case %SB_LineLeft, %SB_LineUp : si.nPos -= IIf(HorzVert,PPhs,PPvs)
Case %SB_PageLeft, %SB_PageUp : si.nPos -= si.nPage
Case %SB_LineRight, %SB_LineDown : si.nPos += IIf(HorzVert,PPhs,PPvs)
Case %SB_PageRight, %SB_PageDown : si.nPos += si.nPage
Case %SB_ThumbTrack : si.nPos=Hi(Word, wParam)
Case Else : Exit Sub
End Select
si.nPos=Max&(si.nMin, Min&(si.nPos, si.nMax-si.nPage))
SetScrollInfo hPPViewPort,HorzVert,si,1
If HorzVert = %SB_Horz Then ScrollWindow hPPViewPort, oldPos-si.nPos,0 , ByVal %NULL, ByVal %NULL
If HorzVert = %SB_Vert Then ScrollWindow hPPViewPort, 0, oldPos-si.nPos, ByVal %NULL, ByVal %NULL
End Sub
'gbs_01187
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm