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