cxshellcombobox.pas

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

PAS
1,877
字号
  if VarIsNull(AEditValue) or VarIsEmpty(AEditValue) then
    APIDL := nil
  else
    APIDL := EditValueToPIDL(AEditValue);
  if APIDL = nil then
    AText := VarToStr(AEditValue)
  else
  begin
    AText := GetPIDLDisplayName(APIDL, (ShowFullPath = sfpAlways) or
      (ShowFullPath = sfpNotFocused) and not AFocused);
    GetShellSysIconIndex(APIDL, AShellSysIconIndex, AShellSysIconOverlayIndex);
    DisposePidl(APIDL);
  end;
  DisplayValueToDisplayText(AText);
end;

class function TcxCustomShellComboBoxProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxShellComboBoxViewInfo;
end;

function TcxCustomShellComboBoxProperties.IsEditValueValid(var EditValue: TcxEditValue;
  AEditFocused: Boolean): Boolean;
begin
  Result := True;
end;

class function TcxCustomShellComboBoxProperties.GetPopupWindowClass: TcxCustomEditPopupWindowClass;
begin
  Result := TcxShellComboBoxPopupWindow;
end;

class function TcxCustomShellComboBoxProperties.GetViewDataClass: TcxCustomEditViewDataClass;
begin
  Result := TcxShellComboBoxViewData;
end;

procedure TcxCustomShellComboBoxProperties.CheckRoot;
begin
  if Root.ShellFolder = nil then
  begin
    BeginUpdate;
    try
      Root.CheckRoot;
    finally
      EndUpdate(False);
    end;
  end;
end;

function TcxCustomShellComboBoxProperties.EditValueToPIDL(const AEditValue: TcxEditValue): PItemIDList;
begin
  CheckRoot;
  if VarIsNull(AEditValue) or VarIsEmpty(AEditValue) then
    Result := nil
  else
    Result := PathToAbsolutePIDL(VarToStr(AEditValue), Root, GetShellViewOptions);
end;

function TcxCustomShellComboBoxProperties.GetShellViewOptions: TcxShellViewOptions;
begin
  Result := [svoShowFolders];
  if scvoShowFiles in FViewOptions then
    Include(Result, svoShowFiles);
  if scvoShowHidden in FViewOptions then
    Include(Result, svoShowHidden);
end;

procedure TcxCustomShellComboBoxProperties.RootChanged;
begin
  Changed;
end;

procedure TcxCustomShellComboBoxProperties.DoRootSettingsChanged;
begin
  if Assigned(FOnRootSettingsChanged) then
    FOnRootSettingsChanged(Self);
end;

function TcxCustomShellComboBoxProperties.GetDropDownSizeable: Boolean;
begin
  Result := PopupSizeable;
end;

function TcxCustomShellComboBoxProperties.GetDropDownWidth: Integer;
begin
  Result := PopupWidth;
end;

procedure TcxCustomShellComboBoxProperties.RootChangeHandler(Sender: TObject);
begin
  RootChanged;
end;

procedure TcxCustomShellComboBoxProperties.RootSettingsChanged(Sender: TObject);
begin
  DoRootSettingsChanged;
end;

procedure TcxCustomShellComboBoxProperties.SetDropDownSizeable(Value: Boolean);
begin
  PopupSizeable := Value;
end;

procedure TcxCustomShellComboBoxProperties.SetDropDownWidth(Value: Integer);
begin
  PopupWidth := Value;
end;

procedure TcxCustomShellComboBoxProperties.SetFastSearch(Value: Boolean);
begin
  if Value <> FFastSearch then
  begin
    FFastSearch := Value;
    Changed;
  end;
end;

procedure TcxCustomShellComboBoxProperties.SetIncrementalSearch(Value: Boolean);
begin
  if Value <> FIncrementalSearch then
  begin
    FIncrementalSearch := Value;
    Changed;
  end;
end;

