systemlistview.pas

动态提示控件

end;

procedure TdfsSystemListView.SetColumnType(ColType: TColumnType);
begin
  if ColType = FColumnType then exit;
  FColumnType := ColType;
  if not (csLoading in ComponentState) then
    CreateColumns(ColType);
end;

procedure TdfsSystemListView.RecreateColumns;
begin
  if HandleAllocated then
    CreateColumns(FColumnType);
end;

// This will be based on what type of stuff we are enumerating eventually
procedure TdfsSystemListView.CreateColumns(ColType: TColumnType);
{var
  ShellDetails: IShellDetails;
  Details: TShellDetails;}
begin
  HandleNeeded;

  Columns.Clear;

  //!!! This will work on Win2k, in theory
(*
  if FCurrentShellFolder <> NIL then
  begin
    if Succeeded(FCurrentShellFolder.CreateViewObject(Handle, IID_IShellDetails,
      ShellDetails)) then
    begin
      MessageBeep(MB_ICONSTOP);
      exit;
    end;
  end;
*)

  case ColType of
    ctMachine:
      begin
        with Columns.Add do
        begin
          Caption := strColName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColType;
          Width := FColumnWidths.cwSize;
        end;
        with Columns.Add do
        begin
          Caption := strColTotalSize;
          Alignment := taRightJustify;
          Width := FColumnWidths.cwType;
        end;
        with Columns.Add do
        begin
          Caption := strColFreeSpace;
          Alignment := taRightJustify;
          Width := FColumnWidths.cwModified;
        end;
      end;
    ctControlPanel:
      begin
        with Columns.Add do
        begin
          Caption := strColName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColDescription;
          Width := FColumnWidths.cwSize;
        end;
      end;
    ctPrinters:
      begin
        with Columns.Add do
        begin
          Caption := strColName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColDocuments;
          Alignment := taCenter;
          Width := FColumnWidths.cwSize;
        end;
        with Columns.Add do
        begin
          Caption := strColStatus;
          Width := FColumnWidths.cwType;
        end;
        with Columns.Add do
        begin
          Caption := strColComment;
          Width := FColumnWidths.cwModified;
        end;
      end;
    ctDUNet:
      begin
        with Columns.Add do
        begin
          Caption := strColEntryName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColPhone;
          Alignment := taRightJustify;
          Width := FColumnWidths.cwSize;
        end;
        with Columns.Add do
        begin
          Caption := strColDeviceName;
          Width := FColumnWidths.cwType;
        end;
      end;
    ctNetwork:
      begin
        with Columns.Add do
        begin
          Caption := strColName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColComment;
          Width := FColumnWidths.cwSize;
        end;
      end;
    ctFileSystem:
      begin
        with Columns.Add do
        begin
          Caption := strColName;
          Width := FColumnWidths.cwName;
        end;
        with Columns.Add do
        begin
          Caption := strColSize;
          Alignment := taRightJustify;
          Width := FColumnWidths.cwSize;
        end;
        with Columns.Add do
        begin
          Caption := strColType;
          Width := FColumnWidths.cwType;
        end;
        with Columns.Add do
        begin
          Caption := strColModified;
          Width := FColumnWidths.cwModified;
        end;
        with Columns.Add do
        begin
          Caption := strColAttrib;
          Width := FColumnWidths.cwAttr;
          Alignment := taRightJustify;
        end;                                             
      end;
    ctUser:
      begin
        if csDesigning in ComponentState then
        begin
          with Columns.Add do
          begin
            Caption := strColUserDefined;
            Width := 150;
          end;
        end else begin
          if assigned(FOnCreateColumns) then
            FOnCreateColumns(Self)
          else
            ColumnType := ctUnknown;
        end;
      end;
  else // ctUnknown;
    with Columns.Add do
    begin
      Caption := strColName;
      Width := FColumnWidths.cwName;
    end;
  end;
end;

// Searches the list for a relative PIDL.  Relative search is faster, and we
// don't need fully-qualified since the tree should take care of that part.
function TdfsSystemListView.FindItemFromID(AnID: PItemIDList): TListItem;
var
  SearchID: PItemIDList;
  Count: integer;
  Item: TListItem;
  ShellFolder: IShellFolder;
begin
  if (AnID.mkid.cb = 0) or (Items.Count < 1) then // nothing to search for.
  begin
    Result := NIL;
    exit;
  end;

  // Initialize some stuff
  Count := 0;
  Item := Items[0];
  with GetItemData(Item) do // Get the first item's data.
  begin
    SearchID := IDList; // It's relative ID
    ShellFolder := SFParent; // It's parent shell folder
  end;

  while assigned(SearchID) and assigned(AnID) do
  begin
    // Is the current portion of the ID we're looking for this node's child?
    if ShellFolder.CompareIDs(0, SearchID, AnID) = 0 then
    begin
      // Found it.
      break;
    end else begin
      inc(Count);
      if Count < Items.Count then
      begin
        Item := Items[Count];
        with GetItemData(Item) do
        begin
          SearchID := IDList; // it's relative ID
          ShellFolder := SFParent; // it's shell folder
        end;
      end else begin
        Item := NIL;
        break;
      end;
    end;
  end; // while

  Result := Item; // Return the deepest match we found.
end; // FindNodeFromID

procedure TdfsSystemListView.Reset;
var
  SelPIDL: PItemIDList;
  SelFolder: IShellFolder;
