'CLASS MODULE TO REPLACE THE CommonDialog CONTROL.
'VERSION ADAPTED FOR EXCEL VBA USE$.

'There is nothing here that is specific to any
'particular project except that:-
'The routines require a Public Boolean, 'canceled', in the main program.
'In fact, this can be removed and a failed process detected by the value returned by functions.
'It's kept in here because I used it in applications which used the CD control.

' Philip Bolt, 2006

'The code is based on that from http://www.mentalis.org/apilist/PrintDialog.shtml, 'Common Dialogs'
'example with additional code and data from http://www.ex-designz.net/apicat.asp and Paul Mather's
'program at http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=3592&lngWId=1

'Last updated: 15/1/2006

Option Explicit

'CD CONSTANTS.
'To be compatible with previous applications which used the CD control, the constants have been
'defined using the VB 6.0 nomenclature rather than the standard form as used with C++, etc.
'e.g. cdlOFNEnableHook rather than OFN_ENABLEHOOK.
'This is done even when there are no VB forms, as for the PAGESETUP constants.

'Those constants which are described in the 'Visual Studio Help'/'CommonDialog Control Constants' are NOT
'documented. In fact, ALL of the constants are documented in their standard forms in the C++
'versions of the API structures. e.g. 'Help'/'PRINTDLG'.
    
'OPEN/SAVE FILES
Public Enum cdlOFN
    cdlOFNAllowMultiselect = &H200
    cdlOFNCreatePrompt = &H2000
    cdlOFNExplorer = &H80000
    cdlOFNExtensionDifferent = &H400
    cdlOFNFileMustExist = &H1000
    cdlOFNHelpButton = &H10
    cdlOFNHideReadOnly = &H4
    cdlOFNLongNames = &H200000
    cdlOFNNoChangeDir = &H8
    CdlOFNNoDereferenceLinks = &H100000
    cdlOFNNoLongNames = &H40000
    CdlOFNNoReadOnlyReturn = &H8000
    cdlOFNNoValidate = &H100
    cdlOFNOverwritePrompt = &H2
    cdlOFNPathMustExist = &H800
    cdlOFNReadOnly = &H1
    CdlOFNShareAware = &H4000
    cdlOFNEnableHook = &H20             'Enables the hook function specified in the lpfnHook
                                        'member.
    cdlOFNEnableTemplateHandle = &H80   'Indicates that the hInstance member identifies a data
                                        'block that contains a preloaded dialog box template.
                                        'The system ignores the lpTemplateName if this flag is
                                        'specified.'
                                        'If the cdlOFNExplorer flag is set, the system uses the
                                        'specified template to create a dialog box that is a
                                        'child of the default Explorer-style dialog box. If the
                                        'cdlOFNExplorer flag is not set, the system uses the
                                        'template to create an old-style dialog box that
                                        'replaces the default dialog box.
    cdlOFNEnableTemplate = &H40         'Indicates that the lpTemplateName member points to the
                                        'name of a dialog template resource in the module
                                        'identified by the hInstance member.
                                        'If the cdlOFNExplorer flag is set, the system uses the
                                        'specified template to create a dialog box that is a
                                        'child of the default Explorer-style dialog box.
                                        'If the cdlOFNExplorer flag is not set, the system uses
                                        'the template to create an old-style dialog box that
                                        'replaces the default dialog box.
    cdlOFNNoTestFileCreate = &H10000    'Specifies that the file is not created before the
                                        'dialog box is closed. This flag should be specified if
                                        'the application saves the file on a create-nonmodify
                                        'network share. When an application specifies this flag,
                                        'the library does not check for write protection, a full
                                        'disk, an open drive door, or network protection.
                                        'Applications using this flag must perform file operations
                                        'carefully, because a file cannot be reopened once it is
                                        'closed.
    cdlOFNNoNetworkButton = &H20000     'Hides and disables the Network button.
    cdlOFNEnableSizing = &H800000       'Windows NT 5.0, Windows 98: Enables the Explorer-style
                                        'dialog box to be resized using either the mouse or the
                                        'keyboard. By default, the Explorer-style Open and Save
                                        'As dialog boxes allow the dialog box to be resized
                                        'regardless of whether this flag is set. This flag is
                                        'necessary only if you provide a hook procedure or
                                        'custom template. The old-style dialog box does not
                                        'permit resizing.
End Enum

'SELECT PRINTER
Public Enum cdlPD
    cdlPDAllPages = &H0
    cdlPDCollate = &H10
    cdlPDDisablePrintToFile = &H80000
    cdlPDHelpButton = &H800
    cdlPDHidePrintToFile = &H100000
    cdlPDNoPageNums = &H8
    cdlPDNoSelection = &H4
    cdlPDNoWarning = &H80
    cdlPDPageNums = &H2
    cdlPDPrintSetup = &H40
    cdlPDPrintToFile = &H20
    cdlPDReturnDC = &H100
    cdlPDReturnDefault = &H400
    cdlPDReturnIC = &H200
    cdlPDSelection = &H1
    cdlPDUseDevModeCopies = &H40000
    cdlPDEnablePrintHook = &H1000               'Enables the hook procedure specified in the
                                                'lpfnPrintHook member. This enables the hook
                                                'procedure for the Print dialog box.
    cdlPDEnableSetupHook = &H2000               'Enables the hook procedure specified in the
                                                'lpfnSetupHook member. This enables the hook
                                                'procedure for the Print Setup dialog box.
    cdlPDEnablePrintTemplate = &H4000           'Indicates that the hInstance and lpPrintTemplateName
                                                'members specify a replacement for the default
                                                'Print dialog box template.
    cdlPDEnableSetupTemplate = &H8000           'Indicates that the hInstance and lpSetupTemplateName
                                                'members specify a replacement for the default
                                                'Print Setup dialog box template.
    cdlPDEnablePrintTemplateHandle = &H10000    'Indicates that the hPrintTemplate member
                                                'identifies a data block that contains a preloaded
                                                'dialog box template.
                                                'This template replaces the default template for
                                                'the Print dialog box. The system ignores the
                                                'lpPrintTemplateName member if this flag is
                                                'specified.
    cdlPDEnableSetupTemplateHandle = &H20000    'Indicates that the hSetupTemplate member
                                                'identifies a data block that contains a preloaded
                                                'dialog box template. This template replaces the
                                                'default template for the Print Setup dialog box.
                                                'The system ignores the lpSetupTemplateName
                                                'member if this flag is specified.
    cdlPDUseDEVMODECopiesAndCollate = &H40000   'This flag indicates whether your application
                                                'supports multiple copies and collation.
                                                'Set this flag on input to indicate that your
                                                'application does not support multiple copies
                                                'and collation. In this case, the nCopies member
                                                'of the PRINTDLG structure always returns 1,
                                                'and cdlPDCollate is never set in the Flags
                                                'member.
    cdlPDNoNetworkButton = &H200000             'Hides and disables the Network button.
End Enum

'SELECT COLOR BOX
Public Enum cdlCC
    cdlCCRGBInit = &H1
    cdlCCFullOpen = &H2
    cdlCCPreventFullOpen = &H4
    cdlCCShowHelp = &H8
    cdlCCEnableHook = &H10              'Use the hook function specified by lpfnHook to process
                                        'the Choose Color box's messages.
    cdlCCEnableTemplate = &H20          'Use the dialog box template identified by hInstance
                                        'identified by hInstance, ignoring lpTemplateName.
    cdlCCEnableTemplateHandle = &H40    'Use the preloaded dialog box template identified by
                                        'hInstance, ignoring lpTemplateName.
    cdlCCSolidColor = &H80              'Only allow the user to select solid colors.
                                        'If the user attempts to select a non-solid color,
                                        'convert it to the closest solid color.
    cdlCCAnyColor = &H100               'Allow the user to select any colour.
End Enum

