How to set the Global Printer object, using the Common Dialog without modifying the system default p

I am trying to set the global printer object to point to a network printer using the following code.


private Sub Form_Click()

Printer.TrackDefault = true
DefaultPrinter = Printer.DeviceName
CommonDialog1.PrinterDefault = true
CommonDialog1.Orientation = cdlLandscape
CommonDialog1.Copies = 1
CommonDialog1.CancelError = true
on error GoTo ErrHandler
CommonDialog1.Flags = cdlPDDisablePrintToFile _
Or cdlPDHidePrintToFile _
Or cdlPDNoSelection _
Or cdlPDReturnIC
Form1.CommonDialog1.ShowPrinter
MsgBox (Printer.DeviceName)

Printer.Copies = CommonDialog1.Copies

Printer.Orientation = CommonDialog1.Orientation
Printer.ScaleMode = vbTwips
Printer.print "Some Text"
Printer.EndDoc
ErrHandler:
' User pressed Cancel button.
Exit Sub
End Sub




However, this piece of code will eventually go into a control that will be accessed through a web browser environment. I can not be sure that the clients machine will alow me to change the default printer. So this not acceptable.

Does anyone have example code that sets the Printer object to that selected by the user of the CommonDialog box, but without affecting the system default settings?

Simon Pettman

The Printer support of the CommonDialog control is at the least lousy. Many problems have been documented about your problem as well as others such as the Copy counter. You either set the values system wide or can't set them at all.
Below is a routine in wide use that allows for the client to manipulate Printer settings without effecting the entire system. It is available from many sites including http://search.microsoft.com/us/SearchMS.asp in various forms
I have taken a abridged version and converted the ShowPrinter routine into a Function instead of a subroutine.
This code completely replaces the various functions of the CommonDialog control.

'
'
This code goes into a sample form that has 6 command buttons on it
'
'
private Sub Command1_Click()
Dim sFile as string
sFile = ShowOpen(me, "Text Files (*.txt)|*.txt", "My Title", "C:\Our Stuff")
If sFile <> "" then
MsgBox "You chose this file: " + sFile
else
MsgBox "You pressed cancel"
End If
End Sub
private Sub Command2_Click()
Dim sFile as string
sFile = ShowSave(me)
If sFile <> "" then
MsgBox "You chose this file: " + sFile
else
MsgBox "You pressed cancel"
End If
End Sub
private Sub Command3_Click()
Dim NewColor as Long
NewColor = ShowColor(me)
If NewColor <> -1 then
me.BackColor = NewColor
else
MsgBox "You chose cancel"
End If
End Sub
private Sub Command4_Click()
MsgBox ShowFont(me)
End Sub
private Sub Command5_Click()
lRet = ShowPrinter(me)

MsgBox " Return Code " & lRet & vbCrLf _
& " Printer " & Printer.DeviceName & vbCrLf _
& " Copies " & Printer.Copies & vbCrLf _
& " Orientation " & Printer.Orientation

End Sub
private Sub Command6_Click()
MsgBox ShowPageSetup(me)
End Sub
private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'Redim the variables to store the custom colors
ReDim CustomColors(0 to 16 * 4 - 1) as Byte
Dim i as Integer
for i = LBound(CustomColors) to UBound(CustomColors)
CustomColors(i) = 0
next i
'set the captions
Command1.Caption = "ShowOpen"
Command2.Caption = "ShowSave"
Command3.Caption = "ShowColor"
Command4.Caption = "ShowFont"
Command5.Caption = "ShowPrinter"
Command6.Caption = "ShowPageSetupDlg"
End Sub

