cxshellcontrols.pas

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

procedure TcxCustomInnerShellListView.DoProcessNavigation(
  Item: TcxShellItemInfo);
var
  APIDL: PItemIDList;
begin
  if not Item.IsFolder then
    Exit;
  APIDL := ConcatenatePidls(ItemProducer.FolderPidl, Item.pidl);
  try
    Navigate(APIDL);
  finally
    DisposePidl(APIDL);
  end;
end;

function TcxCustomInnerShellListView.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  new: Boolean;
begin
  DraggedObject := IcxDataObject(dataObj);
  GetDropTarget(pt, new);
  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 TcxCustomInnerShellListView.DragLeave: HResult;
begin
  DraggedObject := nil;
  Result := TryReleaseDropTarget;
end;

function TcxCustomInnerShellListView.IDropTargetDragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
var
  New: Boolean;
begin
  GetDropTarget(pt, new);
  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 TcxCustomInnerShellListView.Drop(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  New: Boolean;
begin
  GetDropTarget(pt, new);
  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;
  DraggedObject := nil;
  TryReleaseDropTarget;
end;

procedure TcxCustomInnerShellListView.DsmNotifyUpdateContents(
  var Message: TMessage);
begin
  if not (csLoading in ComponentState) then
     CheckUpdateItems;
end;

procedure TcxCustomInnerShellListView.DsmNotifyUpdateItem(
  var Message: TMessage);
begin
  UpdateItems(Message.WParam, Message.WParam);
end;

procedure TcxCustomInnerShellListView.DsmSetCount(var Message: TMessage);
begin
  Items.Count := Message.WParam;
  ItemFocused := nil;
  Selected := nil;
end;

procedure TcxCustomInnerShellListView.DsmShellChangeNotify(
  var Message: TMessage);
begin
  if FNotificationLock then
     Exit;
  FNotificationLock := True;
  try
    CheckUpdateItems;
  finally
    FNotificationLock := False;
  end;
  DoShellChange(Self, OnShellChange, Message);
end;

procedure TcxCustomInnerShellListView.Edit(const Item: TLVItem);
var
  tempItem: TcxShellItemInfo;
  NewName: WideString;
  pidlOut: PItemIDList;
begin
  inherited;
  if (ItemProducer.Items.Count - 1) < Item.iItem then
     Exit;
  tempItem := ItemProducer.Items[Item.iItem];
  NewName := StrPas(Item.pszText);
  ItemProducer.ShellFolder.SetNameOf(Handle, tempItem.pidl, PWideChar(NewName),
                SHGDN_INFOLDER or SHGDN_FORPARSING, pidlOut);
  try
    tempItem.SetNewPidl(ItemProducer.ShellFolder, ItemProducer.FolderPidl, pidlOut);
  finally
    DisposePidl(pidlOut);
  end;
end;

procedure TcxCustomInnerShellListView.KeyDown(var Key: Word;
  Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if not IsEditing then
    case Key of
      VK_RETURN:
        DblClick;
      VK_BACK:
        if Options.AutoNavigate then
          BrowseParent;
      VK_F5:
        UpdateContent;
    end;
end;

procedure TcxCustomInnerShellListView.DisplayContextMenu(const APos: TPoint);

  function GetItemPIDLList: TList;
  var
    AItem: TListItem;
    AItemPIDL: PItemIDList;
  begin
    Result := TList.Create;
    AItem := Selected;
    while AItem <> nil do
    begin
      AItemPIDL := TcxShellItemInfo(ItemProducer.Items[AItem.Index]).pidl;
      if AItemPIDL <> nil then
        Result.Add(GetPidlCopy(AItemPIDL));
      AItem := GetNextItem(AItem, sdAll, [isSelected]);
    end;
  end;

var
  AItemPIDLList: TList;
  I: Integer;
begin
  if SelCount = 0 then
    Exit;

  AItemPIDLList := GetItemPIDLList;
  try
    cxShellCommon.DisplayContextMenu(Handle, ItemProducer.ShellFolder,
      AItemPIDLList, APos);
  finally
    for I := 0 to AItemPIDLList.Count - 1 do
      DisposePidl(AItemPIDLList[I]);
    AItemPIDLList.Free;
  end;
end;

procedure TcxCustomInnerShellListView.Loaded;
begin
  inherited Loaded;
  if csDesigning in ComponentState then
    Root.RootUpdated;
end;

procedure TcxCustomInnerShellListView.GetDropTarget(pt: TPoint;
  out New: Boolean);

  function GetDropTargetItemIndex: Integer;
  var
    AItem: TListItem;
    P: TPoint;
  begin
    Result := -1;
    P := ScreenToClient(pt);
    AItem := GetItemAt(P.X, P.Y);
    if AItem <> nil then
      Result := AItem.Index;
  end;

var
  AItemIndex: Integer;
  tempDropTarget: IcxDropTarget;
  tempPidl: PItemIDList;
begin
  AItemIndex := GetDropTargetItemIndex;
  if AItemIndex = -1 then
  begin // There are no items selected, so drop target is current opened folder
    if (DropTargetItemIndex = -1) and (CurrentDropTarget <> nil) then
    begin
      New := False;
      Exit;
    end;
    TryReleaseDropTarget;
    New := True;
    if Failed(ItemProducer.ShellFolder.CreateViewObject(Handle,IDropTarget, tempDropTarget)) then
       Exit;
    CurrentDropTarget := tempDropTarget;
  end
  else
  begin // Use one of Items as Drop Target
    if AItemIndex = DropTargetItemIndex then
    begin
      New := False;
      Exit;
    end;
    TryReleaseDropTarget;
    New := True;
    tempPidl := GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[AItemIndex]).pidl);
    try
      if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, 1, tempPidl, IDropTarget, nil, tempDropTarget)) then
         Exit;
    finally
      DisposePidl(tempPidl);
    end;
    CurrentDropTarget := tempDropTarget;
    DropTargetItemIndex := AItemIndex;
  end;