'SELECT FONTS
Public Enum cdlCF
    cdlCFANSIOnly = &H400
    cdlCFApply = &H200
    cdlCFBoth = &H3
    cdlCFEffects = &H100
    cdlCFFixedPitchOnly = &H4000
    cdlCFForceFontExist = &H10000
    cdlCFHelpButton = &H4               'A.k.a ShowHelp, FontShowHelp.
    cdlCFLimitSize = &H2000
    cdlCFNoFaceSel = &H80000
    cdlCFNoSimulations = &H1000
    cdlCFNoStyleSel = &H100000
    cdlCFNoVectorFonts = &H800
    cdlCFPrinterFonts = &H2
    cdlCFScalableOnly = &H20000
    cdlCFScreenFonts = &H1
    cdlCFTTOnly = &H40000
    cdlCFWYSIWYG = &H8000
    cdlCFEnableHook = &H8               'Use the hook function specified by lpfnHook to process
                                        'the Choose Font dialog's messages.
    cdlCFEnableTemplate = &H10          'Use the dialog box template specified by lpTemplateName.
    cdlCFEnableTemplateHandle = &H20    'Use the preloaded dialog box template specified by
                                        'hInstance.
    cdlCFInittoLogFontStruct = &H40     'Use the settings specified in lpLogFont to select a
                                        'default font in the dialog box.
    cdlCFUseStyle = &H80                'Use information in lpStyle to initialize the dialog box.
    cdlCFScriptsOnly = &H400            'Win NT only: Same as cdlCFANSIOnly.
    cdlCFNoOEMFonts = &H800             'Same as cdlCFNoVectorFonts.
    cdlCFSelectScript = &H400000        'Win 95/98 only: Only list fonts with the proper
                                        'character set.
    cdlCFNoSizeSel = &H200000           'When using aLOGFONT structure to initialize the dialog
                                        'box controls, use this flag to selectively prevent the
                                        'dialog box from displaying an initial selection for the
                                        'font size combo box.
                                        'This is useful when there is no single font size that
                                        'applies to the text selection.
    cdlCFNoScriptSel = &H800000         'Do not select a default script setting for the user.
    cdlCFNoVertFonts = &H1000000        'Win 95/98 only: Do not list vertically-oriented fonts.
    cdlCFNFontNotSupported = &H238      'cdlCFApply or cdlCFEnableHook or cdlCFEnableTemplate or
                                        'cdlCFEnableTemplateHandle
End Enum

'PAGE SETUP
Public Enum cdlPSD
    cdlPSDInWinIniIntlMeasure = &H0                 'Not implemented.
    cdlPSDDefaultMinMargins = &H0                   'Sets the minimum values that the user can
                                                    'specify for the page margins to be the
                                                    'minimum margins allowed by the printer.
                                                    'Zero is the default.
                                                    'This flag is ignored if the cdlPSDMargins
                                                    'and cdlPSDMinMargins flags are also
                                                    'specified.
    cdlPSDMinMargins = &H1                          'Causes the system to use the values
                                                    'specified in the rtMinMargin member as the
                                                    'minimum allowable widths for the left, top,
                                                    'right, and bottom margins.
                                                    'The system prevents the user from entering
                                                    'a width that is less than the specified
                                                    'minimum.
                                                    'If cdlPSDMinMargins is not specified, the
                                                    'system sets the minimum allowable widths to
                                                    'those allowed by the printer.
    cdlPSDMargins = &H2                             'Causes the system to use the values
                                                    'specified in the rtMargin member as the
                                                    'initial widths for the left,top, right, and
                                                    'bottom margins.
                                                    'If cdlPSDMargins is not set, the system sets
                                                    'the initial widths to one inch for all margins.
    cdlPSDInThousandthsofInches = &H4               'Indicates that thousandths of inches are the
                                                    'unit of measurement for margins and paper
                                                    'size.
                                                    'The values in the rtMargin, rtMinMargin,
                                                    'and ptPaperSize members are in thousandths
                                                    'of inches.
                                                    'You can set this flag on input to override
                                                    'the default unit of measurement for the
                                                    'user's locale.
                                                    'When the function returns, the dialog box
                                                    'sets this flag to indicate the units used.
    cdlPSDInHundredthsofMillimeters = &H8           'Indicates that hundredths of millimeters are
                                                    'the unit of measurement for margins and
                                                    'paper size.
                                                    'The values in the rtMargin, rtMinMargin, and
                                                    'ptPaperSize members are in hundredths of
                                                    'millimeters.
                                                    'You can set this flag on input to override
                                                    'the default unit of measurement for the
                                                    'user's locale.
                                                    'When the function returns, the dialog box
                                                    'sets this flag to indicate the units used.
    cdlPSDDisableMargins = &H10                     'Disables the margin controls, preventing the
                                                    'user from setting the margins.
    cdlPSDDisablePrinter = &H20                     'Disables the Printer button, preventing the
                                                    'user from invoking a dialog box that
                                                    'contains additional printer setup information.
    cdlPSDNoWarning = &H80                          'Prevents the system from displaying a
                                                    'warning message when there is no default
                                                    'printer.
    cdlPSDDisableOrientation = &H100                'Disables the orientation controls,
                                                    'preventing the user from setting the page
                                                    'orientation.
    cdlPSDDisablePaper = &H200                      'Disables the paper controls, preventing the
                                                    'user from setting page parameters such as
                                                    'the paper size and source.
    cdlPSDReturnDefault = &H400                     'PageSetupDlg does not display the dialog box.
                                                    'Instead, it sets the hDevNames and hDevMode
                                                    'members to handles to DEVMODE and DEVNAMES
                                                    'structures that are initialized for the
                                                    'system default printer.
                                                    'PageSetupDlg returns an error if either
                                                    'hDevNames or hDevMode is not NULL.
    cdlPSDShowHelp = &H800                          'Causes the dialog box to display the Help
                                                    'button.
                                                    'The hwndOwner member must specify the window
                                                    'to receive the HELPMSGSTRING registered
                                                    'messages that the dialog box sends when the
                                                    'user clicks the Help button.
    cdlPSDEnablePageSetupHook = &H2000              'Enables the hook procedure specified in the
                                                    'lpfnPageSetupHook member.
    cdlPSDEnablePageSetupTemplate = &H8000          'Indicates that the hInstance and
                                                    'lpPageSetupTemplateName members specify a
                                                    'dialog box template to use in place of the
                                                    'default template.
    cdlPSDEnablePageSetupTemplateHandle = &H20000   'Indicates that the hPageSetupTemplate
                                                    'member identifies a data block that contains
                                                    'a preloaded dialog box template.
                                                    'The system ignores the lpPageSetupTemplateName
                                                    'member if this flag is specified.
    cdlPSDEnablePagePaintHook = &H40000             'Enables the hook procedure specified in the
                                                    'lpfnPagePaintHook member.
    cdlPSDDisablePagePainting = &H80000             'Prevents the dialog box from drawing the
                                                    'contents of the sample page.
                                                    'If you enable a PagePaintHook hook
                                                    'procedure, you can still draw the contents
                                                    'of the sample page.
    cdlPSDNnNetworkButton = &H200000                'Hides and disables the Network button.
End Enum