'
'The rest of this code goes into a module
'
'
option Explicit
Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const DM_DUPLEX = &H1000&
Const DM_ORIENTATION = &H1&
Const PD_PRINTSETUP = &H40
Const PD_DISABLEPRINTTOFILE = &H80000
private Type POINTAPI
x as Long
y as Long
End Type
private Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
private Type OPENFILENAME
lStructSize as Long
hwndOwner as Long
hInstance as Long
lpstrFilter as string
lpstrCustomFilter as string
nMaxCustFilter as Long
nFilterIndex as Long
lpstrFile as string
nMaxFile as Long
lpstrFileTitle as string
nMaxFileTitle as Long
lpstrInitialDir as string
lpstrTitle as string
flags as Long
nFileOffset as Integer
nFileExtension as Integer
lpstrDefExt as string
lCustData as Long
lpfnHook as Long
lpTemplateName as string
End Type
private Type PAGESETUPDLG
lStructSize as Long
hwndOwner as Long
hDevMode as Long
hDevNames as Long
flags as Long
ptPaperSize as POINTAPI
rtMinMargin as RECT
rtMargin as RECT
hInstance as Long
lCustData as Long
lpfnPageSetupHook as Long
lpfnPagePaintHook as Long
lpPageSetupTemplateName as string
hPageSetupTemplate as Long
End Type
private Type CHOOSECOLOR
lStructSize as Long
hwndOwner as Long
hInstance as Long
rgbResult as Long
lpCustColors as string
flags as Long
lCustData as Long
lpfnHook as Long
lpTemplateName as string
End Type
private Type LOGFONT
lfHeight as Long
lfWidth as Long
lfEscapement as Long
lfOrientation as Long
lfWeight as Long
lfItalic as Byte
lfUnderline as Byte
lfStrikeOut as Byte
lfCharSet as Byte
lfOutPrecision as Byte
lfClipPrecision as Byte
lfQuality as Byte
lfPitchAndFamily as Byte
lfFaceName as string * 31
End Type
private Type CHOOSEFONT
lStructSize as Long
hwndOwner as Long ' caller's window handle
hDC as Long ' printer DC/IC or null
lpLogFont as Long ' ptr. to a LOGFONT struct
iPointSize as Long ' 10 * size in points of selected font
flags as Long ' enum. type flags
rgbColors as Long ' returned text color
lCustData as Long ' data passed to hook fn.
lpfnHook as Long ' ptr. to hook function
lpTemplateName as string ' custom template name
hInstance as Long ' instance handle of.EXE that
' contains cust. dlg. template
lpszStyle as string ' return the style field here
' must be LF_FACESIZE or bigger
nFontType as Integer ' same value reported to the EnumFonts
' call back with the extra FONTTYPE_
' bits added
MISSING_ALIGNMENT as Integer
nSizeMin as Long ' minimum pt size allowed &
nSizeMax as Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type
private Type PRINTDLG_TYPE
lStructSize as Long
hwndOwner as Long
hDevMode as Long
hDevNames as Long
hDC as Long
flags as Long
nFromPage as Integer
nToPage as Integer
nMinPage as Integer
nMaxPage as Integer
nCopies as Integer
hInstance as Long
lCustData as Long
lpfnPrintHook as Long
lpfnSetupHook as Long
lpPrintTemplateName as string
lpSetupTemplateName as string
hPrintTemplate as Long
hSetupTemplate as Long
End Type
private Type DEVNAMES_TYPE
wDriverOffset as Integer
wDeviceOffset as Integer
wOutputOffset as Integer
wDefault as Integer
extra as string * 100
End Type
private Type DEVMODE_TYPE
dmDeviceName as string * CCHDEVICENAME
dmSpecVersion as Integer
dmDriverVersion as Integer
dmSize as Integer
dmDriverExtra as Integer
dmFields as Long
dmOrientation as Integer
dmPaperSize as Integer
dmPaperLength as Integer
dmPaperWidth as Integer
dmScale as Integer
dmCopies as Integer
dmDefaultSource as Integer
dmPrintQuality as Integer
dmColor as Integer
dmDuplex as Integer
dmYResolution as Integer
dmTTOption as Integer
dmCollate as Integer
dmFormName as string * CCHFORMNAME
dmUnusedPadding as Integer
dmBitsPerPel as Integer
dmPelsWidth as Long
dmPelsHeight as Long
dmDisplayFlags as Long
dmDisplayFrequency as Long
End Type
private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor as CHOOSECOLOR) as Long
private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename as OPENFILENAME) as Long
private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename as OPENFILENAME) as Long
private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg as PRINTDLG_TYPE) as Long
private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg as PAGESETUPDLG) as Long
private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont as CHOOSEFONT) as Long
private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest as Any, hpvSource as Any, byval cbCopy as Long)
private Declare Function GlobalLock Lib "kernel32" (byval hMem as Long) as Long
private Declare Function GlobalUnlock Lib "kernel32" (byval hMem as Long) as Long
private Declare Function GlobalAlloc Lib "kernel32" (byval wFlags as Long, byval dwBytes as Long) as Long
private Declare Function GlobalFree Lib "kernel32" (byval hMem as Long) as Long
Dim OFName as OPENFILENAME
Dim CustomColors() as Byte


