Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Print Form using Printer.Object
Author:
Bob Brandt
E-mail:
Click to e-mail author
Submitted:
12/23/2010
Version:
VB6
Compatibility:
VB6
Category:
Forms
Views:
13864
Print Form using Printer.Object with having to use Printer.Object. Print a form as a Page or Report etc... Prints as you see the form allows sizing to page and other features.
Declarations:
'none
Code:
Sub PrintingAnyForms() On Error Resume Next Dim Shape As Control Dim SizeControl As Double Dim StartAtTop As Integer Dim FontAdjust As Double Dim Width1 As Integer Dim Height1 As Integer Dim Top1 As Integer Dim Left1 As Integer Dim CurrentPrinterName As String Dim WhatIsControlName As String Dim ShapeTypes As String Dim IsItVisible As Boolean Dim TmpControl As Control Dim FontSizing As Double Dim TempSize As Integer Dim TempLeft As Integer Dim TempTop As Integer Dim TempWidth As Integer Dim TempHeight As Integer Dim FirstLeft As Integer Dim FirstTop As Integer Dim SecondLeft As Integer Dim SecondTop As Integer Dim CaptionOrText As String Dim DrawWidthEqual As Integer Dim Image1Left As Integer Dim Image1Top As Integer 'These Size adjustments can be changed to suit you needs FontAdjust = 0.95 SizeControl = 1.85 StartAtTop = 500 On Error GoTo NoPrinter Dim OutputObject As Object Set OutputObject = Printer 'Must use a sizeable font such as Arial OutputObject.FillColor = vbRed OutputObject.FillStyle = vbFSSolid OutputObject.FillColor = QBColor(15) OutputObject.FontName = "Arial" 'This can be modified to improve if wished! 'Just put this in any form of your program and print any other form. 'Bob Brandt Hartsburg Missouri 'Print any form by changing PrintingForm = "Name of form" Dim PrintingForm As Form Set PrintingForm = PrintResultForm For Each TmpControl In PrintingForm WhatIsControlName = TmpControl.Name IsItVisible = TmpControl.Visible FontSizing = 8.5 OutputObject.FontBold = False OutputObject.DrawWidth = 8 'This section prevent controls that are not printable from crashing the program. If TypeOf TmpControl Is Menu Then GoTo bypass End If If TypeOf TmpControl Is Timer Then GoTo bypass End If If TypeOf TmpControl Is VScrollBar Then X = X GoTo Over End If If TypeOf TmpControl Is Image Then X = X GoTo Over End If ShapeTypes = "" If TypeOf TmpControl Is Shape Then 'This enables proper Shape to be printed Select Case TmpControl Case Is = 0 ShapeTypes = "R" 'R = Rectangel" Case Is = 1 ShapeTypes = "B" 'B = Square Case Is = 2 ShapeTypes = "O" 'O = Oval Case Is = 3 ShapeTypes = "C" 'C = Circle Case Is = 4 ShapeTypes = "W" 'W = Rounded Rectangle Case Is = 5 ShapeTypes = "S" 'R = Rounded Square End Select GoTo Over End If If TypeOf TmpControl Is TextBox Then WhatIsControlName = TmpControl.Name X = X End If If TypeOf TmpControl Is Line Then WhatIsControlName = TmpControl.Name GoTo Over End If FontSizing = TmpControl.FontSize Over: 'THIS IF Statement prevent non printable objects from attempting to print If WhatIsControlName <> "WebBrowser1" And WhatIsControlName <> "MSComm1" And _ WhatIsControlName <> "Timer1" And WhatIsControlName <> "CommonDialog1" And _ InStr(1, LCase(WhatIsControlName), LCase("none")) = 0 And TypeOf TmpControl Is Shape And _ ShapeTypes = "C" Then 'PRINT for CIRCLES If TmpControl.Height > TmpControl.Width Or TmpControl.Height < TmpControl.Width Then Width1 = TmpControl.Width * SizeControl Height1 = TmpControl.Height * SizeControl Top1 = TmpControl.Top * SizeControl Left1 = TmpControl.Left * SizeControl If TmpControl.Height > TmpControl.Width Then TempSize = TmpControl.Width * SizeControl TempLeft = (Left1) - ((Width1) / 2) TempTop = (Top1) + ((Height1) / 2) + ((Width1) / 2) Else TempSize = TmpControl.Height * SizeControl TempLeft = ((Left1) + ((Width1) / 2)) '- ((height1) / 4) TempTop = (TmpControl.Top * SizeControl) + ((TmpControl.Height * SizeControl) / 2) End If Else TempSize = TmpControl.Height * SizeControl TempLeft = (TmpControl.Left * SizeControl) + ((TmpControl.Height * SizeControl) / 2) TempTop = StartAtTop + (TmpControl.Top * SizeControl) End If 'PRINT for CIRCLES OutputObject.FillStyle = vbFSTransparent OutputObject.Circle (TempLeft, (TempTop + StartAtTop) - 100), (TempSize / 2) '''(x , y) - (x , OutputObject.FillStyle = vbFSSolid End If If WhatIsControlName <> "WebBrowser1" And WhatIsControlName <> "MSComm1" And _ WhatIsControlName <> "Timer1" And WhatIsControlName <> "CommonDialog1" And _ InStr(1, LCase(WhatIsControlName), LCase("none")) = 0 And TypeOf TmpControl Is Shape And _ (ShapeTypes = "B" Or ShapeTypes = "R" Or ShapeTypes = "W" Or ShapeTypes = "S") Then 'PRINT for Square If ShapeTypes = "W" Or ShapeTypes = "S" Then If TmpControl.Width > TmpControl.Height Then TempWidth = TmpControl.Height TempHeight = TmpControl.Height TempTop = TmpControl.Top TempLeft = TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 Else TempWidth = TmpControl.Width TempHeight = TmpControl.Width TempTop = TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 TempLeft = TmpControl.Left End If Else TempWidth = TmpControl.Width TempHeight = TmpControl.Height TempTop = TmpControl.Top TempLeft = TmpControl.Left End If FirstLeft = (TempLeft * SizeControl) FirstTop = (TempTop * SizeControl) SecondLeft = ((TempLeft * SizeControl * 1) + (TempWidth * SizeControl * 1)) SecondTop = ((TempTop * SizeControl * 1) + (TempHeight * SizeControl * 1)) 'Printing Squares ' Printer.Line (320, 840)-(5200, 3840), vbBlack, B OutputObject.Line (FirstLeft, FirstTop + StartAtTop)-(SecondLeft, SecondTop + StartAtTop), , B End If If WhatIsControlName <> "WebBrowser1" And WhatIsControlName <> "MSComm1" And _ WhatIsControlName <> "Timer1" And WhatIsControlName <> "CommonDialog1" And _ InStr(1, LCase(WhatIsControlName), LCase("label")) > 0 And _ InStr(1, LCase(WhatIsControlName), LCase("line")) = 0 Then 'Print label Caption If TmpControl.Caption <> "" Then OutputObject.FontSize = FontSizing * SizeControl * FontAdjust OutputObject.CurrentX = TmpControl.Left * SizeControl 'X is across Page OutputObject.CurrentY = (TmpControl.Top * SizeControl) + StartAtTop ' Y is up/down Page If TmpControl.FontBold = True Then OutputObject.FontBold = True Else OutputObject.FontBold = False End If CaptionOrText = TmpControl.Caption OutputObject.Print TmpControl.Caption End If End If If WhatIsControlName <> "WebBrowser1" And WhatIsControlName <> "MSComm1" And _ WhatIsControlName <> "Timer1" And WhatIsControlName <> "CommonDialog1" And _ InStr(1, LCase(WhatIsControlName), LCase("text")) > 0 And _ InStr(1, LCase(WhatIsControlName), LCase("line")) = 0 Then ''Print Textbox Text OutputObject.FontSize = FontSizing * SizeControl * FontAdjust OutputObject.CurrentX = TmpControl.Left * SizeControl 'X is across Page OutputObject.CurrentY = (TmpControl.Top * SizeControl) + StartAtTop ' Y is up/down Page If TmpControl.FontBold = True Then OutputObject.FontBold = True Else OutputObject.FontBold = False End If CaptionOrText = TmpControl.Text OutputObject.Print TmpControl.Text End If If WhatIsControlName <> "WebBrowser1" And WhatIsControlName <> "MSComm1" And _ WhatIsControlName <> "Timer1" And WhatIsControlName <> "CommonDialog1" And _ InStr(1, LCase(WhatIsControlName), LCase("none")) = 0 _ And TypeOf TmpControl Is Line And TmpControl.Visible = True Then DrawWidthEqual = TmpControl.BorderWidth OutputObject.DrawWidth = (8 * DrawWidthEqual) 'Printing Lines OutputObject.Line ((TmpControl.x1 * SizeControl), _ (TmpControl.y1 * SizeControl) + StartAtTop)-((TmpControl.x2 * SizeControl), _ (TmpControl.y2 * SizeControl) + StartAtTop) '''(x , y) - (x , End If bypass: Next TmpControl OutputObject.EndDoc Exit Sub NoPrinter: MsgBox ("No Printer Found!") Ends: End Sub
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement