cxshellcombobox.pas

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

    property OnStartDrag;
  end;

var
  cxShellComboBoxImageList: TCustomImageList;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  ActiveX, CommCtrl, Graphics, ShellAPI, SysUtils, cxControls, cxDBEdit,
  cxEditPaintUtils, cxEditUtils, cxExtEditConsts, cxFilterControlUtils,
  cxGeometry, cxVariants;

type
  TcxDBTextEditDataBindingAccess = class(TcxDBTextEditDataBinding);
  TcxCustomEditAccess = class(TcxCustomEdit);
  TcxInnerShellListViewAccess = class(TcxInnerShellListView);
  TcxInnerShellTreeViewAccess = class(TcxInnerShellTreeView);
  TcxPopupEditPopupWindowAccess = class(TcxPopupEditPopupWindow);
  TcxShellTreeItemProducerAccess = class(TcxShellTreeItemProducer);

const
  ShellRootIDL: Word = 0;

type
  { TcxFilterShellComboBoxHelper }

  TcxFilterShellComboBoxHelper = class(TcxFilterDropDownEditHelper)
  public
    class function GetFilterEditClass: TcxCustomEditClass; override;
  end;

class function TcxFilterShellComboBoxHelper.GetFilterEditClass: TcxCustomEditClass;
begin
  Result := TcxShellComboBox;
end;

procedure FreeAndNilPIDL(var APIDL: PItemIDList);
begin
  if APIDL <> nil then
  begin
    cxMalloc.Free(APIDL);
    APIDL := nil;
  end;
end;

procedure GetShellSysIconIndex(APIDL: PItemIDList;
  out AShellSysIconIndex, AShellSysIconOverlayIndex: Integer);
const
  SHGFI_ATTR_SPECIFIED = $20000;
var
  AFlags: Integer;
  ASHFileInfo: TSHFileInfo;
begin
  AFlags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
    SHGFI_ATTR_SPECIFIED or SHGFI_ATTRIBUTES;
  ASHFileInfo.dwAttributes := SFGAO_LINK or SFGAO_SHARE;
  SHGetFileInfo(Pointer(APIDL), 0, ASHFileInfo, SizeOf(ASHFileInfo), AFlags);
  AShellSysIconIndex := ASHFileInfo.iIcon;
  if ASHFileInfo.dwAttributes and SFGAO_LINK <> 0 then
    AShellSysIconOverlayIndex := cxShellShortcutItemOverlayIndex
  else
    if ASHFileInfo.dwAttributes and SFGAO_SHARE <> 0 then
      AShellSysIconOverlayIndex := cxShellSharedItemOverlayIndex
    else
      AShellSysIconOverlayIndex := cxShellNormalItemOverlayIndex;
end;

procedure PrepareShellComboBoxImageList;
var
  ASHFileInfo : TSHFileInfo;
begin
  cxShellComboBoxImageList := TCustomImageList.Create(nil);
  with cxShellComboBoxImageList do
  begin
    ShareImages := True;
    Handle := SHGetFileInfo(@ShellRootIDL, 0, ASHFileInfo, SizeOf(ASHFileInfo),
      SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  end;
end;

{ TcxShellComboBoxViewInfo }

procedure TcxShellComboBoxViewInfo.Offset(DX, DY: Integer);
begin
  inherited Offset(DX, DY);
  Inc(ShellIconPosition.X, DX);
  Inc(ShellIconPosition.Y, DY);
end;

procedure TcxShellComboBoxViewInfo.Paint(ACanvas: TcxCanvas);
var
  R: TRect;
begin
  if (ShellSysIconIndex <> -1) and (cxShellComboBoxImageList <> nil) then
  begin
    R.TopLeft := ShellIconPosition;
    R.Right := R.Left + cxShellComboBoxImageList.Width;
    R.Bottom := R.Top + cxShellComboBoxImageList.Height;
    if not Transparent then
      cxEditFillRect(ACanvas.Handle, R, GetSolidBrush(BackgroundColor));
    ImageList_Draw(cxShellComboBoxImageList.Handle, ShellSysIconIndex,
      ACanvas.Handle, R.Left, R.Top,
      ILD_TRANSPARENT or IndexToOverlayMask(ShellSysIconOverlayIndex + 1));
    if not Transparent then
      ACanvas.ExcludeClipRect(R);
  end;
  inherited Paint(ACanvas);
end;

{ TcxShellComboBoxViewData }

procedure TcxShellComboBoxViewData.Calculate(ACanvas: TcxCanvas;
  const ABounds: TRect; const P: TPoint; Button: TcxMouseButton;
  Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
  AIsMouseEvent: Boolean);

  function GetIconPosition: TPoint;
  begin
    if cxShellComboBoxImageList = nil then
      Result := cxNullPoint
    else
      with TcxShellComboBoxViewInfo(AViewInfo) do
      begin
        Result.X :=  BorderRect.Left + 1;
        Result.Y := BorderRect.Top + (BorderRect.Bottom - BorderRect.Top -
          cxShellComboBoxImageList.Height) div 2
      end;
  end;

begin
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo, AIsMouseEvent);
  TcxShellComboBoxViewInfo(AViewInfo).ShellIconPosition := GetIconPosition;