public Function ShowColor(frm as Form) as Long
Dim cc as CHOOSECOLOR
Dim Custcolor(16) as Long
Dim lReturn as Long

'set the structure size
cc.lStructSize = len(cc)
'set the owner
cc.hwndOwner = frm.hWnd
'set the application's instance
cc.hInstance = App.hInstance
'set the custom colors (converted to Unicode)
cc.lpCustColors = StrConv(CustomColors, vbUnicode)
'no extra flags
cc.flags = 0

'Show the 'Select Color'-dialog
If CHOOSECOLOR(cc) <> 0 then
ShowColor = cc.rgbResult
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
else
ShowColor = -1
End If
End Function
public Function ShowOpen(frm as Form, optional Filter as string, _
optional Title as string, _
optional InitDir as string) as string
' added optional Filter, Title and InitDir parms 3/9/2001 jgd
'set the structure size
OFName.lStructSize = len(OFName)
'set the owner window
OFName.hwndOwner = frm.hWnd
'set the application's instance
OFName.hInstance = App.hInstance
'Create a buffer
OFName.lpstrFile = Space$(254)
'set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'set the maximum number of chars
OFName.nMaxFileTitle = 255
'set the filter
' added optional parm Filter 2/9/2001 jgd
If Filter = "" then
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
else
OFName.lpstrFilter = Filter
End If
'set the initial directory
' added optional parm InitDir 2/9/2001 jgd
If InitDir = "" then
OFName.lpstrInitialDir = "C:\"
else
OFName.lpstrInitialDir = InitDir
End If
'set the dialog title
' added optional parm Title 2/9/2001 jgd
If Title = "" then
OFName.lpstrTitle = "Open File - KPD-Team 1998"
else
OFName.lpstrTitle = Title
End If
'no extra flags
OFName.flags = 0

'Show the 'Open File'-dialog
If GetOpenFileName(OFName) then
ShowOpen = Trim$(OFName.lpstrFile)
else
ShowOpen = ""
End If
End Function
public Function ShowFont(frm) as string
Dim cf as CHOOSEFONT, lfont as LOGFONT, hMem as Long, pMem as Long
Dim fontname as string, retval as Long
lfont.lfHeight = 0 ' determine default height
lfont.lfWidth = 0 ' determine default width
lfont.lfEscapement = 0 ' angle between baseline and escapement vector
lfont.lfOrientation = 0 ' angle between baseline and orientation vector
lfont.lfWeight = FW_NORMAL ' normal weight i.e. not bold
lfont.lfCharSet = DEFAULT_CHARSET ' use default character set
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS ' default precision mapping
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS ' default clipping precision
lfont.lfQuality = DEFAULT_QUALITY ' default quality setting
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN ' default pitch, proportional with serifs
lfont.lfFaceName = "Times new Roman" & vbNullChar ' string must be null-terminated
' Create the memory block which will act as the LOGFONT structure buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, len(lfont))
pMem = GlobalLock(hMem) ' lock and get pointer
CopyMemory byval pMem, lfont, len(lfont) ' copy structure's contents into block
' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
cf.lStructSize = len(cf) ' size of structure
cf.hwndOwner = frm.hWnd ' window Form1 is opening this dialog box
cf.hDC = Printer.hDC ' device context of default printer (using VB's mechanism)
cf.lpLogFont = pMem ' pointer to LOGFONT memory block buffer
cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)
cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0) ' black
cf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold or anything
cf.nSizeMin = 10 ' minimum point size
cf.nSizeMax = 72 ' maximum point size
' Now, call the function. If successful, copy the LOGFONT structure back into the structure
' and then print out the attributes we mentioned earlier that the user selected.
retval = CHOOSEFONT(cf) ' open the dialog box
If retval <> 0 then ' success
CopyMemory lfont, byval pMem, len(lfont) ' copy memory back
' Now make the fixed-length string holding the font name into a "normal" string.
ShowFont = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
Debug.print ' end the line
End If
' Deallocate the memory block we created earlier. Note that this must
' be done whether the function succeeded or not.
retval = GlobalUnlock(hMem) ' destroy pointer, unlock block
retval = GlobalFree(hMem) ' free the allocated memory
End Function
public Function ShowSave(frm as Form) as string
'set the structure size
OFName.lStructSize = len(OFName)
'set the owner window
OFName.hwndOwner = frm.hWnd
'set the application's instance
OFName.hInstance = App.hInstance
'set the filet
OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
'Create a buffer
OFName.lpstrFile = Space$(254)
'set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'set the maximum number of chars
OFName.nMaxFileTitle = 255
'set the initial directory
OFName.lpstrInitialDir = "C:\"
'set the dialog title
OFName.lpstrTitle = "Save File - KPD-Team 1998"
'no extra flags
OFName.flags = 0

