cxshellcommon.pas

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

    repeat
      if CanProcessFetchQueueItems then
      begin
        AItemsInfoGatherer.FetchResumed;
        if AItemsInfoGatherer.FetchQueue.Count <> 0 then
          ProcessFetchQueueItems;
      end;
      if AItemsInfoGatherer.IsFetchThreadTerminating then
        Break;
      if AItemsInfoGatherer.IsFetchStopping then
        AItemsInfoGatherer.FetchStopped;
      Sleep(cxShellItemsInfoGathererSleepPause);
    until False;
    Result := 0;
  finally
    CoUninitialize;
  end;
end;

procedure RegisterShellItemsInfoGatherer(AGatherer: TcxShellItemsInfoGatherer);
begin
  if FShellItemsInfoGatherers = nil then
    FShellItemsInfoGatherers := TList.Create;
  FShellItemsInfoGatherers.Add(AGatherer);
end;

procedure UnregisterShellItemsInfoGatherer(AGatherer: TcxShellItemsInfoGatherer);
begin
  FShellItemsInfoGatherers.Remove(AGatherer);
  if FShellItemsInfoGatherers.Count = 0 then
    FreeAndNil(FShellItemsInfoGatherers);
end;

{ TcxCustomShellRoot }

procedure TcxCustomShellRoot.CheckRoot;
const
  ACSIDLs: array[TcxBrowseFolder] of Integer = (
    $00, $07, $0A, $19, $2E, $1F, $17, $16, $18, $2D,
    $03, $00, $10, $11, $04, $06, $14, $22, $0D, $27,
    $12, $28, $26, $02, $08, $0B, $07, $15
  );
var
  ABrowseFolder: TcxBrowseFolder;
  ACSIDL: Integer;
  ADesktopFolder: IShellFolder;
  AParsedCharCount, AAttributes: Cardinal;
  ATempCustomPath: PWideChar;
  ATempPIDL: PItemIDList;
begin
  if FIsRootChecking then
    Exit;

  ADesktopFolder := GetDesktopIShellFolder;
  ATempPIDL := nil;
  FValid := False;
  FShellFolder := nil;
  if FPidl <> nil then
  begin
    DisposePidl(FPidl);
    FPidl := nil;
  end;

  ABrowseFolder := BrowseFolder;
  if (ABrowseFolder = bfCustomPath) and (CustomPath = '') then
    ABrowseFolder := bfDesktop;

  FIsRootChecking := True;
  try
    try
      if ABrowseFolder = bfCustomPath then
      begin
        ATempCustomPath := StringToOleStr(CustomPath);
        OleCheck(ADesktopFolder.ParseDisplayName(ParentWindow, nil,
          ATempCustomPath, AParsedCharCount, ATempPIDL, AAttributes));
      end
      else
      begin
        ACSIDL := ACSIDLs[ABrowseFolder];
        if Win32MajorVersion < 5 then
          OleCheck(SHGetSpecialFolderLocation(ParentWindow, ACSIDL, ATempPIDL))
        else
          OleCheck(cxSHGetFolderLocation(ParentWindow, ACSIDL, 0, 0, ATempPIDL));
      end;
    except
      on E: Exception do
        if FRootChangingCount > 0 then
          raise EcxEditError.Create(E.Message)
        else
        begin
          RootUpdated;
          Exit;
        end;
    end;
    if ABrowseFolder = bfDesktop then
    begin
      FShellFolder := ADesktopFolder;
      FPidl := GetPidlCopy(ATempPIDL);
      FValid := True;
      FAttributes := SFGAO_FILESYSTEM;
      RootUpdated;
    end
    else
      Pidl := ATempPIDL;
  finally
    FIsRootChecking := False;
    if ATempPIDL <> nil then
      DisposePidl(ATempPIDL);
  end;
end;

procedure TcxCustomShellRoot.DoSettingsChanged;
begin
  if not FUpdating and Assigned(FOnSettingsChanged) then
    FOnSettingsChanged(Self);
end;

procedure TcxCustomShellRoot.RootUpdated;
begin
  UpdateFolder;
end;

procedure TcxCustomShellRoot.SetPidl(const Value: PItemIDList);
var
  DesktopFolder:IShellFolder;
  pFolder:IShellFolder;
