cxshellcontrols.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,033 行 · 第 1/5 页

PAS
2,033
字号
    Handled := True;
    if ANode.Parent = nil then
      Exit;

    FContextPopupItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
    FContextPopupItemProducer.OnDestroy := ContextPopupItemProducerDestroyHandler;
    FContextPopupItemProducer.LockRead;
    try
      CreateChangeNotification(ANode);
      AItem := FContextPopupItemProducer.Items[ANode.Index];
      FIsChangeNotificationCreationLocked := True;
      if AItem.pidl <> nil then
      begin
        AItemPIDLList := TList.Create;
        try
          AItemPIDLList.Add(GetPidlCopy(AItem.pidl));
          cxShellCommon.DisplayContextMenu(Handle, FContextPopupItemProducer.ShellFolder,
            AItemPIDLList, ClientToScreen(MousePos));
        finally
          DisposePidl(AItemPIDLList[0]);
          AItemPIDLList.Free;
        end;
      end;
    finally
      if FContextPopupItemProducer <> nil then
        FContextPopupItemProducer.UnlockRead;
    end;
  finally
    FIsChangeNotificationCreationLocked := False;
    if FContextPopupItemProducer <> nil then
    begin
      FContextPopupItemProducer.OnDestroy := nil;
      FContextPopupItemProducer := nil;
    end;
  end;
end;

function TcxCustomInnerShellTreeView.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  New: Boolean;
begin
  DraggedObject := IcxDataObject(dataObj);
  GetDropTarget(new, pt);
  dwEffect := DragDropSettings.DefaultDropEffectAPI;
  if CurrentDropTarget = nil then
  begin
    dwEffect := DROPEFFECT_NONE;
    Result := S_OK;
  end
  else
    Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
end;

function TcxCustomInnerShellTreeView.DragLeave: HResult;
begin
  DraggedObject := nil;
  Result := TryReleaseDropTarget;
end;

function TcxCustomInnerShellTreeView.IDropTargetDragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
var
  New: Boolean;
begin
  GetDropTarget(new, pt);
  if CurrentDropTarget = nil then
  begin
    dwEffect := DROPEFFECT_NONE;
    Result := S_OK;
  end
  else
  begin
    if New then
       Result := CurrentDropTarget.DragEnter(DraggedObject, grfKeyState, pt, dwEffect)
    else
       Result := S_OK;
    if Succeeded(Result) then
       Result := CurrentDropTarget.DragOver(grfKeyState, pt, dwEffect);
  end;
end;