'Show the 'Save File'-dialog
If GetSaveFileName(OFName) then
ShowSave = Trim$(OFName.lpstrFile)
else
ShowSave = ""
End If
End Function
public Function ShowPageSetup(frm as Form) as Long
Dim m_PSD as PAGESETUPDLG
'set the structure size
m_PSD.lStructSize = len(m_PSD)
'set the owner window
m_PSD.hwndOwner = frm.hWnd
'set the application instance
m_PSD.hInstance = App.hInstance
'no extra flags
m_PSD.flags = 0

'Show the pagesetup dialog
If PAGESETUPDLG(m_PSD) then
ShowPageSetup = 0
else
ShowPageSetup = -1
End If
End Function
public Function ShowPrinter(frmOwner as Form, optional PrintFlags as Long) as Long
'public Sub ShowPrinter(frmOwner as Form, optional PrintFlags as Long)
' Modified jgd 3/9/2001 to become a Function instead of a Sub
' AllAPI.Net supplied version of this procedure has it set as a
' Subroutine. I have changed it to a Function as Boolean and added
' Code at end to return false if user Cancels procedure
'-> Code by Donald Grover
Dim PrintDlg as PRINTDLG_TYPE
Dim DevMode as DEVMODE_TYPE
Dim DevName as DEVNAMES_TYPE

Dim lpDevMode as Long, lpDevName as Long
Dim bReturn as Integer
Dim objPrinter as Printer, NewPrinterName as string

' Use PrintDialog to get the handle to a memory
' block with a DevMode and DevName structures

PrintDlg.lStructSize = len(PrintDlg)
PrintDlg.hwndOwner = frmOwner.hWnd

PrintDlg.flags = PrintFlags
on error resume next
'set the current orientation and duplex setting
DevMode.dmDeviceName = Printer.DeviceName
DevMode.dmSize = len(DevMode)
DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
DevMode.dmPaperWidth = Printer.Width
DevMode.dmOrientation = Printer.Orientation
DevMode.dmPaperSize = Printer.PaperSize
DevMode.dmDuplex = Printer.Duplex
on error GoTo 0

'Allocate memory for the initialization hDevMode structure
'and copy the settings gathered above into this memory
PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, len(DevMode))
lpDevMode = GlobalLock(PrintDlg.hDevMode)
If lpDevMode > 0 then
CopyMemory byval lpDevMode, DevMode, len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
End If

'set the current driver, device, and port name strings
With DevName
.wDriverOffset = 8
.wDeviceOffset = .wDriverOffset + 1 + len(Printer.DriverName)
.wOutputOffset = .wDeviceOffset + 1 + len(Printer.Port)
.wDefault = 0
End With

With Printer
DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
End With

'Allocate memory for the initial hDevName structure
'and copy the settings gathered above into this memory
PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, len(DevName))
lpDevName = GlobalLock(PrintDlg.hDevNames)
If lpDevName > 0 then
CopyMemory byval lpDevName, DevName, len(DevName)
bReturn = GlobalUnlock(lpDevName)
End If

'Call the print dialog up and let the user make changes
Dim lRet as Long ' added 3/9/2001 jgd
' If PrintDialog(PrintDlg) <> 0 then ' replaced 3/9/2001 jgd
lRet = PrintDialog(PrintDlg) ' added 3/9/2001 jgd
ShowPrinter = lRet ' set return code added 3/9/2001 jgd
If lRet <> 0 then '
'First get the DevName structure.
lpDevName = GlobalLock(PrintDlg.hDevNames)
CopyMemory DevName, byval lpDevName, 45
bReturn = GlobalUnlock(lpDevName)
GlobalFree PrintDlg.hDevNames