'EXTENDED ERROR CODES
Private Enum CDERR
    CDERR_DIALOGFAILURE = &HFFFF    'The function could not open the dialog box.
    CDERR_FINDRESFAILURE = &H6      'The function failed to find the desired resource.
    CDERR_GENERALCODES = &H0        'The error involved a general common dialog box property.
    CDERR_INITIALIZATION = &H2      'The function failed during initialization (probably insufficient
                                    'memory).
    CDERR_LOADRESFAILURE = &H7      'The function failed to load the desired resource.
    CDERR_LOADSTRFAILURE = &H5      'The function failed to load the desired string.
    CDERR_LOCKRESFAILURE = &H8      'The function failed to lock the desired resource.
    CDERR_MEMALLOCFAILURE = &H9     'The function failed to allocate sufficient memory.
    CDERR_MEMLOCKFAILURE = &HA      'The function failed to lock the desired memory.
    CDERR_NOHINSTANCE = &H4         'The function was not provided with a valid instance handle (if one
                                    'was required).
    CDERR_NOHOOK = &HB              'The function was not provided with a valid hook function handle
                                    '(if one was required).
    CDERR_NOTEMPLATE = &H3          'The function was not provided with a valid template (if one was
                                    'required).
    CDERR_REGISTERMSGFAIL = &HC     'The function failed to successfully register a window message.
    CDERR_STRUCTSIZE = &H1          'The function was provided with an invalid structure size.
    CFERR_CHOOSEFONTCODES = &H2000  'The error involved the Choose Font common dialog box.
    CFERR_MAXLESSTHANMIN = &H2002   'The function was provided with a maximum font size value smaller
                                    'than the provided minimum font size.
    CFERR_NOFONTS = &H2001          'The function could not find any existing fonts.
    FNERR_BUFFERTOOSMALL = &H3003   'The function was provided with a filename buffer which was too
                                    'small.
    FNERR_FILENAMECODES = &H3000    'The error involved the Open File or Save File common dialog box.
    FNERR_INVALIDFILENAME = &H3002  'The function was provided with or received an invalid filename.
    FNERR_SUBCLASSFAILURE = &H3001  'The function had insufficient memory to subclass the list box.
    FRERR_BUFFERLENGTHZERO = &H4001 'The function was provided with an invalid buffer.
    FRERR_FINDREPLACECODES = &H4000 'The error involved the Find or Replace common dialog box.
    PDERR_CREATEICFAILURE = &H100A  'The function failed to create an information context.
    PDERR_DEFAULTDIFFERENT = &H100C 'The function was told that the information provided described the
                                    'default printer, but the default printer's actual settings were
                                    'different.
    PDERR_DNDMMISMATCH = &H1009     'The data in the two data structures describe different printers
                                    '(i.e., they hold conflicting information).
    PDERR_GETDEVMODEFAIL = &H1005   'The printer driver failed to initialize the DEVMODE structure.
    PDERR_INITFAILURE = &H1006      'The function failed during initialization.
    PDERR_LOADDRVFAILURE = &H1004   'The function failed to load the desired device driver.
    PDERR_NODEFAULTPRN = &H1008     'The function could not find a default printer.
    PDERR_NODEVICES = &H1007        'The function could not find any printers.
    PDERR_PARSEFAILURE = &H1002     'The function failed to parse the printer-related strings in
                                    'WIN.INI.
    PDERR_PRINTERCODES = &H1000     'The error involved the Print common dialog box.
    PDERR_PRINTERNOTFOUND = &H100B  'The function could not find information in WIN.INI about the
                                    'requested printer.
    PDERR_RETDEFFAILURE = &H1003    'The handles to the data structures provided were nonzero even
                                    'though the function was asked to return information about the
                                    'default printer.
    PDERR_SETUPFAILURE = &H1001     'The function failed to load the desired resources.
End Enum

'The VB Printer constants, (Help/Printer Object Constants), are all recognised but these apply
'to the Printer OBJECT, not to the PRINTDLG or PAGESETUPDLG structures.

Private Const CCHDEVICENAME = 32    'String buffer sizes.
Private Const CCHFORMNAME = 32
Private Const GMEM_MOVEABLE = &H2   'Memory manipulation flags.
Private Const GMEM_ZEROINIT = &H40

'The API data structures documentation can be found in the Help file.
'This is given for C++ code but the names and function are the same as below.
'e.g. 'Visual Basic Help'/'OPENFILENAME', 'PAGESETUPDLG', 'CHOOSECOLOR', etc.

'==============================================================================================
'FILE OPERATIONS, OPEN/SAVE.

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 SelectedFile       'Custom Type to deal with multiple files.
    nFilesSelected As Integer   'Number of files selected.
    sFiles() As String          'File storage array.
    sLastDirectory As String    'Last directory accessed.
    bCanceled As Boolean        'CANCELed flag.
End Type

'==============================================================================================
'PRINTER SELECTION

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  'See 'Help'/'DEVMODE'
    dmSpecVersion As Integer                        ''
    dmDriverVersion As Integer                      ''
    dmSize As Integer                               ''
    dmDriverExtra As Integer                        ''
    DMFIELDS As Long                        'See below.
    dmOrientation As Integer                    ''
    dmPaperSize As Integer                      ''
    dmPaperLength As Integer                'See 'Help'/'DEVMODE'
    dmPaperWidth As Integer                         ''
    dmScale As Integer                              ''
    dmCopies As Integer                             ''
    dmDefaultSource As Integer              'See below.
    dmPrintQuality As Integer                   ''
    dmColor As Integer                          ''
    dmDuplex As Integer                         ''
    dmYResolution As Integer                'See 'Help'/'DEVMODE'
    dmTTOption As Integer                   'See below.
    DMCOLLATE As Integer                        ''
    dmFormName As String * CCHFORMNAME      'See 'Help'/'DEVMODE'
    dmUnusedPadding As Integer              'Reserved. DO NOT USE.
    dmBitsPerPel As Integer                 'See 'Help'/'DEVMODE'
    dmPelsWidth As Long                             ''
    dmPelsHeight As Long                            ''
    dmDisplayFlags As Long                  'See below.
    dmDisplayFrequency As Long              'See 'Help'/'DEVMODE'
    'Only available if WINVER >=400
    dmICMMethod As Long                     'See below.
    dmICMIntent As Long                         ''
    dmMediaType As Long                         ''
    dmDitherType As Long                        ''
    dmReserved1 As Long                     'Not used. MUST = 0
    dmReserved2 As Long                     'Not used. MUST = 0
    'Only available if WINVER >=500
    dmPanningWidth As Long                  'MUST = 0
    dmPanningHeight As Long                 'MUST = 0
End Type

'Standard variables for fields, (dmFields).
Public Enum DMFIELDS
    DM_ORIENTATION = &H1
    DM_PAPERSIZE = &H2
    DM_PAPERLENGTH = &H4
    DM_PAPERWIDTH = &H8
    DM_SCALE = &H10
    DM_POSITION = &H20              'WINVER >= 500
    DM_NUP = &H4                    'WINVER >= 500
    DM_DISPLAYORIENTATION = &H80    'WINVER >= 501
    DM_COPIES = &H100
    DM_DEFAULTSOURCE = &H200
    DM_PRINTQUALITY = &H400
    DM_COLOR = &H800
    DM_DUPLEX = &H1000
    DM_YRESOLUTION = &H2000
    DM_TTOPTION = &H4000
    DM_COLLATE = &H8000
    DM_FORMNAME = &H10000
    DM_LOGPIXELS = &H20000
    DM_BITSPERPEL = &H40000
    DM_PELSWIDTH = &H80000
    DM_PELSHEIGHT = &H100000
    DM_DISPLAYFLAGS = &H200000
    DM_DISPLAYFREQUENCY = &H400000
    DM_ICMMETHOD = &H800000         'WINVER >= 400
    DM_ICMINTENT = &H1000000              ''
    DM_MEDIATYPE = &H2000000              ''
    DM_DITHERTYPE = &H4000000             ''
    DM_PANNINGWIDTH = &H8000000           ''
    DM_PANNINGHEIGHT = &H10000000         ''
    DM_DISPLAYFIXEDOUTPUT = &H20000000  'WINVER >= 501
End Enum

'Standard variables for orientations, (dmOrientation).
Public Enum DMORIENT
    DMORIENT_PORTRAIT = 1
    DMORIENT_LANDSCAPE = 2
End Enum

