home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR3 / LANG20.ZIP / CMNDLG.BAS next >
BASIC Source File  |  1993-11-08  |  9KB  |  237 lines

  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Common Dialog Toolkit
  3. '
  4. ' Copyright (C) 1982-1992 Microsoft Corporation
  5. '
  6. ' You have a royalty-free right to use, modify, reproduce
  7. ' and distribute the sample applications and toolkits provided with
  8. ' Visual Basic for MS-DOS (and/or any modified version)
  9. ' in any way you find useful, provided that you agree that
  10. ' Microsoft has no warranty, obligations or liability for
  11. ' any of the sample applications or toolkits.
  12. ' ------------------------------------------------------------------------
  13.  
  14. ' Include file containing declarations for called procedures.
  15. '$INCLUDE: 'CMNDLG.BI'
  16.  
  17. ' Common dialog form
  18. '$FORM frmCmnDlg
  19.  
  20. CONST FALSE = 0
  21. CONST TRUE = NOT FALSE
  22.  
  23. ' CmnDlgClose common dialog support routine
  24. '
  25. ' Unloads common dialog form (if you have preloaded it for
  26. ' better performance) so program will terminate,
  27. ' otherwise common dialog form will remain loaded but
  28. ' invisible.  This routine should be called if
  29. ' CmnDlgRegister was used to preload the form.  If
  30. ' CmnDlgRegister was not used, the form will be unloaded
  31. ' after each use.
  32. '
  33. SUB CmnDlgClose ()
  34.     UNLOAD frmCmnDlg            ' Unload form.
  35. END SUB
  36.  
  37. ' CmnDlgRegister common dialog support routine
  38. '
  39. ' Loads and registers common dialog form before using it
  40. ' to obtain better performance (loaded forms display faster
  41. ' than unloaded forms).  Form will remain loaded (but
  42. ' invisible) until this routine is called again to
  43. ' unload it.  Thus, all common dialog usage in your
  44. ' program will be faster (form is not loaded and unload
  45. ' each time a common dialog is invoked).  Keeping the
  46. ' form loaded requires more memory, however, than loading
  47. ' and unloading it each time a common dialog is used.
  48. '
  49. ' Use of this routine is optional since the common dialog
  50. ' form does not need to be loaded before it is used (each
  51. ' common dialog routine will load the form is it is not
  52. ' loaded).
  53. '
  54. ' Parameters:
  55. '   Success - returns TRUE (-1) if the load or unload
  56. '           attempt was successful, otherwise returns
  57. '           FALSE (0).
  58. '
  59. SUB CmnDlgRegister (Success AS INTEGER)
  60.     ' Set up error handling.
  61.     ON LOCAL ERROR GOTO RegisterError
  62.  
  63.     LOAD frmCmnDlg              ' Load form.
  64.     frmCmnDlg.Tag = "H"         ' Set flag for keeping form loaded after
  65.                                 ' each common dialog usage.
  66.  
  67.     Success = TRUE
  68.     EXIT SUB
  69.  
  70. ' Option error handling routine.
  71. ' Trap errors that occur when preloading dialog.
  72. RegisterError:
  73.     SELECT CASE ERR
  74.     CASE 7:                                       ' Out of memory.
  75.           MSGBOX "Out of memory.  Can't load Common Dialogs.", 0, "Common Dialog"
  76.           Success = FALSE
  77.           EXIT SUB
  78.     CASE ELSE
  79.           MSGBOX ERROR$ + ".  Can't load Common Dialogs.", 0, "Common Dialog"
  80.           Success = FALSE
  81.           EXIT SUB
  82.     END SELECT
  83. END SUB
  84.  
  85. ' FileSave common dialog support routine
  86. '
  87. ' Displays Save dialog which allows users to specify
  88. ' filename for subsequent file save operation.
  89. ' This procedure only provides the user interface and
  90. ' returns user input.  It does not actually carry out
  91. ' the corresponding action.
  92. '
  93. ' Parameters:
  94. '   FileName - returns the name (without path) of the
  95. '           file for the save operation.  To supply
  96. '           default filename in dialog, assign default
  97. '           to FileName then pass it to this procedure.
  98. '   PathName - returns the path (without filename) of
  99. '           the file for the save operation.  To supply
  100. '           default path in dialog, assign default to
  101. '           PathName then pass it to this procedure.
  102. '           Note, only pass a valid drive and path. Do
  103. '           not include a filename or file pattern.
  104. '   DefaultExt - sets the default search pattern for the
  105. '           File Listbox.  Default pattern when DefaultExt
  106. '           is null is "*.*".  To specify a different
  107. '           search pattern (i.e. "*.BAS"), assign new
  108. '           value to DefaultExt then pass it to this
  109. '           procedure.
  110. '   DialogTitle - sets the dialog title.  Default title
  111. '           when DialogTitle is null is "Save As".  To
  112. '           specify a different title (i.e. "Save My File"),
  113. '           assign new value to DialogTitle then pass it to
  114. '           this procedure.
  115. '   ForeColor - sets the dialog foreground color.  Does not affect
  116. '           SCREEN.ControlPanel color settings.
  117. '   BackColor - sets the dialog background color.  Does not affect
  118. '           SCREEN.ControlPanel color settings.
  119. '   Flags - unused.  Use this to customize dialog action if needed.
  120. '   Cancel - returns whether or not user pressed the dialog's Cancel
  121. '           button.  True (-1) means the user cancelled the dialog.
  122. '
  123. SUB FileSave (FileName AS STRING, PathName AS STRING, DefaultExt AS STRING, DialogTitle AS STRING, ForeColor AS INTEGER, BackColor AS INTEGER, Flags AS INTEGER, Cancel AS INTEGER)
  124.     ' Set up error handling for option validation.
  125.     ON LOCAL ERROR GOTO FileSaveError
  126.  
  127.     ' Set form caption.
  128.     IF DialogTitle = "" THEN
  129.         frmCmnDlg.Caption = "Save As"
  130.     ELSE
  131.         frmCmnDlg.Caption = DialogTitle
  132.     END IF
  133.     frmCmnDlg.Tag = frmCmnDlg.Tag + "SAVE"              ' Set form tag for common unload procedure.
  134.  
  135.     ' Determine search pattern for file listbox.
  136.     IF DefaultExt <> "" THEN
  137.         frmCmnDlg.filOpenList.Pattern = DefaultExt
  138.     ELSE
  139.         frmCmnDlg.filOpenList.Pattern = "*.*"
  140.     END IF
  141.  
  142.     ' Determine default path.
  143.     IF PathName <> "" THEN
  144.         ' If the path ends with a backslash, remove it.
  145.         IF RIGHT$(PathName, 1) = "\" THEN
  146.             PathName = LEFT$(PathName, LEN(PathName) - 1)
  147.         END IF
  148.         ' Set drive and path for file-system controls.
  149.  
  150.         ' Set File listbox path.  If PathName is different
  151.         ' than current path, PathChange event will be triggered
  152.         ' which updates Drive listbox drive and Directory listbox path.
  153.         frmCmnDlg.filOpenList.Path = PathName
  154.     END IF
  155.     ' Display current path to the user.
  156.     frmCmnDlg.lblOpenPath.Caption = frmCmnDlg.filOpenList.Path
  157.  
  158.     ' Determine default filename to display in edit field.
  159.     IF FileName <> "" THEN
  160.         frmCmnDlg.txtOpenFile.Text = UCASE$(FileName)
  161.     ELSE
  162.         frmCmnDlg.txtOpenFile.Text = frmCmnDlg.filOpenList.Pattern
  163.     END IF
  164.  
  165.     ' Set default and cancel command buttons.
  166.     frmCmnDlg.cmdOpenOK.Default = TRUE
  167.     frmCmnDlg.cmdOpenCancel.Cancel = TRUE
  168.  
  169.     ' Size and position Open/Save container.
  170.     frmCmnDlg.pctFileOpen.BorderStyle = 0
  171.     frmCmnDlg.pctFileOpen.visible = TRUE
  172.  
  173.     ' Size and center dialog.
  174.     frmCmnDlg.MOVE frmCmnDlg.Left, frmCmnDlg.Top, frmCmnDlg.pctFileOpen.Width + 2, frmCmnDlg.pctFileOpen.Height + 2
  175.     frmCmnDlg.MOVE (SCREEN.Width - frmCmnDlg.Width) \ 2, ((SCREEN.Height - frmCmnDlg.Height) \ 2) - 2
  176.  
  177.     ' Set dialog colors.
  178.     frmCmnDlg.ForeColor = ForeColor
  179.     frmCmnDlg.BackColor = BackColor
  180.     frmCmnDlg.pctFileOpen.ForeColor = ForeColor
  181.     frmCmnDlg.pctFileOpen.BackColor = BackColor
  182.     frmCmnDlg.lblOpenFile.ForeColor = ForeColor
  183.     frmCmnDlg.lblOpenFile.BackColor = BackColor
  184.     frmCmnDlg.txtOpenFile.ForeColor = ForeColor
  185.     frmCmnDlg.txtOpenFile.BackColor = BackColor
  186.     frmCmnDlg.lblOpenPath.ForeColor = ForeColor
  187.     frmCmnDlg.lblOpenPath.BackColor = BackColor
  188.     frmCmnDlg.filOpenList.ForeColor = ForeColor
  189.     frmCmnDlg.filOpenList.BackColor = BackColor
  190.     frmCmnDlg.drvOpenList.ForeColor = ForeColor
  191.     frmCmnDlg.drvOpenList.BackColor = BackColor
  192.     frmCmnDlg.dirOpenList.ForeColor = ForeColor
  193.     frmCmnDlg.dirOpenList.BackColor = BackColor
  194.     frmCmnDlg.cmdOpenOK.BackColor = BackColor
  195.     frmCmnDlg.cmdOpenCancel.BackColor = BackColor
  196.  
  197.     ' Display dialog modally.
  198.     frmCmnDlg.SHOW 1
  199.  
  200.     ' Determine if user canceled dialog.
  201.     IF frmCmnDlg.cmdOpenCancel.Tag <> "FALSE" THEN
  202.         Cancel = TRUE
  203.     ' If not, return FileName and PathName.
  204.     ELSE
  205.         Cancel = FALSE
  206.         FileName = frmCmnDlg.txtOpenFile.Text
  207.         PathName = frmCmnDlg.filOpenList.Path
  208.         frmCmnDlg.cmdOpenCancel.Tag = ""
  209.     END IF
  210.  
  211.     ' Hide or unload dialog and return control to user's program.
  212.     ' (Hide if user chose to preload form for performance.)
  213.     IF LEFT$(frmCmnDlg.Tag, 1) = "H" THEN
  214.         frmCmnDlg.pctFileOpen.visible = FALSE
  215.         frmCmnDlg.HIDE
  216.         frmCmnDlg.Tag = "H"              ' Reset tag.
  217.     ELSE
  218.         UNLOAD frmCmnDlg
  219.     END IF
  220.  
  221.     EXIT SUB
  222.  
  223. ' Option error handling routine.
  224. ' Ignore errors here and let dialog's controls
  225. ' handle the errors.
  226. FileSaveError:
  227.     SELECT CASE ERR
  228.     CASE 7:                                       ' Out of memory.
  229.           MSGBOX "Out of memory.  Can't load dialog.", 0, "FileSave"
  230.           Cancel = TRUE
  231.           EXIT SUB
  232.     CASE ELSE
  233.           RESUME NEXT
  234.     END SELECT
  235. END SUB
  236.  
  237.