'next get the DevMode structure and set the printer
'properties appropriately
lpDevMode = GlobalLock(PrintDlg.hDevMode)
CopyMemory DevMode, byval lpDevMode, len(DevMode)
bReturn = GlobalUnlock(PrintDlg.hDevMode)
GlobalFree PrintDlg.hDevMode
NewPrinterName = UCase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
If Printer.DeviceName <> NewPrinterName then
for Each objPrinter In Printers
If UCase$(objPrinter.DeviceName) = NewPrinterName then
set Printer = objPrinter
'set printer toolbar name at this point
End If
next
End If

on error resume next
'set printer object properties according to selections made
'by user
Printer.Copies = DevMode.dmCopies
Printer.Duplex = DevMode.dmDuplex
Printer.Orientation = DevMode.dmOrientation
Printer.PaperSize = DevMode.dmPaperSize
Printer.PrintQuality = DevMode.dmPrintQuality
Printer.ColorMode = DevMode.dmColor
Printer.PaperBin = DevMode.dmDefaultSource
on error GoTo 0
End If
End Function






John G

This piece of code has one drawback if the the path and device name of the printer you are trying to select is > 31 characters it fails.

If you substitute the line

If Left(UCase$(objPrinter.DeviceName), 31) = Left(NewPrinterName, 31) then



It works. However their is a potential resolution problem when the length of the path to the printer aproaches 31 characters. I would love to find a solution that did not have this limitation.

Simon Pettman

Simon,
I was unaware of the 32 bit limitation. The comments in the sample dates the code to 1998. Could be there is an update.
Preliminary searching on MSDN shows a bunch of hits against PRINTDIALOG but most are for the .Net architecture.
Incidentially that code is a modified version of code MSDN published sometime back but its whereabouts eludes me at this time. IT was for NT but worked on WIN95/98 architecture systems.
'
MSDN article Q198712 documents your original problem of changing system wide settings.
Q169131 might also be of interest.

John G

Hi John

Firstly I dont think there is a way round the 31 charater DeviceName limit as it is a constant in the DevMode Struct.

I have made some changes to the code you sent me shown here:-

With DevName
.wDriverOffset = 8 'the first 8 bytes are allocated for 4 WORD members of the struct
.wDeviceOffset = .wDriverOffset + 1 + len(Printer.DriverName)
'.wOutputOffset = .wDeviceOffset + 1 + len(Printer.Port)
'the following five lines replace the line above which I believe to be incorrect
If len(Printer.DeviceName) > 32 then
.wOutputOffset = .wDeviceOffset + 32
else
.wOutputOffset = .wDeviceOffset + 1 + len(Printer.DeviceName)
End If
.wDefault = 0
End With

With Printer
DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
End With

'Allocate memory for the initial hDevName structure
'and copy the settings gathered above into this memory
PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, len(DevName))
lpDevName = GlobalLock(PrintDlg.hDevNames)
If lpDevName > 0 then
CopyMemory byval lpDevName, DevName, len(DevName)
bReturn = GlobalUnlock(lpDevName)
End If

'Call the print dialog up and let the user make changes
If PrintDialog(PrintDlg) <> 0 then

'First get the DevName structure.
lpDevName = GlobalLock(PrintDlg.hDevNames)
CopyMemory DevName, byval lpDevName, len(DevName) 'len(DevName) was 45
bReturn = GlobalUnlock(lpDevName)
GlobalFree PrintDlg.hDevNames



It is just two edits near the begining and end of this snippet. Please comment if you agree we the changes I have made. Before the edits I was getting crashes due to memory access faults. But only occasionally so I am not entirely sure I have solved the problem.

I am also getting bizarre results using the Printer.TextWidth(STRING) function. I am cursing VB and its so called printing functionality.

Simon Pettman

I aggree with you in that the VB Printer Object sucks. To many problems for the serious programmer. OK for the Hobbyist though if they do not care about the limitations and problems.
I have just about abandoned the printer object altogether and am using strictky APIs to do printing.

John G