home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD50754222000.psc / basCommonDialog.bas next >
Encoding:
BASIC Source File  |  2000-03-06  |  21.3 KB  |  596 lines
  1. Attribute VB_Name = "basCommonDialog"
  2. Option Explicit
  3.  
  4. Type RECT
  5.     left As Long
  6.     top As Long
  7.     Right As Long
  8.     Bottom As Long
  9. End Type
  10.  
  11. Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  12. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  13. Declare Function GetCurrentThreadId Lib "KERNEL32" () As Long
  14. Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
  15. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  16. Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  17.  
  18. Const GWL_HINSTANCE = (-6)
  19. Const SWP_NOSIZE = &H1
  20. Const SWP_NOZORDER = &H4
  21. Const SWP_NOACTIVATE = &H10
  22. Const HCBT_ACTIVATE = 5
  23. Const WH_CBT = 5
  24.  
  25. Dim hHook As Long
  26.  
  27. Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  28. Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
  29. Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLORS) As Long
  30. Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
  31. Declare Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
  32. Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONTS) As Long
  33. Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLGS) As Long
  34.  
  35. Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  36. Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
  37.  
  38. Public Const OFN_ALLOWMULTISELECT = &H200
  39. Public Const OFN_CREATEPROMPT = &H2000
  40. Public Const OFN_ENABLEHOOK = &H20
  41. Public Const OFN_ENABLETEMPLATE = &H40
  42. Public Const OFN_ENABLETEMPLATEHANDLE = &H80
  43. Public Const OFN_EXPLORER = &H80000
  44. Public Const OFN_EXTENSIONDIFFERENT = &H400
  45. Public Const OFN_FILEMUSTEXIST = &H1000
  46. Public Const OFN_HIDEREADONLY = &H4
  47. Public Const OFN_LONGNAMES = &H200000
  48. Public Const OFN_NOCHANGEDIR = &H8
  49. Public Const OFN_NODEREFERENCELINKS = &H100000
  50. Public Const OFN_NOLONGNAMES = &H40000
  51. Public Const OFN_NONETWORKBUTTON = &H20000
  52. Public Const OFN_NOREADONLYRETURN = &H8000
  53. Public Const OFN_NOTESTFILECREATE = &H10000
  54. Public Const OFN_NOVALIDATE = &H100
  55. Public Const OFN_OVERWRITEPROMPT = &H2
  56. Public Const OFN_PATHMUSTEXIST = &H800
  57. Public Const OFN_READONLY = &H1
  58. Public Const OFN_SHAREAWARE = &H4000
  59. Public Const OFN_SHAREFALLTHROUGH = 2
  60. Public Const OFN_SHAREWARN = 0
  61. Public Const OFN_SHARENOWARN = 1
  62. Public Const OFN_SHOWHELP = &H10
  63. Public Const OFS_MAXPATHNAME = 256
  64.  
  65. Public Const LF_FACESIZE = 32
  66.  
  67. 'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
  68. 'are mine to save long statements; they're not
  69. 'a standard Win32 type.
  70. Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT
  71. Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
  72.  
  73. Public Type OPENFILENAME
  74.     nStructSize As Long
  75.     hwndOwner As Long
  76.     hInstance As Long
  77.     sFilter As String
  78.     sCustomFilter As String
  79.     nCustFilterSize As Long
  80.     nFilterIndex As Long
  81.     sFile As String
  82.     nFileSize As Long
  83.     sFileTitle As String
  84.     nTitleSize As Long
  85.     sInitDir As String
  86.     sDlgTitle As String
  87.     flags As Long
  88.     nFileOffset As Integer
  89.     nFileExt As Integer
  90.     sDefFileExt As String
  91.     nCustDataSize As Long
  92.     fnHook As Long
  93.     sTemplateName As String
  94. End Type
  95.  
  96. Type NMHDR
  97.     hwndFrom As Long
  98.     idfrom As Long
  99.     code As Long
  100. End Type
  101.  
  102. Type OFNOTIFY
  103.         hdr As NMHDR
  104.         lpOFN As OPENFILENAME
  105.         pszFile As String        '  May be NULL
  106. End Type
  107.  
  108. Type CHOOSECOLORS
  109.     lStructSize As Long
  110.     hwndOwner As Long
  111.     hInstance As Long
  112.     rgbResult As Long
  113.     lpCustColors As String
  114.     flags As Long
  115.     lCustData As Long
  116.     lpfnHook As Long
  117.     lpTemplateName As String
  118. End Type
  119.  
  120. Type LOGFONT
  121.     lfHeight As Long
  122.     lfWidth As Long
  123.     lfEscapement As Long
  124.     lfOrientation As Long
  125.     lfWeight As Long
  126.     lfItalic As Byte
  127.     lfUnderline As Byte
  128.     lfStrikeOut As Byte
  129.     lfCharSet As Byte
  130.     lfOutPrecision As Byte
  131.     lfClipPrecision As Byte
  132.     lfQuality As Byte
  133.     lfPitchAndFamily As Byte
  134.     lfFaceName(LF_FACESIZE) As Byte
  135. End Type
  136.  
  137. Public Type CHOOSEFONTS
  138.     lStructSize As Long
  139.     hwndOwner As Long          '  caller's window handle
  140.     hDC As Long                '  printer DC/IC or NULL
  141.     lpLogFont As Long          '  ptr. to a LOGFONT struct
  142.     iPointSize As Long         '  10 * size in points of selected font
  143.     flags As Long              '  enum. type flags
  144.     rgbColors As Long          '  returned text color
  145.     lCustData As Long          '  data passed to hook fn.
  146.     lpfnHook As Long           '  ptr. to hook function
  147.     lpTemplateName As String     '  custom template name
  148.     hInstance As Long          '  instance handle of.EXE that
  149.     lpszStyle As String          '  return the style field here
  150.     nFontType As Integer          '  same value reported to the EnumFonts
  151.     MISSING_ALIGNMENT As Integer
  152.     nSizeMin As Long           '  minimum pt size allowed &
  153.     nSizeMax As Long           '  max pt size allowed if
  154. End Type
  155.  
  156. Public Const CC_RGBINIT = &H1
  157. Public Const CC_FULLOPEN = &H2
  158. Public Const CC_PREVENTFULLOPEN = &H4
  159. Public Const CC_SHOWHELP = &H8
  160. Public Const CC_ENABLEHOOK = &H10
  161. Public Const CC_ENABLETEMPLATE = &H20
  162. Public Const CC_ENABLETEMPLATEHANDLE = &H40
  163. Public Const CC_SOLIDCOLOR = &H80
  164. Public Const CC_ANYCOLOR = &H100
  165.  
  166. Public Const COLOR_FLAGS = CC_FULLOPEN Or CC_ANYCOLOR Or CC_RGBINIT
  167.  
  168. Public Const CF_SCREENFONTS = &H1
  169. Public Const CF_PRINTERFONTS = &H2
  170. Public Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
  171. Public Const CF_SHOWHELP = &H4&
  172. Public Const CF_ENABLEHOOK = &H8&
  173. Public Const CF_ENABLETEMPLATE = &H10&
  174. Public Const CF_ENABLETEMPLATEHANDLE = &H20&
  175. Public Const CF_INITTOLOGFONTSTRUCT = &H40&
  176. Public Const CF_USESTYLE = &H80&
  177. Public Const CF_EFFECTS = &H100&
  178. Public Const CF_APPLY = &H200&
  179. Public Const CF_ANSIONLY = &H400&
  180. Public Const CF_SCRIPTSONLY = CF_ANSIONLY
  181. Public Const CF_NOVECTORFONTS = &H800&
  182. Public Const CF_NOOEMFONTS = CF_NOVECTORFONTS
  183. Public Const CF_NOSIMULATIONS = &H1000&
  184. Public Const CF_LIMITSIZE = &H2000&
  185. Public Const CF_FIXEDPITCHONLY = &H4000&
  186. Public Const CF_WYSIWYG = &H8000 '  must also have CF_SCREENFONTS CF_PRINTERFONTS
  187. Public Const CF_FORCEFONTEXIST = &H10000
  188. Public Const CF_SCALABLEONLY = &H20000
  189. Public Const CF_TTONLY = &H40000
  190. Public Const CF_NOFACESEL = &H80000
  191. Public Const CF_NOSTYLESEL = &H100000
  192. Public Const CF_NOSIZESEL = &H200000
  193. Public Const CF_SELECTSCRIPT = &H400000
  194. Public Const CF_NOSCRIPTSEL = &H800000
  195. Public Const CF_NOVERTFONTS = &H1000000
  196.  
  197. Public Const SIMULATED_FONTTYPE = &H8000
  198. Public Const PRINTER_FONTTYPE = &H4000
  199. Public Const SCREEN_FONTTYPE = &H2000
  200. Public Const BOLD_FONTTYPE = &H100
  201. Public Const ITALIC_FONTTYPE = &H200
  202. Public Const REGULAR_FONTTYPE = &H400
  203.  
  204. Public Const LBSELCHSTRING = "commdlg_LBSelChangedNotify"
  205. Public Const SHAREVISTRING = "commdlg_ShareViolation"
  206. Public Const FILEOKSTRING = "commdlg_FileNameOK"
  207. Public Const COLOROKSTRING = "commdlg_ColorOK"
  208. Public Const SETRGBSTRING = "commdlg_SetRGBColor"
  209. Public Const HELPMSGSTRING = "commdlg_help"
  210. Public Const FINDMSGSTRING = "commdlg_FindReplace"
  211.  
  212. Public Const CD_LBSELNOITEMS = -1
  213. Public Const CD_LBSELCHANGE = 0
  214. Public Const CD_LBSELSUB = 1
  215. Public Const CD_LBSELADD = 2
  216.  
  217. Type PRINTDLGS
  218.         lStructSize As Long
  219.         hwndOwner As Long
  220.         hDevMode As Long
  221.         hDevNames As Long
  222.         hDC As Long
  223.         flags As Long
  224.         nFromPage As Integer
  225.         nToPage As Integer
  226.         nMinPage As Integer
  227.         nMaxPage As Integer
  228.         nCopies As Integer
  229.         hInstance As Long
  230.         lCustData As Long
  231.         lpfnPrintHook As Long
  232.         lpfnSetupHook As Long
  233.         lpPrintTemplateName As String
  234.         lpSetupTemplateName As String
  235.         hPrintTemplate As Long
  236.         hSetupTemplate As Long
  237. End Type
  238.  
  239. Public Const PD_ALLPAGES = &H0
  240. Public Const PD_SELECTION = &H1
  241. Public Const PD_PAGENUMS = &H2
  242. Public Const PD_NOSELECTION = &H4
  243. Public Const PD_NOPAGENUMS = &H8
  244. Public Const PD_COLLATE = &H10
  245. Public Const PD_PRINTTOFILE = &H20
  246. Public Const PD_PRINTSETUP = &H40
  247. Public Const PD_NOWARNING = &H80
  248. Public Const PD_RETURNDC = &H100
  249. Public Const PD_RETURNIC = &H200
  250. Public Const PD_RETURNDEFAULT = &H400
  251. Public Const PD_SHOWHELP = &H800
  252. Public Const PD_ENABLEPRINTHOOK = &H1000
  253. Public Const PD_ENABLESETUPHOOK = &H2000
  254. Public Const PD_ENABLEPRINTTEMPLATE = &H4000
  255. Public Const PD_ENABLESETUPTEMPLATE = &H8000
  256. Public Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
  257. Public Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
  258. Public Const PD_USEDEVMODECOPIES = &H40000
  259. Public Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000
  260. Public Const PD_DISABLEPRINTTOFILE = &H80000
  261. Public Const PD_HIDEPRINTTOFILE = &H100000
  262. Public Const PD_NONETWORKBUTTON = &H200000
  263.  
  264. Type DEVNAMES
  265.         wDriverOffset As Integer
  266.         wDeviceOffset As Integer
  267.         wOutputOffset As Integer
  268.         wDefault As Integer
  269. End Type
  270.  
  271. Public Const DN_DEFAULTPRN = &H1
  272.  
  273. Public Type SelectedFile
  274.     nFilesSelected As Integer
  275.     sFiles() As String
  276.     sLastDirectory As String
  277.     bCanceled As Boolean
  278. End Type
  279.  
  280. Public Type SelectedColor
  281.     oSelectedColor As OLE_COLOR
  282.     bCanceled As Boolean
  283. End Type
  284.  
  285. Public Type SelectedFont
  286.     sSelectedFont As String
  287.     bCanceled As Boolean
  288.     bBold As Boolean
  289.     bItalic As Boolean
  290.     nSize As Integer
  291.     bUnderline As Boolean
  292.     bStrikeOut As Boolean
  293.     lColor As Long
  294.     sFaceName As String
  295. End Type
  296.  
  297. Public FileDialog As OPENFILENAME
  298. Public ColorDialog As CHOOSECOLORS
  299. Public FontDialog As CHOOSEFONTS
  300. Public PrintDialog As PRINTDLGS
  301. Dim parenthWnd As Long
  302.  
  303. Public Function ShowOpen(ByVal hwnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedFile
  304. Dim ret As Long
  305. Dim Count As Integer
  306. Dim fileNameHolder As String
  307. Dim LastCharacter As Integer
  308. Dim NewCharacter As Integer
  309. Dim tempFiles(1 To 200) As String
  310. Dim hInst As Long
  311. Dim Thread As Long
  312.     
  313.     parenthWnd = hwnd
  314.     FileDialog.nStructSize = Len(FileDialog)
  315.     FileDialog.hwndOwner = hwnd
  316.     FileDialog.sFileTitle = Space$(2048)
  317.     FileDialog.nTitleSize = Len(FileDialog.sFileTitle)
  318.     FileDialog.sFile = FileDialog.sFile & Space$(2047) & Chr$(0)
  319.     FileDialog.nFileSize = Len(FileDialog.sFile)
  320.     
  321.     'If FileDialog.flags = 0 Then
  322.         FileDialog.flags = OFS_FILE_OPEN_FLAGS
  323.     'End If
  324.     
  325.     'Set up the CBT hook
  326.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
  327.     Thread = GetCurrentThreadId()
  328.     If centerForm = True Then
  329.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
  330.     Else
  331.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread)
  332.     End If
  333.     
  334.     ret = GetOpenFileName(FileDialog)
  335.  
  336.     If ret Then
  337.         If Trim$(FileDialog.sFileTitle) = "" Then
  338.             LastCharacter = 0
  339.             Count = 0
  340.             While ShowOpen.nFilesSelected = 0
  341.                 NewCharacter = InStr(LastCharacter + 1, FileDialog.sFile, Chr$(0), vbTextCompare)
  342.                 If Count > 0 Then
  343.                     tempFiles(Count) = Mid(FileDialog.sFile, LastCharacter + 1, NewCharacter - LastCharacter - 1)
  344.                 Else
  345.                     ShowOpen.sLastDirectory = Mid(FileDialog.sFile, LastCharacter + 1, NewCharacter - LastCharacter - 1)
  346.                 End If
  347.                 Count = Count + 1
  348.                 If InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0), vbTextCompare) = InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0) & Chr$(0), vbTextCompare) Then
  349.                     tempFiles(Count) = Mid(FileDialog.sFile, NewCharacter + 1, InStr(NewCharacter + 1, FileDialog.sFile, Chr$(0) & Chr$(0), vbTextCompare) - NewCharacter - 1)
  350.                     ShowOpen.nFilesSelected = Count
  351.                 End If
  352.                 LastCharacter = NewCharacter
  353.             Wend
  354.             ReDim ShowOpen.sFiles(1 To ShowOpen.nFilesSelected)
  355.             For Count = 1 To ShowOpen.nFilesSelected
  356.                 ShowOpen.sFiles(Count) = tempFiles(Count)
  357.             Next
  358.         Else
  359.             ReDim ShowOpen.sFiles(1 To 1)
  360.             ShowOpen.sLastDirectory = left$(FileDialog.sFile, FileDialog.nFileOffset)
  361.             ShowOpen.nFilesSelected = 1
  362.             ShowOpen.sFiles(1) = Mid(FileDialog.sFile, FileDialog.nFileOffset + 1, InStr(1, FileDialog.sFile, Chr$(0), vbTextCompare) - FileDialog.nFileOffset - 1)
  363.         End If
  364.         ShowOpen.bCanceled = False
  365.         Exit Function
  366.     Else
  367.         ShowOpen.sLastDirectory = ""
  368.         ShowOpen.nFilesSelected = 0
  369.         ShowOpen.bCanceled = True
  370.         Erase ShowOpen.sFiles
  371.         Exit Function
  372.     End If
  373. End Function
  374.  
  375. Public Function ShowSave(ByVal hwnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedFile
  376. Dim ret As Long
  377. Dim hInst As Long
  378. Dim Thread As Long
  379.     
  380.     parenthWnd = hwnd
  381.     FileDialog.nStructSize = Len(FileDialog)
  382.     FileDialog.hwndOwner = hwnd
  383.     FileDialog.sFileTitle = Space$(2048)
  384.     FileDialog.nTitleSize = Len(FileDialog.sFileTitle)
  385.     If FileDialog.sFile = "" Then
  386.         FileDialog.sFile = Space$(2047) & Chr$(0)
  387.     ElseIf Right(FileDialog.sFile, 1) <> Chr$(0) Then
  388.         FileDialog.sFile = FileDialog.sFile & Space$(2047 - Len(FileDialog.sFile)) & Chr$(0)
  389.     End If
  390.     FileDialog.nFileSize = Len(FileDialog.sFile)
  391.     
  392.     If FileDialog.flags = 0 Then
  393.         FileDialog.flags = OFS_FILE_SAVE_FLAGS
  394.     End If
  395.     
  396.     'Set up the CBT hook
  397.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
  398.     Thread = GetCurrentThreadId()
  399.     If centerForm = True Then
  400.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
  401.     Else
  402.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread)
  403.     End If
  404.     
  405.     ret = GetSaveFileName(FileDialog)
  406.     ReDim ShowSave.sFiles(1)
  407.  
  408.     If ret Then
  409.         ShowSave.sLastDirectory = left$(FileDialog.sFile, FileDialog.nFileOffset)
  410.         ShowSave.nFilesSelected = 1
  411.         ShowSave.sFiles(1) = Mid(FileDialog.sFile, FileDialog.nFileOffset + 1, InStr(1, FileDialog.sFile, Chr$(0), vbTextCompare) - FileDialog.nFileOffset - 1)
  412.         ShowSave.bCanceled = False
  413.         Exit Function
  414.     Else
  415.         ShowSave.sLastDirectory = ""
  416.         ShowSave.nFilesSelected = 0
  417.         ShowSave.bCanceled = True
  418.         Erase ShowSave.sFiles
  419.         Exit Function
  420.     End If
  421. End Function
  422.  
  423. Public Function ShowColor(ByVal hwnd As Long, Optional ByVal centerForm As Boolean = True) As SelectedColor
  424. Dim customcolors() As Byte  ' dynamic (resizable) array
  425. Dim i As Integer
  426. Dim ret As Long
  427. Dim hInst As Long
  428. Dim Thread As Long
  429.  
  430.     parenthWnd = hwnd
  431.     If ColorDialog.lpCustColors = "" Then
  432.         ReDim customcolors(0 To 16 * 4 - 1) As Byte  'resize the array
  433.     
  434.         For i = LBound(customcolors) To UBound(customcolors)
  435.           customcolors(i) = 254 ' sets all custom colors to white
  436.         Next i
  437.         
  438.         ColorDialog.lpCustColors = StrConv(customcolors, vbUnicode)  ' convert array
  439.     End If
  440.     
  441.     ColorDialog.hwndOwner = hwnd
  442.     ColorDialog.lStructSize = Len(ColorDialog)
  443.     ColorDialog.flags = COLOR_FLAGS
  444.     
  445.     'Set up the CBT hook
  446.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
  447.     Thread = GetCurrentThreadId()
  448.     If centerForm = True Then
  449.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
  450.     Else
  451.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread)
  452.     End If
  453.     
  454.     ret = ChooseColor(ColorDialog)
  455.     If ret Then
  456.         ShowColor.bCanceled = False
  457.         ShowColor.oSelectedColor = ColorDialog.rgbResult
  458.         Exit Function
  459.     Else
  460.         ShowColor.bCanceled = True
  461.         ShowColor.oSelectedColor = &H0&
  462.         Exit Function
  463.     End If
  464. End Function
  465.  
  466. Public Function ShowFont(ByVal hwnd As Long, ByVal startingFontName As String, Optional ByVal centerForm As Boolean = True) As SelectedFont
  467. Dim ret As Long
  468. Dim lfLogFont As LOGFONT
  469. Dim hInst As Long
  470. Dim Thread As Long
  471. Dim i As Integer
  472.     
  473.     parenthWnd = hwnd
  474.     FontDialog.nSizeMax = 0
  475.     FontDialog.nSizeMin = 0
  476.     FontDialog.nFontType = Screen.FontCount
  477.     FontDialog.hwndOwner = hwnd
  478.     FontDialog.hDC = 0
  479.     FontDialog.lpfnHook = 0
  480.     FontDialog.lCustData = 0
  481.     FontDialog.lpLogFont = VarPtr(lfLogFont)
  482.     FontDialog.iPointSize = 10
  483.     FontDialog.lpTemplateName = Space$(2048)
  484.     FontDialog.rgbColors = RGB(0, 255, 255)
  485.     FontDialog.lStructSize = Len(FontDialog)
  486.     
  487.     If FontDialog.flags = 0 Then
  488.         FontDialog.flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT 'Or CF_EFFECTS
  489.     End If
  490.     
  491.     For i = 0 To Len(startingFontName) - 1
  492.         lfLogFont.lfFaceName(i) = Asc(Mid(startingFontName, i + 1, 1))
  493.     Next
  494.     
  495.     'Set up the CBT hook
  496.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
  497.     Thread = GetCurrentThreadId()
  498.     If centerForm = True Then
  499.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
  500.     Else
  501.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread)
  502.     End If
  503.     
  504.     ret = ChooseFont(FontDialog)
  505.         
  506.     If ret Then
  507.         ShowFont.bCanceled = False
  508.         ShowFont.bBold = IIf(lfLogFont.lfWeight > 400, 1, 0)
  509.         ShowFont.bItalic = lfLogFont.lfItalic
  510.         ShowFont.bStrikeOut = lfLogFont.lfStrikeOut
  511.         ShowFont.bUnderline = lfLogFont.lfUnderline
  512.         ShowFont.lColor = FontDialog.rgbColors
  513.         ShowFont.nSize = FontDialog.iPointSize / 10
  514.         For i = 0 To 31
  515.             ShowFont.sSelectedFont = ShowFont.sSelectedFont + Chr(lfLogFont.lfFaceName(i))
  516.         Next
  517.     
  518.         ShowFont.sSelectedFont = Mid(ShowFont.sSelectedFont, 1, InStr(1, ShowFont.sSelectedFont, Chr(0)) - 1)
  519.         Exit Function
  520.     Else
  521.         ShowFont.bCanceled = True
  522.         Exit Function
  523.     End If
  524. End Function
  525. Public Function ShowPrinter(ByVal hwnd As Long, Optional ByVal centerForm As Boolean = True) As Long
  526. Dim hInst As Long
  527. Dim Thread As Long
  528.     
  529.     parenthWnd = hwnd
  530.     PrintDialog.hwndOwner = hwnd
  531.     PrintDialog.lStructSize = Len(PrintDialog)
  532.     
  533.     'Set up the CBT hook
  534.     hInst = GetWindowLong(hwnd, GWL_HINSTANCE)
  535.     Thread = GetCurrentThreadId()
  536.     If centerForm = True Then
  537.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterForm, hInst, Thread)
  538.     Else
  539.         hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProcCenterScreen, hInst, Thread)
  540.     End If
  541.     
  542.     ShowPrinter = PrintDlg(PrintDialog)
  543. End Function
  544. Private Function WinProcCenterScreen(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  545.     Dim rectForm As RECT, rectMsg As RECT
  546.     Dim x As Long, y As Long
  547.     If lMsg = HCBT_ACTIVATE Then
  548.         'Show the MsgBox at a fixed location (0,0)
  549.         GetWindowRect wParam, rectMsg
  550.         x = Screen.Width / Screen.TwipsPerPixelX / 2 - (rectMsg.Right - rectMsg.left) / 2
  551.         y = Screen.Height / Screen.TwipsPerPixelY / 2 - (rectMsg.Bottom - rectMsg.top) / 2
  552.         Debug.Print "Screen " & Screen.Height / 2
  553.         Debug.Print "MsgBox " & (rectMsg.Right - rectMsg.left) / 2
  554.         SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
  555.         'Release the CBT hook
  556.         UnhookWindowsHookEx hHook
  557.     End If
  558.     WinProcCenterScreen = False
  559. End Function
  560.  
  561. Private Function WinProcCenterForm(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  562.     Dim rectForm As RECT, rectMsg As RECT
  563.     Dim x As Long, y As Long
  564.     'On HCBT_ACTIVATE, show the MsgBox centered over Form1
  565.     If lMsg = HCBT_ACTIVATE Then
  566.         'Get the coordinates of the form and the message box so that
  567.         'you can determine where the center of the form is located
  568.         GetWindowRect parenthWnd, rectForm
  569.         GetWindowRect wParam, rectMsg
  570.         x = (rectForm.left + (rectForm.Right - rectForm.left) / 2) - ((rectMsg.Right - rectMsg.left) / 2)
  571.         y = (rectForm.top + (rectForm.Bottom - rectForm.top) / 2) - ((rectMsg.Bottom - rectMsg.top) / 2)
  572.         'Position the msgbox
  573.         SetWindowPos wParam, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE
  574.         'Release the CBT hook
  575.         UnhookWindowsHookEx hHook
  576.      End If
  577.      WinProcCenterForm = False
  578. End Function
  579.  
  580. Public Function DetermineDirectory(inputString As String) As String
  581. Dim pos As Integer
  582.     pos = InStrRev(inputString, "\", , vbTextCompare)
  583.     DetermineDirectory = Mid(inputString, 1, pos)
  584. End Function
  585. Public Function DetermineFilename(inputString As String) As String
  586. Dim pos As Integer
  587.     If InStr(1, inputString, "\") = 0 Then
  588.         DetermineFilename = inputString
  589.     Else
  590.         pos = InStrRev(inputString, "\", , vbTextCompare)
  591.         DetermineFilename = Mid(inputString, pos + 1, Len(inputString) - pos)
  592.     End If
  593. End Function
  594.  
  595.  
  596.