cxshellcontrols.pas

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

  function IsFolder(APIDL: PItemIDList): Boolean;
  const
    SHGFI_ATTR_SPECIFIED = $20000;
  var
    ASHFileInfo: TSHFileInfo;
  begin
    ASHFileInfo.dwAttributes := SFGAO_FOLDER;
    SHGetFileInfo(Pointer(APIDL), 0, ASHFileInfo, SizeOf(ASHFileInfo),
      SHGFI_PIDL or SHGFI_ATTR_SPECIFIED or SHGFI_ATTRIBUTES);
    Result := ASHFileInfo.dwAttributes and SFGAO_FOLDER <> 0;
  end;

begin
  NavigationLock := True;
  try
    if IsFolder(APIDL) and not EqualPIDLs(APIDL, Root.Pidl) then
      Root.Pidl := APIDL;
  finally
    NavigationLock := False;
  end;
end;

procedure TcxCustomInnerShellListView.Sort;
begin
  ItemProducer.Sort;
end;

procedure TcxCustomInnerShellListView.UpdateContent;
var
  AItemIndex: Integer;
  ASelectedItemPID: PItemIDList;
begin
  ASelectedItemPID := nil;
  try
    if not MultiSelect and (Selected <> nil) then
      ASelectedItemPID := GetPidlCopy(
        TcxShellItemInfo(ItemProducer.Items[Selected.Index]).pidl);
    CheckUpdateItems;
    if ASelectedItemPID <> nil then
    begin
      AItemIndex := ItemProducer.GetItemIndexByPidl(ASelectedItemPID);
      if (AItemIndex >= 0) and (AItemIndex < Items.Count) then
        Items[AItemIndex].Selected := True;
    end;
  finally
    DisposePidl(ASelectedItemPID);
  end;
end;

{ TcxShellListRoot }

procedure TcxShellListRoot.RootUpdated;
begin
  inherited RootUpdated;
  (Owner as TcxCustomInnerShellListView).CheckUpdateItems;
  if Assigned(TcxCustomInnerShellListView(Owner).OnRootChanged) then
     TcxCustomInnerShellListView(Owner).OnRootChanged(Owner, Self);
end;

{ TcxShellListViewProducer }

function TcxShellListViewProducer.AllowBackgroundProcessing: Boolean;
begin
  Result := True;
end;

function TcxShellListViewProducer.CanAddFolder(AFolder: TcxShellFolder): Boolean;
begin
  Result := ListView.DoAddFolder(AFolder);
end;

function TcxShellListViewProducer.DoCompareItems(AItem1, AItem2: TcxShellFolder;
  out ACompare: Integer): Boolean;
begin
  Result := ListView.DoCompare(AItem1, AItem2, ACompare);
end;

function TcxShellListViewProducer.GetEnumFlags: Cardinal;
begin
  Result := ListView.Options.GetEnumFlags;
end;

function TcxShellListViewProducer.GetItemsInfoGatherer: TcxShellItemsInfoGatherer;
begin
  Result := ListView.ItemsInfoGatherer;
end;

function TcxShellListViewProducer.GetShowToolTip: Boolean;
begin
  Result := ListView.Options.ShowToolTip;
end;

function TcxShellListViewProducer.GetListView: TcxCustomInnerShellListView;
begin
  Result := TcxCustomInnerShellListView(Owner);
end;

procedure TcxShellListViewProducer.NotifyUpdateItem(AItem: PcxRequestItem);
begin
  if AItem.Priority and Owner.HandleAllocated and (AItem.ItemIndex >= 0) and
    (AItem.ItemIndex < Items.Count) then
      PostMessage(Owner.Handle, DSM_NOTIFYUPDATE, AItem.ItemIndex, 0);
end;

procedure TcxShellListViewProducer.ProcessDetails(ShellFolder: IShellFolder;
  CharWidth: Integer);
begin
  inherited ProcessDetails(ShellFolder, ListView.StringWidth('X'));
  ListView.CreateColumns;
end;

{ TcxShellTreeRoot }

procedure TcxShellTreeRoot.RootUpdated;
begin
  inherited RootUpdated;
//  TcxCustomInnerShellTreeView(Owner).ItemsInfoGatherer.ClearFetchQueue(nil);
  TcxCustomInnerShellTreeView(Owner).Items.Clear;
  TcxCustomInnerShellTreeView(Owner).UpdateNode(nil, False);
  if Assigned(TcxCustomInnerShellTreeView(Owner).OnRootChanged) then
     TcxCustomInnerShellTreeView(Owner).OnRootChanged(Owner, Self);
end;

{ TcxCustomInnerShellTreeView }

procedure TcxCustomInnerShellTreeView.AddItemProducer(
  Producer: TcxShellTreeItemProducer);
