dxbarcustform.pas

胜天进销存源码,国产优秀的进销存

    FCommandListBoxOldWndProc: TWndMethod;

    FGroupListBoxOldWndProc: TWndMethod;
    FGroupsOldChangeEvent: TdxBarListChangeEvent;

    FGroupItemListBoxOldWndProc: TWndMethod;
    FSelectedGroupItems: TdxBarComponentList;

    FDraggingCategoryIndex: Integer;

    FAllCommandsNameWidth: Integer;
    FAllCommandsCaptionWidth: Integer;
    FAllCommandsShortCutWidth: Integer;

    FAlreadySynchronous: TListBox;

    //Common Tools
    procedure DeleteSelectedObjects(AListBox: TListBox;
      ADeleteProc: TNotifyEvent = nil; ASynchronizeDesigner: Boolean = True);
    procedure EnableWindows(AEnable: Boolean);
    function GetVisibleItemsCount(AListBox: TListBox): Integer;
    function GetExclusiveObject(AListBox: TListBox): TObject;
    function GetObjectFromListBox(AListBox: TListBox; AIndex: Integer): TObject;
    function GetNextSelectedObject(AListBox: TListBox): TObject;
    function GetPainterClass: TdxBarCustomizingFormPainterClass;
    function GetSelCount(AListBox: TListBox): Integer;
    procedure GetSelection(AListBox: TListBox; AList: TList);
    procedure MoveItems(AListBox: TListBox;
      ABarComponentList: TdxBarComponentList; ADirection: Integer);
    procedure SelectBarManager;
    procedure SetNewWindowProc(AControl: TControl; ANewWindowProc: TWndMethod;
      out AOldWindowProc: TWndMethod);
    procedure SetSelection(AListBox: TListBox; AList: TList); overload;
    procedure SetSelection(AListBox: TListBox; AObject: TObject); overload;
    procedure SynchronizeDesigner(ANewSelection: IdxBarSelectableItem); overload;
    procedure SynchronizeDesigner(AListBox: TListBox); overload;
    procedure SynchronizeListBox(AListBox: TListBox; AChangedObject: TObject = nil; AAction: TcxComponentCollectionNotification = ccnChanged);
    procedure SynchronizeListBoxes;
    procedure SynchronizeListBoxSelection(AListBox: TListBox);
    procedure UpdateCommonEvents(AListBox: TListBox;
      AAddAction, ADeleteAction, AMoveUpAction, AMoveDownAction: TAction;
      ADeletePermissiveProc: TdxBarPermissiveProc = nil);
    procedure UpdateTopIndex(AListBox: TListBox);

    //BarList
    procedure BarListToggleCheck(AIndex: Integer);
    procedure BarListBoxWndProc(var Message: TMessage);
    procedure BarsChange(Sender: TObject; AItem: TcxComponentCollectionItem;
      AAction: TcxComponentCollectionNotification);
    function CanDeleteBar(ABar: TComponent): Boolean;
    function GetBarList(Index: Integer): TdxBar;
    function GetSelectedBar: TdxBar;
    function IsBarPredefined(ABar: TdxBar): Boolean;

    //CategoryList
    function CanDeleteSelectedCategory: Boolean;
    function CanDeleteSelectedCategoryCommands: Boolean;
    procedure CategoryListBoxWndProc(var Message: TMessage);

    //ItemList
    function GetItemList(Index: Integer): TdxBarItem;
    function GetSelectedItem: TdxBarItem;
    procedure ItemListBoxWndProc(var Message: TMessage);
    procedure ItemsChange(Sender: TObject; AComponent: TComponent;
      AAction: TcxComponentCollectionNotification);
    procedure MoveItem(Delta: Integer);

   //CommandList
    procedure CommandListBoxWndProc(var Message: TMessage);
    function GetCommandList(Index: Integer): TdxBarItem;
    procedure RefreshAllCommandListBox;

    //GroupList
    function GetSelectedGroup: TdxBarGroup;
    procedure GroupListBoxWndProc(var Message: TMessage);
    procedure GroupsChange(Sender: TObject; AComponent: TComponent;
      AAction: TcxComponentCollectionNotification);
    procedure MoveGroup(ADirection: Integer);
    procedure RememberSelectedList;

    //GroupItemList
    procedure GroupItemListBoxWndProc(var Message: TMessage);
    procedure GroupStuctureChange;
    procedure DeleteGroupItem(AGroupItem: TObject);
    procedure MoveGroupItem(ADirection: Integer);
    procedure UpdateGroupItemEvents;

    procedure WMActivate(var Message: TMessage); message WM_ACTIVATE;
    procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
    procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;

    property BarList[Index: Integer]: TdxBar read GetBarList;
    property CommandList[Index: Integer]: TdxBarItem read GetCommandList;
    property ItemList[Index: Integer]: TdxBarItem read GetItemList;

    property SelectedBar: TdxBar read GetSelectedBar;
    property SelectedGroup: TdxBarGroup read GetSelectedGroup;
    property SelectedItem: TdxBarItem read GetSelectedItem;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  {$IFDEF DELPHI9}
    procedure DestroyWindowHandle; override;
  {$ENDIF}
  public
    BarManager: TdxBarManager;
    constructor CreateEx(ABarManager: TdxBarManager);
    destructor Destroy; override;
    procedure MouseWheelHandler(var Message: TMessage); override;
    procedure BarManagerStyleChanged;
    procedure DesignSelectionChanged(Sender: TObject);
    procedure SelectPage(APageIndex: Integer);
    procedure UpdateHelpButton;
    procedure UpdateOptions;
    procedure UpdateVisibility(const AWindowPos: TWindowPos);
    property PainterClass: TdxBarCustomizingFormPainterClass read GetPainterClass;
  end;