'Standard variables for paper sizes, (dmPaperSize).
Public Enum DMPAPER
    DMPAPER_LETTER = 1              'Letter, 8 1/2" x 11"
    DMPAPER_FIRST = DMPAPER_LETTER
    DMPAPER_LETTERSMALL = 2         'Letter Small, 8 1/2" x 11"
    DMPAPER_TABLOID = 3             'Tabloid, 11" x 17"
    DMPAPER_LEDGER = 4              'Ledger, 17" x 11"
    DMPAPER_LEGAL = 5               'Legal, 8 1/2" x 14"
    DMPAPER_STATEMENT = 6           'Statement, 5 1/2" x 8 1/2"
    DMPAPER_EXECUTIVE = 7           'Executive, 7 1/4" x 10 1/2"
    DMPAPER_A3 = 8                  'A3 sheet, 297mm x 420mm
    DMPAPER_A4 = 9                  'A4 Sheet, 210mm x 297mm
    DMPAPER_A4SMALL = 10            'A4 small sheet, 210mm x 297mm
    DMPAPER_A5 = 11                 'A5 sheet, 148mm x 210mm
    DMPAPER_B4 = 12                 'B4 sheet, 250mm x 354mm
    DMPAPER_B5 = 13                 'B5 sheet, 182mm x 257mm
    DMPAPER_FOLIO = 14              'Folio, 8 1/2" x 13"
    DMPAPER_QUARTO = 15             'Quarto, 215mm x 275mm
    DMPAPER_10X14 = 16              '10" x 14" sheet
    DMPAPER_11X17 = 17              '11" x 17" sheet
    DMPAPER_NOTE = 18               'Note, 8 1/2" x 11"
    DMPAPER_ENV_9 = 19              '#9 Envelope, 3 7/8" x 8 7/8"
    DMPAPER_ENV_10 = 20             '#10 Envelope, 4 1/8" x 9 1/2"
    DMPAPER_ENV_11 = 21             '#11 Envelope, 4 1/2" x 10 3/8"
    DMPAPER_ENV_12 = 22             '#12 Envelope, 4 3/4" x 11"
    DMPAPER_ENV_14 = 23             '#14 Envelope, 5" x 11 1/2"
    DMPAPER_CSHEET = 24             'C Sheet, 17" x 22"
    DMPAPER_DSHEET = 25             'D Sheet, 22" x 34"
    DMPAPER_ESHEET = 26             'E Sheet, 34" x 44"
    DMPAPER_ENV_DL = 27             'DL Envelope, 110mm x 220mm
    DMPAPER_ENV_C5 = 28             'C5 Envelope, 162mm x 229mm
    DMPAPER_ENV_C3 = 29             'C3 Envelope, 324mm x 458mm
    DMPAPER_ENV_C4 = 30             'C4 Envelope, 229mm x 324mm
    DMPAPER_ENV_C6 = 31             'C6 Envelope, 114mm x 162mm
    DMPAPER_ENV_C65 = 32            'C65 Envelope, 114mm x 229mm
    DMPAPER_ENV_B4 = 33             'B4 Envelope, 250mm x 353mm
    DMPAPER_ENV_B5 = 34             'B5 Envelope, 176mm x 250mm
    DMPAPER_ENV_B6 = 35             'B6 Envelope, 176mm x 125mm
    DMPAPER_ENV_ITALY = 36          'Italian Envelope, 110mm x 230mm
    DMPAPER_ENV_MONARCH = 37        'Monarch Envelope, 3 7/8" x 7 1/2"
    DMPAPER_ENV_PERSONAL = 38       '6 3/4" Envelope, 3 5/8" x 6 1/2"
    DMPAPER_FANFOLD_US = 39         'US Std Fanfold, 14 7/8" x 11"
    DMPAPER_FANFOLD_STD_GERMAN = 40 'German Std Fanfold, 8 1/2" x 12"
    DMPAPER_FANFOLD_LGL_GERMAN = 41 'German Legal Fanfold, 8 1/2" x 13"
    'If WINVER >= 400 then the following sizes are also available.
    DMPAPER_ISO_B4 = 42             'B4 (ISO) 250mm x 353mm
    DMPAPER_JAPANESE_POSTCARD = 43  'Japanese Postcard 100mm x 148mm
    DMPAPER_9X11 = 44               '9" x 11"
    DMPAPER_10X11 = 45              '10" x 11"
    DMPAPER_15X11 = 46              '15" x 11"
    DMPAPER_ENV_INVITE = 47         'Envelope Invite 220mm x 220mm
    DMPAPER_RESERVED_48 = 48        'RESERVED--DO NOT USE
    DMPAPER_RESERVED_49 = 49        'RESERVED--DO NOT USE
    DMPAPER_LETTER_EXTRA = 50       'Letter Extra 9.275" x 12"
    DMPAPER_LEGAL_EXTRA = 51        'Legal Extra 9.275" x 15"
    DMPAPER_TABLOID_EXTRA = 52      'Tabloid Extra 11.69" x 18"
    DMPAPER_A4_EXTRA = 53           'A4 Extra 9.27" x 12.69"
    DMPAPER_LETTER_TRANSVERSE = 54  'Letter Transverse 8.27" x 11"
    DMPAPER_A4_TRANSVERSE = 55      'A4 Transverse 210MM x 297mm
    DMPAPER_LETTER_EXTRA_TRANSVERSE = 56 'Letter Extra Transverse 9.275" x 12"
    DMPAPER_A_PLUS = 57             'SuperA/SuperA/A4 227mm x 356mm
    DMPAPER_B_PLUS = 58             'SuperB/SuperB/A3 305mm x 487mm
    DMPAPER_LETTER_PLUS = 59        'Letter Plus 8.5" x 12.69"
    DMPAPER_A4_PLUS = 60            'A4 Plus 210mm x 330mm
    DMPAPER_A5_TRANSVERSE = 61      'A5 Transverse 148mm x 210mm
    DMPAPER_B5_TRANSVERSE = 62      'B5 (JIS) Transverse 182mm x 257mm
    DMPAPER_A3_EXTRA = 63           'A3 Extra 322mm x 445mm
    DMPAPER_A5_EXTRA = 64           'A5 Extra 174mm x 235mm
    DMPAPER_B5_EXTRA = 65           'B5 (ISO) Extra 201mm x 276mm
    DMPAPER_A2 = 66                 'A2 420mm x 594 mm
    DMPAPER_A3_TRANSVERSE = 67      'A3 Transverse 297mm x 420mm
    DMPAPER_A3_EXTRA_TRANSVERSE = 68 'A3 Extra Transverse 322mm x 445mm
    DMPAPER_LAST = DMPAPER_A3_EXTRA_TRANSVERSE  'If WINVER >= 400
    'DMPAPER_LAST = DMPAPER_FANFOLD_LGL_GERMAN   'If WINVER < 400
    DMPAPER_USER = 256              'Device-specific papers start from here.
End Enum

'Standard variables for paper source bins, (dmDefaultSource).
Public Enum DMBIN
    DMBIN_UPPER = 1
    DMBIN_ONLYONE = 1
    DMBIN_LOWER = 2
    DMBIN_MIDDLE = 3
    DMBIN_MANUAL = 4
    DMBIN_ENVELOPE = 5
    DMBIN_ENVMANUAL = 6
    DMBIN_AUTO = 7
    DMBIN_TRACTOR = 8
    DMBIN_SMALLFMT = 9
    DMBIN_LARGEFMT = 10
    DMBIN_LARGECAPACITY = 11
    DMBIN_CASSETTE = 14
    DMBIN_FORMSOURCE = 15
    DMBIN_USER = 256        'Device specific values start here.
End Enum

'Standard variables for print quality, (dmPrintQuality).
Public Enum DMRES
    DMRES_DRAFT = -1
    DMRES_LOW = -2
    DMRES_MEDIUM = -3
    DMRES_HIGH = -4
End Enum

'Standard variables for print quality, (dmColor).
Public Enum dmColor
    DMCOLOR_MONOCHROME = 1
    DMCOLOR_COLOR = 2
End Enum

