'********************************************************** ************************ ** Module Name: MDLPrint '** Created: Ye Fan' ** Japan: 2004 April 02 Day '** Modifier:' ** Japan: '** Description: Printer Settings' ** version: v1.0' ****************** *********************************************************** ****
Option expedition
Public Declare Function EnumForms Lib "winspool.drv" Alias "EnumFormsA" (ByVal hPrinter As Long, ByVal Level As Long, ByRef pForm As Any, ByVal cbBuf As Long, ByRef pcbNeeded As Long, ByRef pcReturned As Long) As LongPublic Declare Function AddForm Lib "winspool.drv" Alias "AddFormA" (ByVal hPrinter As Long, ByVal Level As Long, pForm As Byte) As LongPublic Declare Function DeleteForm Lib "winspool.drv" Alias "DeleteFormA" (ByVal hPrinter As Long, ByVal pFormName As String ) As LongPublic Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As LongPublic Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As LongPublic Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) As LongPublic Declare Function ResetDC Lib "gdi32" Alias "ResetDCA" (ByVal hdc As Long, lpInitData As Any) As LongPublic Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) Public Declare Function lstrcpy Lib "KERNEL32" Alias "lstrcpyA" (ByVal lpString1 As String, ByRef lpString2 As Long) As LongPublic Declare Function GetForm Lib "winspool.drv" Alias "GetFormA" (ByVal hPrinter As Long, ByVal pFormName As String, ByVal Level As Long, pForm AS BYTE, BYVAL CBBUF As Long, PCBNEED AS Long AS Longpublic Declare Function SETFORM LIB "Winspool.drv" Alias "
SetFormA "(ByVal hPrinter As Long, ByVal pFormName As String, ByVal Level As Long, pForm As Byte) As Long'DEVMODE parameters related to Public Const CCHFORMNAME = 32Public Const CCHDEVICENAME = 32Public Const DM_FORMNAME As Long = & H10000Public Const DM_ORIENTATION = & H1 &
'For PRINTER_DEFAULTS.DesiredAccess parameter related to Public Const PRINTER_ACCESS_ADMINISTER = & H4Public Const PRINTER_ACCESS_USE = & H8Public Const STANDARD_RIGHTS_REQUIRED = & HF0000Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)' DocumentProperties () return value of Public Const DM_MODIFY = 8Public Const DM_IN_BUFFER = DM_MODIFYPublic Const DM_COPY = 2PUBLIC ConST DM_OUT_BUFFER = DM_COPY
'Format Add information PUBLIC const form_not_selected = 0public const form_selected = 1PUBLIC const form_added = 2
Public Type Rectl Left As Long Top As Long Right As Long Bottom as Longend Type
Public Type Sizel CX As Long Cy As Longend Type
PUBLIC TYPE SECURITY_DESCRIPTOR REVISION AS BYTE SBZ1 AS BYTE CONTROL AS Long Owner AS Long Group As Long Sacl AS Long 'ACL DACL AS Long' ACLEND TYPE
Public Type Form_info_1 Flags As Long Pname As Long Size As Sizel ImageableArea As RectLend Type
'String Public Type Sform_info_1 Flags As Long Pname As String Size As Sizel ImageableArea As Rectlend Type
Public Type DEVMODE 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 Long dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As LongEnd TypePublic Type PRINTER_DEFAULTS pDatatype As String pDevMode As Long 'DEVMODE DesiredAccess As LongEnd Type
Public Type PRINTER_INFO_2 pServerName As String pPrinterName As String pShareName As String pPortName As String pDriverName As String pComment As String pLocation As String pDevMode As DEVMODE pSepFile As String pPrintProcessor As String pDatatype As String pParameters As String pSecurityDescriptor As SECURITY_DESCRIPTOR Attributes As Long Priority As Long DefaultPriority As Long StartTime As Long Untiltime As Long Status As Long CJObs As Long Averageppm As LONGEND TYPE
'********************************************************** ************************ ** function name: getFormName '** input: BYVAL PrinterHandle (long) - Printer Handle' **: Formsize (Sizel) - Format size '**: formname (string) - Format Name' ** Out: (Integer) - '** Function Description: Returns the pre-found format serial number, 0 is not found' ** global variable: '** Call Module:' ** Author: Ye Fan '** Japan: April 02, 2004' ** Modifier: '** Japan:' ** Edition: v1.0 '** *********************************************************** *************************** PUBLIC FUNCTION GETFORMNAME (BYVAL PrinterHandle As Long, Formsize As Sizel, Formname As String) AS INTEGER DIM NUMFORMS AS Long, i As Long Dim Fi1 As FORM_INFO_1 Dim aFI1 () As FORM_INFO_1 'Working FI1 array Dim Temp () As Byte' Temp FI1 array Dim FormIndex As Integer Dim BytesNeeded As Long Dim RetVal As Long FormIndex = 0 ReDim aFI1 (1) RetVal = EnumForms (PrinterHandle, 1, AFI1 (0), 0 &, BYTESNEDED, NUMFORMS) Redim Temp (Bytesneeded) Redim Afi1 (Bytesneeded / Len (Fi1)) Retval = Enumforms (Printerh ANDLE, 1, TEMP (0), Bytesneed, Bytesneeded, Numforms, Call CopyMemory (AFI1 (0), Temp (0), Bytesneeded) for i = 0 to NumForms - 1 with AFI1 (i) 'if .size.cx = FormSize.cx And .Size.cy = FormSize.cy And FormName = PtrCtoVbString (.pName) Then If FormName = PtrCtoVbString (.pName) Then FormIndex = i 1 Exit For End If End With Next getFormName = FormIndexEnd Function
'********************************************************** ************************ ** function name: addnewform '** input: printerHandle (long) - printer handle' **: Formsize Sizel) - Format size '**: formname (String) - Format Name' ** Out: (long) - 0 Add success 1 Do not allow 2 Add Failed '** Function Description: Add new print format' ** Global variable: '** Call Module:' ** Server: Ye Fan '** Japan: April 02, 2004' ** Modifier: '** Japan:' ** Edition: v1.0 '********************************************************** ************************ Public Function AddNewform (PrinterHandle As Long, Formsize As Sizel, Formname As String) AS Long Dim Fi1 As SFORM_INFO_1 DIM AFI1 () AS BYTE DIM RETVAL As Long with Fi1 .flags = 0 .pname = formname with .size .cx = formsize.cx .cy = forMsize.cy end with .cy = formableArea .left = 0 .top = 0 .right = fi1.size .cx .bottom = fi1.size.cy end with end with redim AFI1 (Len (Fi1)) Call CopyMemory (AFI1 (0), FI1, LEN (FI1)) RetVal = AddForm (PrinterHandle, 1, AFI1 (0)) if retval = 0 THEN 'Settings failed if err.lastdller = 5 THEN' does not allow setting print format addnewform = 1 else 'err.lastdller ardnewform = 2 end if else addnewform = 0 end ifend function
'********************************************************** ************************ ** function name: PTRCTOVBSTRING '** input: ByVal Add (long) - Character address' ** output : (String) - String '** Function Description: Returns the string of the specified address' ** global variable:' ** Call Module: '** Server: Ye Fan' ** Japan: April 2004 02 Day '** Modifier:' ** Japan: '** Edition: v1.0' ************************** ***************************************************************** Public Function PTRCTOVBSTRING BYVAL Add as long) AS STRING DIM STEMP AS STRING * 512, X as long x = LSTRCPY (STEMP, BYVAL ADD) IF (INSTR (1, STEMP, CHR (0)) = 0) Then Ptrctovbstring = "" ELSE PTRCTOVBSTRING = Left (Stemp, INSTR (1, Stemp, Chr (0)) - 1) End ifend function
'********************************************************** ************************ ** function name: setprintform '** input: ByVal myhwnd (long) - Form handle' **: FormName (String) - Format Name '**: LNGPAGEX (long) - Width value (mm)' **: lngpagey (long) - Height value (mm) '** output: (Integer) - 0 format Unable to add 1 format added 2 format Add success' ** function description: custom print format '** global variable:' ** Call module: '** author: Ye Fan' ** Japan: April 02, 2004 '** Modifier:' ** Japan: '** version: v1.0' ************************************* ********************************************** PUBLIC FUNCTION SETPRINTFORM (ByVal) MyhWnd As Long, FormName As String, lngPageX As Long, lngPageY As Long) As Integer Dim nSize As Long Dim pDevMode As DEVMODE Dim PrinterHandle As Long Dim hPrtDC As Long Dim PrinterName As String Dim aDevMode () As Byte Dim FormSize As SIZEL PrinterName = Printer.DeviceName hPrtDC = Printer.hdc SetPrintForm = FORM_NOT_SELECTED 'preset format can not be added If OpenPrinter (PrinterName, PrinterHandle, 0 &) Then nSize = DocumentProperties (MyhWnd, PrinterHandle, PrinterNam e, 0 &, 0 &, 0 &) ReDim aDevMode (1 To nSize) nSize = DocumentProperties (MyhWnd, PrinterHandle, PrinterName, aDevMode (1), 0 &, DM_OUT_BUFFER) Call CopyMemory (pDevMode, aDevMode (1), Len (pDevMode)) ' Set size with formsize .cx = lngpagex * 1000 'paper width. Cyby = lngpagey * 1000' Paper Height End with 'This format defines if getFormName (PrinterHandle, Formsize, Formname) = 0 Then' does not exist this format '
Add the format AddNewForm PrinterHandle, FormSize, FormName If GetFormName (PrinterHandle, FormSize, FormName) = 0 Then ClosePrinter (PrinterHandle) SetPrintForm = FORM_NOT_SELECTED 'format is not added Exit Function Else SetPrintForm = FORM_ADDED' added successfully End If End If 'formatted format name pDevMode.dmFormName = FormName & Chr (0) pDevMode.dmFields = DM_FORMNAME 'setting change Call CopyMemory (aDevMode (1), pDevMode, Len (pDevMode)) nSize = DocumentProperties (MyhWnd, PrinterHandle, PrinterName, aDevMode (1), aDevMode (1), DM_IN_BUFFER Or DM_OUT_BUFFER) nSize = ResetDC (hPrtDC, aDevMode (1)) ClosePrinter (PrinterHandle) If SetPrintForm <> FORM_ADDED Then SetPrintForm = FORM_SELECTED 'format is added End If Else SetPrintForm = FORM_NOT_SELECTED' format is not added End IfEnd Function
'********************************************************** ************************ ** function name: DELFORM '** input: formname (string) - Format Name' ** output: (Long) - 0 Delete success 1 Delete failed '** function description:' ** Global variable: '** Call Module:' ** Author: Ye Fan '** Japan: April 02, 2004' * * Modify: '** Japan:' ** version: v1.0 '************************************ *************************************************************** Public Function Delform (Formname As String ) As Long Dim RetVal As Long Dim PrinterHandle As Long Dim PrinterName As String Dim Continue As Long 'current printer PrinterName = Printer.DeviceName DelForm = 1 If OpenPrinter (PrinterName, PrinterHandle, 0 &) Then RetVal = DeleteForm (PrinterHandle, FormName & Chr ( 0)) IF RETVAL <> 0 THEN DELFORM = 0 'Delete Successfully Else Delform = 1' Delete Failed End IF Closeprinter (PrinterHandle) End IFEND Function
'********************************************************** ************************ ** function name: enumprintform '** input: strformname () (String) - Format Name "**: SZFORMXY () (Sizel) - The size of the format '** output: (long) - number of available formats' ** Function Description: Enumerate Print Format' ** Global Variable: '** Call Module:' ** Author: Ye Fan '** Japan: April 02, 2004' ** Modified: '** Japan:' ** version: v1.0 '******** *********************************************************** ************** PUBLIC FUNCTION Enumprintform (StrformName () AS STRING, SZFORMXY () As Sizel AS Long 'Open Errors Handling Trap On Error Goto Errgoto' -------- ------------------------------------------ DIM LNGNUMFORMS AS Long, i As Long Dim FI1 As FORM_INFO_1 Dim aFI1 () As FORM_INFO_1 Dim Temp () As Byte Dim BytesNeeded As Long Dim PrinterName As String Dim PrinterHandle As Long Dim strFormItem As String Dim RetVal As Long PrinterName = Printer.DeviceName If OpenPrinter (PrinterName, PrinterHandle, 0 &) THEN Redim AFI1 (1) Retval = Enumforms (PrinterHandle, 1, AFI1 (0), 0 &, Bytesneed, LNGNUM Forms) ReDim Temp (BytesNeeded) ReDim aFI1 (BytesNeeded / Len (FI1)) RetVal = EnumForms (PrinterHandle, 1, Temp (0), BytesNeeded, BytesNeeded, lngNumForms) Call CopyMemory (aFI1 (0), Temp (0), BytesNeeded ) Redim Strformxy (1 to lngnumforms) for i = 0 to lngnumforms - 1 with AFI1 (i) 'Returns printable paper name and print size StrFormName (i 1) = PTRCTOVBSTRING (.pname ) SZFORMXY (i 1) .cx =
.Size.cx / 1000 szformxy (i 1) .cy = .size.cy / 1000 end with next i closeprinter (printerhandle) enumprintform = lngnumforms else enumprintform = 0 end if '----------- ----------------------------------------- EXIT function '------ ----------------------- Errgoto: enumprintform = -1nd function
'********************************************************** ************************ '** function name: enumuseform' ** input: lngFormno () (long) - format number **: StrformName () - Format Name '**: Szformxy () (Sizel) - Size of format' ** Output: (long) - Number of available formats' ** function description: Enumerate users available printing Format '** Function Description:' ** Global Variable: '** Call Module:' ** Server: Ye Fan '** Japan: April 02, 2004' ** Modify: '** Japan : '** version: v1.0' ************************************************ ********************************************** PUBLIC FUNCTION ENUMUSEFORM (LngFormNo () as long, strformname () AS String, szFormXY () As SIZEL) As Long Dim strFormName1 () As String Dim szFormXY1 () As SIZEL Dim i As Long, j As Long Dim lngValue As Long lngValue = EnumPrintForm (strFormName1, szFormXY1) j = 0 If lngValue> 0 Then For i = 1 to lngvalue if setsize (i) = 0 THEN J = J 1 Redim preserve LngFormno (1 to j) Redim Preserve Strformname (1 to j) Redim Preserve Szformxy (1 to j) LngFormNo (j) = i Strformname (j) = StrFormName1 (i) SZFORMXY (j) .cx = szformxy1 (i) .cx szformxy (j) .cy = szformxy1 (i) .cy end if next end if enumuseform = j end function
'********************************************************** ************************ ** function name: setsize '** input: lngno (long) - available format number' ** Out: (long) - 0 Available 1 Unavailable '** Function Description: Determine if the print format is available in' ** global variable: '** call module:' ** author: Ye Fan '** Japan: 2004 April 02, '** Modified:' ** Japan: '** version: v1.0' *********************** ***************************************************************************** Function setsize (lngno as long) as long on error goto errexit printer.papersize = lngno set = 0 exit functionerRexit: setsize = 1END function