var
  tempList: TList;
begin
  tempList := ItemProducersList.LockList;
  try
    tempList.Add(Producer);
  finally
    ItemProducersList.UnlockList;
  end;
end;

function TcxCustomInnerShellTreeView.CanEdit(Node: TTreeNode): Boolean;
var
  ItemProducer:TcxShellTreeItemProducer;
begin
  Result := False;
  if Node.Parent = nil then
     Exit;
  ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
  ItemProducer.LockRead;
  try
    if (ItemProducer.Items.Count - 1) < Node.Index then
       Exit;
    Result := TcxShellItemInfo(ItemProducer.Items[Node.Index]).CanRename;
    Result := Result and inherited CanEdit(Node);
  finally
    ItemProducer.UnlockRead;
  end;
end;

function TcxCustomInnerShellTreeView.CanExpand(Node: TTreeNode): Boolean;
var
  ItemProducer: TcxShellTreeItemProducer;
  processingPidl: PItemIDList;
  processingFolder: IShellFolder;
 begin
  Result := True;
  if Node.GetFirstChild = nil then
  begin
    if Node.Parent <> nil then
    begin
      ItemProducer := TcxShellTreeItemProducer(Node.Parent.Data);
      Result := TcxShellItemInfo(ItemProducer.Items[Node.Index]).IsFolder;
      Node.HasChildren := Result;
      if not Result then
         Exit;
      if (ItemProducer.Items.Count-1) < Node.Index then
      begin
        Result := False;
        Exit;
      end;
      if Failed(ItemProducer.ShellFolder.BindToObject(TcxShellItemInfo(ItemProducer.
            Items[Node.Index]).pidl, nil, IID_IShellFolder, processingFolder)) then
      begin
        Result := False;
        Exit;
      end;
      processingPidl := ConcatenatePidls(ItemProducer.FolderPidl,
                           TcxShellItemInfo(ItemProducer.Items[Node.Index]).pidl);
    end
    else
    begin
      processingFolder := Root.ShellFolder;
      processingPidl := GetPidlCopy(Root.Pidl);
    end;
    try
      ItemProducer := TcxShellTreeItemProducer(Node.Data);
      ItemProducer.ProcessItems(processingFolder, processingPidl, Node, 0);
    finally
      DisposePidl(processingPidl);
    end;
  end;
  Result := Result and inherited CanExpand(Node);
end;

procedure TcxCustomInnerShellTreeView.CNNotify(var Message: TWMNotify);
var
  tempNode: TTreeNode;
  ItemProducer: TcxShellTreeItemProducer;
begin
  if (Message.NMHdr^.code = TVN_BEGINDRAG) or
     (Message.NMHdr^.code = TVN_BEGINRDRAG) then
  begin
    with PNMTreeView(Message.NMHdr)^ do
      Selected := GetNodeFromItem(ItemNew);
    DoBeginDrag;
  end
  else
  if Message.NMHdr^.code = TVN_GETINFOTIP then
  begin
     tempNode := Items.GetNode(PNMTVGetInfoTip(Message.NMHdr)^.hItem);
     if (tempNode <> nil) and (tempNode.Parent <> nil) then
     begin
       ItemProducer := TcxShellTreeItemProducer(tempNode.Parent.Data);
       ItemProducer.DoGetInfoTip(Handle,tempNode.Index,
              PNMTVGetInfoTip(Message.NMHdr)^.pszText,
              PNMTVGetInfoTip(Message.NMHdr)^.cchTextMax);
     end;
  end
  else
    inherited;
end;

constructor TcxCustomInnerShellTreeView.Create(AOwner: TComponent);
var
  FileInfo: TShFileInfo;