procedure dxBarCustomizing(ABarManager: TdxBarManager; AShow: Boolean);
function dxBarCustomizingForm: TdxBarCustomizingForm;
function IsCustomization: Boolean;
procedure PrepareCustomizationFormFont(AForm: TCustomForm;
  ABarManager: TdxBarManager);

procedure HostBarManagerStyleChanged;
procedure UpdateHelpButton;
procedure UpdateBarManagerOptions;

implementation

{$R *.DFM}

uses
{$IFDEF DELPHI8}
  Types,
{$ENDIF}
  dxBarNameEd, dxBarPopupMenuEd, dxBarItemEd, dxBarStrs, dxBarAddGroupItemsEd,
  TypInfo, dxUxTheme, dxThemeManager, dxThemeConsts, dxOffice11, cxContainer,
  cxControls, cxGraphics, Math, cxLookAndFeelPainters;

const
  AllCommandsIndent = 5;

  AToolBarsPage = 0;
  ACommandsPage = 1;
  AAllCommandsPage = 3;
  AGroupsPage = 4;

  LB_SYNCHRONYZE = WM_DX + 1;
  LB_SYNCHRONYZESELECTION = WM_DX + 2;
  LB_UPDATEEVENTS = WM_DX + 3;

type
  TCustomdxBarContainerItemAccess = class(TCustomdxBarContainerItem);
  TdxBarAccess = class(TdxBar);
  TdxBarGroupAccess = class(TdxBarGroup);
  TdxBarControlAccess = class(TdxBarControl);
  TdxBarItemAccess = class(TdxBarItem);
  TdxBarManagerAccess = class(TdxBarManager);
  TdxCustomBarEditAccess = class(TdxCustomBarEdit);

{ TCheckListBox }

{ procedures }

var
  FdxBarCustomizingForm: TdxBarCustomizingForm;
  FCloseCustomizingFormFlag: Boolean;

procedure dxBarCustomizing(ABarManager: TdxBarManager; AShow: Boolean);

  procedure InvalidateUncustomizableToolbars;
  var
    ABar: TdxBar;
    I, J: Integer;
  begin
    for I := 0 to dxBarManagerList.Count - 1 do
      if dxBarManagerList[I] <> ABarManager then
        for J := 0 to dxBarManagerList[I].Bars.Count - 1 do
        begin
          ABar := dxBarManagerList[I].Bars[J];
          if ABar.Visible and (ABar.Control <> nil) and
            ABar.Control.HandleAllocated then
          begin
            TdxBarControlAccess(ABar.Control).UpdateDoubleBuffered;
            ABar.Control.Invalidate;
            SendMessage(ABar.Control.Handle, WM_NCPAINT, 1, 0);
          end;
        end;
  end;

  procedure DoShowCustomizingForm;
  begin
    if Assigned(ABarManager.OnShowCustomizingForm) then
      ABarManager.OnShowCustomizingForm(ABarManager);
  end;

  procedure DoHideCustomizingForm;
  begin
    if Assigned(ABarManager.OnHideCustomizingForm) then
      ABarManager.OnHideCustomizingForm(ABarManager);
  end;