function TcxCustomInnerShellTreeView.Drop(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  New: Boolean;
begin
  GetDropTarget(new, pt);
  if CurrentDropTarget = nil then
  begin
    dwEffect := DROPEFFECT_NONE;
    Result := S_OK;
  end
  else
  begin
    if New then
       Result := CurrentDropTarget.DragEnter(dataObj, grfKeyState, pt, dwEffect)
    else
       Result := S_OK;
    if Succeeded(Result) then
       Result := CurrentDropTarget.Drop(dataObj, grfKeyState, pt, dwEffect);
  end;
  PostMessage(Handle, DSM_SHELLCHANGENOTIFY, WPARAM(PrevTargetNode.Data), 0);
  TryReleaseDropTarget;
end;

procedure TcxCustomInnerShellTreeView.DsmNotifyAddItem(var Message: TMessage);
var
  Node, NewNode: TTreeNode;
  ItemProducer: TcxShellTreeItemProducer;
  tempShellItem: TcxShellItemInfo;
begin
  Node := TTreeNode(Message.LParam);
  ItemProducer := TcxShellTreeItemProducer(Node.Data);
  ItemProducer.LockRead;
  try
    tempShellItem := ItemProducer.Items[Message.WParam];
    NewNode := Items.AddChild(Node, tempShellItem.Name);
    NewNode.Data := TcxShellTreeItemProducer.Create(Self);
    NewNode.ImageIndex := tempShellItem.IconIndex;
    NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
    NewNode.HasChildren := tempShellItem.HasSubfolder;
  finally
    ItemProducer.UnlockRead;
  end;
end;

procedure TcxCustomInnerShellTreeView.DsmNotifyRemoveItem(
  var Message: TMessage);
var
  Node: TTreeNode;
begin
  Node := TTreeNode(Message.LParam);
  if Message.WParam < Node.Count then
     Node.Item[Message.WParam].Delete;
end;

procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateContents(
  var Message: TMessage);
begin
  if not (csLoading in ComponentState) then
     UpdateNode(nil, False);
end;

procedure TcxCustomInnerShellTreeView.DsmNotifyUpdateItem(
  var Message: TMessage);

  function GetChildNode(ANode: TTreeNode; AIndex: Integer): TTreeNode;
  begin
    Result := ANode.getFirstChild;
    while (Result <> nil) and (AIndex > 0) do
    begin
      Result := ANode.GetNextChild(Result);
      Dec(AIndex);
    end;
  end;

var
  AItem: TcxShellItemInfo;
  AItemProducer: TcxShellTreeItemProducer;
  ANode, ATempNode: TTreeNode;
begin
  ANode := TTreeNode(Message.LParam);
  if ANode.getFirstChild = nil then
    Exit;
  ATempNode := GetChildNode(ANode, Message.WParam);
  if ATempNode = nil then
    Exit;

  AItemProducer := TcxShellTreeItemProducer(ANode.Data);
  AItemProducer.LockRead;
  try
    AItem := AItemProducer.Items[Message.WParam];
    ATempNode.ImageIndex := AItem.IconIndex;
    ATempNode.SelectedIndex := AItem.OpenIconIndex;
    ATempNode.Text := AItem.Name;
    ATempNode.HasChildren := AItem.HasSubfolder;
    ATempNode.Cut := AItem.IsGhosted;
    ATempNode.OverlayIndex := GetShellItemOverlayIndex(AItem);
  finally
    AItemProducer.UnlockRead;
  end;
end;

procedure TcxCustomInnerShellTreeView.DsmSetCount(var Message: TMessage);
var
  Node: TTreeNode;
  ItemProducer: TcxShellTreeItemProducer;
  i: Integer;
  NewNode: TTreeNode;
  tempShellItem: TcxShellItemInfo;
begin
  Node := TTreeNode(Message.LParam);
  if Message.WParam = 0 then
  begin
    Node.DeleteChildren;
    Node.HasChildren := False;
    Exit;
  end;
  ItemProducer := TcxShellTreeItemProducer(Node.Data);
  ItemProducer.LockRead;
  try
    Items.BeginUpdate;
    try
      for i := 0 to ItemProducer.Items.Count-1 do
      begin
        tempShellItem := ItemProducer.Items[i];
        if not tempShellItem.Updated then
           ItemProducer.FetchRequest(i, False);
        NewNode := Items.AddChild(Node, tempShellItem.Name);
        NewNode.Data := TcxShellTreeItemProducer.Create(Self);
        NewNode.ImageIndex := tempShellItem.IconIndex;
        NewNode.SelectedIndex := tempShellItem.OpenIconIndex;
        NewNode.HasChildren := tempShellItem.HasSubfolder;
        NewNode.Cut := tempShellItem.IsGhosted;
        NewNode.OverlayIndex := GetShellItemOverlayIndex(tempShellItem);
      end;
    finally
      Items.EndUpdate;
    end;
    if Node.GetFirstChild = nil then
       Node.HasChildren := False;
  finally
    ItemProducer.UnlockRead;
  end;
end;

procedure TcxCustomInnerShellTreeView.DsmShellChangeNotify(
  var Message: TMessage);
begin
  Sleep(100);
  if not TcxShellTreeItemProducer(Message.WParam).CheckUpdates then
    UpdateNode(PrevTargetNode, False);
end;

procedure TcxCustomInnerShellTreeView.Edit(const Item: TTVItem);
var
  AItemInfo: TcxShellItemInfo;
  AItemProducer: TcxShellTreeItemProducer;
  ANode: TTreeNode;
  APIDL: PItemIDList;
  APrevNodeText: string;
begin
  ANode := GetNodeFromItem(Item);
  APrevNodeText := '';
  if ANode <> nil then
    APrevNodeText := ANode.Text;
  inherited Edit(Item);
  if (Item.pszText = nil) or (ANode = nil) or (ANode.Parent = nil) then
    Exit;
  AItemProducer := TcxShellTreeItemProducer(ANode.Parent.Data);
  AItemInfo := AItemProducer.Items[ANode.Index];
  RemoveChangeNotification;
  if AItemProducer.ShellFolder.SetNameOf(Handle, AItemInfo.pidl, PWideChar(WideString(ANode.Text)),
    SHGDN_INFOLDER or SHGDN_FORPARSING, APIDL) = S_OK then
      try
        AItemInfo.SetNewPidl(AItemProducer.ShellFolder, AItemProducer.FolderPidl, APIDL);
      finally
        DisposePidl(APIDL);
      end
  else
    ANode.Text := APrevNodeText; 
end;

procedure TcxCustomInnerShellTreeView.GetDropTarget(out New: Boolean;pt:TPoint);
var
  Node: TTreeNode;
  cpt: TPoint;
  ItemProducer: TcxShellTreeItemProducer;
  tempDropTarget: IcxDropTarget;
  tempShellItem: TcxShellItemInfo;
  tempPidl: PItemIDList;
  Res: HRESULT;
  tempShellFolder: IShellFolder;
begin
  cpt := ScreenToClient(pt);
  Node := GetNodeAt(cpt.X, cpt.Y);
  if Node = nil then
  begin
    TryReleaseDropTarget;
    Exit;
  end;
  if (Node = PrevTargetNode) and (CurrentDropTarget <> nil) then
  begin
    New := False;
    Exit;
  end;
  TryReleaseDropTarget;
  New := True;
  if Node.Parent = nil then
  begin // Root object selected
    ItemProducer := TcxShellTreeItemProducer(Node.Data);
    if ItemProducer.ShellFolder = nil then
       Exit;
    Res:=ItemProducer.ShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget);
    if Failed(Res) then
       Exit;
  end
  else
  begin // Non-root object selected
    ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
    tempShellItem := ItemProducer.Items[Node.Index];
    tempPidl := GetPidlCopy(tempShellItem.pidl);
    try
      if tempShellItem.IsFolder then
      begin
        if Failed(ItemProducer.ShellFolder.BindToObject(tempPidl, nil, IID_IShellFolder, tempShellFolder)) then
           Exit;
        if Failed(tempShellFolder.CreateViewObject(Handle, IDropTarget, tempDropTarget)) then
           Exit;
      end
      else
      begin
        Res := ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDropTarget, nil, tempDropTarget);
        if Failed(Res) then
           Exit;
      end;
    finally
      DisposePidl(tempPidl);
    end;
  end;

  PrevTargetNode := Node;
  CurrentDropTarget := tempDropTarget;