'Standard variables for duplex printing, (if supported), (dmDuplex).
Public Enum DMDUP
    DMDUP_SIMPLEX = 1
    DMDUP_VERTICAL = 2
    DMDUP_HORIZONTAL = 3
End Enum

'Standard variables to specify how TrueType fonts are printed, (dmTTOption).
Public Enum DMTT
    DMTT_BITMAP = 1     'Prints TrueType fonts as graphics. This is the default action for dot-matrix
                        'printers.
    DMTT_DOWNLOAD = 2   'Downloads TrueType fonts as soft fonts. This is the default action for
                        'Hewlett-Packard printers that use Printer Control Language (PCL).
    DMTT_SUBDEV = 3     'Substitute device fonts for TrueType fonts. This is the default action for
                        'PostScript printers.
End Enum

'Standard variables to specify collation, (dmCollate).
Public Enum DMCOLLATE
    DMCOLLATE_FALSE = 0
    DMCOLLATE_TRUE = 1
End Enum

'Standard variables for the display mode, (dmDisplayFlags).
Public Enum DMDISFLAGS
    DM_GRAYSCALE = 1    'Specifies that the display is a noncolor device. If this flag is not set,
                        'color is assumed.
    DM_INTERLACED = 2   'Specifies that the display mode is interlaced. If the flag is not set,
                        'noninterlaced is assumed.
End Enum

'Standard variables to specify how ICM is handled, (dmICMMethod).
Public Enum DMICMMETH
    DMICMMETHOD_NONE = 1    'Specifies that ICM is disabled.
    DMICMMETHOD_SYSTEM = 2  'Specifies that ICM is handled by Windows.
    DMICMMETHOD_DRIVER = 3  'Specifies that ICM is handled by the device driver.
    DMICMMETHOD_DEVICE = 4  'Specifies that ICM is handled by the destination device.
End Enum

'Standard variables to specify which of the three color matching methods is used, (dmICMIntent).
Public Enum DMICM
    DMICM_SATURATE = 1      'Color matching should optimize for color saturation. This value is the
                            'most appropriate choice for business graphs when dithering is not desired.
    DMICM_CONTRAST = 2      'Color matching should optimize for color contrast. This value is the most
                            'appropriate choice for scanned or photographic images when dithering is
                            'desired.
    DMICM_COLORMETRIC = 3   'Color matching should optimize to match the exact color requested. This
                            'value is most appropriate for use with business logos or other images when
                            'an exact color match is desired.
End Enum

'Standard variables to specify the type of media, (dmMediaType).
Public Enum DMMEDIA
    DMMEDIA_STANDARD = 1        'Plain paper.
    DMMEDIA_GLOSSY = 2          'Glossy paper
    DMMEDIA_TRANSPARECNY = 3    'Transparent film
    DMMEDIA_USER = 256          'Custom values start from here, (Thick media, Labels, etc.)
End Enum

'Standard variables to specify the dither type, (dmDitherType).
Public Enum DMDITHER
    DMDITHER_NONE = 1       'No dithering.
    DMDITHER_COARSE = 2     'Dithering with a coarse brush.
    DMDITHER_FINE = 3       'Dithering with a fine brush.
    DMDITHER_LINEART = 4    'Line art dithering, a special dithering method that produces well defined
                            'borders between black, white, and gray scalings.
                            'It is not suitable for images that include continuous graduations in
                            'intensisty and hue such as scanned photographs.
    DMDITHER_GRAYSCALE = 5  'Device does grayscaling.
End Enum

'==============================================================================================
'PAGE SETUP DIALOG.

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 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

'==============================================================================================
'SELECT COLOUR

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

'==============================================================================================
'FONT SELECTION

Private Type CHOOSEFONT
        lStructSize As Long
        hwndOwner As Long
        hDC As Long
        lpLogFont As Long
        iPointSize As Long
        flags As Long
        rgbColors As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
        hInstance As Long
        lpszStyle As String
        nFontType As Integer
        MISSING_ALIGNMENT As Integer    'Never set this variable. It is there only to align the other
                                        'members of the structure in memory.
        nSizeMin As Long
        nSizeMax As Long
End Type

'Standard variables for font types, (nFontType).
Public Enum FONTTYPE
    BOLD_FONTTYPE = &H100
    ITALIC_FONTTYPE = &H200
    PRINTER_FONTTYPE = &H4000
    REGULAR_FONTTYPE = &H400
    SCREEN_FONTTYPE = &H2000
    SIMULATED_FONTTYPE = &H8000
End Enum

'Font display defaults.
Private Const def_font = "Century Gothic" & vbNullChar      'String must be null-terminated.
Private Const pt_sz = 120       'Initial point size in 1/10th pts.
Private Const sz_min = 10       'Minimum point size.
Private Const sz_max = 72       'Maximum point size.

'Variables for returned data.
Private font_name As String
Private font_size As Integer
Private font_bold As Boolean
Private font_italic As Boolean
Private font_underline As Boolean
Private font_strikeout As Boolean
Private font_colour As Long
Private font_weight As String

Private Type LOGFONT
        lfHeight As Long        'See 'Help/LOGFONT' for data.
        lfWidth As Long                     ''
        lfEscapement As Long                ''
        lfOrientation As Long               ''
        lfWeight As Long        'See below for data.
        lfItalic As Byte        'Boolean, TRUE = Italic, etc.
        lfUnderline As Byte         ''
        lfStrikeOut As Byte         ''
        lfCharSet As Byte           'See below for data.
        lfOutPrecision As Byte              ''
        lfClipPrecision As Byte             ''
        lfQuality As Byte                   ''
        lfPitchAndFamily As Byte            ''
        lfFaceName As String * 31   'See 'Help/LOGFONT' for data.
End Type

'Standard variables for font weights, (lfWeight).
Public Enum LFWT
    FW_DONTCARE = 0
    FW_THIN = 100
    FW_EXTRALIGHT = 200
    FW_ULTRALIGHT = 200
    FW_LIGHT = 300
    FW_NORMAL = 400
    FW_REGULAR = 400
    FW_MEDIUM = 0
    FW_SEMIBOLD = 600
    FW_DEMIBOLD = 600
    FW_BOLD = 700
    FW_EXTRABOLD = 800
    FW_ULTRABOLD = 800
    FW_HEAVY = 900
    FW_BLACK = 900
End Enum

'Standard variables for character sets, (lfCharSet).
Public Enum LFCHAR
    ARABIC_CHARSET = 178
    ANSI_CHARSET = 0
    BALTIC_CHARSET = 186
    CHINESEBIG5_CHARSET = 136
    DEFAULT_CHARSET = 1
    EASTEUROPE_CHARSET = 238
    GB2312_CHARSET = 134
    GREEK_CHARSET = 161
    HANGUL_CHARSET = 129
    HEBREW_CHARSET = 177
    JOHAB_CHARSET = 130
    MAC_CHARSET = 77
    OEM_CHARSET = 255
    RUSSIAN_CHARSET = 204
    SHIFTJIS_CHARSET = 128
    SYMBOL_CHARSET = 2
    THAI_CHARSET = 222
    TURKISH_CHARSET = 162
End Enum

'Standard variables for output precision, (lfOutPrecision).
Public Enum LFOUT
    OUT_CHARACTER_PRECIS = 2
    OUT_DEFAULT_PRECIS = 0
    OUT_DEVICE_PRECIS = 5
    OUT_OUTLINE_PRECIS = 8
    OUT_RASTER_PRECIS = 6
    OUT_STRING_PRECIS = 1
    OUT_STROKE_PRECIS = 3
    OUT_TT_ONLY_PRECIS = 7
    OUT_TT_PRECIS = 4
    OUT_SCREEN_OUTLINE_PRECIS = 9
End Enum

