cxshellcontrols.pas

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

  if Assigned(AEvent) then
    AEvent(Sender, Message.LParam, PPItemIDList(Message.WParam)^,
      PPItemIDList(Message.WParam + SizeOf(Pointer))^);
end;

function GetShellItemOverlayIndex(AItemData: TcxShellItemInfo): Integer;
const
  SHGFI_OVERLAYINDEX = $40;
var
  AFileInfo: TShFileInfo;
  AFlags: Cardinal;
begin
  if GetComCtlVersion >= ComCtlVersionIE5 then
  begin
    AFlags := SHGFI_PIDL or SHGFI_ICON or SHGFI_OVERLAYINDEX;
    ZeroMemory(@AFileInfo, SizeOf(AFileInfo));
    SHGetFileInfo(PChar(AItemData.FullPIDL), 0, AFileInfo, SizeOf(AFileInfo), AFlags);
    Result := AFileInfo.iIcon;
    Result := (Result shr ((SizeOf(Result) - 1) * 8)) and $FF - 1;
  end
  else
  begin
    if AItemData.IsLink then
      Result := cxShellShortcutItemOverlayIndex
    else
      if AItemData.IsShare then
        Result := cxShellSharedItemOverlayIndex
      else
        Result := cxShellNormalItemOverlayIndex;
  end;
end;

procedure RegisterShellChangeNotifier(ANotifierPIDL: PItemIDList; AWnd: HWND;
  ANotificationMsg: Cardinal; AWatchSubtree: Boolean;
  var ANotifierData: TcxShellChangeNotifierData);
var
  AItems: PSHChangeNotifyEntry;
begin
  if EqualPIDLs(ANotifierData.PIDL, ANotifierPIDL) then
    Exit;
  UnregisterShellChangeNotifier(ANotifierData);
  ANotifierData.PIDL := GetPidlCopy(ANotifierPIDL);
  New(AItems);
  try
    AItems.pidlPath := ANotifierPIDL;
    AItems.bWatchSubtree := AWatchSubtree;
    ANotifierData.Handle := SHChangeNotifyRegister(AWnd,
      SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
      SHCNE_RENAMEITEM or SHCNE_CREATE or SHCNE_DELETE or SHCNE_MKDIR or
      SHCNE_RMDIR or SHCNE_ATTRIBUTES or SHCNE_UPDATEDIR or SHCNE_UPDATEITEM or
      SHCNE_UPDATEIMAGE or SHCNE_RENAMEFOLDER, ANotificationMsg, 1, AItems);
  finally
    Dispose(AItems);
  end;
end;

procedure UnregisterShellChangeNotifier(
  var ANotifierData: TcxShellChangeNotifierData);
begin
  if ANotifierData.Handle <> 0 then
  begin
    SHChangeNotifyUnregister(ANotifierData.Handle);
    ANotifierData.Handle := 0;
    DisposePidl(ANotifierData.PIDL);
    ANotifierData.PIDL := nil;
  end;
end;

{ TcxShellListViewOptions }

constructor TcxShellListViewOptions.Create(AOwner: TWinControl);
begin
  inherited Create(AOwner);
  FAutoNavigate := True;
end;

procedure TcxShellListViewOptions.Assign(Source: TPersistent);
begin
  if Source is TcxShellListViewOptions then
    AutoNavigate := TcxShellListViewOptions(Source).AutoNavigate;
  inherited Assign(Source);
end;

{ TcxCustomInnerShellListView }

constructor TcxCustomInnerShellListView.Create(AOwner: TComponent);
var
  AFileInfo: TShFileInfo;
