home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / code / various / cmdial / cmdialog.bas next >
Encoding:
BASIC Source File  |  1995-02-27  |  14.8 KB  |  416 lines
  1.  
  2. ' File Open/Save structure/declarations
  3. Type OpenSaveFile
  4.      lStructSize As Long
  5.      hwndOwner As Integer
  6.      hInstance As Integer
  7.      lpstrFilter As Long
  8.      lpstrCustomFilter As Long
  9.      nMaxCustFilter As Long
  10.      nFilterIndex As Long
  11.      lpstrFile As Long
  12.      nMaxFile As Long
  13.      lpstrFileTitle As Long
  14.      nMaxFileTitle As Long
  15.      lpstrInitialDir As Long
  16.      lpstrTitle As Long
  17.      Flags As Long
  18.      nFileOffset As Integer
  19.      nFileExtension As Integer
  20.      lpstrDefExt As Long
  21.      lCustData As Long
  22.      lpfnHook As Long
  23.      lpTemplateName As Long
  24. End Type
  25.  
  26. Declare Function GetOpenFileName Lib "COMMDLG.DLL" (pOpenSaveFile As OpenSaveFile) As Integer
  27. Declare Function GetSaveFileName Lib "COMMDLG.DLL" (pOpenSaveFile As OpenSaveFile) As Integer
  28. Declare Function GetFileTitle Lib "COMMDLG.DLL" (ByVal FName As String, ByVal Title As String, Size As Integer)
  29.  
  30. Global Const OFN_READONLY = &H1
  31. Global Const OFN_OVERWRITEPROMPT = &H2
  32. Global Const OFN_HIDEREADONLY = &H4
  33. Global Const OFN_NOCHANGEDIR = &H8
  34. Global Const OFN_SHOWHELP = &H10
  35. Global Const OFN_ENABLEHOOK = &H20
  36. Global Const OFN_ENABLETEMPLATE = &H40
  37. Global Const OFN_ENABLETEMPLATEHANDLE = &H80
  38. Global Const OFN_NOVALIDATE = &H100
  39. Global Const OFN_ALLOWMULTISELECT = &H200
  40. Global Const OFN_EXTENSIONDIFFERENT = &H400
  41. Global Const OFN_PATHMUSTEXIST = &H800
  42. Global Const OFN_FILEMUSTEXIST = &H1000
  43. Global Const OFN_CREATEPROMPT = &H2000
  44. Global Const OFN_SHAREAWARE = &H4000
  45. Global Const OFN_NOREADONLYRETURN = &H8000
  46. Global Const OFN_NOTESTFILECREATE = &H10000
  47. Global Const OFN_SHAREFALLTHROUGH = 2
  48. Global Const OFN_SHARENOWARN = 1
  49. Global Const OFN_SHAREWARN = 0
  50.  
  51. 'ChooseColor structure/declarations/constants
  52. Type ChooseColor
  53.      lStructSize As Long
  54.      hwndOwner As Integer
  55.      hInstance  As Integer
  56.      RgbResult As Long
  57.      lpCustColors As Long
  58.      Flags As Long
  59.      lCustData As Long
  60.      lpfnHook As Long
  61.      lpTemplateName As Long
  62. End Type
  63.  
  64. Declare Function ChooseColor Lib "COMMDLG.DLL" (pCHOOSECOLOR As ChooseColor) As Integer
  65.  
  66. Global Const CC_RGBINIT = &H1
  67. Global Const CC_FULLOPEN = &H2
  68. Global Const CC_PREVENTFULLOPEN = &H4
  69. Global Const CC_SHOWHELP = &H8
  70. Global Const CC_ENABLEHOOK = &H10
  71. Global Const CC_ENABLETEMPLATE = &H20
  72. Global Const CC_ENABLETEMPLATEHANDLE = &H40
  73.  
  74. ' ChooseFont structures/declarations/constants
  75. Type ChooseFont
  76.     lStructSize As Long
  77.     hwndOwner As Integer
  78.     hDC As Integer
  79.     lpLogFont As Long
  80.     iPointSize As Integer
  81.     Flags As Long
  82.     rgbColors As Long
  83.     lCustData As Long
  84.     lpfnHook As Long 'Integer ?
  85.     lpTemplateName As Long
  86.     hInstance  As Integer
  87.     lpszStyle As Long
  88.     nfonttype As Integer
  89.     nSizeMin As Integer
  90.     nSizeMax As Integer
  91. End Type
  92.  
  93. Declare Function ChooseFont Lib "COMMDLG.DLL" (pCHOOSEFONT As ChooseFont) As Integer
  94.  
  95. Global Const CF_SCREENFONTS = &H1&
  96. Global Const CF_PRINTERFONTS = &H2&
  97. Global Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
  98. Global Const CF_SHOWHELP = &H4&
  99. Global Const CF_ENABLEHOOK = &H8&
  100. Global Const CF_ENABLETEMPLATE = &H10&
  101. Global Const CF_ENABLETEMPLATEHANDLE = &H20&
  102. Global Const CF_INITTOLOGFONTSTRUCT = &H40&
  103. Global Const CF_USESTYLE = &H80&
  104. Global Const CF_EFFECTS = &H100&
  105. Global Const CF_APPLY = &H200&
  106. Global Const CF_ANSIONLY = &H400&
  107. Global Const CF_NOVECTORFONTS = &H800&
  108. Global Const CF_NOOEMFONTS = CF_NOVECTORFONTS
  109. Global Const CF_NOSIMULATIONS = &H1000&
  110. Global Const CF_LIMITSIZE = &H2000&
  111. Global Const CF_FIXEDPITCHONLY = &H4000&
  112. Global Const CF_WYSIWYG = &H8000&  ' Also need CF_SCREENFONTS and CF_PRINTERFONTS
  113. Global Const CF_FORCEFONTEXIST = &H1000&
  114. Global Const CF_SCALABLEONLY = &H2000&
  115. Global Const CF_TTONLY = &H4000&
  116. Global Const CF_NOFACESEL = &H8000&
  117. Global Const CF_NOSTYLESEL = &H100000
  118. Global Const CF_NOSIZESEL = &H200000
  119. Global Const SIMULATED_FONTTYPE = &H8000
  120. Global Const PRINTER_FONTTYPE = &H4000
  121. Global Const SCREEN_FONTTYPE = &H2000
  122. Global Const BOLD_FONTTYPE = &H100
  123. Global Const ITALIC_FONTTYPE = &H200
  124. Global Const REGULAR_FONTTYPE = &H400
  125. Global Const WM_CHOOSEFONT_GETLOGFONT = (&H400 + 1) 'WM_USER + 1
  126. Global Const LF_FACESIZE = 32
  127.  
  128. Type LOGFONT
  129.     lfHeight As Integer
  130.     lfWidth As Integer
  131.     lfEscapement As Integer
  132.     lfOrientation As Integer
  133.     lfWeight As Integer
  134.     lfItalic As String * 1
  135.     lfUnderline As String * 1
  136.     lfStrikeOut As String * 1
  137.     lfCharSet As String * 1
  138.     lfOutPrecision As String * 1
  139.     lfClipPrecision As String * 1
  140.     lfQuality As String * 1
  141.     lfPitchAndFamily As String * 1
  142.     lfFaceName As String * LF_FACESIZE
  143. End Type
  144.  
  145. Global Const LBSELCHSTRING = "commdlg_LBSelChangedNotify"
  146. Global Const SHAREVISTRING = "commdlg_ShareViolation"
  147. Global Const FILEOKSTRING = "commdlg_FileNameOK"
  148. Global Const COLOROKSTRING = "commdlg_ColorOK"
  149. Global Const SETRGBSTRING = "commdlg_SetRGBColor"
  150. Global Const FINDMSGSTRING = "commdlg_FindReplace"
  151. Global Const HELPMSGSTRING = "commdlg_help"
  152. Global Const CD_LBSELNOITEMS = -1
  153. Global Const CD_LBSELCHANGE = 0
  154. Global Const CD_LBSELSUB = 1
  155. Global Const CD_LBSELADD = 2
  156.  
  157. ' Printer related structures/declarations/constants
  158. Type PrintDlg
  159.     lStructSize As Long
  160.     hwndOwner As Integer
  161.     hDevMode As Integer
  162.     hDevNames As Integer
  163.     hDC As Integer
  164.     Flags As Long
  165.     nFromPage As Integer
  166.     nToPage As Integer
  167.     nMinPage As Integer
  168.     nMaxPage As Integer
  169.     nCopies As Integer
  170.     hInstance As Integer
  171.     lCustData As Long
  172.     lpfnPrintHook As Long
  173.     lpfnSetupHook As Long
  174.     lpPrintTemplateName As Long
  175.     lpSetupTemplateName As Long
  176.     hPrintTemplate As Integer
  177.     hSetupTemplate As Integer
  178. End Type
  179.  
  180. Declare Function PrintDlg Lib "COMMDLG.DLL" (pPrintDLG As PrintDlg) As Integer
  181.  
  182. Global Const PD_ALLPAGES = &H0
  183. Global Const PD_SELECTION = &H1
  184. Global Const PD_PAGENUMS = &H2
  185. Global Const PD_NOSELECTION = &H4
  186. Global Const PD_NOPAGENUMS = &H8
  187. Global Const PD_COLLATE = &H10
  188. Global Const PD_PRINTTOFILE = &H20
  189. Global Const PD_PRINTSETUP = &H40
  190. Global Const PD_NOWARNING = &H80
  191. Global Const PD_RETURNDC = &H100
  192. Global Const PD_RETURNIC = &H200
  193. Global Const PD_RETURNDEFAULT = &H400
  194. Global Const PD_SHOWHELP = &H800
  195. Global Const PD_ENABLEPRINTHOOK = &H1000
  196. Global Const PD_ENABLESETUPHOOK = &H2000
  197. Global Const PD_ENABLEPRINTTEMPLATE = &H4000
  198. Global Const PD_ENABLESETUPTEMPLATE = &H8000
  199. Global Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
  200. Global Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
  201. Global Const PD_USEDEVMODECOPIES = &H40000
  202. Global Const PD_DISABLEPRINTTOFILE = &H80000
  203. Global Const PD_HIDEPRINTTOFILE = &H100000
  204.  
  205. Type DEVNAMES
  206.     wDriverOffset As Integer
  207.     wDeviceOffset As Integer
  208.     wOutputOffset As Integer
  209.     wDefault As Integer
  210. End Type
  211.  
  212. Global Const DN_DEFAULTPRN = &H1
  213.  
  214. Type DevMode
  215.     dmDeviceName As String * 32
  216.     dmSpecVersion As Integer
  217.     dmDriverVersion As Integer
  218.     dmSize As Integer
  219.     dmDriverExtra As Integer
  220.     dmFields As Long
  221.     dmOrientation As Integer
  222.     dmPaperSize As Integer
  223.     dmPaperLength As Integer
  224.     dmPaperWidth As Integer
  225.     dmScale As Integer
  226.     dmCopies As Integer
  227.     dmDefaultSource As Integer
  228.     dmPrintQuality As Integer
  229.     dmColor As Integer
  230.     dmDuplex As Integer
  231.     dmYResolution As Integer
  232.     dmTTOption As Integer
  233. End Type
  234.  
  235. ' Returns error value
  236. Declare Function CommDlgExtendedError Lib "COMMDLG.DLL" () As Long
  237.  
  238. ' Misc. memory declarations/constants
  239. Declare Sub hmemcpy Lib "Kernel" (lpDest As Any, lpSource As Any, ByVal dwBytes As Long)
  240. Declare Function Lstrcpy Lib "KERNEL" (p1 As Any, p2 As Any) As Long
  241. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  242. Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  243. Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  244. Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
  245.  
  246. Global Const GMEM_MOVEABLE = &H2
  247. Global Const GMEM_ZEROINIT = &H40
  248. Global Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  249.  
  250. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  251. Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  252. Global Const LOGPIXELSY = 90    '  Logical pixels/inch in Y
  253.  
  254. Function DialogColor& (Ctrl As Control, CurrColor&)
  255. '   Sample call:
  256. '   Text1.BackColor = DialogColor(Text1, (Text1.BackColor))
  257.     
  258.     Dim i%, rc%, ArrySize%, MemHndl%, MemAddr&, ChsColor As ChooseColor
  259.     
  260.     ReDim CstmClrs(0 To 15) As Long    ' Array for custom colors
  261.     ArrySize% = Len(CstmClrs(0)) * 16  ' Pre-size memory block
  262.  
  263.     MemHndl% = GlobalAlloc(GHND, ArrySize%)
  264.     If MemHndl% = False Then Exit Function
  265.     MemAddr& = GlobalLock(MemHndl%)
  266.  
  267.     ' Preload custom colors array with WHITE
  268.     For i% = 0 To 15
  269.         CstmClrs(i%) = &HFFFFFF
  270.     Next i%
  271.  
  272.     ' Copy custom colors array to memory
  273.     Call hmemcpy(ByVal MemAddr&, CstmClrs(0), ArrySize%)
  274.  
  275.     ChsColor.lStructSize = Len(ChsColor)
  276.     ChsColor.hwndOwner = Ctrl.Parent.hWnd
  277.     ChsColor.lpCustColors = MemAddr&
  278.     ChsColor.RgbResult = CurrColor&
  279.     ChsColor.Flags = ChsColor.Flags Or CC_RGBINIT  ' To pre-select dialog color to current color
  280. '    ChsColor.Flags = ChsColor.Flags Or CC_FULLOPEN  ' To allow custom colors selection
  281.     ChsColor.Flags = ChsColor.Flags Or CC_PREVENTFULLOPEN  ' To prevent custom colors selection
  282.     
  283.     ' Call the ChooseColor function in the Common Dialog DLL
  284.     rc% = ChooseColor(ChsColor)
  285.  
  286.     ' Copy the selected custom colors back into the array
  287.     If rc% <> False Then Call hmemcpy(CstmClrs(0), ByVal MemAddr&, ArrySize%)
  288.     
  289.     i% = GlobalUnlock(MemHndl%)
  290.     i% = GlobalFree(MemHndl%)
  291. '    If rc% = False Then Exit Function
  292.  
  293.     ' Return the selected color
  294.     DialogColor = ChsColor.RgbResult
  295.  
  296.     ' Get the selected custom colors
  297. '    For i% = 0 To UBound(CstmClrs)
  298. '        = Hex$(CstmClrs(i%))
  299. '    Next i%
  300.  
  301. End Function
  302.  
  303. Function DialogFile$ (DirPath$, FileSpec$, Filters$, OpenFile%)
  304. '   Sample call:
  305. '   opening ... DirPath$ = "C:\WINDOWS\VB"
  306. '               FileSpec$ = ""  ' limits to only matching files (wildcards allowed *.*)
  307. '               Filters$ = "Graphic Files|*.bmp; *.ico|Text Files|*.txt"
  308. '               OpenFile% = True
  309. '               tmpfile$ = DialogFile(DirPath$,FileSpec$, Filters$, OpenFile%)
  310.  
  311. '   saving .... DirPath$ = "C:\WINDOWS\VB\PROJECTS"
  312. '               FileSpec$ = "MYFILE.RPT"  ' default file name
  313. '               Filters$ = "Report Files|*.rpt"
  314. '               OpenFile% = False
  315. '               tmpfile$ = DialogFile(DirPath$,FileSpec$, Filters$, OpenFile%)
  316.  
  317.     Dim rc%, FileSize%, MemHndl%, MemAddr&, osFile As OpenSaveFile
  318.     
  319.     Do While InStr(Filters$, "|") <> False
  320.         Mid$(Filters$, InStr(Filters$, "|"), 1) = Chr$(0)  ' Separate with NULL
  321.     Loop
  322.     Filters$ = Filters$ & Chr$(0) & Chr$(0)  ' Terminate with double NULL
  323.  
  324.     FileSpec$ = FileSpec$ & String$(128 - Len(FileSpec$), 0)
  325.     FileSize% = Len(FileSpec$) + Len(Filters$)
  326.     
  327.     MemHndl% = GlobalAlloc(GHND, FileSize%)
  328.     If MemHndl% = False Then Exit Function
  329.     MemAddr& = GlobalLock(MemHndl%)
  330.  
  331.     Call hmemcpy(ByVal MemAddr&, ByVal (FileSpec$ + Filters$), FileSize%)
  332.     osFile.lStructSize = Len(osFile)
  333. '    osFile.hwndOwner =
  334.     osFile.Flags = osFile.Flags Or OFN_HIDEREADONLY
  335.     osFile.Flags = osFile.Flags Or OFN_PATHMUSTEXIST
  336.     If OpenFile% = True Then osFile.Flags = osFile.Flags Or OFN_FILEMUSTEXIST
  337.     If OpenFile% = False Then osFile.Flags = osFile.Flags Or OFN_OVERWRITEPROMPT
  338.     osFile.nFilterIndex = 1
  339.     osFile.lpstrFile = MemAddr&
  340.     osFile.nMaxFile = Len(FileSpec$)
  341.     osFile.lpstrFilter = MemAddr& + Len(FileSpec$)
  342.     If Len(Trim$(DirPath$)) Then  ' Convert DirPath$ to a LONG integer
  343.         If Right$(Trim$(DirPath$), 1) = "\" Then DirPath$ = Left$(DirPath$, Len(DirPath$) - 1)  ' Strip any trailing '\'
  344.         osFile.lpstrInitialDir = Lstrcpy(ByVal DirPath$, ByVal DirPath$)
  345.     End If
  346.     If OpenFile% = True Then
  347.         rc% = GetOpenFileName(osFile)
  348.     Else
  349.         rc% = GetSaveFileName(osFile)
  350.     End If
  351.     If rc% <> False Then
  352.         Call hmemcpy(ByVal FileSpec$, ByVal MemAddr&, Len(FileSpec$))
  353.         DialogFile = Left$(FileSpec$, InStr(FileSpec$, Chr$(0)) - 1)
  354. '       Path = Left$(FileSpec$, osFile.nFileOffset)
  355. '       Filename = Right$(FileSpec$, Len(FileSpec$) - osFile.nFileOffset)
  356. '       Extension = Right$(FileSpec$, Len(FileSpec$) - osFile.nFileExtension)
  357.     End If
  358.     rc% = GlobalUnlock(MemHndl%)
  359.     rc% = GlobalFree(MemHndl%)
  360.  
  361. End Function
  362.  
  363. Function DialogFont% (Ctrl As Control)
  364. '   Sample call:
  365. '   If DialogFont(Text1) = True Then Text1.Text = Text1.FontName
  366.     
  367.     Dim i%, rc%, MemHndl%, MemAddr&, lFont As LOGFONT, cFont As ChooseFont
  368.  
  369.     lFont.lfHeight = Ctrl.FontSize / (72 / GetDeviceCaps(Ctrl.Parent.hDC, LOGPIXELSY)) * -1
  370.     If Ctrl.FontBold = True Then lFont.lfWeight = 700 Else lFont.lfWeight = 300
  371.     If Ctrl.FontItalic = True Then lFont.lfItalic = Chr$(255)
  372.     If Ctrl.FontStrikethru = True Then lFont.lfStrikeOut = Chr$(1)
  373.     If Ctrl.FontUnderline = True Then lFont.lfUnderline = Chr$(1)
  374.     lFont.lfFaceName = Ctrl.FontName & Chr$(0)  ' Terminate with a NULL or it won't work
  375.     
  376.     ' Copy lFont to memory for .lpLogFont
  377.     MemHndl% = GlobalAlloc(GHND, Len(lFont))
  378.     If MemHndl% = False Then Exit Function
  379.     MemAddr& = GlobalLock(MemHndl%)
  380.     Call hmemcpy(ByVal MemAddr&, lFont, Len(lFont))
  381.  
  382.     cFont.lStructSize = Len(cFont)
  383.     cFont.hwndOwner = Ctrl.Parent.hWnd
  384.     cFont.Flags = cFont.Flags Or CF_SCREENFONTS          ' Need this to display on screen
  385.     cFont.Flags = cFont.Flags Or CF_EFFECTS              ' Allow selection of underline, color, etc.
  386.     cFont.Flags = cFont.Flags Or CF_INITTOLOGFONTSTRUCT  ' Default to current settings
  387.     cFont.nfonttype = SCREEN_FONTTYPE
  388.     cFont.rgbColors = Ctrl.ForeColor
  389.     cFont.lpLogFont = MemAddr&
  390.     
  391.     ' Call the ChooseFont function in the Common Dialog DLL
  392.     rc% = ChooseFont(cFont)
  393.     
  394.     ' Copy to the LogFont structure from memory
  395.     If rc% <> False Then Call hmemcpy(lFont, ByVal MemAddr&, Len(lFont))
  396.     i% = GlobalUnlock(MemHndl%)
  397.     i% = GlobalFree(MemHndl%)
  398.     If rc% = False Then Exit Function
  399.  
  400.     ' Copy the LogFont structure to the global DlgFont structure
  401.     Dim tmpname$
  402.     If Len(lFont.lfFaceName) And InStr(lFont.lfFaceName, Chr$(0)) <> False Then
  403.         tmpname$ = Left$(lFont.lfFaceName, InStr(lFont.lfFaceName, Chr$(0)) - 1)
  404.         If Len(tmpname$) <> False Then Ctrl.FontName = tmpname$
  405.     End If
  406.     Ctrl.FontSize = Abs(lFont.lfHeight * (72 / GetDeviceCaps(Ctrl.Parent.hDC, LOGPIXELSY)))
  407.     If lFont.lfWeight < 500 Then Ctrl.FontBold = False Else Ctrl.FontBold = True
  408.     Ctrl.FontItalic = Asc(lFont.lfItalic)
  409.     Ctrl.FontStrikethru = Asc(lFont.lfStrikeOut)
  410.     Ctrl.FontUnderline = Asc(lFont.lfUnderline)
  411.     Ctrl.ForeColor = cFont.rgbColors
  412.     DialogFont = True
  413.  
  414. End Function
  415.  
  416.