procedure TcxCustomShellComboBoxProperties.SetShowFullPath(
  Value: TcxShellComboBoxShowFullPath);
begin
  if Value <> FShowFullPath then
  begin
    FShowFullPath := Value;
    Changed;
  end;
end;

procedure TcxCustomShellComboBoxProperties.SetStoreRelativePath(Value: Boolean);
begin
  if Value <> FStoreRelativePath then
  begin
    FStoreRelativePath := Value;
    Changed;
  end;
end;

procedure TcxCustomShellComboBoxProperties.SetTreeViewOptions(Value: TcxPopupShellTreeViewOptions);
begin
  if Value <> FTreeViewOptions then
  begin
    FTreeViewOptions := Value;
    Changed;
  end;
end;

procedure TcxCustomShellComboBoxProperties.SetViewOptions(Value: TcxShellComboBoxViewOptions);
begin
  if Value <> FViewOptions then
  begin
    FViewOptions := Value;
    Changed;
  end;
end;

{ TcxPopupShellTreeView }

procedure TcxPopupShellTreeView.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_TAB then
    Edit.DoEditKeyDown(Key, Shift);
  inherited KeyDown(Key, Shift);
  case Key of
    VK_ESCAPE:
      begin
        DoSelectNode(crCancel);
        Key := 0;
      end;
    VK_F4:
      if not (ssAlt in Shift) then
      begin
        DoSelectNode(crClose);
        Key := 0;
      end;
    VK_UP, VK_DOWN:
      if ssAlt in Shift then
      begin
        DoSelectNode(crClose);
        Key := 0;
      end;
    VK_RETURN:
      if (Shift = []) and (InnerTreeView.Selected <> nil) then
        DoSelectNode(crEnter);
  end;
end;

procedure TcxPopupShellTreeView.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  AHitTests : THitTests;
begin
  inherited MouseUp(Button, Shift, X, Y);
  AHitTests := InnerTreeView.GetHitTestInfoAt(X, Y);
  if ((Button = mbLeft) and not RightClickSelect) or ((Button = mbRight) and RightClickSelect) then
    if ([htOnIcon, htOnItem, htOnLabel] * AHitTests <> []) and (AHitTests <> [htOnIcon, htOnItem]) then
      DoSelectNode(crEnter);
end;

procedure TcxPopupShellTreeView.DoSelectNode(AClosePopupReason: TcxEditCloseUpReason);
begin
  Edit.CloseUp(AClosePopupReason)
end;

function TcxPopupShellTreeView.GetEdit: TcxCustomShellComboBox;
begin
  Result := TcxCustomShellComboBox(TcxPopupEditPopupWindowAccess(Parent).Edit);
end;

{ TcxShellComboBoxPopupWindow }

procedure TcxShellComboBoxPopupWindow.WMEnable(var Message: TMessage);
begin
  inherited;
  if not IsInternalWindowsDisabling then
    if Bool(Message.WParam) then
      EnableAppWindows
    else
      DisableAppWindows;
end;

{ TcxCustomShellComboBox }

destructor TcxCustomShellComboBox.Destroy;
begin
  if FAbsolutePIDL <> nil then
  begin
    DisposePidl(FAbsolutePIDL);
    FAbsolutePIDL := nil;
  end;

  if FShellListView <> nil then
    with FShellListView do
      if (InnerListView <> nil) and not(csDestroying in InnerListView.ComponentState) then
        TcxInnerShellListViewAccess(InnerListView).ComboBoxControl := nil;

  if FShellTreeView <> nil then
    with FShellTreeView do
      if (InnerTreeView <> nil) and not(csDestroying in InnerTreeView.ComponentState) then
        TcxInnerShellTreeViewAccess(InnerTreeView).ComboBoxControl := nil;

  inherited Destroy;
end;

function TcxCustomShellComboBox.CanHide: Boolean;
begin
  Result := not HasPopupWindow or IsWindowEnabled(PopupWindow.Handle);