begin
  // The list prefers to work from a linked treeview, if available.  If not,
  // it works from a linked combo.  If neither are available, it works from
  // it's current selection, or the desktop root if there's no selection.

  {$IFDEF DFS_SCP_SYSTREEVIEW}
  if TreeView <> NIL then
  begin
    SelPIDL := TreeView.SelectionPIDL;
    SelFolder := TreeView.SelectionParentFolder;
  end else
  {$ENDIF}

  {$IFDEF DFS_SCP_SYSCOMBOBOX}
  if ComboBox <> NIL then
  begin
    SelPIDL := ComboBox.SelectionPIDL;
    SelFolder := ComboBox.SelectionParentFolder;
  end else
  {$ENDIF}

  begin
    SelPIDL := FCurrentPIDL;
    SelFolder := FCurrentShellFolder;
  end;

  LinkedReset(SelFolder, SelPIDL, FALSE);

  inherited Reset;
end;

(* Old v0.95 code that tied the list to the tree.  bad idea (tm)
procedure TdfsSystemListView.ResetNode(const ParentNode: TTreeNode;
   IsDesktopNode: boolean);
var
  SubFolder: IShellFolder;
  Attrs: UINT;
  AnIDList: PItemIDList;
  CurrentItemID: PItemIDList;
{$IFDEF DFS_DEBUG}
  TC: DWORD;
{$ENDIF}
begin
{$IFDEF DFS_DEBUG} TC := timeGetTime; {$ENDIF}
  if (ParentNode = NIL) or (ParentNode.Data = NIL) then exit;
  FLastNode := ParentNode;
  FLastNodeWasDesktop := IsDesktopNode;
  if (not HandleAllocated) then
  begin
    FNeedsReset := TRUE;
    exit;
  end else begin
    FNeedsReset := FALSE;
  end;

  // If we have a selection, stash the item ID so we can find it after
  // resetting. All of the node data is going to get cleared, so we have to
  // copy the selected ID, not just store the the current pointer.
  if (ItemFocused <> NIL) and (ItemFocused.Data <> NIL) and
     (TFolderItemData(ItemFocused.Data).FQ_IDList <> NIL) then
    CurrentItemID := CopyPIDL(TFolderItemData(ItemFocused.Data).IDList)
  else
    CurrentItemID := NIL;
  Items.BeginUpdate;
  try
    // Clear old stuff
    Selected := NIL;
    FreeAllItemData;
    Items.Clear;

    if (IsDesktopNode) then
    begin
      SHGetDesktopFolder(SubFolder);
      if ColumnType <> ctUser then
        ColumnType := ctFileSystem;
      EnumerateFiles(SubFolder, ParentNode);
      {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
    end else begin
      with TFolderItemData(ParentNode.Data) do
      begin
        Attrs := SFGAO_FILESYSTEM;
        AnIDList := IDList;
        if SUCCEEDED(SFParent.GetAttributesOf(1, AnIDList, Attrs)) then
        begin
          if (Attrs and SFGAO_FILESYSTEM) <> 0 then
          begin
            if ColumnType <> ctUser then
              ColumnType := ctFileSystem;
          end else begin
            // need to find out what kind of object we have.  No idea how.
            if ColumnType <> ctUser then
              ColumnType := ctUnknown;
          end;
        end else
          if ColumnType <> ctUser then
            ColumnType := ctUnknown;

        if SUCCEEDED(SFParent.BindToObject(IDList, NIL, IID_IShellFolder,
           pointer(SubFolder))) then
        begin
          EnumerateFiles(SubFolder, ParentNode);
          {$IFNDEF DFS_NO_COM_CLEANUP} SubFolder.Release; {$ENDIF}
        end; // if
      end; // with
    end; //if
    if CurrentItemID <> NIL then
      ItemFocused := FindItemFromID(CurrentItemID);
  finally
    Items.EndUpdate;
  end;
  // Have to do this after Items.EndUpdate because BeginUpdate sets SortType to
  // stNone.  EndUpdate restores it.
  if SortType <> stNone then
    AlphaSort;

  Populated;

{$IFDEF DFS_DEBUG} ODM(Format('SLV.Reset %s: %d', [ParentNode.Text, timeGetTime-TC])); {$ENDIF}
end; {ResetNode}
*)

function TdfsSystemListView.EnumerateFiles(const Folder: IShellFolder;
   const IDList: PItemIDList): boolean;
var
  Flags: DWORD;
  EnumList: IEnumIDList;
  FQ_List,
  List: PItemIDList;
  Fetched: ULONG;
  OldCursor: TCursor;
begin
  Result := FALSE;

  if Folder = NIL then exit;

  // Inhibit screen painting for speed
  Items.BeginUpdate;
  // I wish there was some way to find out the number of items being enumerated,
  // and only set the hourglass cursor if there were many of them....
  OldCursor := Cursor;
  Cursor := crHourglass;

  try
    Flags := SHCONTF_NONFOLDERS;
    if FShowHiddenFiles then
      Flags := Flags or SHCONTF_INCLUDEHIDDEN;
    if FShowFolders then
      Flags := Flags or SHCONTF_FOLDERS;

    if SUCCEEDED(Folder.EnumObjects(GetValidHandle, Flags, EnumList)) then
//    if SUCCEEDED(Folder.EnumObjects(GetValidHandle, Flags, EnumList)) then
    begin
      // Walk the folders.
      // The list will be saved so don't free it anywhere in here.
      while EnumList.Next(1, List, Fetched) = S_OK do
      begin
        Result := TRUE;  // only successful if we managed to enumerate at least once.
        FQ_List := ConcatPIDLs(IDList, List);
        AddNode(Folder, FQ_List, List);
      end; {while}

      {$IFNDEF DFS_NO_COM_CLEANUP} EnumList.Release; {$ENDIF}
    end else
      // Maybe an event for this???  No items to enum when there should be.