'Standard variables for cliping precision, (lfClipPrecision).
Public Enum LFCLIP
    CLIP_CHARACTER_PRECIS = 1
    CLIP_DEFAULT_PRECIS = 0
    CLIP_EMBEDDED = 128
    CLIP_LH_ANGLES = 16
    CLIP_MASK = 15
    CLIP_STROKE_PRECIS = 2
    CLIP_TT_ALWAYS = 32
End Enum

'Standard variables for output quality, (lfQuality).
Public Enum LFQUAL
    DEFAULT_QUALITY = 0
    DRAFT_QUALITY = 1
    PROOF_QUALITY = 2
End Enum

'Standard variables for pitch and family, (lfPitchAndFamily).
'Bits 0 & 1 define the pitch; bits 4 to 7, the quality.
Public Enum LFPITCH         'Binary
    DEFAULT_PITCH = 0       '------00
    FIXED_PITCH = 1         '------01
    VARIABLE_PITCH = 2      '------10
    FF_DONTCARE = 0         '000000--
    FF_ROMAN = 16           '000100--
    FF_SWISS = 32           '001000--
    FF_MODERN = 48          '001100--
    FF_SCRIPT = 64          '010000--
    FF_DECORATIVE = 80      '010100--
End Enum

'API function declarations.
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
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Dim OFName As OPENFILENAME
Dim CustomColors() As Byte

Private in_existance As Boolean     'CD object constructed flag.
Private errcode As Long             'Error code.

'Object constructor.
'Run when an object is created.

Private Sub Class_Initialize()

    If Not in_existance Then
        '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
        
        in_existance = True 'Flag that an instance of the class exists.

    End If
    
End Sub

'Procedure name:    Class_Terminate()
'Run when a page is terminated.

Private Sub Class_Terminate()

    in_existance = False    'Clear the existance flag.
 
End Sub

'Routine to return the name of a file to be OPENed.
'Function name: ShowOpen(ByVal huke As Long, filters as string, flgs as long, title as string,
'                        byval idir as string)
'Parameters:    huke;       hook,
'               filters;    required filter string,
'               flgs;       process flags,
'               title;      window title,
'               idir;       initial directory.

'NB A list of files is delimited by CRs so these need to be removed before
'   the string is used to open the files concerned.
'   A single file is stripped before the text is returned.

Public Function ShowOpen(ByVal huke As Long, filters, flgs, title, ByVal idir As String)
 
    Dim sOpen As SelectedFile
    Dim Count, f_sel As Integer
    Dim FileList As String
    
    canceled = False
 
    OFName.lpstrFilter = filters    'File type filters.
    'See CommonDialog Flags for all options
    OFName.flags = flgs             'Device flags.
    OFName.lpstrTitle = title       'Window title.
    OFName.lpstrInitialDir = idir   'Initial directory.
 
    sOpen = ShwOpen(huke)           'Call API routine.
    
    If Err.Number <> 32755 And sOpen.bCanceled = False Then 'it's OK.
        f_sel = sOpen.nFilesSelected    'Store the number of files selected
        If f_sel > 1 Then 'several files have been selected, so
            FileList = sOpen.sLastDirectory & vbCr      'initialise the file list with the path string.
            For Count = 1 To sOpen.nFilesSelected                   'Use a loop
                FileList = FileList & sOpen.sFiles(Count) & vbCr    'to add the file names
            Next Count                                              'to the list and
            ShowOpen = FileList                                     'return the names.
        Else                                            'Otherwise, it's a single file, so
            FileList = Trim$(OFName.lpstrFile)          'store it,
            FileList = Replace(FileList, " ", "")       'remove any spaces and
            ShowOpen = Replace(FileList, Chr(0), "")    'Chr(0)'s before returning the string.
        End If
    Else                                        'There was an error, so
        errcode = CommDlgExtendedError()        'get the error code and,
        If errcode <> 0 Then                    'if it wasn't a CANCEL,
            error_message "ShowOpen", errcode  'display the error message.
        End If
        canceled = True     'In case of error or a user CANCEL set the CANCELed flag and
        ShowOpen = ""       'return an empty string as an error indicator.
    End If
    
 End Function

'Routine that actually makes the API call.
Private Function ShwOpen(ByVal hWnd As Long) As SelectedFile

    Dim ret As Long                     'API returned value.
    Dim Count As Integer                'File count.
    Dim fd_t As String                  'File title.
    Dim LastCharacter As Integer
    Dim NewCharacter As Integer
    Dim tempFiles(1 To 200) As String   'Temporary file array
    
    On Error Resume Next
    
    OFName.lStructSize = Len(OFName)    'Populate the Open File Name structure.
    OFName.hwndOwner = hWnd
    OFName.lpstrFileTitle = Space$(2048)
    OFName.nMaxFileTitle = Len(OFName.lpstrFileTitle)
    OFName.lpstrFile = OFName.lpstrFile & Space$(2047) & Chr$(0)
    OFName.nMaxFile = Len(OFName.lpstrFile)

    ret = GetOpenFileName(OFName)       'API call.

    If ret Then
        fd_t = Trim$(OFName.lpstrFileTitle)
        If fd_t = "" Or fd_t = Chr(0) Then 'a GROUP of files has been selected.
            LastCharacter = 0
            Count = 0
            'Use a loop to read the selected file names into the 'tempFiles()' array.
            While ShwOpen.nFilesSelected = 0
                NewCharacter = InStr(LastCharacter + 1, OFName.lpstrFile, Chr$(0), vbTextCompare)
                If Count > 0 Then
                    tempFiles(Count) = Mid(OFName.lpstrFile, LastCharacter + 1, NewCharacter - LastCharacter - 1)
                Else
                    ShwOpen.sLastDirectory = Mid(OFName.lpstrFile, LastCharacter + 1, NewCharacter - LastCharacter - 1)
                End If
                Count = Count + 1
                If InStr(NewCharacter + 1, OFName.lpstrFile, Chr$(0), vbTextCompare) = InStr(NewCharacter + 1, OFName.lpstrFile, Chr$(0) & Chr$(0), vbTextCompare) Then
                    tempFiles(Count) = Mid(OFName.lpstrFile, NewCharacter + 1, InStr(NewCharacter + 1, OFName.lpstrFile, Chr$(0) & Chr$(0), vbTextCompare) - NewCharacter - 1)
                    ShwOpen.nFilesSelected = Count
                End If
                LastCharacter = NewCharacter
            Wend
            ReDim ShwOpen.sFiles(1 To ShwOpen.nFilesSelected)
            For Count = 1 To ShwOpen.nFilesSelected
                ShwOpen.sFiles(Count) = tempFiles(Count)
            Next
        Else
            ReDim ShwOpen.sFiles(1 To 1)
            ShwOpen.sLastDirectory = Left$(OFName.lpstrFile, OFName.nFileOffset)
            ShwOpen.nFilesSelected = 1
            ShwOpen.sFiles(1) = Mid(OFName.lpstrFile, OFName.nFileOffset + 1, InStr(1, OFName.lpstrFile, Chr$(0), vbTextCompare) - OFName.nFileOffset - 1)
        End If

        ShwOpen.bCanceled = False
        Exit Function
    Else
        ShwOpen.sLastDirectory = ""
        ShwOpen.nFilesSelected = 0
        ShwOpen.bCanceled = True
        Erase ShwOpen.sFiles
        Exit Function
    End If
    
End Function

'Routine to return the name of a file to be SAVEd.
'Function name: ShowSave(ByVal huke As Long, ByVal filter As String, ByVal ext_txt As String,
'                        ByVal flgs As Long, ByVal title As String, ByVal idir As String)
'                        As String

'Parameters:    huke;       hook,
'               filter;     required filter string,
'               ext_txt;    default extension text, (needed if default filter isn't 1st.),
'               flgs;       process flags,
'               title;      window title,
'               idir;       initial directory.

