cxshellcommon.pas

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

begin
  Items.Sort(@ShellSortFunction);
end;

procedure TcxCustomItemProducer.FetchItems(cPreloadItems:Integer);
const
  R: array[Boolean] of Byte = (0, 1);
var
  pEnum:IEnumIDList;
  currentCelt:Cardinal;
  rPidl:PItemIDList;
  Item:TcxShellItemInfo;
  Res:HRESULT;
  SaveCursor:TCursor;
  PreloadInfo:Integer;

begin
  if Succeeded(ShellFolder.EnumObjects(Owner.ParentWindow, GetEnumFlags, pEnum)) and
    Assigned(pEnum) then
  begin
    currentCelt:=1;
    PreloadInfo:=cPreloadItems;
    LockWrite;
    SaveCursor:=Screen.Cursor;
    try
      try
        Screen.Cursor:=crHourGlass;
        repeat
          Res:=pEnum.Next(currentCelt,rPidl,currentCelt);
          if Res=E_INVALIDARG then
          begin
            currentCelt:=1;
            Res:=pEnum.Next(currentCelt,rPidl,currentCelt);
          end;
          if Failed(Res) or (Res=S_FALSE) then
             Break;
          if (currentCelt=0) or (rPidl=nil) then
             Break;
          try
            Item:=TcxShellItemInfo.Create(Self, ShellFolder, FFolderPidl, rPidl, False);
            if (Item.Name = '') or not CanAddFolder(Item.Folder) then
            begin
              Item.Free;
              Continue;
            end;
            if PreloadInfo>0 then
            begin
              Item.CheckUpdate(ShellFolder,FolderPidl,False);
              Dec(PreloadInfo);
            end
            else
              InitializeItem(Item);
            Items.Add(Item);
          finally
            DisposePidl(rPidl);
          end;
        until(Res=S_FALSE);
        Sort;
      finally
        UnlockWrite;
      end;
    finally
      Screen.Cursor:=SaveCursor;
    end;
  end;
  SetItemsCount(Items.Count);
end;

procedure TcxCustomItemProducer.ProcessDetails(ShellFolder: IShellFolder;
  CharWidth: Integer);
var
  DesktopFolder:IShellFolder;
  Attr:Cardinal;
  tempPidl:PitemIDList;
begin
  if Failed(SHGetDesktopFolder(DesktopFolder)) then
     Exit;
  Attr:=0;
  tempPidl:=GetPidlCopy(FolderPidl);
  try
    if Failed(DesktopFolder.GetAttributesOf(1,tempPidl,Attr)) then
       Attr:=0;
    Details.ProcessDetails(CharWidth,ShellFolder,(Attr and SFGAO_FILESYSTEM)=SFGAO_FILESYSTEM);
  finally
    DisposePidl(tempPidl);
  end;
end;

procedure TcxCustomItemProducer.DoGetInfoTip(Handle:HWND;ItemIndex: Integer;
  InfoTip: PChar; cch: Integer);
var
  tempShellItem:TcxShellItemInfo;
  tempPidl:PItemIDList;
  queryInfo:IQueryInfo;
  infoStr:PWideChar;
begin
  if GetShowToolTip then
  begin
    if ItemIndex>Items.Count-1 then
       Exit;
    tempShellItem:=Items[ItemIndex];
    tempPidl:=GetPidlCopy(tempShellItem.pidl);
    try
      if Failed(ShellFolder.GetUIObjectOf(Handle,1,tempPidl,IQueryInfo,nil,queryInfo)) then
         Exit;
      if Succeeded(queryInfo.GetInfoTip(0,infoStr)) and (infoStr <> nil) then
      begin
        StrPLCopy(InfoTip,StrPasW(infoStr),cch);
        cxMalloc.Free(infoStr);
      end;
    finally
      DisposePidl(tempPidl);
    end;
  end
  else
    StrPLCopy(InfoTip,'',cch);
end;

function TcxCustomItemProducer.GetItemByPidl(
  apidl: PItemIDList): TcxShellItemInfo;
var
  i:Integer;
  tempItem:TcxShellItemInfo;
begin
  Result:=nil;
  LockRead;
  try
    for i:=0 to Items.Count-1 do
    begin
      tempItem:=Items[i];
      if SmallInt(ShellFolder.CompareIDs(0,tempItem.pidl,apidl))=0 then
      begin
        Result:=tempItem;
        Break;
      end;
    end;
  finally
    UnlockRead;
  end;
end;

function TcxCustomItemProducer.GetItemIndexByPidl(
  apidl: PItemIDList): Integer;
var
  i:Integer;
  tempItem:TcxShellItemInfo;