end;

class function TcxCustomShellComboBox.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomShellComboBoxProperties;
end;

function TcxCustomShellComboBox.CanDropDown: Boolean;
begin
  Result := True;
end;

procedure TcxCustomShellComboBox.CloseUp(AReason: TcxEditCloseUpReason);
begin
  if not HasPopupWindow then
    Exit;
  if AReason in [crTab, crEnter] then
  begin
    ValidateEdit(True);
    SelectAll;
  end;
  FCloseUpReason := AReason;
  PopupWindow.ClosePopup;
end;

procedure TcxCustomShellComboBox.CreatePopupWindow;
begin
  inherited CreatePopupWindow;
  PopupWindow.ModalMode := False;
end;

procedure TcxCustomShellComboBox.DoInitPopup;
begin
  inherited DoInitPopup;
  ActiveProperties.PopupControl := FPopupShellTreeView;  
end;

procedure TcxCustomShellComboBox.DropDown;
begin
  FIsSelectedNodeChangeEventLocked := True;
  inherited DropDown;
end;

procedure TcxCustomShellComboBox.HandleSelectItem(Sender: TObject);
var
  ANodeIndex: Integer;
  APIDL: PItemIDList;
begin
  ANodeIndex := ILookupData.CurrentKey;
  APIDL := FPopupShellTreeView.GetNodeAbsolutePIDL(TraverseAllVisibleNodes(ANodeIndex));
  InternalSynchronizeEditValue(APIDL, '');
  DisposePidl(APIDL);
  SelectAll;
end;

procedure TcxCustomShellComboBox.Initialize;
begin
  inherited Initialize;
  ActiveProperties.Root.OnChange := RootChangeHandler;
  ActiveProperties.Root.OnSettingsChanged := RootSettingsChanged;
  if IsDesigning then
    Exit;
  FPopupShellTreeView := GetPopupShellTreeViewClass.Create(PopupWindow);
  ActiveProperties.PopupControl := FPopupShellTreeView;
  with FPopupShellTreeView do
  begin
    LookAndFeel.MasterLookAndFeel := Self.PopupControlsLookAndFeel;
    ParentColor := True;
    Parent := Self.PopupWindow;
    Options.ShowNonFolders := False;
    Style.BorderStyle := cbsNone;
    Style.HotTrack := False;
    Style.TransparentBorder := False;
    TreeHotTrack := True;
    InnerTreeView.ShowInfoTips := False;
    OnAddFolder := Self.AddFolderHandler;
    OnChange := Self.SelectedNodeChangeHandler;
  end;
end;

procedure TcxCustomShellComboBox.InitializePopupWindow;
begin
  inherited InitializePopupWindow;
  TcxPopupEditPopupWindowAccess(PopupWindow).SysPanelStyle := ActiveProperties.PopupSizeable;
  PopupShellTreeView.Color := ActiveStyle.Color;
  PopupWindow.Font := ActiveStyle.GetVisibleFont;
end;

procedure TcxCustomShellComboBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if AComponent = ShellListView then
      ShellListView := nil
    else
      if AComponent = ShellTreeView then
        ShellTreeView := nil;
end;

procedure TcxCustomShellComboBox.PopupWindowShowed(Sender: TObject);
begin
  inherited PopupWindowShowed(Sender);
  FPopupWindowShowing := False;
end;

procedure TcxCustomShellComboBox.PopupWindowShowing(Sender: TObject);
var
  ARootNode: TTreeNode;
begin
  FPopupWindowShowing := True;
  try
    inherited PopupWindowShowing(Sender);
    SynchronizePopupShellTreeView;
    ARootNode := FPopupShellTreeView.InnerTreeView.Items.GetFirstNode;
    if (ARootNode <> nil) and not ARootNode.Expanded then
      ARootNode.Expanded := True;
  finally
    FIsSelectedNodeChangeEventLocked := False;
  end;
end;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?