acshellctrls.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

end;

{ TacCustomShellTreeView }

constructor TacCustomShellTreeView.Create(AOwner: TComponent);
var
  FileInfo: TSHFileInfo;
begin
  inherited Create(AOwner);
  FRootFolder := nil;
//  ShowRoot := False;
  FObjectTypes := [otFolders];
  RightClickSelect := True;
  FAutoContext := True;
  //! OnDeletion := NodeDeleted;
  FUpdating := False;
  FComboBox := nil;
  FListView := nil;
  FImageListChanging := False;
  FUseShellImages := True;
  FShowExtension := (seSystem);
  FImage := SHGetFileInfo('C:\', { Do not localize } 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

  FNotifier := TacShellChangeNotifier.Create(Self);
{$IFDEF DELPHI6UP}
  FNotifier.FComponentStyle := FNotifier.FComponentStyle + [ csSubComponent ];
{$ENDIF}
  FRoot := SRFDesktop;
  FLoadingRoot := False;
end;

procedure TacCustomShellTreeView.ClearItems;
var
  I: Integer;
begin
  Items.BeginUpdate;
  SkinData.BeginUpdate;
  try
    for I := 0 to Items.Count - 1 do begin
      if Assigned(Folders[i]) then Folders[I].Free;
      Items[I].Data := nil;
    end;
    Items.Clear;
  finally
  end;
  skinData.EndUpdate;
  Items.EndUpdate;
end;

procedure TacCustomShellTreeView.CreateWnd;
begin
  inherited CreateWnd;
  if (Items.Count > 0) then
    ClearItems;
  if not Assigned(Images) then SetUseShellImages(FUseShellImages);
  { TODO : What is the Items.Count test for here? }
  if (not FLoadingRoot) {and (Items.Count = 0)} then
    CreateRoot;
end;

procedure TacCustomShellTreeView.DestroyWnd;
begin
  ClearItems;
// v4.63 if FRootFolder <> nil then FreeAndNil(FRootFolder); // v4.54
  inherited DestroyWnd;
end;

procedure TacCustomShellTreeView.CommandCompleted(Verb: String; Succeeded: Boolean);
var
  Fldr : TacShellFolder;
begin
  if not Succeeded then Exit;
  if Assigned(Selected) then begin
    if SameText(Verb, SCmdVerbDelete) then begin
      Fldr := TacShellFolder(Selected.Data);
      if not FileExists(Fldr.PathName) then begin
        Selected.Data := nil;
        Selected.Delete;
        FreeAndNil(Fldr);
      end;
    end
    else if SameText(Verb, SCmdVerbPaste) then Refresh(Selected)
    else if SameText(Verb, SCmdVerbOpen) then SetCurrentDirectory(PChar(FSavePath));
  end;
end;

procedure TacCustomShellTreeView.ExecuteCommand(Verb: String; var Handled: Boolean);
var
  szPath: array[0..MAX_PATH] of char;
begin
  if SameText(Verb, SCmdVerbRename) and Assigned(Selected) then begin
    Selected.EditText;
    Handled := True;
  end
  else if SameText(Verb, SCmdVerbOpen) then begin
    GetCurrentDirectory(MAX_PATH, szPath);
    FSavePath := StrPas(szPath);
    StrPCopy(szPath, ExtractFilePath(TacShellFolder(Selected.Data).PathName));
    SetCurrentDirectory(szPath);
  end;
end;

function TreeSortFunc(Node1, Node2: TTreeNode; lParam: Integer): Integer; stdcall;
begin
  Result := SmallInt(TacShellFolder(Node1.Data).ParenTacShellFolder.CompareIDs(
       0, TacShellFolder(Node1.Data).RelativeID, TacShellFolder(Node2.Data).RelativeID));
end;

procedure TacCustomShellTreeView.InitNode(NewNode: TTreeNode; ID: PItemIDList; ParentNode: TTreeNode);
var
  CanAdd: Boolean;
  NewFolder: IShellFolder;
  AFolder: TacShellFolder;
begin
  AFolder := TacShellFolder(ParentNode.Data);
  NewFolder := GetIShellFolder(AFolder.ShellFolder, ID);
  NewNode.Data := TacShellFolder.Create(AFolder, ID, NewFolder);
  with TacShellFolder(NewNode.Data) do begin
    NewNode.Text := DisplayName(FShowExtension);
    if FUseShellImages and not Assigned(Images) then begin
      NewNode.ImageIndex := GetShellImage(AbsoluteID, False, False);
      NewNode.SelectedIndex := GetShellImage(AbsoluteID, False, True);
    end;
    if NewNode.SelectedIndex = 0 then NewNode.SelectedIndex := NewNode.ImageIndex;
    NewNode.HasChildren := SubFolders;
    if fpShared in Properties then NewNode.OverlayIndex := 0;
    if (otNonFolders in ObjectTypes) and (ShellFolder <> nil) then
      NewNode.HasChildren := GetHasSubItems(ShellFolder, ObjectFlags(FObjectTypes));
  end;

  CanAdd := True;
  if Assigned(FOnAddFolder) then FOnAddFolder(Self, TacShellFolder(NewNode.Data), CanAdd);
  if not CanAdd then NewNode.Delete;
end;

procedure TacCustomShellTreeView.PopulateNode(Node: TTreeNode);
var
  ID: PItemIDList;
  EnumList: IEnumIDList;
  NewNode: TTreeNode;
  NumIDs: LongWord;
  SaveCursor: TCursor;
  HR: HResult;
begin
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  Items.BeginUpdate;
//  SkinData.BeginUpdate;
  try
    try
      HR := TacShellFolder(Node.Data).ShellFolder.EnumObjects(Application.Handle, ObjectFlags(FObjectTypes), EnumList);
      if HR <> 0 then Exit;
    except on E:Exception do end;

    while EnumList.Next(1, ID, NumIDs) = S_OK do begin
      NewNode := Items.AddChild(Node, '');
      InitNode(NewNode, ID, Node);
    end;

    Node.CustomSort(@TreeSortFunc, 0);
  finally
//    SkinData.EndUpdate;
    Items.EndUpdate;
    Screen.Cursor := SaveCursor;
  end;
end;

procedure TacCustomShellTreeView.SetObjectTypes(Value: TacShellObjectTypes);
begin
  FObjectTypes := Value;
  RootChanged;
end;

procedure TacCustomShellTreeView.CreateRoot;
var
  RootNode: TTreeNode;
  ErrorMsg: string;
begin
  if (csLoading in ComponentState) or (csDesigning in ComponentState) then Exit;
  try
    FRootFolder := CreateRootFolder(FRootFolder, FOldRoot, FRoot);
    ErrorMsg := '';
  except
    on E : Exception do ErrorMsg := E.Message;
  end;

  if Assigned(FRootFolder) then begin
    FLoadingRoot := true;
    try
      if Items.Count > 0 then ClearItems;
      RootNode := Items.Add(nil, '');
      with RootNode do begin
        Data := TacShellFolder.Create(nil, FRootFolder.AbsoluteID, FRootFolder.ShellFolder);

        Text := GetDisplayName(DesktopShellFolder,
                               TacShellFolder(Data).AbsoluteID,
                               SHGDN_NORMAL, FShowExtension);

        if FUseShellImages and not Assigned(Images) then begin
          RootNode.ImageIndex := GetShellImage(TacShellFolder(RootNode.Data).AbsoluteID, False, False);
          RootNode.SelectedIndex := GetShellImage(TacShellFolder(RootNode.Data).AbsoluteID, False, True);
        end;
        RootNode.HasChildren := TacShellFolder(RootNode.Data).SubFolders;
      end;
      RootNode.Expand(False);
      Selected := RootNode;
    finally
      FLoadingRoot := False;
    end;
  end;
  if ErrorMsg <> '' then Raise Exception.Create( ErrorMsg );
end;

function TacCustomShellTreeView.CanExpand(Node: TTreeNode): Boolean;
var
  Fldr: TacShellFolder;
begin
  Result := True;
  Fldr := TacShellFolder(Node.Data);
  if (csDesigning in ComponentState) and (Node.Level > 0) then Exit;
  if Assigned(OnExpanding) then OnExpanding(Self, Node, Result);
  if Result then
    if Fldr.IsFolder and (Node.HasChildren) and (Node.Count = 0) then
      PopulateNode(Node)
    else if not Fldr.IsFolder then
    begin
      ShellExecute(Handle, nil, PChar(Fldr.PathName), nil,
        PChar(ExtractFilePath(Fldr.PathName)), 0);
    end;
  Node.HasChildren := Node.Count > 0;
end;

procedure TacCustomShellTreeView.Edit(const Item: TTVItem);
var
  S: string;
  Node: TTreeNode;
begin
  with Item do if pszText <> nil then begin
    S := pszText;
    Node := Items.GetNode(Item.hItem);
    if Assigned(OnEdited) then OnEdited(Self, Node, S);
    if ( Node <> nil ) and TacShellFolder(Node.Data).Rename(S) then begin
      Node.Text := S;
      if Node.Parent <> nil then Refresh(Node.Parent); // v4.60
    end;
  end;
end;

procedure TacCustomShellTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //! Commenting this out fixes #107480, #109250
  (*
  if (Button = mbRight) and FAutoContext and (Selected <> nil) and (Selected.Data <> nil) then
    InvokeContextMenu(Self, SelectedFolder, X, Y)
  else
  (**)
  inherited MouseUp(Button, Shift, X, Y);
end;

function TacCustomShellTreeView.NodeFromRelativeID(ParentNode: TTreeNode; ID: PItemIDList): TTreeNode;
var
  HR: HResult;
begin
  Result := ParentNode.GetFirstChild;
  while (Result <> nil) do
  begin
    HR := TacShellFolder(ParentNode.Data).ShellFolder.CompareIDs(0, ID, TacShellFolder(Result.Data).RelativeID);
    if HR = 0 then Exit;
    Result := ParentNode.GetNextChild(Result);
  end;
end;

function TacCustomShellTreeView.NodeFromAbsoluteID(StartNode: TTreeNode; ID: PItemIDList): TTreeNode;
var
  HR: HResult;
begin
  Result := StartNode;
  while Result <> nil do
  begin
    HR := DesktopShellFolder.CompareIDs(0, ID, TacShellFolder(Result.Data).AbsoluteID);
    if HR = 0 then Exit;
    Result := Result.GetNext;
  end;
end;

procedure TacCustomShellTreeView.Delete(Node: TTreeNode);
begin
  if Assigned(Node.Data) then
  begin
    TacShellFolder(Node.Data).Free;
    Node.Data := nil;
  end;
  inherited Delete(Node);
end;

(*
procedure TacCustomShellTreeView.NodeDeleted(Sender: TObject; Node: TTreeNode);
begin
  if Assigned(Node.Data) then
  begin
    TacShellFolder(Node.Data).Free;
    Node.Data := nil;
  end;
end;
(**)

procedure TacCustomShellTreeView.RootChanged;
begin
  if Updating then Exit;
  FUpdating := True;
  try
    CreateRoot;
    if Assigned(FComboBox) then FComboBox.SetRoot(FRoot);
    if Assigned(FListView) then FListView.SetRoot(FRoot);
  finally
    FUpdating := False;
  end;
end;

function TacCustomShellTreeView.FolderExists(FindID: PItemIDList; InNode: TTreeNode): TTreeNode;
var
  ALevel: Integer;
begin
  Result := nil;
  ALevel := InNode.Level;
  repeat
    if DesktopShellFolder.CompareIDs(
      0,
      FindID,
      TacShellFolder(InNode.Data).AbsoluteID) = 0 then
    begin
      Result := InNode;
      Exit;
    end else
      InNode := InNode.GetNext;
  until (InNode = nil) or (InNode.Level <= ALevel);
end;

procedure TacCustomShellTreeView.RefreshEvent;
begin
  if Assigned(Selected) then Refresh(Selected);
end;

procedure TacCustomShellTreeView.Refresh(Node: TTreeNode);
var
  NewNode, OldNode, Temp: TTreeNode;
  OldFolder, NewFolder: TacShellFolder;
  ThisLevel: Integer;
  SaveCursor: TCursor;
  TopID, SelID: PItemIDList;
  ParentFolder: TacShellFolder;
begin
  if TacShellFolder(Node.Data).ShellFolder = nil then Exit;
  SaveCursor := Screen.Cursor;
  ParentFolder := nil;
  //Need absolute PIDL to search for top item once tree is rebuilt.
  TopID := CopyPIDL(TacShellFolder(TopItem.Data).RelativeID);
  if TacShellFolder(TopItem.Data).Parent <> nil then TopID := ConcatPIDLs(TacShellFolder(TopItem.Data).Parent.AbsoluteID, TopID);
  //Same thing for SelID
  SelID := nil;
  if (Selected <> nil) and (Selected.Data <> nil) then begin
    SelID := CopyPIDL(TacShellFolder(Selected.Data).RelativeID);
    if TacShellFolder(Selected.Data).Parent <> nil then SelID := ConcatPIDLs(TacShellFolder(Selected.Data).Parent.AbsoluteID, SelID);
  end;

  Items.BeginUpdate;
  SkinData.BeginUpdate;
  try
    Screen.Cursor := crHourglass;
    OldFolder := Node.Data;
    NewNode := Items.Insert(Node, '');
    if Node.Parent <> nil then ParentFolder := TacShellFolder(Node.Parent.Data);
    NewNode.Data := TacShellFolder.Create(ParentFolder,
                                   OldFolder.RelativeID,
                                   OldFolder.ShellFolder);
    PopulateNode(NewNode);
    with NewNode do begin
      NewFolder := Data;
      ImageIndex := GetShellImage(NewFolder.AbsoluteID, False, False);
      SelectedIndex := GetShellImage(NewFolder.AbsoluteID, False, True);
      HasChildren := NewFolder.SubFolders;
      Text := NewFolder.DisplayName(FShowExtension);
    end;

    ThisLevel := Node.Level;
    OldNode := Node;
    repeat
      Temp := FolderExists(TacShellFolder(OldNode.Data).AbsoluteID, New