begin
  if Value = nil then
     Exit;
  if FPidl<>nil then
  begin
    DisposePidl(FPidl);
    FPidl:=nil;
    FValid:=False;
    FAttributes:=0;
  end;
  if Failed(SHGetDesktopFolder(DesktopFolder)) then
     Exit;
  if Succeeded(DesktopFolder.BindToObject(Value,nil,IID_IShellFolder, pFolder)) then
  begin
    FShellFolder:=pFolder;
    FPidl:=GetPidlCopy(Value);
    FValid:=True;
    FAttributes:=0;
    if Failed(DesktopFolder.GetAttributesOf(1,FPidl,FAttributes)) then
       FAttributes:=0;
  end
  else
  begin
    FShellFolder:=DesktopFolder;
    FPidl:=GetPidlCopy(Value);
    FValid:=True;
    FAttributes:=SFGAO_FILESYSTEM;
  end;
  RootUpdated;
end;

constructor TcxCustomShellRoot.Create(AOwner: TPersistent; AParentWindow: HWND);
begin
  inherited Create;
  FOwner := AOwner;
  FParentWindow := AParentWindow;
  FBrowseFolder := bfDesktop;
  FCustomPath := '';
  FShellFolder := nil;
  FPidl := nil;
end;

destructor TcxCustomShellRoot.Destroy;
begin
  FreeAndNil(FFolder);
  FShellFolder := nil;
  DisposePidl(FPidl);
  inherited;
end;

procedure TcxCustomShellRoot.Assign(Source: TPersistent);
var
  APrevBrowseFolder: TcxBrowseFolder;
  APrevCustomPath: WideString;
begin
  if Source is TcxCustomShellRoot then
  begin
    APrevBrowseFolder := FBrowseFolder;
    APrevCustomPath := FCustomPath;
    try
      FBrowseFolder := TcxCustomShellRoot(Source).FBrowseFolder;
      FCustomPath := TcxCustomShellRoot(Source).FCustomPath;
      Inc(Self.FRootChangingCount);
      try
        CheckRoot;
      finally
        Dec(FRootChangingCount);
      end;
      DoSettingsChanged;
    except
      FBrowseFolder := APrevBrowseFolder;
      FCustomPath := APrevCustomPath;
      CheckRoot;
      raise;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TcxCustomShellRoot.Update(ARoot: TcxCustomShellRoot);
begin
  if FUpdating then
    Exit;
  FUpdating := True;
  try
    Assign(ARoot);
  finally
    FUpdating := False;
  end;
end;

procedure TcxCustomShellRoot.SetBrowseFolder(Value: TcxBrowseFolder);
var
  APrevBrowseFolder: TcxBrowseFolder;
begin
  APrevBrowseFolder := FBrowseFolder;
  try
    Inc(FRootChangingCount);
    try
      if FBrowseFolder <> Value then
      begin
        FBrowseFolder := Value;
        CheckRoot;
      end
      else
        if Pidl = nil then
          CheckRoot;
    finally
      Dec(FRootChangingCount);
    end;
    DoSettingsChanged;
  except
    FBrowseFolder := APrevBrowseFolder;
    CheckRoot;
    raise;
  end;
end;

procedure TcxCustomShellRoot.SetCustomPath(const Value: WideString);
var
  APrevCustomPath: WideString;
begin
  APrevCustomPath := FCustomPath;
  try
    FCustomPath := Value;
    Inc(FRootChangingCount);
    try
      if BrowseFolder = bfCustomPath then
        CheckRoot;
    finally
      Dec(FRootChangingCount);
    end;
    DoSettingsChanged;
  except
    FCustomPath := APrevCustomPath;
    CheckRoot;
    raise;
  end;
end;

function TcxCustomShellRoot.GetCurrentPath: WideString;
var
  Desktop:IShellFolder;
  StrName:TStrRet;
begin
  Result:='';
  if Pidl<>nil then
  begin
    if Failed(SHGetDesktopFolder(Desktop)) then
       Exit;
    if Succeeded(Desktop.GetDisplayNameOf(Pidl,SHGDN_NORMAL or SHGDN_FORPARSING,StrName)) then
       Result:=GetTextFromStrRet(StrName,Pidl);
  end;
end;

procedure TcxCustomShellRoot.UpdateFolder;
begin
  FreeAndNil(FFolder);
  FFolder := TcxShellFolder.Create(PIDL);
end;

{ TcxCustomItemProducer }

procedure TcxCustomItemProducer.ClearItems;

  (*function HasItems: Boolean;
  begin
    LockRead;
    try
      Result := Items.Count <> 0;
    finally
      UnlockRead;
    end;
  end;*)

