cxshellcombobox.pas

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

procedure TcxCustomShellComboBox.PropertiesChanged(Sender: TObject);
begin
  inherited PropertiesChanged(Sender);
  ActiveProperties.PopupControl := FPopupShellTreeView;
  if FPopupShellTreeView <> nil then
    with FPopupShellTreeView do
    begin
      ImeMode := ActiveProperties.ImeMode;
      ImeName := ActiveProperties.ImeName;
      Options.ContextMenus := tvoContextMenus in ActiveProperties.TreeViewOptions;
      Options.ShowHidden := scvoShowHidden in ActiveProperties.ViewOptions;
      Options.ShowNonFolders := scvoShowFiles in ActiveProperties.ViewOptions;
      Options.ShowToolTip := tvoShowToolTip in ActiveProperties.TreeViewOptions;
      RightClickSelect := tvoRightClickSelect in ActiveProperties.TreeViewOptions;
      ShowButtons := tvoShowButtons in ActiveProperties.TreeViewOptions;
      ShowInfoTips := tvoShowInfoTips in ActiveProperties.TreeViewOptions;
      ShowLines := tvoShowLines in ActiveProperties.TreeViewOptions;
      ShowRoot := tvoShowRoot in ActiveProperties.TreeViewOptions;
      TreeHotTrack := tvoHotTrack in ActiveProperties.TreeViewOptions
    end;
end;

procedure TcxCustomShellComboBox.SynchronizeDisplayValue;
var
  APIDL: PItemIDList;
  S: String;
begin
  if DataBinding is TcxDBTextEditDataBinding then // TODO Remove cxDBEdit, IsDataSourceLive
    with TcxDBTextEditDataBindingAccess(DataBinding) do
      if not IsDataAvailable then
      begin
        ViewInfo.ShellSysIconIndex := -1;
        Exit;
      end;

  if VarIsNull(FEditValue) or VarIsEmpty(FEditValue) then
  begin
    ActiveProperties.CheckRoot;
    APIDL := GetPidlCopy(ActiveProperties.Root.Pidl);
  end
  else
    APIDL := ActiveProperties.EditValueToPIDL(FEditValue);

  InternalSetAbsolutePIDL(APIDL);

  if APIDL = nil then
  begin
    S := VarToStr(FEditValue);
    ViewInfo.ShellSysIconIndex := -1;
  end
  else
  begin
    S := GetPIDLDisplayName(APIDL, (ActiveProperties.ShowFullPath = sfpAlways) or
      (ActiveProperties.ShowFullPath = sfpNotFocused) and not IsFocused);
    GetShellSysIconIndex(APIDL, ViewInfo.ShellSysIconIndex,
      ViewInfo.ShellSysIconOverlayIndex);
    DisposePidl(APIDL);
  end;

  DataBinding.DisplayValue := S;
//  SelStart := Length(S);
  InvalidateShellIconRect;
end;