end;

procedure TcxShellComboBoxViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
begin
  with TcxShellComboBoxViewInfo(AViewInfo) do
  begin
    Properties.GetShellDisplayValue(AEditValue, False, string(Text),
      ShellSysIconIndex, ShellSysIconOverlayIndex);
    DoOnGetDisplayText(string(Text));
  end;
  PrepareSelection(AViewInfo);
end;

function TcxShellComboBoxViewData.GetClientExtent(ACanvas: TcxCanvas;
  AViewInfo: TcxCustomEditViewInfo): TRect;
begin
  Result := inherited GetClientExtent(ACanvas, AViewInfo);
  if not (Properties.FastSearch and (Edit = nil) or (cxShellComboBoxImageList = nil)) then
    Inc(Result.Left, cxShellComboBoxImageList.Width + 4);
end;

function TcxShellComboBoxViewData.InternalGetEditConstantPartSize(ACanvas: TcxCanvas;
  AIsInplace: Boolean; AEditSizeProperties: TcxEditSizeProperties;
  var MinContentSize: TSize; AViewInfo: TcxCustomEditViewInfo): TSize;
begin
  Result := inherited InternalGetEditConstantPartSize(ACanvas, AIsInplace,
    AEditSizeProperties, MinContentSize, AViewInfo);
  if IsInplace or (Edit <> nil) and TcxCustomEditAccess(Edit).AutoSize then
  begin
    if (cxShellComboBoxImageList <> nil) and
      (MinContentSize.cy < cxShellComboBoxImageList.Height) then
        MinContentSize.cy := cxShellComboBoxImageList.Height;
  end;
end;

function TcxShellComboBoxViewData.InternalEditValueToDisplayText(
  AEditValue: TcxEditValue): string;
var
  AShellSysIconIndex, AShellSysIconOverlayIndex: Integer;
begin
  Properties.GetShellDisplayValue(AEditValue, Focused, Result, AShellSysIconIndex,
    AShellSysIconOverlayIndex);
end;

function TcxShellComboBoxViewData.GetProperties: TcxCustomShellComboBoxProperties;
begin
  Result := TcxCustomShellComboBoxProperties(FProperties);
end;

{ TcxShellComboBoxRoot }

procedure TcxShellComboBoxRoot.RootUpdated;
begin
  inherited RootUpdated;
  TcxCustomShellComboBoxProperties(Owner).RootChangeHandler(Self);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

{ TcxShellComboBoxLookupData }

function TcxShellComboBoxLookupData.GetItem(Index: Integer): string;
begin
  Result := Edit.TraverseAllVisibleNodes(Index).Text;
end;

function TcxShellComboBoxLookupData.GetItemCount: Integer;
begin
  if Edit.ActiveProperties.IncrementalSearch then
  begin
    Result := -1;
    Edit.TraverseAllVisibleNodes(Result);
  end
  else
    Result := 0;
end;

procedure TcxShellComboBoxLookupData.ListChanged;
begin
end;

function TcxShellComboBoxLookupData.GetEdit: TcxCustomShellComboBox;
begin
  Result := TcxCustomShellComboBox(GetOwner);
end;

{ TcxCustomShellComboBoxProperties }

constructor TcxCustomShellComboBoxProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  FRoot := TcxShellComboBoxRoot.Create(Self, 0);
  FRoot.OnSettingsChanged := RootSettingsChanged;
  DropDownSizeable := True;
  ImmediateDropDown := False;
  PopupAutoSize := False;
  TreeViewOptions := [tvoContextMenus, tvoHotTrack, tvoShowButtons,
    tvoShowLines, tvoShowRoot, tvoShowToolTip];
  ValidateOnEnter := True;

  FStoreRelativePath := True;
