/ Snippet Library - View Code

Visual Basic / Printing / Get DeviceCaps

Snippet details

ID: 422

Viewed: 1394

Added: 2002-08-19

Version:

Snippets in this catagory
Show Printable Version

Get device caps to determine margines

1.Start a new project in Visual Basic. Form1 is created by default.

2.Add two CommandButtons to the Form and paste the following code into the Form's module:

3.Run the project.

4.Click Command1. You will see a message box listing the margins and printable area of the page.

5.Click Command2. Several pages are printed. The printing includes:

Report Header - Only printed at the top of page 1.

Page Header - Consists of some text printed in italics and the current date right-justified on the page. Printed on all pages.

Page Footer - Consists of some text and a page number printed on multiple lines. Printed on all pages.

Additionally, lines numbered 10 through 14 are indented an additional 2 inches and lines numbered 48 through 56 demonstrate enforcing a custom right margin.

General Details

Snippet uploaded by: snippet

Email : webmaster@snippetlibrary.com

Snippet By: Unknown

Snippet By:	Unknown
Declarations
Highlight AllOption Explicit Private Declare Function GetDeviceCaps Lib "gdi32" _ (ByVal hdc As Long, ByVal nIndex As Long) As Long ' Constants for nIndex argument of GetDeviceCaps Private Const HORZRES = 8 Private Const VERTRES = 10 Private Const LOGPIXELSX = 88 Private Const LOGPIXELSY = 90 Private Const PHYSICALWIDTH = 110 Private Const PHYSICALHEIGHT = 111 Private Const PHYSICALOFFSETX = 112 Private Const PHYSICALOFFSETY = 113
Code
Highlight AllPrivate Sub PrintHeader(PrintTitle As Boolean, Margins As Long, _ LMargin As Long) Dim BodyFontBold As Boolean, BodyFontSize As Integer Dim BodyFontItalic As Boolean, HeaderLine As String Dim PrtPositionX As Integer, PrtPositionY As Integer If PrintTitle Then ' Only Print Title on first Page PrtPositionX = Printer.Width / 2 ' center of page ' Save any attributes you change for the header... BodyFontBold = Printer.Font.Bold BodyFontSize = Printer.Font.Size ' Change the font for the header... Printer.Font.Size = 16 Printer.Font.Bold = True ' Print header lines... HeaderLine = "Title of This Test Report" ' Center Report title Printer.CurrentX = PrtPositionX - (LMargin + _ Printer.TextWidth(HeaderLine) / 2) Printer.Print HeaderLine ' Reset the font... Printer.Font.Size = BodyFontSize Printer.Font.Bold = BodyFontBold Else Printer.NewPage ' Otherwise we are at the bottom of a page End If PrtPositionY = Printer.CurrentY ' remember this line BodyFontItalic = Printer.Font.Italic Printer.Font.Italic = True Printer.Print "My very nice, Visual Basic report" Printer.Font.Italic = BodyFontItalic HeaderLine = Format(Date, "Long Date") ' Right justify today's date Printer.CurrentX = Printer.Width - (Margins + _ Printer.TextWidth(HeaderLine)) Printer.CurrentY = PrtPositionY ' return to previous line Printer.Print HeaderLine End Sub Private Sub PrintFooter(LastLine As Integer, _ LineHeight As Integer, LMargin As Long) Dim PrtPositionX As Integer, PrintText As String Static PageNum As Integer PageNum = PageNum + 1 PrtPositionX = Printer.Width / 2 ' center of page ' Move to the end of the page to print the Page Footer: ' LastLine is where there is only room for one more line. ' Set CurrentY to LastLine minus LineHeight times the number of ' additional lines in the Footer. Printer.CurrentY = LastLine - LineHeight ' for 2 footer lines PrintText = "Sample Page Footer" ' Print the Footer text centered Printer.CurrentX = PrtPositionX - (LMargin + _ Printer.TextWidth(PrintText) / 2) Printer.Print PrintText PrintText = "This is Page " & CStr(PageNum) & " of Test Report" Printer.CurrentX = PrtPositionX - (LMargin + _ Printer.TextWidth(PrintText) / 2) Printer.Print PrintText End Sub Private Function GetLargeString() As String Dim BaseString As String, I As Integer BaseString = "This is just a fairly long string to demonstrate how " BaseString = BaseString & "to wrap text to impose your own right " BaseString = BaseString & "margin. " For I = 1 To 3 BaseString = BaseString & BaseString Next I GetLargeString = BaseString End Function Private Sub Command1_Click() Dim dpiX As Long, dpiY As Long Dim MarginLeft As Long, MarginRight As Long Dim MarginTop As Long, MarginBottom As Long Dim PrintAreaHorz As Long, PrintAreaVert As Long Dim PhysHeight As Long, PhysWidth As Long Dim Info As String dpiX = GetDeviceCaps(Printer.hdc, LOGPIXELSX) Info = "Pixels X: " & dpiX & " dpi" dpiY = GetDeviceCaps(Printer.hdc, LOGPIXELSY) Info = Info & vbCrLf & "Pixels Y: " & dpiY & " dpi" MarginLeft = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) Info = Info & vbCrLf & "Unprintable space on left: " & _ MarginLeft & " pixels = " & MarginLeft / dpiX & " inches" MarginTop = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) Info = Info & vbCrLf & "Unprintable space on top: " & _ MarginTop & " pixels = " & MarginTop / dpiY & " inches" PrintAreaHorz = GetDeviceCaps(Printer.hdc, HORZRES) Info = Info & vbCrLf & "Printable space (Horizontal): " & _ PrintAreaHorz & " pixels = " & PrintAreaHorz / dpiX & " inches" PrintAreaVert = GetDeviceCaps(Printer.hdc, VERTRES) Info = Info & vbCrLf & "Printable space (Vertical): " & _ PrintAreaVert & " pixels = " & PrintAreaVert / dpiY & " inches" PhysWidth = GetDeviceCaps(Printer.hdc, PHYSICALWIDTH) Info = Info & vbCrLf & "Total space (Horizontal): " & _ PhysWidth & " pixels = " & PhysWidth / dpiX & " inches" MarginRight = PhysWidth - PrintAreaHorz - MarginLeft Info = Info & vbCrLf & "Unprintable space on right: " & _ MarginRight & " pixels = " & MarginRight / dpiX & " inches" PhysHeight = GetDeviceCaps(Printer.hdc, PHYSICALHEIGHT) Info = Info & vbCrLf & "Total space (Vertical): " & _ PhysHeight & " pixels = " & PhysHeight / dpiY & " inches" MarginBottom = PhysHeight - PrintAreaVert - MarginTop Info = Info & vbCrLf & "Unprintable space on bottom: " & _ MarginBottom & " pixels = " & MarginBottom / dpiY & " inches" MsgBox Info, , "GetDeviceCaps Returned the Following:" End Sub Private Sub Command2_Click() Dim FooterLines As Integer, TextLine As String Dim LineHeight As Integer, LastLine As Integer Dim TotWidth As Long, TotHeight As Long Dim MarginTop As Long, MarginBottom As Long Dim TotalPrtAreaVert As Long, TotalPrtAreaHorz As Long Dim MarginLeft As Long, MarginRight As Long Dim LeftMargin As Long, HorzMargins As Long Dim Line As Integer, RptHeaderPrint As Boolean Dim BreakPoint As Integer, PrintLength As Integer Dim TempString As String, CharLength As Integer Dim WrapPoint As Integer, EstWrapPoint As Integer Printer.Font.Name = "Arial" Printer.Font.Size = 12 ' The next 8 values are in Pixels. ' TotalPrtAreaVert is eqivalent to Printer.ScaleHeight TotalPrtAreaVert = GetDeviceCaps(Printer.hdc, VERTRES) TotHeight = GetDeviceCaps(Printer.hdc, PHYSICALHEIGHT) MarginTop = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY) MarginBottom = TotHeight - TotalPrtAreaVert - MarginTop ' TotalPrtAreaHorz is eqivalent to Printer.ScaleWidth TotalPrtAreaHorz = GetDeviceCaps(Printer.hdc, HORZRES) TotWidth = GetDeviceCaps(Printer.hdc, PHYSICALWIDTH) MarginLeft = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX) MarginRight = TotWidth - TotalPrtAreaHorz - MarginLeft HorzMargins = (MarginRight + MarginLeft) * Printer.TwipsPerPixelX LeftMargin = MarginLeft * Printer.TwipsPerPixelX ' Covert to twips for ease of use TotalPrtAreaHorz = TotalPrtAreaHorz * Printer.TwipsPerPixelX LineHeight = Printer.TextHeight("Test") FooterLines = 2 ' number of lines in footer LastLine = TotalPrtAreaVert * Printer.TwipsPerPixelY - LineHeight ' Set the break point a line high so we can check it after printing BreakPoint = LastLine - LineHeight * FooterLines ' reduce the right margin by 1 inch, which is 1440 twips PrintLength = TotalPrtAreaHorz - 1440 PrintHeader True, HorzMargins, LeftMargin ' Report Header RptHeaderPrint = False ' Print the Footer when the current Y position >= ' LastLine - LineHeight * <Number Of Lines In Footer> For Line = 1 To 120 If RptHeaderPrint Then PrintHeader False, HorzMargins, LeftMargin ' Page Header RptHeaderPrint = False End If TextLine = "This is line " & Line ' To indent or set a new left margin, reset CurrentX before each ' new line. ' To use a new right margin, wrap lines at appropriate points. If Line >= 10 And Line <= 14 Then TextLine = TextLine & " indented." Printer.CurrentX = 2 * 1440 ' indent 2 additional inches ElseIf Line >= 48 And Line <= 52 Then TextLine = GetLargeString() ' Need String long for demo End If ' Use TotalPrtAreaHorz to use the default right margin ' or use your own value for PrintLength for a custom right margin ' in this example we bring in the right margin by 1 inch If Printer.TextWidth(TextLine) > PrintLength Then ' Wrap text ' This estimating technique is used for simplicity ' First, approximate character length CharLength = Printer.TextWidth("aeiou.") / 6 ' Where to start looking for a line break (wrap) EstWrapPoint = PrintLength / CharLength WrapPoint = EstWrapPoint Line = Line - 1 ' Since current line has already been counted Do While Len(TextLine) > EstWrapPoint TextLine = Trim(TextLine) ' remove spaces from either end ' break on a space near the estimated break point Do While InStr(WrapPoint, TextLine, " ") <> WrapPoint WrapPoint = WrapPoint - 1 Loop TempString = Mid(TextLine, 1, WrapPoint) ' what will fit Printer.Print Trim(TempString) ' print what will fit TextLine = Mid(TextLine, WrapPoint + 1) ' get remaining text WrapPoint = EstWrapPoint ' Reset the estimated wrap point Line = Line + 1 ' Increment line counter If Printer.CurrentY >= BreakPoint Then ' another line? PrintFooter LastLine, LineHeight, LeftMargin If Len(TextLine) > 0 Then ' Print header if text remains PrintHeader False, HorzMargins, LeftMargin End If End If Loop If Len(TextLine) > 0 Then ' leftover text? Printer.Print TextLine Line = Line + 1 ' Increment line counter If Printer.CurrentY >= BreakPoint Then ' another line? PrintFooter LastLine, LineHeight, LeftMargin RptHeaderPrint = True ' Print Header if more lines End If End If Else Printer.Print TextLine If Printer.CurrentY >= BreakPoint Then PrintFooter LastLine, LineHeight, LeftMargin RptHeaderPrint = True ' Print Header if more lines End If End If Next Line If Printer.CurrentY > 0 Then PrintFooter LastLine, LineHeight, LeftMargin ' For last page End If Printer.EndDoc ' Finish MsgBox "Check Printer for results.", , "Done!" End Sub

No Reviews to show