home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Tiny_GFX322226387252012.psc / TinyGFX32_25Jul12_PSC / cFileDlg2.cls < prev    next >
Text File  |  2009-07-07  |  10KB  |  300 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cOSDialog"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' OSDialog  cFileDlg2.cls  Open Save Dialog
  15.  
  16. ' (Modified from vbAccelerator.com)
  17.  
  18. '  Use eg
  19. '  On Form1:=
  20.  
  21. '' For using OSDialog(FileDlg2.cls)
  22.  
  23. '  Private CommonDialog1 As cOSDialog
  24.  
  25. ' Examples:-
  26. '  Dim Title$, Filt$, InDir$
  27. '  Dim FIndex As Long
  28.  
  29. '  LOAD egs
  30. '   Title$ = "Load a picture file"
  31. '   Filt$ = "Pics bmp,jpg,gif,ico,cur,wmf,emf|*.bmp;*.jpg;*.gif;*.ico;*.cur;*.wmf;*.emf"
  32. '   Filt$ = "Open vbp (*.vbp)|*.vbp|All files (*.*)|*.*"
  33. '   FileSpec$=""
  34. '   InDir$ = CurrPath$ 'AppPathSpec$
  35. '   Set CommonDialog1 = New OSDialog
  36.  
  37. '   CommonDialog1.ShowOpen FileSpec$, Title$, Filt$, InDir$, "", Me.hWnd, FIndex
  38. '   FIndex = 1 bmp
  39. '   FIndex = 2 jpg
  40. '   etc
  41.  
  42. '   Set CommonDialog1 = Nothing
  43.  
  44. '  SAVE eg
  45. '   Title$ = "Save Mask as 2-color bmp"
  46. '   Filt$ = "Save bmp|*.bmp"
  47. '   InDir$ = CurrPath$ 'AppPathSpec$
  48. '   FileSpec$=""
  49. '   Set CommonDialog1 = New OSDialog
  50. '   CommonDialog1.ShowSave FileSpec$, Title$, Filt$, InDir$, "", Me.hwnd
  51. '   Set CommonDialog1 = Nothing
  52. '
  53. '   Len(FileSpec$)=0 for cancel
  54.  
  55. Option Explicit
  56. Private Declare Function CommDlgExtendedError Lib "COMDLG32" () As Long
  57.  
  58. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  59.     (ByVal lpString As String) As Long
  60.  
  61. Private Const MAX_PATH = 2048 ' To accomodate multi-select string
  62. Private Const MAX_FILE = 2048
  63. Private Const MULTIFILEOPENORD = 1537
  64.  
  65. Private Type OPENFILENAME
  66.     lStructSize As Long          ' UDT length
  67.     hwndOwner As Long            ' Owner
  68.     hInstance As Long            ' Ignored (used only by templates)
  69.     lpstrFilter As String        ' Filter
  70.     lpstrCustomFilter As String  ' Ignored
  71.     nMaxCustFilter As Long       ' Ignored
  72.     nFilterIndex As Long         ' FilterIndex
  73.     lpstrFile As String          ' FileName
  74.     nMaxFile As Long             ' Handled internally
  75.     lpstrFileTitle As String     ' FileTitle
  76.     nMaxFileTitle As Long        ' Handled internally
  77.     lpstrInitialDir As String    ' InitDir
  78.     lpstrTitle As String         ' Dialog Title
  79.     Flags As Long                ' Flags
  80.     nFileOffset As Integer       ' Ignored
  81.     nFileExtension As Integer    ' Ignored
  82.     lpstrDefExt As String        ' DefaultExt
  83.     lCustData As Long            ' Ignored (needed for hooks)
  84.     lpfnHook As Long             ' Ignored
  85.     lpTemplateName As Long       ' Ignored
  86. End Type
  87.  
  88. Public Enum OpenFile
  89.     OFN_READONLY = &H1
  90.     OFN_OVERWRITEPROMPT = &H2
  91.     OFN_HIDEREADONLY = &H4
  92.     OFN_NOCHANGEDIR = &H8
  93.     OFN_SHOWHELP = &H10
  94.     OFN_ENABLEHOOK = &H20
  95.     OFN_ENABLETEMPLATE = &H40
  96.     OFN_ENABLETEMPLATEHANDLE = &H80
  97.     OFN_NOVALIDATE = &H100
  98.     OFN_ALLOWMULTISELECT = &H200
  99.     OFN_EXTENSIONDIFFERENT = &H400
  100.     OFN_PATHMUSTEXIST = &H800
  101.     OFN_FILEMUSTEXIST = &H1000
  102.     OFN_CREATEPROMPT = &H2000
  103.     OFN_SHAREAWARE = &H4000
  104.     OFN_NOREADONLYRETURN = &H8000&
  105.     OFN_NOTESTFILECREATE = &H10000
  106.     OFN_NONE2RKBUTTON = &H20000
  107.     OFN_NOLONGNAMES = &H40000
  108.     OFN_EXPLORER = &H80000
  109.     OFN_NODEREFERENCELINKS = &H100000
  110.     OFN_LONGNAMES = &H200000
  111. End Enum
  112.  
  113. Private Declare Function GetOpenFileName Lib "COMDLG32" Alias "GetOpenFileNameA" _
  114.     (file As OPENFILENAME) As Long
  115.  
  116. Private Declare Function GetSaveFileName Lib "COMDLG32" Alias "GetSaveFileNameA" _
  117.     (file As OPENFILENAME) As Long
  118.  
  119. Dim m_lExtendedError As Long
  120.  
  121. ' If parameter MultiSelect is True, dialog will be new style
  122.  
  123. Function ShowOpen(Optional FileName As String, _
  124.                   Optional DlgTitle As String, _
  125.                   Optional Filter As String = "All (*.*)| *.*", _
  126.                   Optional InitDir As String, _
  127.                   Optional DefaultExt As String = "", _
  128.                   Optional owner As Long = -1, _
  129.                   Optional FilterIndex As Long = 1, _
  130.                   Optional MultiSelect As Boolean = False, _
  131.                   Optional lpTemplateName As Long = False, _
  132.                   Optional FileTitle As String, _
  133.                   Optional FileMustExist As Boolean = True, _
  134.                   Optional ReadOnly As Boolean = False, _
  135.                   Optional HideReadOnly As Boolean = False, _
  136.                   Optional Flags As Long = 0) As String
  137.  
  138. Dim typOpenFile As OPENFILENAME
  139. Dim S As String
  140. Dim CHS As String
  141. Dim i As Integer
  142. Dim mResult As Long
  143.  
  144. Dim p As Long
  145.  
  146. m_lExtendedError = 0
  147.  
  148. With typOpenFile
  149.     .lStructSize = Len(typOpenFile)
  150.  
  151.      ' Add in specific flags and STRIP out non-VB flags
  152.     .Flags = (-FileMustExist * OFN_FILEMUSTEXIST) Or _
  153.          (-MultiSelect * OFN_ALLOWMULTISELECT) Or _
  154.          (-ReadOnly * OFN_READONLY) Or _
  155.          (-HideReadOnly * OFN_HIDEREADONLY) Or _
  156.          (.Flags And CLng(Not (OFN_ENABLEHOOK Or OFN_ENABLETEMPLATE)))
  157.     If owner <> -1 Then .hwndOwner = owner
  158.     .Flags = .Flags Or OFN_EXPLORER
  159.     .lpstrInitialDir = InitDir
  160.     .lpstrDefExt = DefaultExt
  161.     .lpstrTitle = DlgTitle
  162.     .lpTemplateName = MULTIFILEOPENORD
  163.  
  164.     ' To make Windows-style filter, replace | and : with nulls
  165.     For i = 1 To Len(Filter)
  166.         CHS = Mid$(Filter, i, 1)
  167.         If CHS = "|" Or CHS = ":" Then
  168.              S = S & vbNullChar
  169.         Else
  170.              S = S & CHS
  171.         End If
  172.     Next
  173.  
  174.     ' Put double null at end
  175.     S = S & vbNullChar & vbNullChar
  176.     .lpstrFilter = S
  177.     .nFilterIndex = FilterIndex
  178.  
  179.     ' Pad file and file title buffers to maximum path
  180.     S = FileName & String$(MAX_PATH - Len(FileName), 0)
  181.     .lpstrFile = S
  182.     .nMaxFile = MAX_PATH
  183.     S = FileTitle & String$(MAX_FILE - Len(FileTitle), 0)
  184.     .lpstrFileTitle = S
  185.     .nMaxFileTitle = MAX_FILE
  186.  
  187.     mResult = GetOpenFileName(typOpenFile)
  188.  
  189.     If mResult = 1 Then
  190.          ' Find terminating string of at least double vbNullChars ||
  191.          mResult = InStr(1, .lpstrFile, vbNullChar & vbNullChar)
  192.          If mResult = 0 Then
  193.             FileName$ = .lpstrFile
  194.          Else
  195.             '' Original
  196.             '' Remove excess vbNullChars
  197.             ''FileName$ = Left$(.lpstrFile, mResult - 1)
  198.             
  199.             ' Find 1st vbNullChar
  200.             p = InStr(1, .lpstrFile, vbNullChar)
  201.             If p = 0 Then  ' No vbNullChar - ERROR
  202.                FileName$ = vbNullString
  203.                If mResult <> 0 Then    ' 0 is Cancel, else extended error
  204.                     m_lExtendedError = CommDlgExtendedError()
  205.                End If
  206.             Else
  207.                FileName$ = Left$(.lpstrFile, p - 1)
  208.                FilterIndex = .nFilterIndex
  209.             End If
  210.          End If
  211.     Else
  212.          FileName$ = vbNullString
  213.          If mResult <> 0 Then    ' 0 is Cancel, else extended error
  214.               m_lExtendedError = CommDlgExtendedError()
  215.          End If
  216.     End If
  217. End With
  218. ShowOpen = FileName
  219. End Function
  220.  
  221.  
  222. Private Function StrZToStr(S As String) As String
  223.     StrZToStr = Left$(S, lstrlen(S))
  224. End Function
  225.  
  226. Function ShowSave(Optional FileName As String, _
  227.                   Optional DlgTitle As String, _
  228.                   Optional Filter As String = "All (*.*)| *.*", _
  229.                   Optional InitDir As String, _
  230.                   Optional DefaultExt As String, _
  231.                   Optional owner As Long = -1, _
  232.                   Optional FilterIndex As Long = 1, _
  233.                   Optional FileTitle As String, _
  234.                   Optional OverWritePrompt As Boolean = True, _
  235.                   Optional Flags As Long) As String
  236.             
  237. Dim typOpenFile As OPENFILENAME
  238. Dim S As String
  239. Dim CHS As String
  240. Dim i As Integer
  241. Dim mResult As Long
  242.  
  243. m_lExtendedError = 0
  244.  
  245. With typOpenFile
  246.     .lStructSize = Len(typOpenFile)
  247.  
  248.     ' Add in specific flags and STRIP out non-VB flags
  249.     .Flags = (-OverWritePrompt * OFN_OVERWRITEPROMPT) Or _
  250.      OFN_HIDEREADONLY Or _
  251.      (Flags And CLng(Not (OFN_ENABLEHOOK Or OFN_ENABLETEMPLATE)))
  252.     If owner <> -1 Then .hwndOwner = owner
  253.     .lpstrInitialDir = InitDir
  254.     .lpstrDefExt = DefaultExt
  255.     .lpstrTitle = DlgTitle
  256.  
  257.     ' Make new filter with bars (|) replacing nulls
  258.     ' and double null at end
  259.     For i = 1 To Len(Filter)
  260.          CHS = Mid$(Filter, i, 1)
  261.          If CHS = "|" Or CHS = ":" Then
  262.               S = S & vbNullChar
  263.          Else
  264.               S = S & CHS
  265.          End If
  266.     Next
  267.     ' Put double null at end
  268.     S = S & vbNullChar & vbNullChar
  269.     .lpstrFilter = S
  270.     .nFilterIndex = FilterIndex
  271.  
  272.     ' Pad file and file title buffers to maximum path
  273.     S = FileName & String$(MAX_PATH - Len(FileName), 0)
  274.     .lpstrFile = S
  275.     .nMaxFile = MAX_PATH
  276.     S = FileTitle & String$(MAX_FILE - Len(FileTitle), 0)
  277.     .lpstrFileTitle = S
  278.     .nMaxFileTitle = MAX_FILE
  279.     ' All other fields zero
  280.  
  281.     mResult = GetSaveFileName(typOpenFile)
  282.     
  283.     If mResult = 1 Then
  284.          FileName = StrZToStr(.lpstrFile)
  285.          '  If you initiate the variables,
  286.          '  you can return the value(s)
  287.          'FileTitle = StrZToStr(.lpstrFileTitle)
  288.            ' Return the filter index '' here 1 bmp, 2 gif
  289.          FilterIndex = .nFilterIndex
  290.     Else
  291.          FileName = vbNullString
  292.          If mResult <> 0 Then   ' 0 is Cancel, else extended error
  293.               m_lExtendedError = CommDlgExtendedError()
  294.          End If
  295.     End If
  296. End With
  297. ShowSave = FileName
  298. End Function
  299.  
  300.