Public Function ShowSave(ByVal huke As Long, ByVal filter As String, ByVal ext_txt As String, _
                         ByVal flgs As Long, ByVal title As String, ByVal idir As String) _
                         As String

    On Error Resume Next
   
    canceled = False                    'Clear the canceled flag.
    
    OFName.lStructSize = Len(OFName)    'Set the structure size.
    OFName.hwndOwner = huke             'Set the owner window.
    OFName.hInstance = Application.hInstance    'Set the application's instance
    OFName.lpstrFilter = filter         'Set the filter
    OFName.lpstrFile = Space$(254)      'Create a buffer
    OFName.nMaxFile = 255               'Set the maximum number of chars
    OFName.lpstrFileTitle = Space$(254) 'Create a buffer
    OFName.nMaxFileTitle = 255          'Set the maximum number of chars
    OFName.lpstrInitialDir = idir       'Set the initial directory
    OFName.lpstrDefExt = ext_txt        'Set the default extension.
    OFName.lpstrTitle = title           'Set the window title
    OFName.flags = flgs                 'Set the flags

    'Show the 'Save File'dialog
    If GetSaveFileName(OFName) Then 'it's OK, so
        ShowSave = Trim$(OFName.lpstrFile)  'return the file name.
    Else                                        'Otherwise, there was an error, so
        errcode = CommDlgExtendedError()        'get the error code and,
        If errcode <> 0 Then                    'if it wasn't a CANCEL,
            error_message "ShowSave", errcode   'display the error message.
        End If
        canceled = True     'In case of error or a user CANCEL set the CANCELed flag and
        ShowSave = ""       'return an empty string as an error indicator.
    End If
    
End Function

'Routine to display the PRINTER window.
'Procedure name:    ShowPrinter(ByVal huke, ByVal flgs As Long)
'Parameters;        huke;       hook,
'                   lgs;        flags.

Public Sub ShowPrinter(ByVal huke, ByVal flgs As Long)

    '-> 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, s_p, n_p As Integer
    Dim NewPrinterName, NewPortName, DeviceName, PortName, n_str As String ', objPrinter As Printer

    canceled = False 'Clear the CANCELed flag.
    
    'Use PrintDialog to get the handle to a memory
    'block with a DevMode and DevName structures
    PrintDlg.lStructSize = Len(PrintDlg)
    PrintDlg.hwndOwner = huke

    PrintDlg.flags = flgs
    
    On Error Resume Next
    n_p = InStr(Application.ActivePrinter, "on")                                            'Get the 'on' position in the name,
    DeviceName = Left(Application.ActivePrinter, n_p - 2)                                   'hence the device and
    PortName = Right(Application.ActivePrinter, Len(Application.ActivePrinter) - n_p - 2)   'Port names.
 MsgBox PortName
    'Set the current orientation and duplex setting
    DevMode.dmDeviceName = DeviceName 'Printer.DeviceName
    DevMode.dmSize = Len(DevMode)
    DevMode.DMFIELDS = DM_ORIENTATION Or DM_DUPLEX
    'DevMode.dmPaperWidth = Printer.Width
    DevMode.dmOrientation = 1   'Set arbitary defaults.
    DevMode.dmPaperSize = 9
    DevMode.dmDuplex = 1
    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(DeviceName)
        .wOutputOffset = .wDeviceOffset + 1 + Len(PortName)      'Set the default port.
        .wDefault = 0
    End With
    
    DevName.extra = "WINSPOOL" & Chr(0) & DeviceName & Chr(0) & "LPT1:" & Chr(0)
 
    '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 'it's Ok, so
        'First get the DevName structure.
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 100
        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))
'n_str = Replace(DevName.extra, Chr$(0), "|")
'MsgBox n_str
    s_p = DevName.wOutputOffset - 7
    NewPortName = Mid(DevName.extra, s_p, InStr(s_p, DevName.extra, Chr$(0)) - s_p)

'MsgBox NewPortName
        On Error Resume Next
        Application.ActivePrinter = NewPrinterName + " on " + NewPortName
'MsgBox Application.ActivePrinter
        On Error GoTo 0
    Else                                            'Otherwsie, there was an error, so
        errcode = CommDlgExtendedError()            'get the error code and,
        If errcode <> 0 Then                        'if it wasn't a CANCEL,
            error_message "ShowPrinter", errcode    'display the error message.
        End If
        canceled = True         'In case of error or a user CANCEL set the CANCELed flag.
    End If
    
End Sub

'Routine to display the COLOUR selection window.
'Function name: ShowColor(ByVal huke As Long, ByVal flgs As Long) As Long
'Parameters;    huke;   hook,
'               flgs;   flags.

Public Function ShowColor(ByVal huke As Long, ByVal flgs As Long) As Long

    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long

    canceled = False            'Clear the canceled flag.
    
    cc.lStructSize = Len(cc)                            'Set the structure size.
    cc.hwndOwner = huke                                 'Set the owner.
    cc.hInstance = Application.hInstance                        'Set the application's instance.
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)  'Set the custom colors (converted to Unicode).
    cc.flags = flgs                                     'Set the flags.

    'Show the 'Select Color' dialog
    If CHOOSECOLOR(cc) <> 0 Then
        ShowColor = cc.rgbResult
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else                                        'An error occured, or Cancel was pressed
        errcode = CommDlgExtendedError()        'Get the error code and,
        If errcode <> 0 Then                    'if it wasn't a CANCEL,
            error_message "ShowColor", errcode  'display the error message.
        End If
        
        canceled = True 'Set the canceled flag and
        ShowColor = -1  'return an error indicator.
    End If
   
End Function

'Routine to display the FONT selection window.
'Function name: ShowFont(ByVal huke As Long, ByVal flgs As Long) As string
'Parameters;    huke;   hook,
'               flgs;   flags.

