|
NewListViewFileItem |
Description
|
Adds a file (or folder) item to a listview. |
|
|
- oDlg.GetAssociatedIconKey |
(to generate a unique key for the icon(s)) |
Warning
|
Adding large amounts of icons to an imagelist takes a considerable amount of time and may deplete all available resources! |
Syntax
|
[Set oItem =] oFrm. NewListViewFileItem |
( ListView, *INIT | File,[ImageListSmall], [ImageListLarge] ) |
Parameters
|
Part |
Description |
|
|
Set oItem = |
(optional) Store a reference to the new listitem in the variable oItem. This variable can be used to access the listitem's properties and methods |
|
|
oFrm |
A reference to a form object (see the NewForm method) |
|
|
ListView |
The listview object to which the listitem should be added |
|
|
*INIT | File |
*INIT |
This option will clear the specified imagelist(s) and disassociate them from the listview |
|
File |
The file or folder to be added to the listview |
|
|
ImageListSmall |
(optional) An imagelist control to which the small icons associated with the specified file or folder will be added |
|
|
ImageListLarge |
(optional) An imagelist control to which the large icons associated with the specified file or folder will be added |
|
Example: WshExplorer
|
Option Explicit Set oShell = Wscript.CreateObject("WScript.Shell") Set oFso = WScript.CreateObject("Scripting.FileSystemObject") 'Create the WshDialog.Kit object and store a reference in oDlg Set oDlg = WScript.CreateObject("WshDialog.Kit", "oDlg_") 'Determine icon library sIconLibrary = oFso.GetParentFolderName(WScript.ScriptFullName) & "\WshExplorer.icl" 'Call BuildNewFileForm to build the 'New file/folder' dialog Set oFrmNewFile = BuildNewFileForm 'Call BuildExplorerForm to build the main form Set oFrm = BuildExplorerForm 'Show the Explorer form oFrm.Show vbModal '------------------------------------------------------------------------------- ' This function builds the explorer form and returns a reference to it '------------------------------------------------------------------------------- Function BuildExplorerForm Dim oFrm, oCtl, oItem 'Add a form and store a reference in the variable oFrm Set oFrm = oDlg.NewForm("") 'Enable a close and minimize button oFrm.CloseBox = True oFrm.MinBox = True 'Set the form's caption (must use CaptionEx, to preserve CloseBox and MinBox) oFrm.CaptionEx = "WshExplorer - Demonstrating Listview and Imagelist controls" 'Add imagelist controls for small and large icons Set oILS = oFrm.NewImageList("ILS", 16, 16) Set oILL = oFrm.NewImageList ("ILL", 32, 32) 'Add a drive listbox Set oCtl = oFrm.NewDriveListBox("DRIVE", 150, 300, 2500) oCtl.Drive = "C\" 'Add a label to show the current path Set oCtl = oFrm.NewLabel("PATH", 150, 800, 7500, 300, "") oCtl.Borderstyle = 1 'Add a progressbar oFrm.NewProgressBar "BAR", 7800, 800, 4200, 300, 0, 100 'Add browse and delete buttons, use icons from sIconLibrary Set oCtl = oFrm.NewButton("PARENTFOLDER", 7800, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 4, oCtl.BackColor) oCtl.ToolTipText = "Parent folder" Set oCtl = oFrm.NewButton("OPENFOLDER", 8300, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 5, oCtl.BackColor) oCtl.ToolTipText = "Open folder" Set oCtl = oFrm.NewButton("DELETE", 8800, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 6, oCtl.BackColor) oCtl.ToolTipText = "Delete" Set oCtl = oFrm.NewButton("NEW", 9300, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 7, oCtl.BackColor) oCtl.ToolTipText = "New" 'Add buttons to change the appearance of the listview Set Octl = oFrm.NewButton("LVWBTN0", 10000, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 0, oCtl.BackColor) oCtl.ToolTipText = "Large icons" Set oCtl = oFrm.NewButton("LVWBTN1", 10500, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 1, oCtl.BackColor) oCtl.ToolTipText = "Small icons" Set oCtl = oFrm.NewButton("LVWBTN2", 11000, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 2, oCtl.BackColor) oCtl.ToolTipText = "List" Set oCtl = oFrm.NewButton("LVWBTN3", 11500, 150, 500, 500, "") oCtl.Picture = oDlg.GetIcon(sIconLibrary, True, 3, oCtl.BackColor) oCtl.ToolTipText = "Details" 'Add button captions if sIconLibrary can not be found on the system If Not oFso.FileExists(sIconLibrary) Then oFrm.Ctl("PARENTFOLDER").Caption = "UP" & vbCrlf oFrm.Ctl("OPENFOLDER").Caption = "OP" & vbCrlf & "EN" oFrm.Ctl("DELETE").Caption = "DEL" & vbCrlf oFrm.Ctl("NEW").Caption = "NEW" & vbCrlf oFrm.Ctl("LVWBTN0").Caption = "LAR" & vbCrlf & "GE" oFrm.Ctl("LVWBTN1").Caption = "SMA" & vbCrlf & "LL" oFrm.Ctl("LVWBTN2").Caption = "LIST" & vbCrlf oFrm.Ctl("LVWBTN3").Caption = "DET" & vbCrlf & "AIL" End If 'Add the listview Set oLVW = oFrm.NewListView("LVW", 100, 1200, 12000, 5000) 'Must be set before adding listitems! 'oLVW.CheckBoxes = True 'Add columnheaders to the listview oLVW.Columnheaders.Add , "#1", "Name", oLVW.Width * 0.35 Set oItem = oLVW.Columnheaders.Add(, "#2", "Size", oLVW.Width * 0.10) oItem.Alignment = 1 'Align right oLVW.Columnheaders.Add , "#3", "Type", oLVW.Width * 0.25 oLVW.Columnheaders.Add , "#4", "Date", oLVW.Width * 0.15 oLVW.Columnheaders.Add , "#5", "Attributes", oLVW.Width * 0.15 'Set some listview properties oLVW.AllowColumnReorder = True oLVW.GridLines = True oLVW.FullRowSelect = True oLVW.HideSelection = False oLVW.HotTracking = True 'oLVW.HoverSelection = True oLVW.LabelEdit = 0 oLVW.LabelWrap = False oLVW.MultiSelect = True 'Sort the listview in ascending order on the first column 'oLVW.Sorted = True 'oLVW.SortOrder = 0 'oLVW.SortKey = 0 'Show the listview in report mode oLVW.View = 3 'Add a FINISH button Set oCtl = oFrm.NewButton("FINISH", 5600, 6300, 1000, 375, "&Finish") 'Cannot set this property (Enter must be processed by the listview!) 'oCtl.Default = True 'Add some labels to show the # of items and available function keys Set oCtl = oFrm.NewLabel("ITEMS", 150, 6300, 1000, 300, "") Set oCtl = oFrm.NewLabel("FX", 10300, 6300, 2000, 300, "F2 = Edit F5 = Refresh") 'Automatically size the form to the controls placed on it oFrm.AutoSize 'Show the form in the taskbar oFrm.TaskBar = True 'Enable event handling (callback) for this form oFrm.CallBack = True 'Return the form object Set BuildExplorerForm = oFrm End Function '------------------------------------------------------------------------------- ' This function builds the new file/folder form and returns a reference to it '------------------------------------------------------------------------------- Function BuildNewFileForm Dim oFrm, oCtl 'Add a form and store a reference to it in the variable oFrm Set oFrm = oDlg.NewForm("NewFile") 'Enable a close and minimize button oFrm.CloseBox = True oFrm.MinBox = False 'Set the form's caption (must use CaptionEx, because of CloseBox and MinBox) oFrm.CaptionEx = "Create File Or Folder" 'Add a frame to the form oFrm.NewFrame "FRM", 100, 100, 2500, 1850, "" 'Add optionbuttons for the new file/folder options oFrm.NewOptionButton "FOLDER", 120, 300, 2000, 255, "Folder", False, "FRM" oFrm.NewOptionButton ".TXT", 120, 650, 2000, 255, "Text-document", True, "FRM" oFrm.NewOptionButton ".XLS", 120, 1000, 2000, 255, "Excel-worksheet", False, "FRM" oFrm.NewOptionButton ".DOC", 120, 1350, 2000, 255, "Word-document", False, "FRM" 'Add an OK button and set it's Default Property Set oCtl = oFrm.NewButton("OK", 250, 2100, 1000, 375, "&OK") oCtl.Default = True 'Add a Cancel button and set it's Cancel Property Set oCtl = oFrm.NewButton("CANCEL", 1500, 2100, 1000, 375, "&Cancel") oCtl.Cancel = True 'Automatically size the form to the controls placed on it oFrm.AutoSize 'Show the form in the taskbar oFrm.TaskBar = True 'Enable event handling (callback) for this form oFrm.CallBack = True 'Return the form object Set BuildNewFileForm = oFrm End Function '------------------------------------------------------------------------------- ' oDlg_ClickHandler handles the events sent by the controls '------------------------------------------------------------------------------- Sub oDlg_ClickHandler(sForm, sControl) Dim oFrm, oCtl, oFolder Dim sSlash, sSource, sTarget, sOldLabel, sMsg, nView Dim aEvent, sEvent, sData 'This section is required to handle non-default (listview) events 'For non-default events sControl is a compound value, consisting 'of the controlname, the specific eventname and additional data. 'All these elements are separated by ASCIIZ's characters aEvent = Split(sControl, Chr(0)) sControl = aEvent(0) If Ubound(aEvent) > 0 Then sEvent = aEvent(1) If Ubound(aEvent) > 1 Then sData = aEvent(2) 'Get a reference to the form and the control that raised the event Set oFrm = oDlg.Frm(sForm) Set oCtl = oFrm.Ctl(sControl) 'Check from which form the event was raised Select Case Ucase(sForm) Case "" 'Main form If sFolder = "" Then sFolder = "C:\" Set oFolder = oFso.GetFolder(sFolder) If Not oFolder.IsRootFolder Then sSlash = "\" Select Case UCase(sControl) Case "*ACTIVATE" 'Should run only at the initial activation of the form If Not bInitDone Then bInitDone = True If Not oFso.FileExists(sIconLibrary) Then sMsg = "Cannot find " & sIconLibrary & vbCrlf & vbCrlf sMsg = sMsg & "Button texts are displayed instead of icons." & vbCrlf & vbCrlf sMsg = sMsg & "Copy WshExplorer.icl (included in WshDialog.zip)" & vbCrlf sMsg = sMsg & "to the directory from which this script is executed." MsgBox sMsg, vbOKOnly + vbInformation, "Cannot Find Icon Resource" End If ListFolder oLVW, oILS, oILL, sFolder, oLVW.View End If Case "DRIVE" 'Another drive was selected, show it's root folder sFolder = Ucase(Left(oCtl.Drive, 2) & "\") ListFolder oLVW, oILS, oILL, sFolder, oLVW.View Case "*F2" 'F2 pressed, start a label edit operation oLVW.StartLabelEdit Case "*F5" 'F5 pressed, refresh the listview ListFolder oLVW, oILS, oILL, sFolder, oLVW.View Case "LVW" 'Handle listview events Select Case sEvent Case "" 'Default event (double-click or Enter) OpenFileOrFolder sFolder, sSlash, sControl Case "ItemClick" 'Item selected (by single click or keyboard). Show name in caption oFrm.Ctl("PATH").Caption = sFolder & sSlash & oCtl.ListItems(CInt(sData)) Case "AfterLabelEdit" 'Label editing operation has ended sOldLabel = oCtl.SelectedItem If Ucase(sOldLabel) <> UCase(sData) Then sSource = sFolder & sSlash & sOldLabel sTarget = sFolder & sSlash & sData If oFso.FileExists(sTarget) Or oFso.FolderExists(sTarget) Then sMsg = "A file or folder with this name already exists" MsgBox sMsg, vbOkOnly + vbExclamation, sData 'Cancel the label editing operation oFrm.CancelLabelEdit Else 'Rename (move) the file or folder If oFso.FileExists(sSource) Then oFso.MoveFile sSource, sTarget Elseif oFso.FolderExists(sSource) Then oFso.MoveFolder sSource, sTarget End If End If End If Case "KeyBack" 'Backspace key pressed OpenParentFolder sFolder Case "KeyDelete" 'Delete key pressed DeleteFileOrFolder sFolder, sSlash Case "KeyInsert" 'Insert key pressed CreateFileOrFolder sFolder, sSlash Case Else End Select Case "PARENTFOLDER" OpenParentFolder sFolder Case "OPENFOLDER" OpenFileOrFolder sFolder, sSlash, sControl Case "DELETE" DeleteFileOrFolder sFolder, sSlash Case "NEW" CreateFileOrFolder sFolder, sSlash Case "LVWBTN0", "LVWBTN1", "LVWBTN2", "LVWBTN3" 'Change the viewmode of the listview oLVW.View = Int("0" & Right(sControl, 1)) Case "*CLOSE", "FINISH" 'The closebox or finish button was clicked. Dismiss the form (hide it) oFrm.Hide Case Else 'Ignore all other events. Do NOT use oFrm.Hide here, or any event 'not handled above will dismiss the form End Select Case "NEWFILE" 'The event was raised from the new file/folder dialog Select Case UCase(sControl) Case "*CLOSE", "OK", "CANCEL" 'The closebox or finish button was clicked. Dismiss the form (hide it) oFrm.Hide Case Else 'Ignore all other events. Do NOT use oFrm.Hide here, or any event 'not handled above will dismiss the form End Select Case Else End Select End Sub '------------------------------------------------------------------------------- ' Open the selected parent folder '------------------------------------------------------------------------------- Sub OpenParentFolder(sFolder) Dim oFolder Set oFolder = oFso.GetFolder(sFolder) If Not oFolder.IsRootFolder Then sFolder = oFso.GetParentFolderName(sFolder) ListFolder oLVW, oILS, oILL, sFolder, oLVW.View End If End Sub '------------------------------------------------------------------------------- ' Open the selected file or subfolder '------------------------------------------------------------------------------- Sub OpenFileOrFolder(sFolder, sSlash, sControl) 'Bail out if the listview contains no listitems If oLVW.ListItems.Count = 0 Then Exit Sub If oFso.FolderExists(sFolder & sSlash & oLVW.SelectedItem) Then sFolder = sFolder & sSlash & oLVW.SelectedItem ListFolder oLVW, oILS, oILL, sFolder, oLVW.View Else If Ucase(sControl) = "LVW" Then RunProgram sFolder, sSlash End If End Sub '------------------------------------------------------------------------------- ' Run the selected program or open the selected file '------------------------------------------------------------------------------- Sub RunProgram(sFolder, sSlash) Dim oFile, sFile, sProg, sMsg 'Get the program associated with the selected file sFile = sFolder & sSlash & oLVW.SelectedItem Set oFile = oFso.GetFile(sFile) SProg = oDlg.GetAssociatedProgram(sFile) If sProg = "" Then MsgBox "No program associated with " & sFile ElseIf Ucase(sProg) = Ucase(sFile) Or Ucase(sProg) = Ucase(oFile.ShortPath) Then 'The associated program is the selected file itself, so just run it If vbYes = MsgBox("Run " & sFile & " ?", vbYesNo, "Run Program") Then sFile = Chr(34) & sFile & Chr(34) oShell.Run sFile, 1, False End If Else 'Open the selected file with it's associated program sMsg = "Open " & sFile & vbCrLf & "with " & sProg & " ?" If vbYes = MsgBox(sMsg, vbYesNo, "Run Associated Program") Then sProg = Chr(34) & sProg & Chr(34) sFile = Chr(34) & sFile & Chr(34) oShell.Run sProg & " " & sFile, 1, False End If End If End Sub '------------------------------------------------------------------------------- ' Delete the selected file or folder '------------------------------------------------------------------------------- Sub DeleteFileOrFolder(sFolder, sSlash) Dim X, sPath, sMsg, bDeleted 'Bail out if the listview contains no listitems If oLVW.ListItems.Count = 0 Then Exit Sub sPath = sFolder & sSlash sMsg = "Are you sure you want to permanently delete the selected items(s)" If vbYes = MsgBox(sMsg, vbYesNo + vbQuestion, "Delete file(s)/folder(s)") Then 'Step backwards when deleting items For X = oLVW.ListItems.Count To 1 Step -1 bDeleted = False If oLVW.ListItems(X).Selected Then If oFso.FolderExists(sPath & oLVW.ListItems(X)) Then 'MsgBox "Deleting folder " & sPath & oLVW.ListItems(X) & " (not really)" oFso.DeleteFolder sPath & oLVW.ListItems(X), True bDeleted = True Elseif oFso.FileExists(sPath & oLVW.ListItems(X)) Then 'MsgBox "Deleting file " & sPath & oLVW.ListItems(X) & " (not really)" oFso.DeleteFile sPath & oLVW.ListItems(X), True bDeleted = True End If If bDeleted Then 'Remove the listview item oLVW.ListItems.Remove(X) End If End If Next 'Decrement the item count oFrm.Ctl("ITEMS").Caption = CStr(oLVW.ListItems.Count) & " Item(s)" End If End Sub '------------------------------------------------------------------------------- ' Create a new file or folder '------------------------------------------------------------------------------- Sub CreateFileOrFolder(sFolder, sSlash) Dim oApp, oDoc, oItem, oFile, sFile, sDoc, sExt 'Show the new file/folder dialog oFrmNewFile.Show vbModal If Ucase(oDlg.Clicked) <> "OK" Then Exit Sub 'Check the type of file/folder to create Select Case Ucase(oFrmNewFile.GetOptionButton("FRM")) Case "FOLDER" 'Create a new folder sFile = UniqueName(sFolder & sSlash & "New Folder", "") Set oFile = oFso.CreateFolder(sFile) Case ".TXT" 'Create a new text document sDoc = "New Text-document" : sExt = ".txt" sFile = UniqueName(sFolder & sSlash & sDoc, sExt) oFso.CreateTextFile(sFile) Set oFile = oFso.GetFile(sFile) Case ".DOC" 'Create a new Word document Set oApp = CreateObject("Word.Application") sDoc = "New Microsoft Word-document" : sExt = ".doc" sFile = UniqueName(sFolder & sSlash & sDoc, sExt) oApp.Visible = False Set oDoc = oApp.Documents.Add oDoc.SaveAs sFile oApp.Quit Set oFile = oFso.GetFile(sFile) Case ".XLS" 'Create a new Excel worksheet Set oApp = CreateObject("Excel.Application") sDoc = "New Microsoft Excel-worksheet" : sExt = ".xls" sFile = UniqueName(sFolder & sSlash & sDoc, sExt) oApp.Visible = False Set oDoc = oApp.Workbooks.Add oDoc.SaveAs sFile oApp.Quit Set oFile = oFso.GetFile(sFile) End Select Set oDoc = Nothing : Set oApp = Nothing 'Deselect all items, if any For Each oItem In oLVW.ListItems oItem.Selected = False Next 'Add the new item to the listview Set oItem = AddFile2ListView(oLVW, oFile, oILS, oILL) 'Select the new listitem and ensure it's visible oItem.Selected = True oItem.EnsureVisible 'Increment the item count oFrm.Ctl("ITEMS").Caption = CStr(oLVW.ListItems.Count) & " Item(s)" End Sub '------------------------------------------------------------------------------- ' Return a unique file or folder name '------------------------------------------------------------------------------- Function UniqueName(sBase, sExt) Dim X, sFile If Not oFso.FileExists(sBase & sExt) And Not oFso.FolderExists(sBase & sExt) Then UniqueName = sBase & sExt Else For X = 2 To 999 UniqueName = sBase & " (" & Trim(CStr(X)) & ")" & sExt If Not oFso.FileExists(UniqueName) And Not oFso.FolderExists(UniqueName) Then Exit For Next End If End Function '------------------------------------------------------------------------------- ' Populate the listview '------------------------------------------------------------------------------- Sub ListFolder(oListView, oImageListSmall, oImageListLarge, sFolder, nView) Dim oProgressBar, oFolder, oSubFolder, oFiles, oFile, oItem Dim nCount, sAttributes, sCaption oListView.ListItems.Clear 'Show the foldername sCaption = sFolder If Len(sCaption) > 100 Then 'Abbreviate the foldername to fit the label (if necessary) sCaption = Left(sFolder, 100 - Len(oFso.GetBaseName(sFolder)) - 7) sCaption = sCaption & " .... \" & oFso.GetBaseName(sFolder) End If oFrm.Ctl("PATH").Caption = sCaption 'Get references to the folder and files Set oFolder = oFso.GetFolder(sFolder) Set oFiles = oFolder.Files 'Calculate and show the number of items in the folder nCount = oFolder.SubFolders.Count + oFiles.Count oFrm.Ctl("ITEMS").Caption = CStr(nCount) & " Item(s)" 'Initialize the progressbar Set oProgressBar = oFrm.Ctl("BAR") oProgressBar.Min = 0 oProgressBar.Max = 1 oProgressBar.Value = 0 If nCount > 0 Then oProgressBar.Max = nCount 'Clear imagelist(s) and assign them to the listview oFrm.NewListViewFileItem oListView, "*INIT", oImageListSmall, oImageListLarge 'Add all subfolders to the listview For Each oSubFolder in oFolder.SubFolders AddFile2ListView oListView, oSubFolder, oImageListSmall, oImageListLarge oProgressBar.Value = oProgressBar.Value + 1 Next 'Add all files to the listview For Each oFile in oFiles AddFile2ListView oListView, oFile, oImageListSmall, oImageListLarge oProgressBar.Value = oProgressBar.Value + 1 Next oProgressBar.Value = 0 End Sub '------------------------------------------------------------------------------- ' Add a file or folder to the listview '------------------------------------------------------------------------------- Function AddFile2ListView(oListView, oFile, oImageListSmall, oImageListLarge) Dim oItem, oSubItem, sAttributes 'Add a file/folder item to the listview Set oItem = oFrm.NewListViewFileItem(oListView, oFile.Path, oImageListSmall, oImageListLarge) 'Alternate code for oFrm.NewListViewFileItem above 'Dim sKey, oLicon, oSicon, nLidx, nSidx 'sKey = oDlg.GetAssociatedIconKey(oFile.Path) 'Set oLicon = oDlg.GetAssociatedIcon(oFile.Path, False, oListView.BackColor) 'Set oSicon = oDlg.GetAssociatedIcon(oFile.Path, True, oListView.BackColor) 'nLidx = oFrm.NewImageListPicture(oImageListLarge, oLicon, sKey) 'nSidx = oFrm.NewImageListPicture(oImageListSmall, oSicon, sKey) 'oListView.Icons = oImageListLarge : oListView.SmallIcons = oImageListSmall 'Set oItem = oListView.ListItems.Add(, , oFso.GetFilename(oFile.Path), nLidx, nSidx) 'The subitems show additional file/folder information oItem.SubItems(1) = oFile.Size oItem.SubItems(2) = oFile.Type oItem.SubItems(3) = oFile.DateLastModified sAttributes = "" If oFile.Attributes And 2 Then sAttributes = "H" If oFile.Attributes And 4 Then sAttributes = sAttributes & "S" If oFile.Attributes And 1 Then sAttributes = sAttributes & "R" If oFile.Attributes And 32 Then sAttributes = sAttributes & "A" oItem.SubItems(4) = sAttributes 'Examples of how to modify a subitems's properties Set oSubItem = oItem.ListSubItems(4) If Instr(sAttributes, "H") Then oSubItem.ForeColor = RGB(255, 0, 0) 'oSubItem.ReportIcon = oImageListSmall.ListImages.Count Set AddFile2ListView = oItem End Function |