var
  I: Integer;
begin
  //if HasItems then
  begin
    ClearFetchQueue;
    for I := 0 to Items.Count - 1 do
      TcxShellItemInfo(Items[I]).Free;
    Items.Clear;
  end;
  FShellFolder := nil;
  if FFolderPidl <> nil then
  begin
    DisposePidl(FFolderPidl);
    FFolderPidl := nil;
  end;
end;

constructor TcxCustomItemProducer.Create(AOwner: TWinControl);
begin
  inherited Create;
  FOwner := AOwner;
  FDetails := TcxShellDetails.Create;
  FItems := TList.Create;
  FItemsLock := TMultiReadExclusiveWriteSynchronizer.Create;
end;

procedure TcxCustomItemProducer.RequestItemsInfo;
var
  I: Integer;
begin
  ItemsInfoGatherer.StopFetch;
  try
    for I := 0 to Items.Count - 1 do
      if not TcxShellItemInfo(Items[I]).Updated then
        FetchRequest(I, False);
  finally
    ItemsInfoGatherer.ResumeFetch;
  end;
end;

destructor TcxCustomItemProducer.Destroy;
begin
  ClearItems;
  FreeAndNil(FDetails);
  FreeAndNil(FItems);
  FreeAndNil(FItemsLock);
  inherited Destroy;
end;

procedure TcxCustomItemProducer.LockRead;
begin
  ItemsLock.BeginRead;
end;

procedure TcxCustomItemProducer.LockWrite;
begin
  ItemsLock.BeginWrite;
end;

procedure TcxCustomItemProducer.ProcessItems(AIFolder: IShellFolder;
  AFolderPIDL: PItemIDList; cPreloadItems: Integer);
begin
  if FFolderPidl <> nil then
  begin
    DisposePidl(FFolderPidl);
    FFolderPidl := nil;
  end;
  FShellFolder := AIFolder;
  FFolderPidl := GetPidlCopy(AFolderPIDL);
  ProcessDetails(ShellFolder, cPreloadItems);
  FetchItems(cPreloadItems);
  if AllowBackgroundProcessing then
    RequestItemsInfo;
end;

procedure TcxCustomItemProducer.SetItemsCount(Count: Integer);
begin
  if Owner.HandleAllocated then
     SendMessage(Owner.Handle,DSM_SETCOUNT,Count,0);
end;

procedure TcxCustomItemProducer.UnlockRead;
begin
  ItemsLock.EndRead;
end;

procedure TcxCustomItemProducer.UnlockWrite;
begin
  ItemsLock.EndWrite;
end;

procedure TcxCustomItemProducer.NotifyRemoveItem(Index: Integer);
begin
  if Owner.HandleAllocated then
     SendMessage(Owner.Handle,DSM_NOTIFYREMOVEITEM,Index,0);
end;

procedure TcxCustomItemProducer.NotifyAddItem(Index: Integer);
begin
  if Owner.HandleAllocated then
     SendMessage(Owner.Handle,DSM_NOTIFYADDITEM,Index,0);
end;

procedure TcxCustomItemProducer.InitializeItem(Item:TcxShellItemInfo);
begin
  // Do nothing by default
end;

function TcxCustomItemProducer.CanAddFolder(AFolder: TcxShellFolder): Boolean;
begin
  Result := True;
end;

function TcxCustomItemProducer.DoCompareItems(AItem1, AItem2: TcxShellFolder;
  out ACompare: Integer): Boolean;
begin
  Result := False;
end;

procedure TcxCustomItemProducer.DoSort;

  function ShellSortFunction(Item1, Item2: Pointer): Integer;
  const
    R: array[Boolean] of Byte = (0, 1);
  var
    AItemInfo1, AItemInfo2: TcxShellItemInfo;
  begin
    AItemInfo1 := TcxShellItemInfo(Item1);
    AItemInfo2 := TcxShellItemInfo(Item2);
    if not AItemInfo1.ItemProducer.DoCompareItems(AItemInfo1.Folder, AItemInfo2.Folder, Result) then
    begin
      Result := R[AItemInfo2.IsFolder] - R[AItemInfo1.IsFolder];
      if Result = 0 then
        Result := SmallInt(AItemInfo1.ItemProducer.ShellFolder.CompareIDs(0, AItemInfo1.pidl, AItemInfo2.pidl));
    end;
  end;