begin
  Result:=-1;
  LockRead;
  try
    for i:=0 to Items.Count-1 do
    begin
      tempItem:=Items[i];
      if SmallInt(ShellFolder.CompareIDs(0,tempItem.pidl,apidl))=0 then
      begin
        Result:=i;
        Break;
      end;
    end;
  finally
    UnlockRead;
  end;
end;

procedure TcxCustomItemProducer.Sort;
begin
  LockWrite;
  try
    DoSort;
  finally
    UnlockWrite;
  end;
end;

procedure TcxCustomItemProducer.FetchRequest(AIndex: Integer;
  APriority: Boolean = False);
begin
  ItemsInfoGatherer.RequestItemInfo(Self, AIndex, APriority);
end;

procedure TcxCustomItemProducer.ClearFetchQueue;
begin
  ItemsInfoGatherer.ClearFetchQueue(Self);
end;

procedure TcxCustomItemProducer.CheckForSubitems(AItem: TcxShellItemInfo);
begin
end;

{ TcxShellItemsInfoGatherer }

constructor TcxShellItemsInfoGatherer.Create(AOwner: TWinControl);
begin
  inherited Create;
  FOwner := AOwner;
  FFetchQueue := TList.Create;
  CreateFetchThread;
  RegisterShellItemsInfoGatherer(Self);
end;

destructor TcxShellItemsInfoGatherer.Destroy;
begin
  UnregisterShellItemsInfoGatherer(Self);
  DestroyFetchThread;
  FreeAndNil(FFetchQueue);
  inherited Destroy;
end;

procedure TcxShellItemsInfoGatherer.ClearFetchQueue(
  AItemProducer: TcxCustomItemProducer);

  procedure InternalClearFetchQueue;
  var
    AItem: PcxRequestItem;
    I: Integer;
  begin
    I := 0;
    while I < FetchQueue.Count do
    begin
      AItem := FetchQueue[I];
      if (AItemProducer = nil) or (AItem.ItemProducer = AItemProducer) then
      begin
        FetchQueue.Remove(AItem);
        Dispose(AItem);
      end
      else
        Inc(I);
    end;
  end;

begin
  if FIsFetchQueueClearing then
    Exit;
  FIsFetchQueueClearing := True;
  StopFetch;
  try
    InternalClearFetchQueue;
  finally
    FIsFetchQueueClearing := False;
    ResumeFetch;
  end;
end;

procedure TcxShellItemsInfoGatherer.RequestItemInfo(
  AItemProducer: TcxCustomItemProducer; AIndex: Integer; APriority: Boolean);
var
  AItemIndex: Integer;
begin
  StopFetch;
  try
    AItemIndex := GetFetchQueueItemIndex(FetchQueue, AItemProducer, AIndex);
    if AItemIndex = -1 then
    begin
      if APriority then
        FetchQueue.Insert(0, CreateRequestItem(AItemProducer, AIndex, True))
      else
        FetchQueue.Add(CreateRequestItem(AItemProducer, AIndex, False));
    end
    else
      if APriority then
        FetchQueue.Move(AItemIndex, 0);
  finally
    ResumeFetch;
  end;
end;

procedure TcxShellItemsInfoGatherer.ResumeFetch;
begin
  if FStopFetchCount > 0 then
  begin
    Dec(FStopFetchCount);
    if FStopFetchCount = 0 then
      ResetEvent(FStopFetchEvent);
  end;
end;

procedure TcxShellItemsInfoGatherer.StopFetch;
begin
  Inc(FStopFetchCount);
  if FStopFetchCount = 1 then
  begin
    SetEvent(FStopFetchEvent);
    WaitForSingleObject(FFetchStoppedEvent, INFINITE);
  end;
end;

procedure TcxShellItemsInfoGatherer.DestroyFetchThread;
begin
  TerminateFetchThread;
  InternalCloseHandle(FFetchThread);
  InternalCloseHandle(FFetchStoppedEvent);
  InternalCloseHandle(FStopFetchEvent);
  InternalCloseHandle(FTerminateFetchThreadEvent);
end;

procedure TcxShellItemsInfoGatherer.CreateFetchThread;
var
  AFetchThreadID: DWORD;
begin
  FFetchStoppedEvent := CreateEvent(nil, True, False, nil);
  FStopFetchEvent := CreateEvent(nil, True, False, nil);
  FTerminateFetchThreadEvent := CreateEvent(nil, True, False, nil);
  FFetchThread := CreateThread(nil, 0,
    @cxShellItemsInfoGathererFetchThreadFunction, Self, 0, AFetchThreadID);
end;

function TcxShellItemsInfoGatherer.CreateRequestItem(
  AItemProducer: TcxCustomItemProducer; AIndex: Integer;
  APriority: Boolean): PcxRequestItem;