begin
  inherited Create(AOwner);
  FDragDropSettings := TcxDragDropSettings.Create;
  FDropTargetItemIndex := -1;
  FFirstUpdateItem := -1;
  FInternalLargeImages := SHGetFileInfo('C:\', 0, AFileInfo, SizeOf(AFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
  FInternalSmallImages := SHGetFileInfo('C:\', 0, AFileInfo, SizeOf(AFileInfo),
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  FItemProducer := TcxShellListViewProducer.Create(Self);
  FItemsInfoGatherer := TcxShellItemsInfoGatherer.Create(Self);
  FLastUpdateItem := -1;
  FOptions := TcxShellListViewOptions.Create(Self);
  FRoot := TcxShellListRoot.Create(Self, 0);
  FRoot.OnSettingsChanged := RootSettingsChanged;
  DoubleBuffered := True;
  DragMode := dmManual;
  HideSelection := False;
  OwnerData := True;
end;

destructor TcxCustomInnerShellListView.Destroy;
begin
  RemoveChangeNotification;
  FreeAndNil(FDragDropSettings);
  FreeAndNil(FItemProducer);
  FreeAndNil(FItemsInfoGatherer);
  FreeAndNil(FOptions);
  FreeAndNil(FRoot);
  inherited Destroy;
end;

procedure TcxCustomInnerShellListView.BrowseParent;
var
  APIDL: PItemIDList;
begin
  APIDL := GetPidlParent(ItemProducer.FolderPidl);
  try
    Navigate(APIDL);
  finally
    DisposePidl(APIDL);
  end;
end;

function TcxCustomInnerShellListView.CanEdit(Item: TListItem): Boolean;
begin
  Result := True;
  if Item = nil then
     Exit;
  if Item.Index > ItemProducer.Items.Count - 1 then
  begin
    Result := False;
    Exit;
  end;
  Result := TcxShellItemInfo(ItemProducer.Items[Item.Index]).CanRename;
end;

procedure TcxCustomInnerShellListView.CheckUpdateItems;
begin
  ItemProducer.ClearItems;
  if IsWindow(WindowHandle) then
  begin
    if not Root.IsValid then
      Items.Clear
    else
      if ItemProducer.Items.Count = 0 then
        ItemProducer.ProcessItems(Root.ShellFolder, Root.Pidl,
          PRELOAD_ITEMS_COUNT);
    CreateChangeNotification;
    Refresh;
  end;
end;

procedure TcxCustomInnerShellListView.CNNotify(var Message: TWMNotify);

  function GetOverlayIndex: Integer;
  var
    AItemData: TcxShellItemInfo;
  begin
    AItemData := ItemProducer.Items[PLVDispInfo(Message.NMHdr)^.item.iItem];
    AItemData.CheckUpdate(ItemProducer.ShellFolder, ItemProducer.FolderPidl, False);
    Result := GetShellItemOverlayIndex(AItemData);
  end;

begin
  if csDestroying in ComponentState then
    Exit;
  case Message.NMHdr^.code of
    LVN_BEGINDRAG, LVN_BEGINRDRAG:
      begin
        if not DragDropSettings.AllowDragObjects then
        begin
          inherited;
          Exit;
        end;
        if SelCount <= 0 then
          Exit;
        DoBeginDrag;
      end;
    LVN_GETINFOTIP:
      ItemProducer.DoGetInfoTip(Handle, PNMLVGetInfoTip(Message.NMHdr)^.iItem,
        PNMLVGetInfoTip(Message.NMHdr)^.pszText,
        PNMLVGetInfoTip(Message.NMHdr)^.cchTextMax);
    LVN_GETDISPINFO:
      begin
        inherited;
        with PLVDispInfo(Message.NMHdr)^.item do
          if (mask and LVIF_IMAGE <> 0) and (iSubItem = 0) then
            if (iItem >= 0) and (iItem < ItemProducer.Items.Count) then
            begin
              state := IndexToOverlayMask(GetOverlayIndex + 1);
              stateMask := ILD_OVERLAYMASK;
              mask := mask or LVIF_STATE;
            end;
      end;
    else
      inherited;
  end;
end;

procedure TcxCustomInnerShellListView.CreateChangeNotification;
begin
  if not Options.TrackShellChanges then
    RemoveChangeNotification
  else
    RegisterShellChangeNotifier(ItemProducer.FolderPidl, Handle,
      DSM_SHELLCHANGENOTIFY, False, FShellChangeNotifierData);
end;

procedure TcxCustomInnerShellListView.CreateColumns;
var
  i: Integer;
  Column: TListColumn;
begin
  if ListViewStyle <> lvsReport then
     Exit;
  Columns.BeginUpdate;
  try
    Columns.Clear;
    for i := 0 to ItemProducer.Details.Count - 1 do
    begin
      Column := Columns.Add;
      Column.Caption := ItemProducer.Details[i].Text;
      Column.Alignment := ItemProducer.Details[i].Alignment;
      Column.Width := ItemProducer.Details[i].Width;
    end;
  finally
    Columns.EndUpdate;
  end;
end;

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

procedure TcxCustomInnerShellListView.CreateWnd;
begin
  inherited CreateWnd;
  if HandleAllocated then
  begin
    if FInternalSmallImages <> 0 then
      SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_SMALL, LParam(FInternalSmallImages));
    if FInternalLargeImages <> 0 then
      SendMessage(Handle, LVM_SETIMAGELIST, LVSIL_NORMAL, LParam(FInternalLargeImages));
    CreateDropTarget;
    if Root.Pidl = nil then
      Root.CheckRoot
    else
      CheckUpdateItems;
  end;
end;

procedure TcxCustomInnerShellListView.DblClick;
var
  AItem: TcxShellItemInfo;
begin
  if not Options.AutoNavigate or (Selected = nil) then
     Exit;
  ItemProducer.LockRead;
  try
    AItem := ItemProducer.Items[Selected.Index];
    if AItem.IsFolder then
      DoProcessNavigation(AItem)
    else
      DoProcessDefaultCommand(AItem);
  finally
    ItemProducer.UnlockRead;
  end;
end;

procedure TcxCustomInnerShellListView.DestroyWnd;
begin
  RemoveChangeNotification;
  RemoveColumns;
  RemoveDropTarget;
  inherited DestroyWnd;
end;

function TcxCustomInnerShellListView.DoAddFolder(AFolder: TcxShellFolder): Boolean;
begin
  Result := True;
  if Assigned(FOnAddFolder) then
    FOnAddFolder(Self, AFolder, Result);
end;

procedure TcxCustomInnerShellListView.DoAfterNavigation;
begin
  if Assigned(AfterNavigation) then
     AfterNavigation(Self, Root.Pidl, Root.CurrentPath);
end;

function TcxCustomInnerShellListView.DoCompare(AItem1, AItem2: TcxShellFolder;
  out ACompare: Integer): Boolean;
begin
  Result := Assigned(FOnCompare);
  if Result then
    FOnCompare(Self, AItem1, AItem2, ACompare);
end;

procedure TcxCustomInnerShellListView.DoBeforeNavigation(fqPidl: PItemIDList);
var
  Desktop: IShellFolder;
  tempPath: WideString;
  StrName: TStrRet;
begin
  if Failed(SHGetDesktopFolder(Desktop)) then
     Exit;
  if Succeeded(Desktop.GetDisplayNameOf(fqPidl, SHGDN_NORMAL or SHGDN_FORPARSING, StrName)) then
     tempPath := GetTextFromStrRet(StrName, fqPidl)
  else
     tempPath := '';
  if Assigned(BeforeNavigation) then
     BeforeNavigation(Self, fqPidl, tempPath);
end;

procedure TcxCustomInnerShellListView.DoBeginDrag;
var
  i: Integer;
  tempList: TList;
  pidlList: PItemIDList;
  pDataObject: IDataObject;
  pDropSource: IcxDropSource;
  dwEffect: Integer;
  Item: TListItem;
begin
  tempList := TList.Create;
  try
    Item := Selected;
    while Item <> nil do
    begin
      tempList.Add(GetPidlCopy(TcxShellItemInfo(ItemProducer.Items[Item.Index]).pidl));
      Item := GetNextItem(Item,sdAll,[isSelected]);
    end;
    pidlList := CreatePidlListFromList(tempList);
    try
      if Failed(ItemProducer.ShellFolder.GetUIObjectOf(Handle, SelCount, PItemIDList(pidlList^), IDataObject, nil, Pointer(pDataObject))) then
         Exit;
      pDropSource := TcxDropSource.Create(Self);
      dwEffect := DragDropSettings.DropEffectAPI;
      DoDragDrop(pDataObject, pDropSource, dwEffect, dwEffect);
    finally
      DisposePidl(pidlList);
    end;
  finally
    try
      for i := 0 to tempList.Count - 1 do
          DisposePidl(tempList[i]);
    finally
      FreeAndNil(tempList);
    end;
  end;
end;

procedure TcxCustomInnerShellListView.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
begin
  if Options.ContextMenus and (SelCount > 0) then
  begin
    Handled := True;
    ItemProducer.LockRead;
    try
      DisplayContextMenu(ClientToScreen(MousePos));
    finally
      ItemProducer.UnlockRead;
    end;
  end
  else
    inherited DoContextPopup(MousePos, Handled);
end;

procedure TcxCustomInnerShellListView.DoProcessDefaultCommand(
  Item: TcxShellItemInfo);
var
  fqPidl: PItemIDList;
  lpExecInfo: PShellExecuteInfo;
begin
  fqPidl := ConcatenatePidls(ItemProducer.FolderPidl,Item.pidl);
  try
    New(lpExecInfo);
    try
      ZeroMemory(lpExecInfo, SizeOf(TShellExecuteInfo));
      lpExecInfo.cbSize := SizeOf(TShellExecuteInfo);
      lpExecInfo.fMask := SEE_MASK_INVOKEIDLIST;
      lpExecInfo.Wnd := Handle;
      lpExecInfo.lpIDList := fqPidl;
      lpExecInfo.nShow := SW_SHOW;
      ShellExecuteEx(lpExecInfo);
    finally
      Dispose(lpExecInfo);
    end;
  finally
    DisposePidl(fqPidl);
  end;
end;