begin
  if AShow then
  begin
    if FdxBarCustomizingForm <> nil then Exit;

    TdxBarManagerAccess(ABarManager).InternalUnmerge(nil, True);
    DoShowCustomizingForm;
    InvalidateUncustomizableToolbars;

    FdxBarCustomizingForm := TdxBarCustomizingForm.CreateEx(ABarManager);
    FdxBarCustomizingForm.Show;
  end
  else
  begin
    if not FCloseCustomizingFormFlag then
      FreeAndNil(FdxBarCustomizingForm);
    dxBarSubMenuEditor.Free;

    DoHideCustomizingForm;
    InvalidateUncustomizableToolbars;
    TdxBarManagerAccess(ABarManager).RestoreMergeState;
  end;
end;

function dxBarCustomizingForm: TdxBarCustomizingForm;
begin
  Result := FdxBarCustomizingForm;
end;

function IsCustomization: Boolean;
begin
  Result := FdxBarCustomizingForm <> nil;
end;

procedure PrepareCustomizationFormFont(AForm: TCustomForm;
  ABarManager: TdxBarManager);
begin
  AForm.Font.Name := ABarManager.Font.Name;
  AForm.Font.Charset := ABarManager.Font.Charset;
end;

procedure HostBarManagerStyleChanged;
begin
  if FdxBarCustomizingForm <> nil then
    FdxBarCustomizingForm.BarManagerStyleChanged;
end;

procedure UpdateHelpButton;
begin
  if FdxBarCustomizingForm <> nil then
    FdxBarCustomizingForm.UpdateHelpButton;
end;

procedure UpdateBarManagerOptions;
begin
  if FdxBarCustomizingForm <> nil then
    FdxBarCustomizingForm.UpdateOptions;
end;

{ TCommandsListBox }

const
  dxBarGlyphSize = 16;
  dxBarButtonWidth = 23;
  dxBarButtonHeight = 22;
  dxBarComboBoxArrowWidth = 11;

{ TCheckableButton }

type
  TCheckableButton = class(TGraphicControl)
  private
    FDown: Boolean;
    FDropDownMenu: TdxBarPopupMenu;
    LButtonDown: Boolean;
    procedure SetDown(Value: Boolean);
    procedure SetDropDownMenu(Value: TdxBarPopupMenu);
    procedure DropDownMenuCloseup(Sender: TObject);
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AdjustWithControl(AControl: TControl);
    property Down: Boolean read FDown write SetDown;
    property DropDownMenu: TdxBarPopupMenu read FDropDownMenu write SetDropDownMenu;
  end;

constructor TCheckableButton.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csCaptureMouse];
end;

procedure TCheckableButton.AdjustWithControl(AControl: TControl);
var
  AAdjustment: Integer;
begin
  AAdjustment := AControl.BoundsRect.Right + 5 - Left;
  SetBounds(Left + AAdjustment, Top, Width - AAdjustment, Height);
end;

procedure TCheckableButton.SetDown(Value: Boolean);
begin
  if FDown <> Value then
  begin
    FDown := Value;
    Repaint;
    if FDown and (FDropDownMenu <> nil) then
      with ClientToScreen(Point(0, Height)) do
        FDropDownMenu.PopupEx(X, Y, 0, Height, True, nil);
  end;
end;

procedure TCheckableButton.SetDropDownMenu(Value: TdxBarPopupMenu);
begin
  if FDropDownMenu <> Value then
  begin
    FDropDownMenu := Value;
    FDropDownMenu.OnCloseup := DropDownMenuCloseup;
  end;
end;

procedure TCheckableButton.DropDownMenuCloseup(Sender: TObject);
var
  P: TPoint;
begin
  if FDown then
  begin
    GetCursorPos(P);
    P := ScreenToClient(P);
    LButtonDown := LeftButtonPressed and PtInRect(ClientRect, P);
    Down := False;
  end;
end;

procedure TCheckableButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

procedure TCheckableButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  Repaint;
end;

procedure TCheckableButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if LButtonDown then LButtonDown := False
  else
    if Button = mbLeft then Down := True;
end;

procedure TCheckableButton.Paint;
const
  Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
var
  R: TRect;
  P: TPoint;
begin
  with Canvas do