end;

procedure TcxCustomInnerShellTreeView.ContextPopupItemProducerDestroyHandler(
  Sender: TObject);
begin
  FContextPopupItemProducer.UnlockRead;
  FContextPopupItemProducer.OnDestroy := nil;
  FContextPopupItemProducer := nil;
end;

function TcxCustomInnerShellTreeView.GetFolder(AIndex: Integer): TcxShellFolder;
var
  ANode: TTreeNode;
begin
  ANode := Items[AIndex];
  if ANode.Parent = nil then
    Result := Root.Folder
  else
    Result := TcxShellItemInfo(TcxShellTreeItemProducer(ANode.Parent.Data).Items[ANode.Index]).Folder;
end;

function TcxCustomInnerShellTreeView.GetFolderCount: Integer;
begin
  Result := Items.Count;
end;

function TcxCustomInnerShellTreeView.GetNodeFromItem(
  const Item: TTVItem): TTreeNode;
begin
  Result := nil;
  if Items <> nil then
    with Item do
      if (state and TVIF_PARAM) <> 0 then
        Result := Pointer(lParam)
      else
        Result := Items.GetNode(hItem);
end;

procedure TcxCustomInnerShellTreeView.RestoreTreeState;

  procedure RestoreExpandedNodes;

    procedure ExpandNode(APIDL: PItemIDList);
    var
      ANode: TTreeNode;
    begin
      if Root.ShellFolder = nil then
        Root.CheckRoot;
      if APIDL = nil then
        APIDL := Root.Pidl;
      ANode := GetNodeByPIDL(APIDL);
      if ANode <> nil then
        ANode.Expand(False);
    end;

    procedure DestroyExpandedNodeList;
    var
      I: Integer;
    begin
      if FStateData.ExpandedNodeList = nil then
        Exit;
      for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
        DisposePidl(PItemIDList(FStateData.ExpandedNodeList[I]));
      FreeAndNil(FStateData.ExpandedNodeList);
    end;

  var
    I: Integer;
  begin
    try
      for I := 0 to FStateData.ExpandedNodeList.Count - 1 do
        ExpandNode(PItemIDList(FStateData.ExpandedNodeList[I]));
    finally
      DestroyExpandedNodeList;
    end;
  end;

  procedure RestoreTopItemIndex;
  begin
    if (FStateData.TopItemIndex >= 0) and (FStateData.TopItemIndex < Items.Count) then
      TopItem :

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?