procedure TcxCustomShellComboBox.SynchronizeEditValue;
var
  APIDL: PItemIDList;

  function GetRootAbsolutePIDL: PItemIDList;
  begin
    Result := GetPidlCopy(ActiveProperties.Root.Pidl);
  end;

  function GetSelectedNodeAbsolutePIDL: PItemIDList;
  begin
    with PopupShellTreeView do
      Result := GetNodeAbsolutePIDL(InnerTreeView.Selected);
  end;

  procedure InternalEditValueToPIDL;
  var
    ACSIDL: Integer;
    ANode: TTreeNode;
    AParentIFolder: IShellFolder;
    AParentFolderPIDL: PItemIDList;
    APath: string;
    APathType: TcxShellObjectPathType;
    AShellViewOptions: TcxShellViewOptions;
    ATempPIDL: PItemIDList;
  begin
    APath := AnsiUpperCase(DisplayValue);
    ActiveProperties.CheckRoot;

    if APath = '' then
    begin
      APIDL := GetRootAbsolutePIDL;
      Exit;
    end;

    if IsDesigning or (FPopupShellTreeView.InnerTreeView.Selected = nil) then
      ATempPIDL := GetRootAbsolutePIDL
    else
      ATempPIDL := GetSelectedNodeAbsolutePIDL;
    try
      APathType := CheckShellObjectPath(APath,
        AnsiUpperCase(GetPidlName(ATempPIDL)), True);
    finally
      DisposePidl(ATempPIDL);
    end;

    APIDL := nil;
    AShellViewOptions := ActiveProperties.GetShellViewOptions;
    repeat
      case APathType of
        sptAbsolutePhysical, sptUNC, sptVirtual:
          APIDL := InternalParseDisplayName(GetDesktopIShellFolder, APath,
            AShellViewOptions);
        sptInternalAbsoluteVirtual, sptInternalRelativeVirtual:
          APIDL := ShellObjectInternalVirtualPathToPIDL(APath, ActiveProperties.Root,
            AShellViewOptions);
        sptRelativePhysical:
          begin
            if IsDesigning or (FPopupShellTreeView.InnerTreeView.Selected = nil) then
            begin
              AParentFolderPIDL := GetRootAbsolutePIDL;
              AParentIFolder := ActiveProperties.Root.ShellFolder;
            end
            else
            begin
              AParentFolderPIDL := GetSelectedNodeAbsolutePIDL;
              if APath = AnsiUpperCase(FPopupShellTreeView.InnerTreeView.Selected.Text) then
              begin
                APIDL := AParentFolderPIDL;
                Break;
              end;
              GetDesktopIShellFolder.BindToObject(AParentFolderPIDL, nil,
                IID_IShellFolder, Pointer(AParentIFolder));
            end;
            if AParentIFolder <> nil then
            begin
              APIDL := InternalParseDisplayName(AParentIFolder, APath,
                AShellViewOptions);
              if APIDL <> nil then
              begin
                ATempPIDL := APIDL;
                APIDL := ConcatenatePidls(AParentFolderPIDL, APIDL);
                DisposePidl(ATempPIDL);
              end;
              DisposePidl(AParentFolderPIDL);
              if APIDL <> nil then
                Break;
            end;

            if not IsDesigning then
            begin
              ANode := FindNodeAmongExpandedNodes(APath);
              if ANode <> nil then
              begin
                APIDL := FPopupShellTreeView.GetNodeAbsolutePIDL(ANode);
                Break;
              end;
            end;

            for ACSIDL := CSIDL_DESKTOP to CSIDL_HISTORY do
              with cxShellSpecialFolderInfoTable[ACSIDL] do
                if (PIDL <> nil) and (PIDLUpperCaseDisplayName = APath) and
                  CheckViewOptions(AShellViewOptions, Attributes) then
                begin
                  APIDL := GetPidlCopy(PIDL);
                  Break;
                end;
          end;
      end;
    until True;

    if (APIDL <> nil) and not IsSubPath(ActiveProperties.Root.Pidl, APIDL) then
    begin
      DisposePidl(APIDL);
      APIDL := nil;
    end;
  end;

begin
  if DataBinding is TcxDBTextEditDataBinding then // TODO Remove cxDBEdit, IsDataSourceLive
    with TcxDBTextEditDataBindingAccess(DataBinding) do
      if not IsDataAvailable then
      begin
        ViewInfo.ShellSysIconIndex := -1;
        Exit;
      end;
  InternalEditValueToPIDL;
  InternalSynchronizeEditValue(APIDL, DisplayValue);
  DisposePidl(APIDL);
end;

function TcxCustomShellComboBox.CheckAbsolutePIDL(var APIDL: PItemIDList;
  ACheckObjectExistence: Boolean): Boolean;
begin
  ActiveProperties.CheckRoot;
  if APIDL = nil then
  begin
    Result := True;
    APIDL := ActiveProperties.Root.Pidl;
  end
  else
  begin
    Result := IsSubPath(ActiveProperties.Root.Pidl, APIDL);
    if Result and ACheckObjectExistence then
      Result := CheckShellObjectExistence(APIDL);
  end;
end;

procedure TcxCustomShellComboBox.CheckPopupShellTreeView;
var
  ARootNode: TTreeNode;
begin
  if (FPopupShellTreeView = nil) or (FPopupShellTreeView.InnerTreeView = nil) or
      (FPopupShellTreeView.InnerTreeView.Items.Count = 0) then
    Exit;

  ARootNode := FPopupShellTreeView.InnerTreeView.Items[0];
  if not ARootNode.Expanded then
    ARootNode.Expanded := True;
end;

function TcxCustomShellComboBox.FindNodeAmongExpandedNodes(ANodeText: string): TTreeNode;

  function InternalFindPIDLAmongExpandedNodes(ANode: TTreeNode): TTreeNode;
  var
    AChildNode: TTreeNode;
  begin
    Result := nil;
    if ANode = nil then
      Exit;
    if ANodeText = AnsiUpperCase(ANode.Text) then
    begin
      Result := ANode;
      Exit;
    end;
    if not ANode.Expanded then
      Exit;
    AChildNode := ANode.GetFirstChild;
    while AChildNode <> nil do
    begin
      Result := InternalFindPIDLAmongExpandedNodes(AChildNode);
      if Result <> nil then
        Break;
      AChildNode := ANode.GetNextChild(AChildNode);
    end;
  end;

begin
  ANodeText := AnsiUpperCase(ANodeText);
  with FPopupShellTreeView.InnerTreeView do
    if (Selected <> nil) and (ANodeText = AnsiUpperCase(Selected.Text)) then
      Result := Selected
    else
      Result := InternalFindPIDLAmongExpandedNodes(Items.GetFirstNode);
