04-23-2022, 05:27 PM
Code: (Select All)
CONST PD_ALLPAGES = 0
CONST PD_CURRENTPAGE = &H00400000
CONST PD_DISABLEPRINTTOFILE = &H00080000
CONST PD_PAGENUMS = 2
CONST PD_RETURNDC = &H00000100
CONST PD_RETURNDEFAULT = &H00000400
CONST PD_SELECTION = 1
CONST PD_USEDEVMODECOPIESANDCOLLATE = &H00040000
CONST START_PAGE_GENERAL = -1
CONST PD_RESULT_CANCEL = 0
CONST PD_RESULT_PRINT = 1
CONST PD_RESULT_APPLY = 2
CONST CCHDEVICENAME = 32
CONST CCHFORMNAME = 32
CONST TA_UPDATECP = 1
CONST S_OK = 0
' CONST E_HANDLE = &H80070006
CONST GDI_ERROR = -1
DECLARE DYNAMIC LIBRARY "kernel32"
FUNCTION GlobalFree~%& (BYVAL hMem~%&)
FUNCTION GetLastError~& ()
END DECLARE
DECLARE DYNAMIC LIBRARY "gdi32"
FUNCTION DeleteDC& (BYVAL hdc~%&)
FUNCTION SetTextAlign~& (BYVAL hdc~%&, BYVAL fMode~&)
FUNCTION GetTextAlign~& (BYVAL hdc~%&)
FUNCTION TextOutA& (BYVAL hdc~%&, BYVAL nXStart&, BYVAL nYStart&, BYVAL lpString~%&, BYVAL cchString&)
FUNCTION StartDocA& (BYVAL hdc~%&, BYVAL lpdi~%&)
FUNCTION AbortDoc& (BYVAL hdc~%&)
FUNCTION StartPage& (BYVAL hDC~%&)
FUNCTION EndPage& (BYVAL hdc~%&)
FUNCTION EndDoc& (BYVAL hdc~%&)
FUNCTION ResetDCA~%& (BYVAL hdc~%&, BYVAL lpInitData~%&)
END DECLARE
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION FindWindowA%& (BYVAL lpClassName%&, BYVAL lpWindowName%&)
END DECLARE
DECLARE DYNAMIC LIBRARY "comdlg32"
FUNCTION PrintDlgExA~& (BYVAL lppd~%&) ' returns an HRESULT
END DECLARE
DECLARE CUSTOMTYPE LIBRARY
' http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=10886.msg91583#msg91583
SUB SUB_READDEVMODE (BYVAL p~%&)
SUB SUB_READDEVNAMES (BYVAL p~%&)
END DECLARE
TYPE DOCINFOA
cbSize AS LONG
lpszDocName AS _UNSIGNED _OFFSET ' LPCSTR
lpszOutput AS _UNSIGNED _OFFSET ' LPCSTR
lpszDatatype AS _UNSIGNED _OFFSET ' LPCSTR
fwType AS _UNSIGNED LONG
END TYPE
TYPE POINTL
x AS LONG
y AS LONG
END TYPE
CONST len_DEVMODEA = 156
TYPE DEVMODEA
dmDeviceName AS STRING * CCHDEVICENAME
dmSpecVersion AS _UNSIGNED INTEGER
dmDriverVersion AS _UNSIGNED INTEGER
dmSize AS _UNSIGNED INTEGER
dmDriverExtra AS _UNSIGNED INTEGER
dmFields AS _UNSIGNED LONG
' union {
' struct { comment either the following 8 lines
dmOrientation AS INTEGER
dmPaperSize AS INTEGER
dmPaperLength AS INTEGER
dmPaperWidth AS INTEGER
dmScale AS INTEGER
dmCopies AS INTEGER
dmDefaultSource AS INTEGER
dmPrintQuality AS INTEGER
' };
' struct { or the following 3 lines
' dmPosition AS POINTL
' dmDisplayOrientation AS _UNSIGNED LONG
' dmDisplayFixedOutput AS _UNSIGNED LONG
' };
' };
dmColor AS INTEGER
dmDuplex AS INTEGER
dmYResolution AS INTEGER
dmTTOption AS INTEGER
dmCollate AS INTEGER
dmFormName AS STRING * CCHFORMNAME
dmLogPixels AS _UNSIGNED INTEGER
dmBitsPerPel AS _UNSIGNED LONG
dmPelsWidth AS _UNSIGNED LONG
dmPelsHeight AS _UNSIGNED LONG
' union { comment exactly 1 of the following 2 lines
' dmDisplayFlags AS _UNSIGNED LONG
dmNup AS _UNSIGNED LONG
' };
dmDisplayFrequency AS _UNSIGNED LONG
dmICMMethod AS _UNSIGNED LONG
dmICMIntent AS _UNSIGNED LONG
dmMediaType AS _UNSIGNED LONG
dmDitherType AS _UNSIGNED LONG
dmReserved1 AS _UNSIGNED LONG
dmReserved2 AS _UNSIGNED LONG
dmPanningWidth AS _UNSIGNED LONG
dmPanningHeight AS _UNSIGNED LONG
END TYPE
TYPE DEVNAMES
wDriverOffset AS _UNSIGNED INTEGER
wDeviceOffset AS _UNSIGNED INTEGER
wOutputOffset AS _UNSIGNED INTEGER
wDefault AS _UNSIGNED INTEGER
END TYPE
TYPE PRINTPAGERANGE
nFromPage AS _UNSIGNED LONG
nToPage AS _UNSIGNED LONG
END TYPE
$IF 32BIT THEN
TYPE PRINTDLGEX
lStructSize AS _UNSIGNED LONG
hwndOwner AS _UNSIGNED _OFFSET ' HWND
hDevMode AS _UNSIGNED _OFFSET ' HGLOBAL
hDevNames AS _UNSIGNED _OFFSET ' HGLOBAL
hDC AS _UNSIGNED _OFFSET ' HDC
Flags AS _UNSIGNED LONG
Flags2 AS _UNSIGNED LONG
ExclusionFlags AS _UNSIGNED LONG
nPageRanges AS _UNSIGNED LONG
nMaxPageRanges AS _UNSIGNED LONG
lpPageRanges AS _UNSIGNED _OFFSET ' LPPRINTPAGERANGE
nMinPage AS _UNSIGNED LONG
nMaxPage AS _UNSIGNED LONG
nCopies AS _UNSIGNED LONG
hInstance AS _UNSIGNED _OFFSET ' HINSTANCE
lpPrintTemplateName AS _UNSIGNED _OFFSET ' LPCSTR
lpCallback AS _UNSIGNED _OFFSET ' LPUNKNOWN
nPropertyPages AS _UNSIGNED LONG
lphPropertyPages AS _UNSIGNED _OFFSET ' HPROPSHEETPAGE *
nStartPage AS _UNSIGNED LONG
dwResultAction AS _UNSIGNED LONG
END TYPE
$ELSE
TYPE PRINTDLGEX
lStructSize AS _UNSIGNED _INTEGER64
hwndOwner AS _UNSIGNED _OFFSET ' HWND
hDevMode AS _UNSIGNED _OFFSET ' HGLOBAL
hDevNames AS _UNSIGNED _OFFSET ' HGLOBAL
hDC AS _UNSIGNED _OFFSET ' HDC
Flags AS _UNSIGNED LONG
Flags2 AS _UNSIGNED LONG
ExclusionFlags AS _UNSIGNED LONG
nPageRanges AS _UNSIGNED LONG
nMaxPageRanges AS _UNSIGNED _INTEGER64
lpPageRanges AS _UNSIGNED _OFFSET ' LPPRINTPAGERANGE
nMinPage AS _UNSIGNED LONG
nMaxPage AS _UNSIGNED LONG
nCopies AS _UNSIGNED _INTEGER64 'LONG
hInstance AS _UNSIGNED _OFFSET ' HINSTANCE
lpPrintTemplateName AS _UNSIGNED _OFFSET ' LPCSTR
lpCallback AS _UNSIGNED _OFFSET ' LPUNKNOWN
nPropertyPages AS _UNSIGNED _INTEGER64 'LONG
lphPropertyPages AS _UNSIGNED _OFFSET ' HPROPSHEETPAGE *
nStartPage AS _UNSIGNED LONG
dwResultAction AS _UNSIGNED LONG
END TYPE
$END IF
DIM pageranges(0 TO 7) AS PRINTPAGERANGE
DIM pde AS PRINTDLGEX
DIM hWnd AS _UNSIGNED _OFFSET
DIM hr AS _UNSIGNED LONG
DIM t AS STRING
DIM t1 AS STRING * 16
DIM doc AS DOCINFOA
hWnd = _WINDOWHANDLE 'FindWindowA(0, _OFFSET(t))
_TITLE "Printer API demo"
pde.lStructSize = LEN(pde)
pde.hwndOwner = hWnd
pde.hDevMode = 0
pde.hDevNames = 0
pde.Flags = PD_ALLPAGES OR PD_RETURNDC OR PD_USEDEVMODECOPIESANDCOLLATE
pde.Flags2 = 0
pde.nPageRanges = 0
pde.nMaxPageRanges = 1 + UBOUND(pageranges)
pde.lpPageRanges = _OFFSET(pageranges(0))
pde.nMinPage = 1
pde.nMaxPage = 1
pde.nCopies = 1
pde.hInstance = 0
pde.lpCallback = 0
pde.nPropertyPages = 0
pde.lphPropertyPages = 0
pde.nStartPage = START_PAGE_GENERAL
pde.dwResultAction = 0
hr = PrintDlgExA(_OFFSET(pde))
IF S_OK <> hr THEN PRINT "ZZError. HRESULT: 0x" + LCASE$(HEX$(hr))
PRINT pde.dwResultAction
IF pde.hDevMode THEN SUB_READDEVMODE _OFFSET(pde.hDevMode)
IF pde.hDevNames THEN SUB_READDEVNAMES _OFFSET(pde.hDevNames)
IF PD_RESULT_PRINT = pde.dwResultAction THEN
IF pde.hDC THEN
t1 = "qb64 prn test" + CHR$(0) ' fixed len str so it won't move
doc.cbSize = LEN(doc)
doc.lpszDocName = _OFFSET(t1)
doc.lpszOutput = 0
doc.lpszDatatype = 0
doc.fwType = 0
IF 0 >= StartDocA(pde.hDC, _OFFSET(doc)) THEN PRINT "doc error"
IF 0 >= StartPage(pde.hDC) THEN PRINT "doc error"
IF GDI_ERROR = SetTextAlign(pde.hDC, GetTextAlign(pde.hDC) OR TA_UPDATECP) THEN PRINT "GDI error"
t = "Hello, world!"
IF 0 = TextOutA(pde.hDC, 0, 0, _OFFSET(t), LEN(t)) THEN PRINT "error"
IF 0 >= EndPage(pde.hDC) THEN PRINT "doc error"
IF 0 >= EndDoc(pde.hDC) THEN PRINT "doc error"
END IF
END IF
IF pde.hDevMode THEN
IF 0 <> GlobalFree(pde.hDevMode) THEN PRINT "Error: 0x" + LCASE$(HEX$(GetLastError))
END IF
IF pde.hDevNames THEN
IF 0 <> GlobalFree(pde.hDevNames) THEN PRINT "Error: 0x" + LCASE$(HEX$(GetLastError))
END IF
IF pde.hDC THEN
IF 0 = DeleteDC(pde.hDC) THEN PRINT "Error: 0x" + LCASE$(HEX$(GetLastError))
END IF
END
SUB readDevMode (t AS DEVMODEA)
PRINT t.dmDeviceName
' etc...
END SUB
SUB readDevNames (t AS DEVNAMES)
DIM m AS _MEM
t$ = SPACE$(255)
m = _MEM(_OFFSET(t) + t.wDriverOffset, 255)
_MEMGET m, m.OFFSET, t$
PRINT t$
m = _MEM(_OFFSET(t) + t.wDeviceOffset, 255)
_MEMGET m, m.OFFSET, t$
PRINT t$
m = _MEM(_OFFSET(t) + t.wOutputOffset, 255)
_MEMGET m, m.OFFSET, t$
PRINT t$
'PRINT peekstr(_OFFSET(t) + t.wDriverOffset)
'PRINT peekstr(_OFFSET(t) + t.wDeviceOffset)
'PRINT peekstr(_OFFSET(t) + t.wOutputOffset)
END SUB