begin
  inherited;
  FItemsInfoGatherer := TcxShellItemsInfoGatherer.Create(Self);
  FRoot:=TcxShellTreeRoot.Create(Self, 0);
  FRoot.OnSettingsChanged := RootSettingsChanged;
  FDragDropSettings := TcxDragDropSettings.Create;
  FDragDropSettings.OnChange := DragDropSettingsChanged;
  FOptions := TcxShellTreeViewOptions.Create(Self);
  TcxShellOptionsAccess(FOptions).OnShowToolTipChanged := ShowToolTipChanged;
  FItemProducersList := TThreadList.Create;
  FInternalSmallImages := SHGetFileInfo('C:\', 0, FileInfo, SizeOf(FileInfo),
                                        SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  CurrentDropTarget := nil;
  PrevTargetNode := nil;
  DraggedObject := nil;
  DoubleBuffered := True;
  DragMode := dmAutomatic;
  RightClickSelect := True;
end;

procedure TcxCustomInnerShellTreeView.CreateDropTarget;
var
  AIDropTarget: IcxDropTarget;
begin
  GetInterface(IcxDropTarget, AIDropTarget);
  RegisterDragDrop(Handle,IDropTarget(AIDropTarget));
end;

procedure TcxCustomInnerShellTreeView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if ShowInfoTips then
    Params.Style := (Params.Style or TVS_INFOTIP) and not TVS_NOTOOLTIPS;
end;

function TcxCustomInnerShellTreeView.IsLoading: Boolean;
begin
  Result := csLoading in ComponentState;
end;

procedure TcxCustomInnerShellTreeView.AdjustControlParams;
var
  AStyle: Longint;
begin
  if HandleAllocated then
  begin
    AStyle := GetWindowLong(Handle, GWL_STYLE) and not(TVS_INFOTIP) or TVS_NOTOOLTIPS;
    if ShowInfoTips or Options.ShowToolTip then
      AStyle := AStyle and not TVS_NOTOOLTIPS;
    if ShowInfoTips then
      AStyle := AStyle or TVS_INFOTIP;
    SetWindowLong(Handle, GWL_STYLE, AStyle);
  end;
end;

procedure TcxCustomInnerShellTreeView.CreateWnd;
begin
  inherited;
  if HandleAllocated then
  begin
    if FInternalSmallImages <> 0 then
       SendMessage(Handle, TVM_SETIMAGELIST, TVSIL_NORMAL, LParam(FInternalSmallImages));
    if not IsLoading and (Root.Pidl = nil) then
       Root.CheckRoot;
    UpdateNode(nil, False);
    CreateDropTarget;
  end;
end;

procedure TcxCustomInnerShellTreeView.Delete(Node: TTreeNode);
var
  ItemProducer: TcxShellTreeItemProducer;
begin
  ItemProducer := TcxShellTreeItemProducer(Node.Data);
  if ItemProducer <> nil then
  begin
    ItemProducer.Free;
    Node.Data := nil;
  end;
  inherited;
end;

destructor TcxCustomInnerShellTreeView.Destroy;
var
  AList: TList;
  I: Integer;
begin
  if FListView <> nil then
    FListView.SetTreeView(nil);

  RemoveChangeNotification;

  AList := FItemProducersList.LockList;
  try
    for I := 0 to AList.Count - 1 do
      TcxShellTreeItemProducer(AList[I]).ClearFetchQueue;
  finally
    FItemProducersList.UnlockList;
  end;

  Items.Clear;
  FreeAndNil(FItemProducersList);
  FreeAndNil(FOptions);
  FreeAndNil(FDragDropSettings);
  FreeAndNil(FRoot);
  FreeAndNil(FItemsInfoGatherer);
  inherited Destroy;
end;

procedure TcxCustomInnerShellTreeView.UpdateContent;
begin
  if HandleAllocated then
  begin
    if Root.ShellFolder = nil then
      Root.CheckRoot;
    SendMessage(Handle, DSM_SHELLTREECHANGENOTIFY, WPARAM(Root.Pidl), 0);
  end;
end;

procedure TcxCustomInnerShellTreeView.DestroyWnd;
begin
  RemoveChangeNotification;
  RemoveDropTarget;
  CreateWndRestores := False;
  inherited;
end;

procedure TcxCustomInnerShellTreeView.DoBeginDrag;
var
  ItemProducer: TcxShellTreeItemProducer;
  tempPidl: PItemIDList;
  pDataObject: IDataObject;
  pDropSource: IcxDropSource;
  dwEffect: Integer;
begin
  if Selected.Parent = nil then
     Exit;
  ItemProducer := TcxShellTreeItemProducer(Selected.Parent.Data);
  ItemProducer.LockRead;
  try
    if (ItemProducer.Items.Count-1) < Selected.Index then
       Exit;
    tempPidl:=GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[Selected.Index]).pidl);
    try
      if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDataObject, nil, pDataObject)) then
         Exit;
      pDropSource := TcxDropSource.Create(Self);
      dwEffect := DragDropSettings.DropEffectAPI;
      DoDragDrop(pDataObject, pDropSource, dwEffect, dwEffect);
      if not TcxShellTreeItemProducer(Selected.Parent.Data).CheckUpdates then
         UpdateNode(Selected.Parent, False);
    finally
      DisposePidl(tempPidl);
    end;
  finally
    ItemProducer.UnlockRead;
  end;
end;

procedure TcxCustomInnerShellTreeView.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  AItem: TcxShellItemInfo;
  AItemPIDLList: TList;
  ANode: TTreeNode;
begin
  try
    ANode := GetNodeAt(MousePos.X, MousePos.Y);
    if not Options.ContextMenus or (ANode = nil) then
    begin
      inherited DoContextPopup(MousePos, Handled);
      Exit;
    end;