begin
  New(Result);
  Result.ItemIndex := AIndex;
  Result.ItemProducer := AItemProducer;
  Result.Priority := APriority;
end;

function TcxShellItemsInfoGatherer.GetFetchQueueItemIndex(
  AFetchQueue: TList; AItemProducer: TcxCustomItemProducer;
  AIndex: Integer): Integer;
var
  APItem: PcxRequestItem;
  I: Integer;
begin
  Result := -1;
  for I := 0 to AFetchQueue.Count - 1 do
  begin
    APItem := AFetchQueue[I];
    if (APItem.ItemIndex = AIndex) and (APItem.ItemProducer = AItemProducer) then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TcxShellItemsInfoGatherer.GetIsFetchStopping: Boolean;
begin
  Result := WaitForSingleObject(FStopFetchEvent, 0) = WAIT_OBJECT_0;
end;

function TcxShellItemsInfoGatherer.GetIsFetchThreadTerminating: Boolean;
begin
  Result := WaitForSingleObject(FTerminateFetchThreadEvent, 0) = WAIT_OBJECT_0;
end;

procedure TcxShellItemsInfoGatherer.FetchResumed;
begin
  ResetEvent(FFetchStoppedEvent);
end;

procedure TcxShellItemsInfoGatherer.FetchStopped;
begin
  SetEvent(FFetchStoppedEvent);
end;

procedure TcxShellItemsInfoGatherer.InternalCloseHandle(var AHandle: THandle);
begin
  CloseHandle(AHandle);
  AHandle := 0;
end;

procedure TcxShellItemsInfoGatherer.TerminateFetchThread;
begin
  SetEvent(FTerminateFetchThreadEvent);
  WaitForSingleObject(FFetchThread, INFINITE);
end;

{ TcxShellFolder }

constructor TcxShellFolder.Create(AAbsolutePIDL: PItemIDList);
var
  AParentPIDL: PItemIDList;
begin
  inherited Create;
  FAbsolutePIDL := AAbsolutePIDL;
  if GetPIDLItemsCount(FAbsolutePIDL) <= 1 then
  begin
    FParentShellFolder := GetDesktopIShellFolder;
    FRelativePIDL := GetPIDLCopy(FAbsolutePIDL);
  end
  else
  begin
    AParentPIDL := GetPIDLParent(FAbsolutePIDL);
    try
      GetDesktopIShellFolder.BindToObject(AParentPIDL, nil, IID_IShellFolder,
        FParentShellFolder);
    finally
      DisposePidl(AParentPIDL);
    end;
    FRelativePIDL := GetPIDLCopy(GetLastPIDLItem(FAbsolutePIDL));
  end;
end;

destructor TcxShellFolder.Destroy;
begin
  DisposePIDL(FRelativePIDL);
  inherited Destroy;
end;

function TcxShellFolder.GetAttributes: TcxShellFolderAttributes;

  procedure CheckAttribute(AShellAttributes, AAttributeShellAttribute: LongWord;
    AAttribute: TcxShellFolderAttribute);
  begin
    if HasShellAttribute(AShellAttributes, AAttributeShellAttribute) then
      Include(Result, AAttribute);
  end;

var
  AShellAttributes: LongWord;
begin
  AShellAttributes := GetShellAttributes(SFGAO_DISPLAYATTRMASK);
  Result := [];
  CheckAttribute(AShellAttributes, cxSFGAO_GHOSTED, sfaGhosted);
  CheckAttribute(AShellAttributes, SFGAO_HIDDEN, sfaHidden);
  CheckAttribute(AShellAttributes, SFGAO_ISSLOW, sfaIsSlow);
  CheckAttribute(AShellAttributes, SFGAO_LINK, sfaLink);
  CheckAttribute(AShellAttributes, SFGAO_READONLY, sfaReadOnly);
  CheckAttribute(AShellAttributes, SFGAO_SHARE, sfaShare);
end;

function TcxShellFolder.GetCapabilities: TcxShellFolderCapabilities;

  procedure CheckCapability(AShellAttributes, ACapabilityShellAttribute: LongWord;
    ACapability: TcxShellFolderCapability);
  begin
    if HasShellAttribute(AShellAttributes, ACapabilityShellAttribute) then
      Include(Result, ACapability);
  end;

var
  AShellAttributes: LongWord;
begin
  AShellAttributes := GetShellAttributes(SFGAO_CAPABILITYMASK);
  Result := [];
  CheckCapability(AShellAttributes, SFGAO_CANCOPY, sfcCanCopy);
  CheckCapability(AShellAttributes, SFGAO_CANDELETE, sfcCanDelete);
  CheckCapability(AS