dxstatusbar.pas

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

  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure RestoreDefaults; virtual;

    procedure ParentBiDiModeChanged;
    function UseRightToLeftAlignment: Boolean;
    function UseRightToLeftReading: Boolean;

    property PanelStyleClass: TdxStatusBarPanelStyleClass read FPanelStyleClass write SetPanelStyleClass;
    property StatusBarControl: TdxCustomStatusBar read GetStatusBarControl;
  published
    property PanelStyleClassName: string read GetPanelStyleClassName write SetPanelStyleClassName;
    property PanelStyle: TdxStatusBarPanelStyle read FPanelStyle write SetPanelStyle;
    property PanelStyleEvents: TNotifyEvent read FPanelStyleEvents write FPanelStyleEvents;

    property Bevel: TdxStatusBarPanelBevel read FBevel write SetBevel default dxpbLowered;
    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
    property Fixed: Boolean read GetFixed write SetFixed default True;
    property MinWidth: Integer read GetMinWidth write SetMinWidth stored IsMinWidthStored;
    property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
    property Text: string read FText write SetText;
    property Visible: Boolean read FVisible write SetVisible default True;
    property Width: Integer read GetWidth write SetWidth stored IsWidthStored;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnDrawPanel: TdxStatusBarDrawPanelEvent read FOnDrawPanel write FOnDrawPanel;
  end;

  { TdxStatusBarPanels }
  
  TdxStatusBarPanels = class(TCollection)
  private
    FStatusBarControl: TdxCustomStatusBar;
    function GetItem(Index: Integer): TdxStatusBarPanel;
    procedure SetItem(Index: Integer; Value: TdxStatusBarPanel);
  protected
    function GetOwner: TPersistent; override;
    procedure Loaded;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AStatusBarControl: TdxCustomStatusBar);
    function Add: TdxStatusBarPanel;
    function Insert(Index: Integer): TdxStatusBarPanel;
    property Items[Index: Integer]: TdxStatusBarPanel read GetItem write SetItem; default;
  end;

  { Painters }

  TdxStatusBarPaintStyle = (stpsStandard, stpsFlat, stpsXP, stpsOffice11, stpsUseLookAndFeel);

  TdxStatusBarPainter = class
  public
    // calc
    class procedure AdjustTextColor(AStatusBar: TdxCustomStatusBar; var AColor: TColor;
      Active: Boolean); virtual;
    class function BorderSizes(AStatusBar: TdxCustomStatusBar): TRect; virtual;
    class function DrawSizeGripFirst: Boolean; virtual;
    class function GripAreaSize: TSize; virtual;
    class function GripSize: TSize; virtual;
    class function IsNativeBackground: Boolean; virtual;
    class function SeparatorSize: Integer; virtual;
    class function TopBorderSize: Integer; virtual;
    // draw
    class procedure DrawBorder(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      var R: TRect); virtual;
    class procedure DrawEmptyPanel(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      R: TRect); virtual;
    class procedure DrawPanel(AStatusBar: TdxCustomStatusBar; APanel: TdxStatusBarPanel;
      ACanvas: TcxCanvas; R: TRect); virtual;
    class procedure DrawPanelBorder(AStatusBar: TdxCustomStatusBar; ABevel: TdxStatusBarPanelBevel;
      ACanvas: TcxCanvas; var R: TRect); virtual;
    class procedure DrawPanelSeparator(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      const R: TRect); virtual;
    class procedure DrawSizeGrip(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      R: TRect; AOverlapped: Boolean); virtual;
    class procedure DrawTopBorder(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      const R: TRect); virtual;
    class procedure FillBackground(AStatusBar: TdxCustomStatusBar; APanel: TdxStatusBarPanel;
      ACanvas: TcxCanvas; const R: TRect); virtual;
    class function GetPanelBevel(APanel: TdxStatusBarPanel): TdxStatusBarPanelBevel; virtual;
    class function GetPanelColor(AStatusBar: TdxCustomStatusBar; APanel: TdxStatusBarPanel): TColor; virtual;
    class function ValidatePanelTextRect(AStatusBar: TdxCustomStatusBar;
      APanel: TdxStatusBarPanel; const R: TRect): TRect; virtual;
  end;

  TdxStatusBarStandardPainter = class(TdxStatusBarPainter)
  public
    class procedure DrawPanelBorder(AStatusBar: TdxCustomStatusBar; ABevel: TdxStatusBarPanelBevel;
      ACanvas: TcxCanvas; var R: TRect); override;
    class procedure DrawPanelSeparator(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      const R: TRect); override;
    class procedure FillBackground(AStatusBar: TdxCustomStatusBar; APanel: TdxStatusBarPanel;
      ACanvas: TcxCanvas; const R: TRect); override;
  end;

  TdxStatusBarFlatPainter = class(TdxStatusBarStandardPainter)
  public
    class procedure DrawPanelBorder(AStatusBar: TdxCustomStatusBar; ABevel: TdxStatusBarPanelBevel;
      ACanvas: TcxCanvas; var R: TRect); override;
  end;

  TdxStatusBarOffice11Painter = class(TdxStatusBarPainter)
  public
    // calc
    class function BorderSizes(AStatusBar: TdxCustomStatusBar): TRect; override;
    // draw
    class procedure DrawBorder(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      var R: TRect); override;
    class procedure DrawPanelBorder(AStatusBar: TdxCustomStatusBar; ABevel: TdxStatusBarPanelBevel;
      ACanvas: TcxCanvas; var R: TRect); override;
    class procedure DrawPanelSeparator(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      const R: TRect); override;
    class procedure DrawSizeGrip(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      R: TRect; AOverlapped: Boolean); override;
  end;

  TdxStatusBarXPPainter = class(TdxStatusBarPainter)
  public
    // calc
    class function BorderSizes(AStatusBar: TdxCustomStatusBar): TRect; override;
    class function GripAreaSize: TSize; override;
    class function SeparatorSize: Integer; override;
    // draw
    class procedure DrawBorder(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      var R: TRect); override;
    class procedure DrawPanelSeparator(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      const R: TRect); override;
    class procedure DrawSizeGrip(AStatusBar: TdxCustomStatusBar; ACanvas: TcxCanvas;
      R: TRect; AOverlapped: Boolean); override;
  end;

  { TdxStatusBarViewInfo }

  TdxStatusBarViewInfo = class
  private
    FPanels: TList;
    FWidths: TList;
    FSizeGripOvelapped: Boolean;
    FStatusBar: TdxCustomStatusBar;
    function GetWidth(Index: Integer): Integer;
    function GetPanel(Index: Integer): TdxStatusBarPanel;
    function GetPanelCount: Integer;
  protected
    procedure AddCalculatedItems(AAutoWidthObject: TcxAutoWidthObject);
    function GetCalculatedItemCount: Integer;
    function GetPanelAt(const APanelsBounds: TRect; X, Y: Integer): TdxStatusBarPanel;
    procedure UpdatePanels;
  public
    constructor Create(AOwner: TdxCustomStatusBar); virtual;
    destructor Destroy; override;
    procedure Calculate(const ABounds: TRect); virtual;

    property PanelCount: Integer read GetPanelCount;
    property Panels[Index: Integer]: TdxStatusBarPanel read GetPanel;
    property Widths[Index: Integer]: Integer read GetWidth; default;
    property SizeGripOvelapped: Boolean read FSizeGripOvelapped;
    property StatusBar: TdxCustomStatusBar read FStatusBar;
  end;

  { TdxCustomStatusBar }

  TdxStatusBarPanelCreateClassEvent = procedure(Sender: TdxCustomStatusBar;
    var AStatusPanelClass: TdxStatusBarPanelClass) of object;

  TdxCustomStatusBar = class(TcxControl, IdxSkinSupport)
  private
    FBorderWidth: Integer;
    FImages: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FLookAndFeel: TcxLookAndFeel;
    FPainter: TdxStatusBarPainterClass;
    FPaintStyle: TdxStatusBarPaintStyle;
    FPanels: TdxStatusBarPanels;
    FSizeGrip: Boolean;
    FThemeAvailable: Boolean;
    FThemeChangedNotificator: TdxThemeChangedNotificator;
    FViewInfo: TdxStatusBarViewInfo;
    FOnHint: TNotifyEvent;

    function GetPanelsBounds: TRect;
    procedure ImageListChange(Sender: TObject);
    procedure LookAndFeelChangeHandler(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues);
    procedure SetBorderWidth(Value: Integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetLookAndFeel(Value: TcxLookAndFeel);
    procedure SetPanels(Value: TdxStatusBarPanels);
    procedure SetPaintStyle(Value: TdxStatusBarPaintStyle);
    procedure SetSizeGrip(Value: Boolean);
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMWinIniChange(var Message: TMessage); message CM_WININICHANGE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure AdjustTextColor(var AColor: TColor; Active: Boolean); virtual;
    function CreateViewInfo: TdxStatusBarViewInfo; virtual;
    procedure FontChanged; override;
    function HasBackground: Boolean; override;
    procedure Loaded; override;
    function MayFocus: Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function NeedsScrollBars: Boolean; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure Resize; override;

    procedure Calculate; virtual;
    function ContainerByName(const AName: string): TdxStatusBarContainerControl;
    function CreatePanel: TdxStatusBarPanel; virtual;
    function CreatePanels: TdxStatusBarPanels; virtual;
    function DoHint: Boolean; virtual;
    class function GetDeafultPanelStyleClass: TdxStatusBarPanelStyleClass; virtual;
    function GetPainterClass: TdxStatusBarPainterClass; virtual;
    function GetPaintStyle: TdxStatusBarPaintStyle; virtual;
    class function GetStatusPanelClass: TdxStatusBarPanelClass; virtual;
    procedure InitPainterClass; virtual;
    procedure PaintStyleChanged; virtual;
    procedure Recalculate; 
    function SizeGripAllocated: Boolean; virtual;
    procedure ThemeChanged; virtual;
    procedure UpdatePanels; virtual;

    property Panels: TdxStatusBarPanels read FPanels write SetPanels;
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True;
    property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel;
    property Painter: TdxStatusBarPainterClass read FPainter;
    property PaintStyle: TdxStatusBarPaintStyle read FPaintStyle write SetPaintStyle default stpsStandard;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
    property ViewInfo: TdxStatusBarViewInfo read FViewInfo;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  {$IFNDEF DELPHI10}
    function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
  {$ENDIF}
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function CanAcceptPanelStyle(Value: TdxStatusBarPanelStyleClass): Boolean; virtual;
    function GetPanelAt(X, Y: Integer): TdxStatusBarPanel; virtual;
    property OnHint: TNotifyEvent read FOnHint write FOnHint;
  published
    property Images: TCustomImageList read FImages write SetImages;
  end;

  { TdxStatusBar }

  TdxStatusBar = class(TdxCustomStatusBar)
  published
    property Images;
    property Panels;
    property PaintStyle;
    property SizeGrip;
    property LookAndFeel;
    property OnHint;
    property BorderWidth;
    { TcxControl properties}
    property Anchors;
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Color default clBtnFace;
    property Constraints;
    property ShowHint;
    property ParentBiDiMode;
    property ParentFont default False;
    property ParentShowHint;
    property PopupMenu;
    property Visible;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
  end;

var
  dxStatusBarSkinPainterClass: TdxStatusBarPainterClass = nil;  

function GetRegisteredStatusBarPanelStyles: TcxRegisteredClasses;
procedure LoadIndicatorBitmap(ABitmap: TBitmap; AIndicatorType: TdxStatusBarStateIndicatorType);

implementation

{$R dxStatusBar.res}

uses
  dxThemeConsts, dxUxTheme, dxOffice11, ActnList, StdActns;

const
  GRIP_AREA_SIZE = 16;
  GRIP_SIZE = 12;
  PANELSEPARATORWIDTH = 2;

resourcestring  
  cxSTextPanelStyle = 'Text Panel';
  cxSContainerPanelStyle = 'Container Panel';
  cxSKeyboardStatePanelStyle = 'Keyboard State Panel';
  cxSStateIndicatorPanelStyle = 'State Indicator Panel';
  // design-time
  cxSCantDeleteAncestor = 'Selection contains a component introduced in an ancestor form which cannot be deleted';

var
  FRegisteredStatusBarPanelStyles: TcxRegisteredClasses;

function GetRegisteredStatusBarPanelStyles: TcxRegisteredClasses;
begin
  if FRegisteredStatusBarPanelStyles = nil then
    FRegisteredStatusBarPanelStyles := TcxRegisteredClasses.Create;
  Result := FRegisteredStatusBarPanelStyles;
end;

procedure LoadIndicatorBitmap(ABitmap: TBitmap; AIndicatorType: TdxStatusBarStateIndicatorType);
begin
  case AIndicatorType of
    sitOff: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_GRAY');
    sitYellow: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_YELLOW');
    sitBlue: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_BLUE');
    sitGreen: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_GREEN');
    sitRed: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_RED');
    sitTeal: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_TEAL');
    sitPurple: ABitmap.LoadFromResourceName(HInstance, 'DXSTATUSBAR_PURPLE');
  end;
end;

procedure DrawSizeGrip(DC: HDC; R: TRect); // dxBar
const
  ROP_DSPDxax = $00E20746;
var
  APrevBitmap, ATempBitmap, AMaskBitmap: HBITMAP;
  TempDC, MDC, MaskDC: HDC;
  W, H: Integer;
  APrevBkColor: COLORREF;
begin
  W := R.Right - R.Left;
  H := R.Bottom - R.Top;
  TempDC := CreateCompatibleDC(DC);
  ATempBitmap := SelectObject(TempDC, CreateCompatibleBitmap(DC, W, H));
  try
    BitBlt(TempDC, 0, 0, W, H, DC, R.Left, R.Top, SRCCOPY); // 1
    MDC := CreateCompatibleDC(DC);
    APrevBitmap := SelectObject(MDC, CreateCompatibleBitmap(DC, W, H));
    DrawFrameControl(MDC, Rect(0, 0, W, H), DFC_SCROLL, DFCS_SCROLLSIZEGRIP); // 2

    MaskDC := CreateCompatibleDC(DC);
    AMaskBitmap := SelectObject(MaskDC, CreateBitmap(W, H, 1, 1, nil));
    try
      APrevBkColor := SetBkColor(MDC, ColorToRGB(clBtnFace)); //!
      BitBlt(MaskDC, 0, 0, W, H, MDC, 0, 0, SRCCOPY);
      SetBkColor(MDC, APrevBkColor);

      BitBlt(TempDC, 0, 0, W, H, MaskDC, 0, 0, MERGEPAINT);
      BitBlt(MDC, 0, 0, W, H, MaskDC, 0, 0, SRCPAINT);
      BitBlt(TempDC, 0, 0, W, H, MDC, 0, 0, SRCAND);
    finally
      DeleteObject(SelectObject(MaskDC, AMaskBitmap));
      DeleteDC(MaskDC);
    end;

    DeleteObject(SelectObject(MDC, APrevBitmap));
    DeleteDC(MDC);

    BitBlt(DC, R.Left, R.Top, W, H, TempDC, 0, 0, SRCCOPY);
  finally
    DeleteObject(SelectObject(TempDC, ATempBitmap));
    DeleteDC(TempDC);
  end;
end;

procedure GenContainerName(APanel: TdxStatusBarPanel; AContainer: TdxStatusBarContainerControl);
var
  I: Integer;
begin
  I := APanel.ID;
  while I <> -1 do
    try
      AContainer.Name := APanel.StatusBarControl.Name + 'Container' + IntTostr(I);
      I := -1;