end;

function TcxCustomShellComboBox.GetPopupShellTreeViewClass: TcxPopupShellTreeViewClass;
begin
  Result := TcxPopupShellTreeView;
end;

procedure TcxCustomShellComboBox.InternalSetAbsolutePIDL(Value: PItemIDList);
begin
  if not EqualPIDLs(FAbsolutePIDL, Value) then
  begin
    if FAbsolutePIDL <> nil then
      FreeAndNilPIDL(FAbsolutePIDL);
    if Value <> nil then
    begin
      FAbsolutePIDL := GetPidlCopy(Value);
      SynchronizeDependentShellControls;
    end;
  end;
end;

procedure TcxCustomShellComboBox.InternalSynchronizeEditValue(APIDL: PItemIDList;
  const ADisplayText: string = '');
var
  APIDLName: string;

  function UseInternalVirtualPathFormat: Boolean;
  var
    AShellSysIconIndex1, AShellSysIconOverlayIndex1: Integer;
    AShellSysIconIndex2, AShellSysIconOverlayIndex2: Integer;
    ATempPIDL: PItemIDList;
  begin
    APIDLName := GetPidlName(APIDL);
    Result := APIDLName = '';
    if not Result then
    begin
      ATempPIDL := InternalParseDisplayName(GetDesktopIShellFolder, APIDLName,
        ActiveProperties.GetShellViewOptions);
      try
        GetShellSysIconIndex(APIDL, AShellSysIconIndex1, AShellSysIconOverlayIndex1);
        GetShellSysIconIndex(ATempPIDL, AShellSysIconIndex2, AShellSysIconOverlayIndex2);
        Result := (AShellSysIconIndex1 <> AShellSysIconIndex2) or
          (AShellSysIconOverlayIndex1 <> AShellSysIconOverlayIndex2);
      finally
        DisposePidl(ATempPIDL);
      end;
    end;
  end;

var
  AIsEditValueChanged: Boolean;
  ANewEditValue: string;
  AParentIFolder: IShellFolder;
  AStrRet: TStrRet;
  ATempPIDL, ATempPIDL1: PItemIDList;
  I: Integer;
  S1, S2: string;
begin
  InternalSetAbsolutePIDL(APIDL);

  if APIDL = nil then
  begin
    ViewInfo.ShellSysIconIndex := -1;
    S1 := ADisplayText;
    ANewEditValue := DisplayValue;
  end
  else
  begin
    if ActiveProperties.StoreRelativePath and EqualPIDLs(ActiveProperties.Root.Pidl, APIDL) then
    begin
      ANewEditValue := '';
      S1 := GetPIDLDisplayName(APIDL, (ActiveProperties.ShowFullPath = sfpAlways) or
        (ActiveProperties.ShowFullPath = sfpNotFocused) and not IsFocused);
    end
    else
      if UseInternalVirtualPathFormat then
      begin
        ATempPIDL := APIDL;
        try
          if ActiveProperties.StoreRelativePath then
          begin
            Integer(APIDL) := Integer(APIDL) + GetPidlSize(ActiveProperties.Root.Pidl);
            S2 := cxShellObjectInternalRelativeVirtualPathPrefix;
            AParentIFolder := ActiveProperties.Root.ShellFolder;
          end
          else
          begin
            S2 := cxShellObjectInternalAbsoluteVirtualPathPrefix;
            AParentIFolder := GetDesktopIShellFolder;
          end;
          for I := 1 to GetPidlItemsCount(APIDL) do
          begin
            ATempPIDL1 := cxMalloc.Alloc(APIDL^.mkid.cb + SizeOf(SHITEMID));
            FillChar(ATempPIDL1^, APIDL^.mkid.cb + SizeOf(SHITEMID), 0);
            CopyMemory(ATempPIDL1, APIDL, APIDL^.mkid.cb);
            Integer(APIDL) := Integer(APIDL) + APIDL^.mkid.cb;
            AParentIFolder.GetDisplayNameOf(ATempPIDL1, SHGDN_INFOLDER, AStrRet);
            S1 := GetTextFromStrRet(AStrRet, ATempPIDL1);
            S2 := S2 + '\' + S1;
            AParentIFolder.BindToObject(ATempPIDL1, nil, IID_IShellFolder,
              Pointer(AParentIFolder));
            DisposePidl(ATempPIDL1);
          end;
          ANewEditValue := S2;
        finally
          APIDL := ATempPIDL;
        end;
      end
      else
      begin
        if ActiveProperties.StoreRelativePath then
        begin
          S1 := GetPidlName(ActiveProperties.Root.Pidl);
          S2 := GetPidlName(APIDL);
          if Pos(S1, S2) = 1 then
          begin
            if S1[Length(S1)] = '\' then
              S1 := Copy(S2, Length(S1) + 1, Length(S2) - Length(S1))