end;

procedure TcxCustomInnerShellListView.Navigate(APIDL: PItemIDList);
begin
  if EqualPIDLs(APIDL, ItemProducer.FolderPidl) then
    Exit;
  Items.BeginUpdate;
  try
    DoBeforeNavigation(APIDL);
    Root.Pidl := APIDL;
    DoNavigateTreeView;
    DoAfterNavigation;
  finally
    Items.EndUpdate;
  end;
end;

function TcxCustomInnerShellListView.OwnerDataFetch(Item: TListItem;
  Request: TItemRequest): Boolean;
var
  ShellItem: TcxShellItemInfo;
  i: Integer;
begin
  Result := True;
  ItemProducer.LockRead;
  try
    if Item.Index >= ItemProducer.Items.Count then
       Exit;
    ShellItem := ItemProducer.Items[Item.Index];
    ShellItem.CheckUpdate(ItemProducer.ShellFolder, ItemProducer.FolderPidl, False);
    Item.Caption := ShellItem.Name;
    Item.ImageIndex := ShellItem.IconIndex;
    if ListViewStyle = lvsReport then
    begin
      if ShellItem.Details.Count = 0 then
         ShellItem.FetchDetails(Handle, ItemProducer.ShellFolder, ItemProducer.Details);
      for i := 0 to ShellItem.Details.Count - 1 do
          Item.SubItems.Add(ShellItem.Details[i]);
    end;
    Item.Cut := ShellItem.IsGhosted;
    if not ShellItem.Updated then
      ItemProducer.FetchRequest(Item.Index, True);
  finally
    ItemProducer.UnlockRead;
  end;
  Result := inherited OwnerDataFetch(Item, Request);
end;

procedure TcxCustomInnerShellListView.RemoveChangeNotification;
begin
  UnregisterShellChangeNotifier(FShellChangeNotifierData);
end;

procedure TcxCustomInnerShellListView.RemoveColumns;
begin
  Columns.Clear;
end;

procedure TcxCustomInnerShellListView.RemoveDropTarget;
begin
  RevokeDragDrop(Handle);
end;

procedure TcxCustomInnerShellListView.SetDropTargetItemIndex(Value: Integer);
begin
  if FDropTargetItemIndex <> -1 then
    Items[FDropTargetItemIndex].DropTarget := False;
  FDropTargetItemIndex := Value;
  if FDropTargetItemIndex <> -1 then
    Items[FDropTargetItemIndex].DropTarget := True;
end;

procedure TcxCustomInnerShellListView.DSMSynchronizeRoot(var Message: TMessage);
begin
  if not((Parent <> nil) and (csLoading in Parent.ComponentState)) then
    Root.Update(TcxCustomShellRoot(Message.WParam));
end;

function TcxCustomInnerShellListView.GetFolder(AIndex: Integer): TcxShellFolder;
begin
  Result := TcxShellItemInfo(ItemProducer.Items[AIndex]).Folder;
end;

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

procedure TcxCustomInnerShellListView.RootSettingsChanged(Sender: TObject);
begin
  if (Parent <> nil) and (csLoading in Parent.ComponentState) then
    Exit;
  if (FTreeViewControl <> nil) and FTreeViewControl.HandleAllocated then
    SendMessage(FTreeViewControl.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
  if (FComboBoxControl <> nil) and FComboBoxControl.HandleAllocated then
    SendMessage(FComboBoxControl.Handle, DSM_SYNCHRONIZEROOT, Integer(Root), 0);
end;

procedure TcxCustomInnerShellListView.SetListViewStyle(
  const Value: TcxListViewStyle);
begin
  if FListViewStyle <> Value then
  begin
    FListViewStyle := Value;
    case FListViewStyle of
      lvsIcon:          ViewStyle:=vsIcon;
      lvsSmallIcon:     ViewStyle:=vsSmallIcon;
      lvsList:          ViewStyle:=vsList;
      lvsReport:        ViewStyle:=vsReport;
    end;
    CheckUpdateItems;
  end;
end;

function TcxCustomInnerShellListView.TryReleaseDropTarget:HResult;
begin
  Result := S_OK;
  if CurrentDropTarget <> nil then
     Result := CurrentDropTarget.DragLeave;
  CurrentDropTarget := nil;
  DropTargetItemIndex := -1;
end;

procedure TcxCustomInnerShellListView.SetTreeView(ATreeView: TWinControl);
begin
  TreeViewControl := ATreeView;
end;

var
  NavigationLock: Boolean;

procedure TcxCustomInnerShellListView.DoNavigateTreeView;
var
  tempPidl: PItemIDList;
begin
  if NavigationLock or (not Assigned(TreeViewControl) and not Assigned(ComboBoxControl)) then
     Exit;

  tempPidl:=GetPidlCopy(Root.Pidl);
  try
    if Assigned(TreeViewControl) and (TreeViewControl.Parent <> nil) then
    begin
      TreeViewControl.HandleNeeded;
      SendMessage(TreeViewControl.Handle,DSM_DONAVIGATE,WPARAM(tempPidl),0);
    end;
    if Assigned(ComboBoxControl) and (ComboBoxControl.Parent <> nil) then
    begin
      ComboBoxControl.HandleNeeded;
      SendMessage(ComboBoxControl.Handle,DSM_DONAVIGATE,WPARAM(tempPidl),0);
    end;
  finally
    DisposePidl(tempPidl);
  end;
end;

procedure TcxCustomInnerShellListView.ProcessTreeViewNavigate(
  APIDL: PItemIDList);