end;

destructor TcxCustomShellComboBoxProperties.Destroy;
begin
  FreeAndNil(FRoot);
  inherited Destroy;
end;

procedure TcxCustomShellComboBoxProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomShellComboBoxProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      with Source as TcxCustomShellComboBoxProperties do
      begin
        Self.FastSearch := FastSearch;
        Self.IncrementalSearch := IncrementalSearch;
        Self.Root.Assign(Root);
        Self.ShowFullPath := ShowFullPath;
        Self.StoreRelativePath := StoreRelativePath;
        Self.TreeViewOptions := TreeViewOptions;
        Self.ViewOptions := ViewOptions;
        Self.OnAddFolder := OnAddFolder;
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

function TcxCustomShellComboBoxProperties.CompareDisplayValues(
  const AEditValue1, AEditValue2: TcxEditValue): Boolean;
var
  AShellSysIconIndex1, AShellSysIconIndex2: Integer;
  AShellSysIconOverlayIndex1, AShellSysIconOverlayIndex2: Integer;
  AText1, AText2: string;
begin
  GetShellDisplayValue(AEditValue1, False, AText1, AShellSysIconIndex1,
    AShellSysIconOverlayIndex1);
  GetShellDisplayValue(AEditValue2, False, AText2, AShellSysIconIndex2,
    AShellSysIconOverlayIndex2);
  Result := InternalCompareString(AText1, AText2, True) and (FastSearch or
    (AShellSysIconIndex1 = AShellSysIconIndex2) and
    (AShellSysIconOverlayIndex1 = AShellSysIconOverlayIndex2));
end;

class function TcxCustomShellComboBoxProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxShellComboBox;
end;

function TcxCustomShellComboBoxProperties.GetDisplayText(const AEditValue: TcxEditValue;
  AFullText: Boolean = False; AIsInplace: Boolean = True): WideString;
var
  AShellSysIconIndex, AShellSysIconOverlayIndex: Integer;
  AText: string;
begin
  GetShellDisplayValue(AEditValue, False, AText, AShellSysIconIndex,
    AShellSysIconOverlayIndex);
  Result := AText;
end;

function TcxCustomShellComboBoxProperties.GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource;
begin
  Result := evsValue;
end;

class function TcxCustomShellComboBoxProperties.GetLookupDataClass: TcxInterfacedPersistentClass;
begin
  Result := TcxShellComboBoxLookupData;
end;

procedure TcxCustomShellComboBoxProperties.GetShellDisplayValue(
  const AEditValue: TcxEditValue; AFocused: Boolean;
  out AText: string; out AShellSysIconIndex, AShellSysIconOverlayIndex: Integer);
var
  APath: string;

  procedure GetShellObjectName;
  var
    APathLength: Integer;
    I: Integer;
  begin
    APathLength := Length(APath);
    for I := APathLength - 1 downto 1 do
      if APath[I] = '\' then
      begin
        APath := Copy(APath, I + 1, APathLength - I);
        Break;
      end;
  end;

var
  AAttributes, AParsedCharCount: ULONG;
  APIDL: PItemIDList;
begin
  AShellSysIconIndex := -1;
  if FastSearch then
  begin
    if VarIsNull(AEditValue) or VarIsEmpty(AEditValue) then
      AText := ''
    else
    begin
      APath := VarToStr(AEditValue);
      CheckRoot;
      if APath = '' then
        AText := GetPIDLDisplayName(Root.Pidl)
      else
        case CheckShellObjectPath(APath, GetPidlName(Root.Pidl), False) of
          sptVirtual:
            begin
              AAttributes := SFGAO_HIDDEN or SFGAO_FOLDER;
              GetDesktopIShellFolder.ParseDisplayName(0, nil, StringToOleStr(APath),
                AParsedCharCount, APIDL, AAttributes);
              if (APIDL <> nil) and not CheckViewOptions(GetShellViewOptions, AAttributes) then
                  APIDL := nil;
              if APIDL = nil then
                AText := APath
              else
              begin
                AText := GetPIDLDisplayName(APIDL);
                DisposePidl(APIDL);
              end;
            end;
          else
            begin
              GetShellObjectName;
              AText := APath;
            end;
        end;
    end;
    Exit;
  end;