Public Function ShowFont(ByVal huke As Long, ByVal flgs As Long) As String
 
    Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
    Dim fontname As String, retval As Long
    
    canceled = False
    
    On Error Resume Next
    
    lfont.lfHeight = 0              'Default height.
    lfont.lfWidth = 0               'Default width.
    lfont.lfEscapement = 0          'Angle between baseline and escapement vector.
    lfont.lfOrientation = 0         'Angle between baseline and orientation vector.
    lfont.lfWeight = FW_NORMAL      'Regular 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 = def_font                         'Set default font.
    
    '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 = huke             'Set opening window.
    cf.hDC = 0 'Printer.hDC            'Device context of default printer (using VB's mechanism)
    cf.lpLogFont = pMem             'Pointer to LOGFONT memory block buffer
    cf.iPointSize = pt_sz           'Initial point size.
    cf.flags = flgs                 'Set flags.
    cf.rgbColors = RGB(0, 0, 0)     'Black text.
    cf.nFontType = REGULAR_FONTTYPE 'Regular font type i.e. not bold or anything
    cf.nSizeMin = sz_min            'Minimum point size
    cf.nSizeMax = sz_max            'Maximum point size
    
    'Now, call the function. If successful, copy the LOGFONT structure back into the structure
    'and then print out the attributes  mentioned earlier that the user selected.
    retval = CHOOSEFONT(cf)  ' open the dialog box
 
    If retval <> 0 Then 'it's OK, so
        CopyMemory lfont, ByVal pMem, Len(lfont)  'copy memory back.
        'Assign class font data values.
        font_size = cf.iPointSize / 10          'Store selected point size,
        font_weight = font_wt(lfont.lfWeight)   'weight as text string,
        font_italic = lfont.lfItalic            'italic flag,
        font_underline = lfont.lfUnderline      'underline flag,
        font_strikeout = lfont.lfStrikeOut      'strikeout flag,
        font_colour = cf.rgbColors              'and colour.
        'Make the fixed-length string holding the font name into a "normal" string.
        font_name = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
        Debug.Print  'end the line
        ShowFont = font_name                    'Store the name.
    Else                                        'Otherwise, there was an error, so
        errcode = CommDlgExtendedError()        'get the error code and,
        If errcode <> 0 Then                    'if it wasn't a CANCEL,
            error_message "ShowOpen", errcode   'display the error message.
        End If
        canceled = True     'In case of error or a user CANCEL set the CANCELed flag and
        ShowFont = ""       'return an empty string as an error indicator.
    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 the pointer, unlock block and
    retval = GlobalFree(hMem)       'free the allocated memory
    
End Function

'Routine to find the font weight as text and set BOLD flag.
'Function name:     font_wt(wt_code)
'Parameter:         wt_code;    the weight code, (see LOGFONT constants).

Function font_wt(wt_code)

    Select Case wt_code
        Case 0
            font_wt = "Don't care"
            font_bold = False
        Case 100
            font_wt = "Thin"
            font_bold = False
        Case 200
            font_wt = "Extra Light"
            font_bold = False
        Case 300
            font_wt = "Light"
            font_bold = False
        Case 400
            font_wt = "Normal"
            font_bold = False
        Case 600
            font_wt = "Demi-bold"
            font_bold = True
        Case 700
            font_wt = "Bold"
            font_bold = True
        Case 800
            font_wt = "Extra-bold"
            font_bold = True
        Case 900
            font_wt = "Black"
            font_bold = True
    End Select
    
End Function

'Routine to return font data.
'Procedure name:    FontData(op)
'Parameter:         op; the option number.

Public Function FontData(op)

    Select Case op
        Case 0 'is the font name.
            FontData = font_name
        Case 1
            FontData = font_size
        Case 2
            FontData = font_bold
        Case 3
            FontData = font_italic
        Case 4
            FontData = font_underline
        Case 5
            FontData = font_strikeout
        Case 6
            FontData = font_colour
        Case 7
            FontData = font_weight
        Case Else
            MsgBox "The parameter must be in the range 0 to 7 ", vbOKOnly, "FONT DATA ERROR"
            FontData = ""
    End Select
    
End Function

'Routine to display the PAGE SETUP window.
'Function name: PageSetupDlg(ByVal huke As Long, ByVal flgs As Long) As Long
'Parameters;    huke;   hook,
'               flgs;   flags.

Public Function ShowPageSetupDlg(ByVal huke, ByVal flgs As Long) As Long

    Dim m_PSD As PAGESETUPDLG
    
    On Error Resume Next
    
    m_PSD.lStructSize = Len(m_PSD)  'Set the structure size
    m_PSD.hwndOwner = huke          'Set the owner window
    m_PSD.hInstance = Application.hInstance 'Set the application instance
    m_PSD.flags = flgs              'Set flags.

    'Show the pagesetup dialog
    If PAGESETUPDLG(m_PSD) Then 'it's Ok, so
        ShowPageSetupDlg = 0    'return a zero for success.
    Else                                                'Otherwise, there was an error, so
        errcode = CommDlgExtendedError()                'get the error code and,
        If errcode <> 0 Then                            'if it wasn't a CANCEL,
            error_message "ShowPageSetupDlg", errcode   'display the error message.
        End If
        canceled = True         'In case of error or a user CANCEL set the CANCELed flag and
        ShowPageSetupDlg = -1   'return an error flag value.
    End If
    
End Function



'Error message routine.
'Reports on the error codes generated by the CommDlgExtendedError function.
'Procedure name:    error_message(ByVal fnct As String, ByVal er_cd as long)
'Parameter:         fnct;   the function/procedure name in which the error occured,
'                   er_cd;  the error code.

Sub error_message(ByVal fnct As String, ByVal er_cd As Long)
 
    Dim txt As String
    
    Select Case er_cd
        Case CDERR_DIALOGFAILURE        '&HFFFF
            txt = "The function could not open the dialog box."
        Case CDERR_GENERALCODES         '0
            txt = "The error involved a general common dialog box property."
        Case CDERR_STRUCTSIZE           '1
            txt = "The function was provided with an invalid structure size."
        Case CDERR_INITIALIZATION       '2
            txt = "The function failed during initialization (probably insufficient memory)."
        Case CDERR_NOTEMPLATE           '3
            txt = "The function was not provided with a valid template (if one was required)."
        Case CDERR_NOHINSTANCE          '4
            txt = "The function was not provided with a valid instance handle (if one was required)."
        Case CDERR_LOADSTRFAILURE       '5
            txt = "The function failed to load the desired string."
        Case CDERR_FINDRESFAILURE       '6
            txt = "The function failed to find the desired resource."
        Case CDERR_LOADRESFAILURE       '7
            txt = "The function failed to load the desired resource."
        Case CDERR_LOCKRESFAILURE       '8
            txt = "The function failed to lock the desired resource."
        Case CDERR_MEMALLOCFAILURE      '9
            txt = "The function failed to allocate sufficient memory."
        Case CDERR_MEMLOCKFAILURE       '&HA
            txt = "The function failed to lock the desired memory."
        Case CDERR_NOHOOK               '&HB
            txt = "The function was not provided with a valid hook function handle (if one was required)."
        Case CDERR_REGISTERMSGFAIL      '&HC
            txt = "The function failed to successfully register a window message."
        Case CFERR_CHOOSEFONTCODES      '&H2000
            txt = "The error involved the Choose Font common dialog box."
        Case CFERR_MAXLESSTHANMIN       '&H2002
            txt = "The function was provided with a maximum font size value smaller than the provided minimum font size."
        Case CFERR_NOFONTS              '&H2001
            txt = "The function could not find any existing fonts."
        Case FNERR_BUFFERTOOSMALL       '&H3003
            txt = "The function was provided with a filename buffer which was too small."
        Case FNERR_FILENAMECODES        '&H3000
            txt = "The error involved the Open File or Save File common dialog box."
        Case FNERR_INVALIDFILENAME      '&H3002
            txt = "The function was provided with or received an invalid filename."
        Case FNERR_SUBCLASSFAILURE      '&H3001
            txt = "The function had insufficient memory to subclass the list box."
        Case FRERR_BUFFERLENGTHZERO     '&H4001
            txt = "The function was provided with an invalid buffer."
        Case FRERR_FINDREPLACECODES     '&H4000
            txt = "The error involved the Find or Replace common dialog box."
        Case PDERR_CREATEICFAILURE      '&H100A
            txt = "The function failed to create an information context."
        Case PDERR_DEFAULTDIFFERENT     '&H100C
            txt = "The function was told that the information provided described the default printer," _
                  + " but the default printer's actual settings were different."
        Case PDERR_DNDMMISMATCH         'H1009
            txt = "The data in the two data structures describe different printers (i.e., they hold conflicting information)."
        Case PDERR_GETDEVMODEFAIL       '&H1005
            txt = "The printer driver failed to initialize the DEVMODE structure."
        Case PDERR_INITFAILURE          '&H1006
            txt = "The function failed during initialization."
        Case PDERR_LOADDRVFAILURE       '&H1004
            txt = "The function failed to load the desired device driver."
        Case PDERR_NODEFAULTPRN         '&H1008
            txt = "The function could not find a default printer."
        Case PDERR_NODEVICES            'H1007
            txt = "The function could not find any printers."
        Case PDERR_PARSEFAILURE         '&H1002
            txt = "The function failed to parse the printer-related strings in WIN.INI."
        Case PDERR_PRINTERCODES         '&H1000
            txt = "The error involved the Print common dialog box."
        Case PDERR_PRINTERNOTFOUND      '&H100B
            txt = "The function could not find information in WIN.INI about the requested printer."
        Case PDERR_RETDEFFAILURE        '&H1003
            txt = "The handles to the data structures provided were nonzero even though the function " _
                  + " was asked to return information about the default printer."
        Case PDERR_SETUPFAILURE         '&H1001
            txt = "The function failed to load the desired resources."
        Case Else
            txt = "Undocumented error."
    End Select
    
    MsgBox fnct + vbCrLf + vbCrLf + txt, vbOKOnly, "FUNCTION ERROR"
 
End Sub
