home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / jabber1a / commondi.bas next >
Encoding:
BASIC Source File  |  1999-03-03  |  21.0 KB  |  672 lines
  1. Attribute VB_Name = "CommDlgs"
  2. Option Explicit
  3.  
  4. '//
  5. '// Structures
  6. '//
  7.  
  8. Private Type OPENFILENAME
  9.     lStructSize As Long
  10.     hwnd As Long
  11.     hInstance As Long
  12.     lpstrFilter As String
  13.     lpstrCustomFilter As String
  14.     nMaxCustFilter As Long
  15.     nFilterIndex As Long
  16.     lpstrFile As String
  17.     nMaxFile As Long
  18.     lpstrFileTitle As String
  19.     nMaxFileTitle As Long
  20.     lpstrInitialDir As String
  21.     lpstrTitle As String
  22.     Flags As Long
  23.     nFileOffset As Integer
  24.     nFileExtension As Integer
  25.     lpstrDefExt As String
  26.     lCustData As Long
  27.     lpfnHook As Long
  28.     lpTemplateName As String
  29. End Type
  30.  
  31. Private Type COLORSTRUC
  32.     lStructSize As Long
  33.     hwnd As Long
  34.     hInstance As Long
  35.     rgbResult As Long
  36.     lpCustColors As String
  37.     Flags As Long
  38.     lCustData As Long
  39.     lpfnHook As Long
  40.     lpTemplateName As String
  41. End Type
  42.  
  43. Private Const LF_FACESIZE = 32
  44.  
  45. Private Type LOGFONT
  46.     lfHeight As Long
  47.     lfWidth As Long
  48.     lfEscapement As Long
  49.     lfOrientation As Long
  50.     lfWeight As Long
  51.     lfItalic As Byte
  52.     lfUnderline As Byte
  53.     lfStrikeOut As Byte
  54.     lfCharSet As Byte
  55.     lfOutPrecision As Byte
  56.     lfClipPrecision As Byte
  57.     lfQuality As Byte
  58.     lfPitchAndFamily As Byte
  59.     lfFaceName(LF_FACESIZE) As Byte
  60. End Type
  61.  
  62. Private Type FONTSTRUC
  63.     lStructSize As Long
  64.     hwnd As Long
  65.     hDC As Long
  66.     lpLogFont As Long
  67.     iPointSize As Long
  68.     Flags As Long
  69.     rgbColors As Long
  70.     lCustData As Long
  71.     lpfnHook As Long
  72.     lpTemplateName As String
  73.     hInstance As Long
  74.     lpszStyle As String
  75.     nFontType As Integer
  76.     MISSING_ALIGNMENT As Integer
  77.     nSizeMin As Long
  78.     nSizeMax As Long
  79. End Type
  80.  
  81. Private Type DEVMODE
  82.     dmDeviceName As String * 32
  83.     dmSpecVersion As Integer
  84.     dmDriverVersion As Integer
  85.     dmSize As Integer
  86.     dmDriverExtra As Integer
  87.     dmFields As Long
  88.     dmOrientation As Integer
  89.     dmPaperSize As Integer
  90.     dmPaperLength As Integer
  91.     dmPaperWidth As Integer
  92.     dmScale As Integer
  93.     dmCopies As Integer
  94.     dmDefaultSource As Integer
  95.     dmPrintQuality As Integer
  96.     dmColor As Integer
  97.     dmDuplex As Integer
  98.     dmYResolution As Integer
  99.     dmTTOption As Integer
  100.     dmCollate As Integer
  101.     dmFormName As String * 32
  102.     dmUnusedPadding As Integer
  103.     dmBitsPerPel As Integer
  104.     dmPelsWidth As Long
  105.     dmPelsHeight As Long
  106.     dmDisplayFlags As Long
  107.     dmDisplayFreq As Long
  108. End Type
  109.  
  110. Private Type PRINTDLGSTRUC
  111.     lStructSize As Long
  112.     hwnd As Long
  113.     hDevMode As Long
  114.     hDevNames As Long
  115.     hDC As Long
  116.     Flags As Long
  117.     nFromPage As Integer
  118.     nToPage As Integer
  119.     nMinPage As Integer
  120.     nMaxPage As Integer
  121.     nCopies As Integer
  122.     hInstance As Long
  123.     lCustData As Long
  124.     lpfnPrintHook As Long
  125.     lpfnSetupHook As Long
  126.     lpPrintTemplateName As String
  127.     lpSetupTemplateName As String
  128.     hPrintTemplate As Long
  129.     hSetupTemplate As Long
  130. End Type
  131.  
  132. Public Type PRINTPROPS
  133.     Cancel As Boolean
  134.     Device As String
  135.     Copies As Integer
  136.     FromPage As Integer
  137.     ToPage As Integer
  138.     ToFile As Boolean
  139.     Range As Integer
  140. End Type
  141.  
  142. Private Type SHITEMID
  143.     cb As Long
  144.     abID As Byte
  145. End Type
  146.  
  147. Private Type ITEMIDLIST
  148.     mkid As SHITEMID
  149. End Type
  150.  
  151. Private Type BROWSEINFO
  152.     hOwner As Long
  153.     pidlRoot As Long
  154.     pszDisplayName As String
  155.     lpszTitle As String
  156.     ulFlags As Long
  157.     lpfn As Long
  158.     lParam As Long
  159.     iImage As Long
  160. End Type
  161.  
  162. '//
  163. '// Win32s
  164. '//
  165.  
  166. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  167. Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
  168. Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLGSTRUC) As Long
  169. Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As COLORSTRUC) As Long
  170. Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As FONTSTRUC) As Long
  171. Private Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  172. Private Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
  173. Private Declare Function GlobalLock Lib "Kernel32" (ByVal hMem As Long) As Long
  174. Private Declare Function GlobalUnlock Lib "Kernel32" (ByVal hMem As Long) As Long
  175. Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  176. Private Declare Function ConnectToPrinterDlg Lib "winspool.drv" (ByVal hwnd As Long, ByVal Flags As Long) As Long
  177. Private Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  178. Private Declare Function SHGetSpecialFolderLocation Lib "SHELL32.DLL" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
  179. Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
  180. Private Declare Function WriteProfileString Lib "Kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
  181. Private Declare Function GetProfileString Lib "Kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
  182. Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
  183. Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
  184.  
  185.  
  186. '//
  187. '// Constants (Public for Print Properties Structure)
  188. '//
  189.  
  190. Public Const ppRangeAll = 0
  191. Public Const ppRangePages = 1
  192. Public Const ppRangeSelection = 2
  193.  
  194. '//
  195. '// Constants (Public for Print Dialog Box)
  196. '//
  197.  
  198. Public Const PD_NOSELECTION = &H4
  199. Public Const PD_DISABLEPRINTTOFILE = &H80000
  200. Public Const PD_PRINTTOFILE = &H20
  201. Public Const PD_RETURNDC = &H100
  202. Public Const PD_RETURNDEFAULT = &H400
  203. Public Const PD_RETURNIC = &H200
  204. Public Const PD_SELECTION = &H1
  205. Public Const PD_SHOWHELP = &H800
  206. Public Const PD_NOPAGENUMS = &H8
  207. Public Const PD_PAGENUMS = &H2
  208.  
  209. '//
  210. '// Constants (Public for WinHelp)
  211. '//
  212.  
  213. Public Const HELP_COMMAND = &H102&
  214. Public Const HELP_CONTENTS = &H3&
  215. Public Const HELP_CONTEXT = &H1
  216. Public Const HELP_CONTEXTPOPUP = &H8&
  217. Public Const HELP_FORCEFILE = &H9&
  218. Public Const HELP_HELPONHELP = &H4
  219. Public Const HELP_INDEX = &H3
  220. Public Const HELP_KEY = &H101
  221. Public Const HELP_MULTIKEY = &H201&
  222. Public Const HELP_PARTIALKEY = &H105&
  223. Public Const HELP_QUIT = &H2
  224. Public Const HELP_SETCONTENTS = &H5&
  225. Public Const HELP_SETINDEX = &H5
  226. Public Const HELP_SETWINPOS = &H203&
  227.  
  228.  
  229. '//
  230. '// Constants (Private)
  231. '//
  232.  
  233. Private Const FW_BOLD = 700
  234. Private Const GMEM_MOVEABLE = &H2
  235. Private Const GMEM_ZEROINIT = &H40
  236. Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  237. Private Const OFN_ALLOWMULTISELECT = &H200
  238. Private Const OFN_CREATEPROMPT = &H2000
  239. Private Const OFN_ENABLEHOOK = &H20
  240. Private Const OFN_ENABLETEMPLATE = &H40
  241. Private Const OFN_ENABLETEMPLATEHANDLE = &H80
  242. Private Const OFN_EXPLORER = &H80000
  243. Private Const OFN_EXTENSIONDIFFERENT = &H400
  244. Private Const OFN_FILEMUSTEXIST = &H1000
  245. Private Const OFN_HIDEREADONLY = &H4
  246. Private Const OFN_LONGNAMES = &H200000
  247. Private Const OFN_NOCHANGEDIR = &H8
  248. Private Const OFN_NODEREFERENCELINKS = &H100000
  249. Private Const OFN_NOLONGNAMES = &H40000
  250. Private Const OFN_NONETWORKBUTTON = &H20000
  251. Private Const OFN_NOREADONLYRETURN = &H8000
  252. Private Const OFN_NOTESTFILECREATE = &H10000
  253. Private Const OFN_NOVALIDATE = &H100
  254. Private Const OFN_OVERWRITEPROMPT = &H2
  255. Private Const OFN_PATHMUSTEXIST = &H800
  256. Private Const OFN_READONLY = &H1
  257. Private Const OFN_SHAREAWARE = &H4000
  258. Private Const OFN_SHAREFALLTHROUGH = 2
  259. Private Const OFN_SHARENOWARN = 1
  260. Private Const OFN_SHAREWARN = 0
  261. Private Const OFN_SHOWHELP = &H10
  262. Private Const PD_ALLPAGES = &H0
  263. Private Const PD_COLLATE = &H10
  264. Private Const PD_ENABLEPRINTHOOK = &H1000
  265. Private Const PD_ENABLEPRINTTEMPLATE = &H4000
  266. Private Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
  267. Private Const PD_ENABLESETUPHOOK = &H2000
  268. Private Const PD_ENABLESETUPTEMPLATE = &H8000
  269. Private Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
  270. Private Const PD_HIDEPRINTTOFILE = &H100000
  271. Private Const PD_NONETWORKBUTTON = &H200000
  272. Private Const PD_PRINTSETUP = &H40
  273. Private Const PD_USEDEVMODECOPIES = &H40000
  274. Private Const PD_USEDEVMODECOPIESANDCOLLATE = &H40000
  275. Private Const PD_NOWARNING = &H80
  276. Private Const CF_ANSIONLY = &H400&
  277. Private Const CF_APPLY = &H200&
  278. Private Const CF_BITMAP = 2
  279. Private Const CF_PRINTERFONTS = &H2
  280. Private Const CF_PRIVATEFIRST = &H200
  281. Private Const CF_PRIVATELAST = &H2FF
  282. Private Const CF_RIFF = 11
  283. Private Const CF_SCALABLEONLY = &H20000
  284. Private Const CF_SCREENFONTS = &H1
  285. Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
  286. Private Const CF_DIB = 8
  287. Private Const CF_DIF = 5
  288. Private Const CF_DSPBITMAP = &H82
  289. Private Const CF_DSPENHMETAFILE = &H8E
  290. Private Const CF_DSPMETAFILEPICT = &H83
  291. Private Const CF_DSPTEXT = &H81
  292. Private Const CF_EFFECTS = &H100&
  293. Private Const CF_ENABLEHOOK = &H8&
  294. Private Const CF_ENABLETEMPLATE = &H10&
  295. Private Const CF_ENABLETEMPLATEHANDLE = &H20&
  296. Private Const CF_ENHMETAFILE = 14
  297. Private Const CF_FIXEDPITCHONLY = &H4000&
  298. Private Const CF_FORCEFONTEXIST = &H10000
  299. Private Const CF_GDIOBJFIRST = &H300
  300. Private Const CF_GDIOBJLAST = &H3FF
  301. Private Const CF_INITTOLOGFONTSTRUCT = &H40&
  302. Private Const CF_LIMITSIZE = &H2000&
  303. Private Const CF_METAFILEPICT = 3
  304. Private Const CF_NOFACESEL = &H80000
  305. Private Const CF_NOVERTFONTS = &H1000000
  306. Private Const CF_NOVECTORFONTS = &H800&
  307. Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
  308. Private Const CF_NOSCRIPTSEL = &H800000
  309. Private Const CF_NOSIMULATIONS = &H1000&
  310. Private Const CF_NOSIZESEL = &H200000
  311. Private Const CF_NOSTYLESEL = &H100000
  312. Private Const CF_OEMTEXT = 7
  313. Private Const CF_OWNERDISPLAY = &H80
  314. Private Const CF_PALETTE = 9
  315. Private Const CF_PENDATA = 10
  316. Private Const CF_SCRIPTSONLY = CF_ANSIONLY
  317. Private Const CF_SELECTSCRIPT = &H400000
  318. Private Const CF_SHOWHELP = &H4&
  319. Private Const CF_SYLK = 4
  320. Private Const CF_TEXT = 1
  321. Private Const CF_TIFF = 6
  322. Private Const CF_TTONLY = &H40000
  323. Private Const CF_UNICODETEXT = 13
  324. Private Const CF_USESTYLE = &H80&
  325. Private Const CF_WAVE = 12
  326. Private Const CF_WYSIWYG = &H8000
  327. Private Const CFERR_CHOOSEFONTCODES = &H2000
  328. Private Const CFERR_MAXLESSTHANMIN = &H2002
  329. Private Const CFERR_NOFONTS = &H2001
  330. Private Const CC_ANYCOLOR = &H100
  331. Private Const CC_CHORD = 4
  332. Private Const CC_CIRCLES = 1
  333. Private Const CC_ELLIPSES = 8
  334. Private Const CC_ENABLEHOOK = &H10
  335. Private Const CC_ENABLETEMPLATE = &H20
  336. Private Const CC_ENABLETEMPLATEHANDLE = &H40
  337. Private Const CC_FULLOPEN = &H2
  338. Private Const CC_INTERIORS = 128
  339. Private Const CC_NONE = 0
  340. Private Const CC_PIE = 2
  341. Private Const CC_PREVENTFULLOPEN = &H4
  342. Private Const CC_RGBINIT = &H1
  343. Private Const CC_ROUNDRECT = 256 '
  344. Private Const CC_SHOWHELP = &H8
  345. Private Const CC_SOLIDCOLOR = &H80
  346. Private Const CC_STYLED = 32
  347. Private Const CC_WIDE = 16
  348. Private Const CC_WIDESTYLED = 64
  349. Private Const CCERR_CHOOSECOLORCODES = &H5000
  350. Private Const LOGPIXELSY = 90
  351. Private Const CCHDEVICENAME = 32
  352. Private Const CCHFORMNAME = 32
  353. Private Const SIMULATED_FONTTYPE = &H8000
  354. Private Const PRINTER_FONTTYPE = &H4000
  355. Private Const SCREEN_FONTTYPE = &H2000
  356. Private Const BOLD_FONTTYPE = &H100
  357. Private Const ITALIC_FONTTYPE = &H200
  358. Private Const REGULAR_FONTTYPE = &H400
  359. Private Const WM_CHOOSEFONT_GETLOGFONT = (&H400 + 1)
  360. Private Const LBSELCHSTRING = "commdlg_LBSelChangedNotify"
  361. Private Const SHAREVISTRING = "commdlg_ShareViolation"
  362. Private Const FILEOKSTRING = "commdlg_FileNameOK"
  363. Private Const COLOROKSTRING = "commdlg_ColorOK"
  364. Private Const SETRGBSTRING = "commdlg_SetRGBColor"
  365. Private Const FINDMSGSTRING = "commdlg_FindReplace"
  366. Private Const HELPMSGSTRING = "commdlg_help"
  367. Private Const CD_LBSELNOITEMS = -1
  368. Private Const CD_LBSELCHANGE = 0
  369. Private Const CD_LBSELSUB = 1
  370. Private Const CD_LBSELADD = 2
  371. Private Const NOERROR = 0
  372. Private Const CSIDL_DESKTOP = &H0
  373. Private Const CSIDL_PROGRAMS = &H2
  374. Private Const CSIDL_CONTROLS = &H3
  375. Private Const CSIDL_PRINTERS = &H4
  376. Private Const CSIDL_PERSONAL = &H5
  377. Private Const CSIDL_FAVORITES = &H6
  378. Private Const CSIDL_STARTUP = &H7
  379. Private Const CSIDL_RECENT = &H8
  380. Private Const CSIDL_SENDTO = &H9
  381. Private Const CSIDL_BITBUCKET = &HA
  382. Private Const CSIDL_STARTMENU = &HB
  383. Private Const CSIDL_DESKTOPDIRECTORY = &H10
  384. Private Const CSIDL_DRIVES = &H11
  385. Private Const CSIDL_NETWORK = &H12
  386. Private Const CSIDL_NETHOOD = &H13
  387. Private Const CSIDL_FONTS = &H14
  388. Private Const CSIDL_TEMPLATES = &H15
  389. Private Const BIF_RETURNONLYFSDIRS = &H1
  390. Private Const BIF_DONTGOBELOWDOMAIN = &H2
  391. Private Const BIF_STATUSTEXT = &H4
  392. Private Const BIF_RETURNFSANCESTORS = &H8
  393. Private Const BIF_BROWSEFORCOMPUTER = &H1000
  394. Private Const BIF_BROWSEFORPRINTER = &H2000
  395. Private Const HWND_BROADCAST = &HFFFF&
  396. Private Const WM_WININICHANGE = &H1A
  397.  
  398. Public Sub SetDefaultPrinter(objPrn As Printer)
  399.  
  400.     Dim x As Long, szTmp As String
  401.     
  402.     szTmp = objPrn.DeviceName & "," & objPrn.DriverName & "," & objPrn.Port
  403.     x = WriteProfileString("windows", "device", szTmp)
  404.     x = SendMessageByString(HWND_BROADCAST, WM_WININICHANGE, 0&, "windows")
  405.     
  406. End Sub
  407. Public Function GetDefaultPrinter() As String
  408.  
  409.     Dim x As Long, szTmp As String, dwBuf As Long
  410.  
  411.     dwBuf = 1024
  412.     szTmp = Space(dwBuf + 1)
  413.     x = GetProfileString("windows", "device", "", szTmp, dwBuf)
  414.     GetDefaultPrinter = Trim(Left(szTmp, x))
  415.  
  416. End Function
  417. Public Sub ResetDefaultPrinter(szBuf As String)
  418.  
  419.     Dim x As Long
  420.     
  421.     x = WriteProfileString("windows", "device", szBuf)
  422.     x = SendMessageByString(HWND_BROADCAST, WM_WININICHANGE, 0&, "windows")
  423.  
  424. End Sub
  425. Public Function BrowseFolder(f As Form, szDialogTitle As String) As String
  426.  
  427.     Dim x As Long, BI As BROWSEINFO, dwIList As Long, szPath As String, wPos As Integer
  428.     
  429.     BI.hOwner = f.hwnd
  430.     BI.lpszTitle = szDialogTitle
  431.     BI.ulFlags = BIF_RETURNONLYFSDIRS
  432.     dwIList = SHBrowseForFolder(BI)
  433.     szPath = Space$(512)
  434.     x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
  435.     If x Then
  436.         wPos = InStr(szPath, Chr(0))
  437.         BrowseFolder = Left$(szPath, wPos - 1)
  438.     Else
  439.         BrowseFolder = ""
  440.     End If
  441.  
  442. End Function
  443. Public Function DialogConnectToPrinter(f As Form) As Boolean
  444.  
  445.     Dim x As Long
  446.     DialogConnectToPrinter = True
  447.     x = ConnectToPrinterDlg(f.hwnd, 0)
  448.     
  449. End Function
  450. Private Function ByteToString(aBytes() As Byte) As String
  451.  
  452.     Dim dwBytePoint As Long, dwByteVal As Long, szOut As String
  453.     
  454.     dwBytePoint = LBound(aBytes)
  455.     
  456.     While dwBytePoint <= UBound(aBytes)
  457.         
  458.         dwByteVal = aBytes(dwBytePoint)
  459.         
  460.         If dwByteVal = 0 Then
  461.             ByteToString = szOut
  462.             Exit Function
  463.         Else
  464.             szOut = szOut & Chr$(dwByteVal)
  465.         End If
  466.         
  467.         dwBytePoint = dwBytePoint + 1
  468.     
  469.     Wend
  470.     
  471.     ByteToString = szOut
  472.     
  473. End Function
  474. Public Function DialogColor(f As Form, c As Control) As Boolean
  475.  
  476.     Dim x As Long, CS As COLORSTRUC, CustColor(16) As Long
  477.     
  478.     CS.lStructSize = Len(CS)
  479.     CS.hwnd = f.hwnd
  480.     CS.hInstance = App.hInstance
  481.     CS.Flags = CC_SOLIDCOLOR
  482.     CS.lpCustColors = String$(16 * 4, 0)
  483.     x = ChooseColor(CS)
  484.     If x = 0 Then
  485.         DialogColor = False
  486.     Else
  487.         DialogColor = True
  488.         c.ForeColor = CS.rgbResult
  489.     End If
  490.     
  491. End Function
  492.  
  493.  
  494. Public Function DialogFile(f As Form, wMode As Integer, szDialogTitle As String, szFilename As String, szFilter As String, szDefDir As String, szDefExt As String) As String
  495.  
  496.     Dim x As Long, OFN As OPENFILENAME, szFile As String, szFileTitle As String
  497.     
  498.     OFN.lStructSize = Len(OFN)
  499.     OFN.hwnd = f.hwnd
  500.     OFN.lpstrTitle = szDialogTitle
  501.     OFN.lpstrFile = szFilename & String$(250 - Len(szFilename), 0)
  502.     OFN.nMaxFile = 255
  503.     OFN.lpstrFileTitle = String$(255, 0)
  504.     OFN.nMaxFileTitle = 255
  505.     OFN.lpstrFilter = szFilter
  506.     OFN.nFilterIndex = 1
  507.     OFN.lpstrInitialDir = szDefDir
  508.     OFN.lpstrDefExt = szDefExt
  509.  
  510.     If wMode = 1 Then
  511.         OFN.Flags = OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  512.         x = GetOpenFileName(OFN)
  513.     Else
  514.         OFN.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_PATHMUSTEXIST
  515.         x = GetSaveFileName(OFN)
  516.     End If
  517.     
  518.     If x <> 0 Then
  519.     
  520.         '// If InStr(OFN.lpstrFileTitle, Chr$(0)) > 0 Then
  521.         '//     szFileTitle = Left$(OFN.lpstrFileTitle, InStr(OFN.lpstrFileTitle, Chr$(0)) - 1)
  522.         '// End If
  523.         If InStr(OFN.lpstrFile, Chr$(0)) > 0 Then
  524.             szFile = Left$(OFN.lpstrFile, InStr(OFN.lpstrFile, Chr$(0)) - 1)
  525.         End If
  526.         '// OFN.nFileOffset is the number of characters from the beginning of the
  527.         '// full path to the start of the file name
  528.         '// OFN.nFileExtension is the number of characters from the beginning of the
  529.         '// full path to the file's extention, including the (.)
  530.         '// MsgBox "File Name is " & szFileTitle & Chr$(13) & Chr$(10) & "Full path and file is " & szFile, , "Open"
  531.         
  532.         '// DialogFile = szFile & "|" & szFileTitle
  533.         DialogFile = szFile
  534.     
  535.     Else
  536.     
  537.         DialogFile = ""
  538.         
  539.     End If
  540.     
  541. End Function
  542. Public Function DialogFont(f As Form, c As Control) As Boolean
  543.  
  544.     Dim LF As LOGFONT, FS As FONTSTRUC
  545.     Dim lLogFontAddress As Long, lMemHandle As Long
  546.     
  547.     If c.FontBold Then LF.lfWeight = FW_BOLD
  548.     If c.FontItalic = True Then LF.lfItalic = 1
  549.     If c.FontUnderline = True Then LF.lfUnderline = 1
  550.     If c.FontStrikethru = True Then LF.lfStrikeOut = 1
  551.     
  552.     FS.lStructSize = Len(FS)
  553.     
  554.     lMemHandle = GlobalAlloc(GHND, Len(LF))
  555.     If lMemHandle = 0 Then
  556.         DialogFont = False
  557.         Exit Function
  558.     End If
  559.     
  560.     lLogFontAddress = GlobalLock(lMemHandle)
  561.     If lLogFontAddress = 0 Then
  562.         DialogFont = False
  563.         Exit Function
  564.     End If
  565.     
  566.     CopyMemory ByVal lLogFontAddress, LF, Len(LF)
  567.     FS.lpLogFont = lLogFontAddress
  568.     FS.iPointSize = c.FontSize * 10
  569.     FS.Flags = CF_SCREENFONTS Or CF_EFFECTS
  570.     
  571.     If ChooseFont(FS) = 1 Then
  572.     
  573.         CopyMemory LF, ByVal lLogFontAddress, Len(LF)
  574.             
  575.         If LF.lfWeight >= FW_BOLD Then
  576.             c.FontBold = True
  577.         Else
  578.             c.FontBold = False
  579.         End If
  580.                         
  581.         If LF.lfItalic = 1 Then
  582.             c.FontItalic = True
  583.         Else
  584.             c.FontItalic = False
  585.         End If
  586.             
  587.         If LF.lfUnderline = 1 Then
  588.             c.FontUnderline = True
  589.         Else
  590.             c.FontUnderline = False
  591.         End If
  592.         
  593.         If LF.lfStrikeOut = 1 Then
  594.             c.FontStrikethru = True
  595.         Else
  596.             c.FontStrikethru = False
  597.         End If
  598.             
  599.         c.FontName = ByteToString(LF.lfFaceName())
  600.         c.FontSize = CLng(FS.iPointSize / 10)
  601.         
  602.         DialogFont = True
  603.             
  604.     Else
  605.     
  606.         DialogFont = False
  607.             
  608.     End If
  609.     
  610. End Function
  611. Public Function DialogPrint(hwnd As Long, bPages As Boolean, Flags As Long) As PRINTPROPS
  612.  
  613.     Dim DM As DEVMODE, PD As PRINTDLGSTRUC
  614.     Dim lpDM As Long, wNull As Integer, szDevName As String
  615.     
  616.     PD.lStructSize = Len(PD)
  617.     PD.hwnd = hwnd
  618.     PD.hDevMode = 0
  619.     PD.hDevNames = 0
  620.     PD.hDC = 0
  621.     PD.Flags = Flags
  622.     PD.nFromPage = 0
  623.     PD.nToPage = 0
  624.     PD.nMinPage = 0
  625.     If bPages Then PD.nMaxPage = bPages - 1
  626.     PD.nCopies = 0
  627.     DialogPrint.Cancel = True
  628.     
  629.     If PrintDlg(PD) Then
  630.     
  631.         lpDM = GlobalLock(PD.hDevMode)
  632.         CopyMemory DM, ByVal lpDM, Len(DM)
  633.         lpDM = GlobalUnlock(PD.hDevMode)
  634.         
  635.         DialogPrint.Cancel = False
  636.         
  637.         DialogPrint.Device = Left$(DM.dmDeviceName, InStr(DM.dmDeviceName, Chr(0)) - 1)
  638.         
  639.         If PD.Flags And PD_PRINTTOFILE Then DialogPrint.ToFile = True Else DialogPrint.ToFile = False
  640.         
  641.         If PD.Flags And PD_PAGENUMS Then
  642.             DialogPrint.Range = ppRangePages
  643.             DialogPrint.FromPage = PD.nFromPage
  644.             DialogPrint.ToPage = PD.nToPage
  645.         ElseIf PD.Flags And PD_SELECTION Then
  646.             DialogPrint.Range = ppRangeSelection
  647.             DialogPrint.FromPage = 0
  648.             DialogPrint.ToPage = 0
  649.         Else
  650.             DialogPrint.Range = ppRangeAll
  651.             DialogPrint.FromPage = 0
  652.             DialogPrint.ToPage = 0
  653.         End If
  654.         
  655.         If PD.nCopies = 1 Then
  656.             DialogPrint.Copies = DM.dmCopies
  657.         End If
  658.         
  659.     End If
  660.     
  661. End Function
  662. Public Function DialogPrintSetup(f As Form)
  663.  
  664.     Dim x As Long, PD As PRINTDLGSTRUC
  665.  
  666.     PD.lStructSize = Len(PD)
  667.     PD.hwnd = f.hwnd
  668.     PD.Flags = PD_PRINTSETUP
  669.     x = PrintDlg(PD)
  670.     
  671. End Function
  672.