home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Common_DLG628003172002.psc / CommonDialog.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  2002-03-17  |  24.1 KB  |  748 lines

  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Begin VB.UserControl CommonDialog 
  4.    ClientHeight    =   4185
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   5535
  8.    DefaultCancel   =   -1  'True
  9.    ScaleHeight     =   4185
  10.    ScaleWidth      =   5535
  11.    Begin MSComctlLib.ImageCombo cboType 
  12.       Height          =   330
  13.       Left            =   1500
  14.       TabIndex        =   14
  15.       Top             =   3690
  16.       Width           =   2625
  17.       _ExtentX        =   4630
  18.       _ExtentY        =   582
  19.       _Version        =   393216
  20.       ForeColor       =   -2147483640
  21.       BackColor       =   -2147483643
  22.    End
  23.    Begin MSComctlLib.ImageList ILFiles16 
  24.       Left            =   4830
  25.       Top             =   4320
  26.       _ExtentX        =   1005
  27.       _ExtentY        =   1005
  28.       BackColor       =   -2147483643
  29.       ImageWidth      =   16
  30.       ImageHeight     =   16
  31.       MaskColor       =   12632256
  32.       _Version        =   393216
  33.    End
  34.    Begin VB.PictureBox PicFiles16 
  35.       BackColor       =   &H80000009&
  36.       Height          =   300
  37.       Left            =   4860
  38.       ScaleHeight     =   240
  39.       ScaleWidth      =   240
  40.       TabIndex        =   12
  41.       Top             =   4350
  42.       Visible         =   0   'False
  43.       Width           =   300
  44.    End
  45.    Begin VB.PictureBox PicFiles32 
  46.       BackColor       =   &H80000009&
  47.       Height          =   600
  48.       Left            =   4860
  49.       ScaleHeight     =   540
  50.       ScaleWidth      =   540
  51.       TabIndex        =   11
  52.       Top             =   4320
  53.       Visible         =   0   'False
  54.       Width           =   600
  55.    End
  56.    Begin MSComctlLib.ImageList ImageList1 
  57.       Left            =   4830
  58.       Top             =   4320
  59.       _ExtentX        =   1005
  60.       _ExtentY        =   1005
  61.       BackColor       =   -2147483643
  62.       ImageWidth      =   16
  63.       ImageHeight     =   16
  64.       MaskColor       =   12632256
  65.       _Version        =   393216
  66.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  67.          NumListImages   =   10
  68.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.             Picture         =   "CommonDialog.ctx":0000
  70.             Key             =   "CD"
  71.          EndProperty
  72.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.             Picture         =   "CommonDialog.ctx":0352
  74.             Key             =   "Default"
  75.          EndProperty
  76.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.             Picture         =   "CommonDialog.ctx":0A64
  78.             Key             =   "Desktop"
  79.          EndProperty
  80.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.             Picture         =   "CommonDialog.ctx":0DB6
  82.             Key             =   "Floppy"
  83.          EndProperty
  84.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.             Picture         =   "CommonDialog.ctx":1108
  86.             Key             =   "Folder"
  87.          EndProperty
  88.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  89.             Picture         =   "CommonDialog.ctx":145A
  90.             Key             =   "HD"
  91.          EndProperty
  92.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  93.             Picture         =   "CommonDialog.ctx":17AC
  94.             Key             =   "MyComp"
  95.          EndProperty
  96.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  97.             Picture         =   "CommonDialog.ctx":1AFE
  98.             Key             =   "NetHood"
  99.          EndProperty
  100.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  101.             Picture         =   "CommonDialog.ctx":1E50
  102.             Key             =   "Personal"
  103.          EndProperty
  104.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  105.             Picture         =   "CommonDialog.ctx":21A2
  106.             Key             =   "Remote"
  107.          EndProperty
  108.       EndProperty
  109.    End
  110.    Begin VB.TextBox txtFileName 
  111.       Height          =   285
  112.       Left            =   1500
  113.       TabIndex        =   9
  114.       Top             =   3360
  115.       Width           =   2625
  116.    End
  117.    Begin VB.CommandButton cmdCancel 
  118.       Cancel          =   -1  'True
  119.       Caption         =   "Cancel"
  120.       Height          =   345
  121.       Left            =   4230
  122.       TabIndex        =   8
  123.       Top             =   3750
  124.       Width           =   1245
  125.    End
  126.    Begin VB.CommandButton cmdOK 
  127.       Caption         =   "OK"
  128.       Default         =   -1  'True
  129.       Height          =   345
  130.       Left            =   4230
  131.       TabIndex        =   7
  132.       Top             =   3360
  133.       Width           =   1245
  134.    End
  135.    Begin MSComctlLib.ListView lvwItems 
  136.       Height          =   2655
  137.       Left            =   30
  138.       TabIndex        =   5
  139.       Top             =   570
  140.       Width           =   5415
  141.       _ExtentX        =   9551
  142.       _ExtentY        =   4683
  143.       Arrange         =   2
  144.       LabelWrap       =   -1  'True
  145.       HideSelection   =   0   'False
  146.       _Version        =   393217
  147.       Icons           =   "ILFiles32"
  148.       SmallIcons      =   "ILFiles16"
  149.       ForeColor       =   -2147483640
  150.       BackColor       =   -2147483643
  151.       Appearance      =   1
  152.       NumItems        =   0
  153.    End
  154.    Begin MSComctlLib.ImageCombo imcExtra 
  155.       Height          =   330
  156.       Left            =   1020
  157.       TabIndex        =   4
  158.       Top             =   120
  159.       Width           =   2265
  160.       _ExtentX        =   3995
  161.       _ExtentY        =   582
  162.       _Version        =   393216
  163.       ForeColor       =   -2147483640
  164.       BackColor       =   -2147483643
  165.       Locked          =   -1  'True
  166.       Text            =   "My Computer"
  167.       ImageList       =   "ImageList1"
  168.    End
  169.    Begin VB.CommandButton cmdExtra 
  170.       Enabled         =   0   'False
  171.       Height          =   405
  172.       Index           =   0
  173.       Left            =   3450
  174.       Picture         =   "CommonDialog.ctx":24F4
  175.       Style           =   1  'Graphical
  176.       TabIndex        =   3
  177.       Top             =   60
  178.       Width           =   375
  179.    End
  180.    Begin VB.CommandButton cmdExtra 
  181.       Height          =   405
  182.       Index           =   2
  183.       Left            =   4320
  184.       Picture         =   "CommonDialog.ctx":2836
  185.       Style           =   1  'Graphical
  186.       TabIndex        =   2
  187.       Top             =   60
  188.       Width           =   375
  189.    End
  190.    Begin VB.CommandButton cmdExtra 
  191.       Height          =   405
  192.       Index           =   3
  193.       Left            =   4770
  194.       Picture         =   "CommonDialog.ctx":2EF0
  195.       Style           =   1  'Graphical
  196.       TabIndex        =   1
  197.       Top             =   60
  198.       Width           =   375
  199.    End
  200.    Begin VB.CommandButton cmdExtra 
  201.       Height          =   405
  202.       Index           =   1
  203.       Left            =   3870
  204.       Picture         =   "CommonDialog.ctx":35F2
  205.       Style           =   1  'Graphical
  206.       TabIndex        =   0
  207.       Top             =   60
  208.       Width           =   375
  209.    End
  210.    Begin MSComctlLib.ImageList ILFiles32 
  211.       Left            =   4830
  212.       Top             =   4320
  213.       _ExtentX        =   1005
  214.       _ExtentY        =   1005
  215.       BackColor       =   -2147483643
  216.       ImageWidth      =   32
  217.       ImageHeight     =   32
  218.       MaskColor       =   12632256
  219.       _Version        =   393216
  220.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  221.          NumListImages   =   1
  222.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  223.             Picture         =   "CommonDialog.ctx":3B74
  224.             Key             =   "Folder"
  225.          EndProperty
  226.       EndProperty
  227.    End
  228.    Begin VB.Label Label3 
  229.       Caption         =   "File Type:"
  230.       Height          =   255
  231.       Left            =   210
  232.       TabIndex        =   13
  233.       Top             =   3690
  234.       Width           =   1245
  235.    End
  236.    Begin VB.Label Label2 
  237.       Caption         =   "File Name:"
  238.       Height          =   255
  239.       Left            =   210
  240.       TabIndex        =   10
  241.       Top             =   3360
  242.       Width           =   1245
  243.    End
  244.    Begin VB.Label Label1 
  245.       Caption         =   "Search at:"
  246.       Height          =   255
  247.       Left            =   60
  248.       TabIndex        =   6
  249.       Top             =   180
  250.       Width           =   795
  251.    End
  252.    Begin VB.Menu mnuView 
  253.       Caption         =   "mnuView"
  254.       Visible         =   0   'False
  255.       Begin VB.Menu mnuViewOptions 
  256.          Caption         =   "Icons"
  257.          Index           =   0
  258.       End
  259.       Begin VB.Menu mnuViewOptions 
  260.          Caption         =   "Small Icons"
  261.          Index           =   1
  262.       End
  263.       Begin VB.Menu mnuViewOptions 
  264.          Caption         =   "List"
  265.          Index           =   2
  266.       End
  267.       Begin VB.Menu mnuViewOptions 
  268.          Caption         =   "Report"
  269.          Index           =   3
  270.       End
  271.    End
  272.    Begin VB.Menu mnuFile 
  273.       Caption         =   "mnuFile"
  274.       Visible         =   0   'False
  275.       Begin VB.Menu mnuFileOpen 
  276.          Caption         =   "Open..."
  277.       End
  278.       Begin VB.Menu mnuFileLine1 
  279.          Caption         =   "-"
  280.       End
  281.       Begin VB.Menu mnuFileSendTo 
  282.          Caption         =   "Send To"
  283.          Begin VB.Menu mnuSendToNotePad 
  284.             Caption         =   "NotePad"
  285.          End
  286.          Begin VB.Menu mnuSendToDisk 
  287.             Caption         =   "Disk Device"
  288.          End
  289.          Begin VB.Menu mnuSendToDesktop 
  290.             Caption         =   "Desktop (Create Link)"
  291.          End
  292.       End
  293.       Begin VB.Menu mnuFileLine2 
  294.          Caption         =   "-"
  295.       End
  296.       Begin VB.Menu mnuFileRename 
  297.          Caption         =   "Rename"
  298.       End
  299.       Begin VB.Menu mnuFileDelete 
  300.          Caption         =   "Delete"
  301.       End
  302.       Begin VB.Menu mnuFileCreateLink 
  303.          Caption         =   "Create Link..."
  304.       End
  305.       Begin VB.Menu mnuFileLine3 
  306.          Caption         =   "-"
  307.       End
  308.       Begin VB.Menu mnuFileProperties 
  309.          Caption         =   "Properties..."
  310.       End
  311.    End
  312. End
  313. Attribute VB_Name = "CommonDialog"
  314. Attribute VB_GlobalNameSpace = False
  315. Attribute VB_Creatable = True
  316. Attribute VB_PredeclaredId = False
  317. Attribute VB_Exposed = True
  318. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  319. Private Declare Function PathAddBackslash Lib "shlwapi.dll" Alias "PathAddBackslashA" (ByVal pszPath As String) As Long
  320. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  321. Const SW_SHOWNORMAL = 1
  322. Dim Sort(1 To 4) As Boolean
  323. Dim Selitem As Long
  324. Dim History() As String
  325. Const FileTypeSeperator = "$"
  326. Const FileTypeDescSep = "º"
  327. 'Default Property Values:
  328. Const m_def_Path = "C:\"
  329. Const m_def_InitDir = "C:\"
  330. Const m_def_Filter = ""
  331. Const m_def_FileName = ""
  332. 'Property Variables:
  333. Dim m_Path As String
  334. Dim m_InitDir As String
  335. Dim m_Filter As String
  336. Dim m_FileName As String
  337. Public Type FilterType
  338.     Filtername As String
  339.     Filter As String
  340. End Type
  341. 'Event Declarations:
  342. Event OperationDone(FileName As String, FileType As String)
  343.  
  344. Private Sub cboType_Click()
  345. On Error Resume Next
  346. Dim c1 As String
  347. Dim c2 As String
  348. FillList Path
  349. With lvwItems.ListItems
  350.     For i = 1 To .Count
  351.         If .Item(i).Tag <> "Folder" Then
  352.             c1 = UCase(.Item(i).Key)
  353.             c2 = UCase(cboType.SelectedItem.Key)
  354.             If Not (c1) Like (c2) Then
  355.                 .Remove i
  356.                 i = i - 1
  357.                 If Err.Number <> 0 Then Exit Sub
  358.             End If
  359.         End If
  360.         Err.Clear
  361.     Next i
  362. End With
  363. End Sub
  364.  
  365. Private Sub cmdExtra_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  366. On Error Resume Next
  367. Select Case Index
  368.     Case 0
  369.         'Path = History(UBound(History))
  370.         'ReDim Preserve History(UBound(History) - 1)
  371.     Case 1
  372.         Path = fs.GetFolder(Path).ParentFolder
  373.         FillList Path
  374.     Case 2
  375.         newpath = InputBox("Please enter the name for the new Folder." & vbCrLf & vbCrLf & _
  376.                             "It will be created under: " & Path & ".", , "New Folder")
  377.         fs.CreateFolder Path & "\" & newpath
  378.         Path = Path & "\" & newpath
  379.         FillList Path
  380.     Case 3
  381.         UserControl.PopupMenu mnuView, , cmdExtra(Index).Left + x, cmdExtra(Index).Height + y
  382. End Select
  383. End Sub
  384.  
  385. Private Sub cmdOK_Click()
  386. FileName = txtFileName.Text
  387. RaiseEvent OperationDone(txtFileName.Text, cboType.SelectedItem.Text)
  388. End Sub
  389.  
  390. Private Sub imcExtra_Click()
  391. On Error Resume Next
  392. Path = imcExtra.SelectedItem.Key
  393. lvwItems.ListItems.Clear
  394. FillList Path
  395. End Sub
  396.  
  397. Private Sub lvwItems_AfterLabelEdit(Cancel As Integer, NewString As String)
  398. Select Case lvwItems.ListItems(Selitem).Tag
  399.     Case "File"
  400.         fs.GetFile(lvwItems.ListItems(Selitem).Key).Name = NewString
  401.     Case "Folder"
  402.         fs.GetFolder(lvwItems.ListItems(Selitem).Key).Name = NewString
  403. End Select
  404. FillList Path
  405. End Sub
  406.  
  407. Private Sub lvwItems_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
  408. Sort(ColumnHeader.Index) = Not Sort(ColumnHeader.Index)
  409. Select Case ColumnHeader.Index
  410.     Case 1
  411.         SortListView lvwItems, ColumnHeader.Index, ldtString, Sort(ColumnHeader.Index)
  412.     Case 2
  413.         For i = 1 To lvwItems.ListItems.Count
  414.             lvwItems.ListItems(i).SubItems(1) = Replace(lvwItems.ListItems(i).SubItems(1), " KB", "")
  415.         Next i
  416.         SortListView lvwItems, ColumnHeader.Index, ldtNumber, Sort(ColumnHeader.Index)
  417.         For i = 1 To lvwItems.ListItems.Count
  418.             If Not lvwItems.ListItems(i).SubItems(1) = "" Then lvwItems.ListItems(i).SubItems(1) = lvwItems.ListItems(i).SubItems(1) & " KB"
  419.         Next i
  420.     Case 3
  421.         SortListView lvwItems, ColumnHeader.Index, ldtString, Sort(ColumnHeader.Index)
  422.     Case 4
  423.         SortListView lvwItems, ColumnHeader.Index, ldtDateTime, Sort(ColumnHeader.Index)
  424. End Select
  425. End Sub
  426.  
  427. Private Sub lvwItems_DblClick()
  428. On Error Resume Next
  429. With lvwItems.ListItems(Selitem)
  430. Select Case .Tag
  431.     Case "File"
  432.         ShellExecute UserControl.hwnd, "Open", .Key, vbNullString, "C:\", SW_SHOWNORMAL
  433.     Case "Folder"
  434.         Path = .Key
  435.         FillList Path
  436. End Select
  437. End With
  438. End Sub
  439.  
  440. Private Sub lvwItems_ItemClick(ByVal Item As MSComctlLib.ListItem)
  441. Selitem = Item.Index
  442. txtFileName.Text = fs.GetFileName(Item.Key)
  443. FileName = Item.Key
  444. End Sub
  445.  
  446. Private Sub lvwItems_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  447. If Button = 2 Then
  448.     UserControl.PopupMenu mnuFile, , x, y, mnuFileOpen
  449. End If
  450. End Sub
  451.  
  452. Private Sub mnuFileCreateLink_Click()
  453. 'todo Creatlink Property must be added!
  454. End Sub
  455.  
  456. Private Sub mnuFileDelete_Click()
  457. Select Case lvwItems.ListItems(Selitem).Tag
  458. Case "Folder"
  459. fs.DeleteFolder lvwItems.ListItems(Selitem).Key, True
  460. Case "File"
  461. fs.DeleteFile lvwItems.ListItems(Selitem).Key, True
  462. End Select
  463. FillList Path
  464. End Sub
  465.  
  466. Private Sub mnuFileOpen_Click()
  467.     ShellExecute UserControl.hwnd, "Open", lvwItems.ListItems(Selitem).Key, vbNullString, "C:\", SW_SHOWNORMAL
  468. End Sub
  469.  
  470. Private Sub mnuFileProperties_Click()
  471. On Error Resume Next
  472. If Not Selitem = 0 Then
  473. i = lvwItems.ListItems(Selitem).Tag
  474. If Err.Number <> 0 Then
  475.     frmFolderProperties.Show
  476.     frmFolderProperties.SetProps Path
  477.     Exit Sub
  478. End If
  479. Select Case lvwItems.ListItems(Selitem).Tag
  480.     Case "File"
  481.         frmProperties.Show
  482.         frmProperties.SetProps lvwItems.ListItems(Selitem).Key
  483.     Case "Folder"
  484.         frmFolderProperties.Show
  485.         frmFolderProperties.SetProps lvwItems.ListItems(Selitem).Key
  486. End Select
  487. Else
  488. frmFolderProperties.Show
  489. frmFolderProperties.SetProps Path
  490. End If
  491. End Sub
  492.  
  493. Private Sub mnuFileRename_Click()
  494. lvwItems.StartLabelEdit
  495. End Sub
  496.  
  497. Private Sub mnuViewOptions_Click(Index As Integer)
  498. lvwItems.View = Index
  499. End Sub
  500.  
  501. Private Sub UserControl_Initialize()
  502. Dim Folders() As String
  503. Dim Files() As String
  504. Dim DeskPath As String
  505. Dim PersPath As String
  506. Dim d As Drive
  507. Dim Vol As String
  508. On Error Resume Next
  509. ReDim History(0)
  510. With lvwItems
  511.     .ColumnHeaders.Add , , "Name"
  512.     .ColumnHeaders.Add , , "Size"
  513.     .ColumnHeaders.Add , , "Type"
  514.     .ColumnHeaders.Add , , "Last Change"
  515. End With
  516. DeskPath = GetSettingString(&H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Desktop")
  517. PersPath = GetSettingString(&H80000001, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Personal")
  518. With imcExtra.ComboItems
  519.     .Add , DeskPath, "Desktop", "Desktop", "Desktop"
  520.     .Add , PersPath, "Personal", "Personal", "Personal"
  521.     .Add , , "My Computer", "MyComp", "MyComp", 1
  522.     For Each d In fs.Drives
  523.         Vol = d.VolumeName
  524.         If Vol = "" Then Vol = DriveType(d.DriveLetter)
  525.         .Add , d.DriveLetter & ":\", d.DriveLetter & ":\ (" & Vol & ")", GetDriveIcon(d.Path), , 2
  526.     Next
  527.     ShowFolderList DeskPath, Folders
  528.     For i = 1 To UBound(Folders)
  529.         .Add , DeskPath & "\" & Folders(i), Folders(i), "Folder", "Folder", 1
  530.     Next i
  531. End With
  532. Path = InitDir
  533. FillList Path
  534. End Sub
  535.  
  536. Private Function DriveType(Drive As String)
  537.     Select Case GetDriveType(Drive)
  538.         Case 1
  539.             DriveType = "Disk or Absent"
  540.         Case 2
  541.             DriveType = "Removable"
  542.         Case 3
  543.             DriveType = "Drive Fixed"
  544.         Case Is = 4
  545.             DriveType = "Remote"
  546.         Case Is = 5
  547.             DriveType = "Cd-Rom"
  548.         Case Is = 6
  549.             DriveType = "Ram disk"
  550.         Case Else
  551.             DriveType = "Unrecognized"
  552.     End Select
  553. End Function
  554.  
  555. 'Private Function GetIcon(Folder As Boolean) As String
  556. 'If Folder = True Then
  557. '    GetIcon = "Folder"
  558. '    Exit Function
  559. '    GetIcon = "Default"
  560. 'End If
  561. 'End Function
  562.  
  563. Private Function GetDriveIcon(Drive As String)
  564.     Select Case GetDriveType(Drive)
  565.         Case 1
  566.             GetDriveIcon = "Disk"
  567.         Case 2
  568.             GetDriveIcon = "Disk"
  569.         Case 3
  570.             GetDriveIcon = "HD"
  571.         Case Is = 4
  572.             GetDriveIcon = "Remote"
  573.         Case Is = 5
  574.             GetDriveIcon = "CD"
  575.     End Select
  576. End Function
  577.  
  578. Private Function BuildPath(Path As String, FileName As String) As String
  579. PathAddBackslash Path
  580. Path = Fix_NullTermStr(Path)
  581. Path = Path & FileName
  582. BuildPath = Path
  583. End Function
  584.  
  585. Private Sub FillList(sPath)
  586. Dim hSIcon As Long 'SmallIcon
  587. Dim hLIcon As Long 'LargeIcon
  588. Dim c1 As String
  589. Dim c2 As String
  590. txtFileName.Text = ""
  591. On Error Resume Next
  592. Dim Folders() As String
  593. Dim Files() As String
  594. Dim fpath As String
  595. lvwItems.ListItems.Clear
  596. ShowFolderList sPath, Folders
  597. For i = 1 To UBound(Folders)
  598.     fpath = fs.BuildPath(sPath, Folders(i))
  599.     hSIcon = SHGetFileInfo(fpath, 0&, SHInfo, Len(SHInfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
  600.     hLIcon = SHGetFileInfo(fpath, 0&, SHInfo, Len(SHInfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
  601.     With PicFiles16
  602.       Set .Picture = LoadPicture("")
  603.       .AutoRedraw = True
  604.       r = ImageList_Draw(hSIcon, SHInfo.iIcon, .hdc, 0, 0, ILD_TRANSPARENT)
  605.       .Refresh
  606.     End With
  607.     With PicFiles32
  608.       Set .Picture = LoadPicture("")
  609.       .AutoRedraw = True
  610.       r = ImageList_Draw(hLIcon, SHInfo.iIcon, .hdc, 0, 0, ILD_TRANSPARENT)
  611.       .Refresh
  612.     End With
  613.     'ILFiles16.ListImages.Clear
  614.     'MsgBox ILFiles16.ListImages.Count
  615.     ILFiles16.ListImages.Add , , PicFiles16.Image
  616.     'MsgBox ILFiles16.ListImages.Count
  617.     'ILFiles32.ListImages.Clear
  618.     ILFiles32.ListImages.Add , , PicFiles32.Image
  619.     With lvwItems.ListItems.Add(, fpath, Folders(i), ILFiles32.ListImages(1).Index, ILFiles16.ListImages(1).Index)
  620.         '.SubItems(1) = fs.GetFolder(fPath).Size
  621.         .SubItems(2) = fs.GetFolder(fpath).Type
  622.         .SubItems(3) = fs.GetFolder(fpath).DateLastModified
  623.         .Tag = "Folder"
  624.     End With
  625. Next i
  626. ShowFileList sPath, Files
  627. For i = 1 To UBound(Files)
  628.     fpath = fs.BuildPath(sPath, Files(i))
  629.     hSIcon = SHGetFileInfo(fpath, 0&, SHInfo, Len(SHInfo), BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
  630.     hLIcon = SHGetFileInfo(fpath, 0&, SHInfo, Len(SHInfo), BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
  631.     With PicFiles16
  632.       Set .Picture = LoadPicture("")
  633.       .AutoRedraw = True
  634.       r = ImageList_Draw(hSIcon, SHInfo.iIcon, .hdc, 0, 0, ILD_TRANSPARENT)
  635.       .Refresh
  636.     End With
  637.     With PicFiles32
  638.       Set .Picture = LoadPicture("")
  639.       .AutoRedraw = True
  640.       r = ImageList_Draw(hLIcon, SHInfo.iIcon, .hdc, 0, 0, ILD_TRANSPARENT)
  641.       .Refresh
  642.     End With
  643.     'ILFiles16.ListImages.Clear
  644.     ILFiles16.ListImages.Add , fs.GetExtensionName(fpath), PicFiles16.Image
  645.     'ILFiles32.ListImages.Clear
  646.     ILFiles32.ListImages.Add , fs.GetExtensionName(fpath), PicFiles32.Image
  647.     With lvwItems.ListItems.Add(, fpath, Files(i), ILFiles32.ListImages(fs.GetExtensionName(fpath)).Index, ILFiles16.ListImages(fs.GetExtensionName(fpath)).Index)
  648.         .SubItems(1) = FormatNumber(fs.GetFile(fpath).Size \ 1024, 0, vbUseDefault, , vbTrue) & " KB"
  649.         .SubItems(2) = fs.GetFile(fpath).Type
  650.         .SubItems(3) = fs.GetFile(fpath).DateLastModified
  651.         .Tag = "File"
  652.     End With
  653. Next i
  654. With lvwItems.ListItems
  655.     For i = 1 To .Count
  656.         If .Item(i).Tag <> "Folder" Then
  657.             c1 = UCase(.Item(i).Key)
  658.             c2 = UCase(cboType.SelectedItem.Key)
  659.             If Not (c1) Like (c2) Then
  660.                 .Remove i
  661.                 i = i - 1
  662.                 If Err.Number <> 0 Then Exit Sub
  663.             End If
  664.         End If
  665.         Err.Clear
  666.     Next i
  667. End With
  668. End Sub
  669.  
  670. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  671. 'MemberInfo=13,0,0,0
  672. Public Property Get Path() As String
  673.     Path = m_Path
  674. End Property
  675.  
  676. Public Property Let Path(ByVal New_Path As String)
  677.     m_Path = New_Path
  678.     ReDim Preserve History(UBound(History) + 1)
  679.     History(UBound(History)) = New_Path
  680.     PropertyChanged "Path"
  681.     FillList newpath
  682. End Property
  683.  
  684. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  685. 'MemberInfo=13,0,0,0
  686. Public Property Get InitDir() As String
  687.     InitDir = m_InitDir
  688. End Property
  689.  
  690. Public Property Let InitDir(ByVal New_InitDir As String)
  691.     m_InitDir = New_InitDir
  692.     PropertyChanged "InitDir"
  693. End Property
  694.  
  695. Public Sub SetFilter(NewFilter() As FilterType)
  696. Dim i As Long
  697.     For i = LBound(NewFilter) To UBound(NewFilter)
  698.         cboType.ComboItems.Add , NewFilter(i).Filter, NewFilter(i).Filtername
  699.     Next i
  700.     PropertyChanged "Filter"
  701. End Sub
  702.  
  703. Public Function Filter(ByRef OldFilter() As FilterType)
  704. For i = 1 To cboType.ComboItems.Count
  705.     ReDim Preserve OldFilter(i)
  706.     OldFilter(i).Filter = cboType.ComboItems(i).Key
  707.     OldFilter(i).Filter = cboType.ComboItems(i).Text
  708. Next i
  709. End Function
  710.  
  711. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  712. 'MemberInfo=13,0,0,0
  713. Public Property Get FileName() As String
  714.     FileName = m_FileName
  715. End Property
  716.  
  717. Public Property Let FileName(ByVal New_FileName As String)
  718.     m_FileName = New_FileName
  719.     PropertyChanged "FileName"
  720. End Property
  721.  
  722. 'Initialize Properties for User Control
  723. Private Sub UserControl_InitProperties()
  724.     m_Path = m_def_Path
  725.     m_InitDir = m_def_InitDir
  726.     m_Filter = m_def_Filter
  727.     m_FileName = m_def_FileName
  728. End Sub
  729.  
  730. 'Load property values from storage
  731. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  732.     m_Path = PropBag.ReadProperty("Path", m_def_Path)
  733.     m_InitDir = PropBag.ReadProperty("InitDir", m_def_InitDir)
  734.     m_Filter = PropBag.ReadProperty("Filter", m_def_Filter)
  735.     m_FileName = PropBag.ReadProperty("FileName", m_def_FileName)
  736.     Path = m_Path
  737.     InitDir = m_InitDir
  738.     FileName = m_FileName
  739. End Sub
  740.  
  741. 'Write property values to storage
  742. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  743.     Call PropBag.WriteProperty("Path", m_Path, m_def_Path)
  744.     Call PropBag.WriteProperty("InitDir", m_InitDir, m_def_InitDir)
  745.     Call PropBag.WriteProperty("FileName", m_FileName, m_def_FileName)
  746. End Sub
  747.  
  748.