cxgroupbox.pas

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

    procedure SetAlignment(Value: TcxCaptionAlignment);
    procedure SetCaptionBkColor(Value: TColor); // deprecated
    procedure SetColor(Value: TColor); // deprecated
    procedure SetFont(Value: TFont); // deprecated
    procedure SetPanelStyle(AValue: TcxPanelStyle);
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure WMNCPaint(var Message: TWMNCPaint);
  {$IFNDEF DELPHI7}
    procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
  {$ENDIF}
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    function CanAutoSize: Boolean; override;
    function CanFocusOnClick: Boolean; override;
    function CanHaveTransparentBorder: Boolean; override;

    procedure ContainerStyleChanged(Sender: TObject); override;
    function CreatePanelStyle: TcxPanelStyle; virtual;
    function DefaultParentColor: Boolean; override;
    procedure FontChanged; override;
    function GetShadowBounds: TRect; override;
    procedure Initialize; override;
    function InternalGetActiveStyle: TcxContainerStyle; override;
    function InternalGetNotPublishedStyleValues: TcxEditStyleValues; override;
    function IsContainerClass: Boolean; override;
    function IsNativeBackground: Boolean; override;
    function IsPanelStyle: Boolean;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure Paint; override;
    procedure TextChanged; override;
    function HasShadow: Boolean; override;
    procedure AdjustCanvasFontSettings(ACanvas: TcxCanvas);
    function DoCustomDraw: Boolean;
  {$IFDEF DELPHI7}
    function DoCustomDrawCaption(ACanvas: TcxCanvas; const ABounds: TRect; const APainter: TcxCustomLookAndFeelPainterClass): Boolean; virtual;
    function DoCustomDrawContentBackground(ACanvas: TcxCanvas; const ABounds: TRect; const APainter: TcxCustomLookAndFeelPainterClass): Boolean; virtual;
    procedure DoMeasureCaptionHeight(const APainter: TcxCustomLookAndFeelPainterClass; var ACaptionHeight: Integer);
  {$ENDIF}
    function GetCaptionDrawingFlags: Cardinal;
    function HasNonClientArea: Boolean; virtual;
    function IsNonClientAreaSupported: Boolean; virtual;
    function IsVerticalText: Boolean;
    procedure CalculateCaptionFont;
    procedure WndProc(var Message: TMessage); override;
    property CaptionBkColor: TColor read GetCaptionBkColor write SetCaptionBkColor stored False; // deprecated
    property Color: TColor read GetColor write SetColor stored False; // deprecated
    property Ctl3D;
    property Font: TFont read GetFont write SetFont stored False; // deprecated
    property PanelStyle: TcxPanelStyle read FPanelStyle write SetPanelStyle;
    property ParentBackground;
    property TabStop default False;
    property OnCustomDraw: TcxGroupBoxCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
  {$IFDEF DELPHI7}
    property OnCustomDrawCaption: TcxGroupBoxCustomDrawElementEvent read FOnCustomDrawCaption write FOnCustomDrawCaption;
    property OnCustomDrawContentBackground: TcxGroupBoxCustomDrawElementEvent read FOnCustomDrawContentBackground write FOnCustomDrawContentBackground;
    property OnMeasureCaptionHeight: TcxGroupBoxMeasureCaptionHeightEvent read FOnMeasureCaptionHeight write FOnMeasureCaptionHeight;
  {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property Alignment: TcxCaptionAlignment read FAlignment write SetAlignment
      default alTopLeft;
    property Transparent;
  end;

  { TcxGroupBox }

  TcxGroupBox = class(TcxCustomGroupBox)
  published
    property Align;
    property Alignment;
    property Anchors;
    property BiDiMode;
    property Caption;
    property CaptionBkColor; // deprecated
    property Color; // deprecated
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font; // deprecated
    property LookAndFeel; // deprecated
    property ParentBackground;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property PanelStyle;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnCustomDraw;
  {$IFDEF DELPHI7}
    property OnCustomDrawCaption;
    property OnCustomDrawContentBackground;
  {$ENDIF}
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
  {$IFDEF DELPHI7}
    property OnMeasureCaptionHeight;
  {$ENDIF}
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  { TcxCustomButtonGroup }

  TcxCustomButtonGroup = class(TcxCustomGroupBox)
  private
    FButtons: TList;
    procedure DoButtonDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure DoButtonDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DoButtonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DoButtonKeyPress(Sender: TObject; var Key: Char);
    procedure DoButtonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure DoButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoButtonMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure DoButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoButtonMouseWheel(Sender: TObject;
       Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint; var Handled: Boolean);
    function GetProperties: TcxCustomButtonGroupProperties;
    function GetActiveProperties: TcxCustomButtonGroupProperties;
    procedure SetProperties(Value: TcxCustomButtonGroupProperties);
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged);
      message WM_WINDOWPOSCHANGED;
  protected
    function CanAutoSize: Boolean; override;
    procedure ContainerStyleChanged(Sender: TObject); override;
    procedure CursorChanged; override;
    procedure DoEditKeyDown(var Key: Word; Shift: TShiftState); override;
    procedure EnabledChanged; override;
    procedure Initialize; override;
    function IsButtonDC(ADC: THandle): Boolean; override;
    function IsContainerClass: Boolean; override;
    procedure PropertiesChanged(Sender: TObject); override;
    procedure ReadState(Reader: TReader); override;
    function RefreshContainer(const P: TPoint; Button: TcxMouseButton; Shift: TShiftState;
      AIsMouseEvent: Boolean): Boolean; override;
    procedure CreateHandle; override;
    procedure ArrangeButtons; virtual;
    function GetButtonDC(AButtonIndex: Integer): THandle; virtual; abstract;
    function GetButtonIndexAt(const P: TPoint): Integer;
    function GetButtonInstance: TWinControl; virtual; abstract;
    function GetFocusedButtonIndex: Integer;
    procedure InitButtonInstance(AButton: TWinControl); virtual;
    function IsNonClientAreaSupported: Boolean; override;
    procedure SetButtonCount(Value: Integer); virtual;
    procedure SynchronizeButtonsStyle; virtual;
    procedure UpdateButtons; virtual;
    property InternalButtons: TList read FButtons;
    property TabStop default True;
  public
    destructor Destroy; override;
    procedure ActivateByMouse(Shift: TShiftState; X, Y: Integer;
      var AEditData: TcxCustomEditData); override;
    function Focused: Boolean; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    procedure GetTabOrderList(List: TList); override;
    function IsButtonNativeStyle: Boolean;
    property AutoSize default False;
    property ActiveProperties: TcxCustomButtonGroupProperties
      read GetActiveProperties;
    property Properties: TcxCustomButtonGroupProperties read GetProperties
      write SetProperties;
  end;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  dxThemeConsts, cxEditUtils, Math, Types, dxOffice11, TypInfo, dxThemeManager,
  dxUxTheme, cxDrawTextUtils, cxGeometry;

const
  cxCaptionRectLeftBound = 8;
  cxNativeState: array[Boolean] of Integer = (GBS_DISABLED, GBS_NORMAL);

  WM_DXUPDATENONCLIENTAREA: Cardinal = WM_DX + $10;

type
  TControlAccess = class(TControl);
  TWinControlAccess = class(TWinControl);

function cxGroupBoxAlignment2GroupBoxCaption(AAlignment: TcxCaptionAlignment): TcxGroupBoxCaptionPosition;
begin
  if AAlignment in [alTopLeft, alTopCenter, alTopRight] then
    Result := cxgpTop
  else
  if AAlignment in [alBottomLeft, alBottomCenter, alBottomRight] then
    Result := cxgpBottom
  else
  if AAlignment in [alLeftTop, alLeftCenter, alLeftBottom] then
    Result := cxgpLeft
  else
  if AAlignment in [alRightTop, alRightCenter, alRightBottom] then
    Result := cxgpRight
  else
    Result := cxgpCenter;
end;

{ TcxGroupBoxButtonViewInfo }

function TcxGroupBoxButtonViewInfo.GetGlyphRect(ACanvas: TcxCanvas; AGlyphSize: TSize; AAlignment: TLeftRight; AIsPaintCopy: Boolean): TRect;
begin
  Result.Top := Bounds.Top + (Bounds.Bottom - Bounds.Top - AGlyphSize.cy) div 2;
  Result.Bottom := Result.Top + AGlyphSize.cy;
  if AAlignment = taRightJustify then
  begin
    Result.Left := Bounds.Left;
    Result.Right := Result.Left + AGlyphSize.cx;
  end
  else
  begin
    Result.Right := Bounds.Right;
    Result.Left := Result.Right - AGlyphSize.cx;
  end;
end;

{ TcxGroupBoxViewInfo }

constructor TcxGroupBoxViewInfo.Create;
begin
  inherited Create;
end;

destructor TcxGroupBoxViewInfo.Destroy;
begin
  inherited Destroy;
end;

procedure TcxGroupBoxViewInfo.AdjustCaptionRect(ACaptionPosition: TcxGroupBoxCaptionPosition);
var
  ACaptionHeight: Integer;
begin
  if not Edit.IsVerticalText then
    ACaptionHeight := cxRectHeight(CaptionRect)
  else
    ACaptionHeight := cxRectWidth(CaptionRect);
{$IFDEF DELPHI7}
  Edit.DoMeasureCaptionHeight(Painter, ACaptionHeight);
{$ENDIF}
  case Edit.Alignment of
    alTopLeft, alTopCenter, alTopRight:
      CaptionRect.Bottom := CaptionRect.Top + ACaptionHeight;
    alBottomLeft, alBottomCenter, alBottomRight:
      CaptionRect.Top := CaptionRect.Bottom - ACaptionHeight;
    alLeftTop, alLeftCenter, alLeftBottom:
      CaptionRect.Right := CaptionRect.Left + ACaptionHeight;
    alRightTop, alRightCenter, alRightBottom:
      CaptionRect.Left := CaptionRect.Right - ACaptionHeight;
  end;
end;

procedure TcxGroupBoxViewInfo.DrawCaption(ACanvas: TcxCanvas);

  procedure AdjustRectForBordersNone(var R: TRect);
  var
    ACaptionPos: TcxGroupBoxCaptionPosition;
    ARect: TRect;
  begin
    if (BorderStyle = ebsNone) then
    begin
      ACaptionPos := cxGroupBoxAlignment2GroupBoxCaption(Edit.Alignment);
      case ACaptionPos of
        cxgpTop:
          ACaptionPos := cxgpBottom;
        cxgpBottom:
          ACaptionPos := cxgpTop;
        cxgpLeft:
          ACaptionPos := cxgpRight;
        cxgpRight:
          ACaptionPos := cxgpLeft;
      end;
      ARect := Painter.GroupBoxBorderSize(False, ACaptionPos);
      R := Rect(R.Left - ARect.Left, R.Top - ARect.Top, R.Right + ARect.Right, R.Bottom + ARect.Bottom);
    end;
  end;

var
  ACaptionPos: TcxGroupBoxCaptionPosition;
  ACaptionRect: TRect;
begin
  ACanvas.SaveClipRegion;
  try
    ACanvas.SetClipRegion(TcxRegion.Create(CaptionRect), roIntersect);
    if (Edit.FVisibleCaption = '') {$IFDEF DELPHI7}or Edit.DoCustomDrawCaption(ACanvas, CaptionRect, Painter){$ENDIF} then
      Exit;
    Edit.AdjustCanvasFontSettings(ACanvas);
    if Assigned(Painter) then
    begin
      ACaptionPos := cxGroupBoxAlignment2GroupBoxCaption(Edit.Alignment);
      if not Edit.IsPanelStyle then
      begin
        ACaptionRect := CaptionRect;
        AdjustRectForBordersNone(ACaptionRect);
        Painter.DrawGroupBoxCaption(ACanvas, ACaptionRect, ACaptionPos);
      end;
    end;
    ACanvas.Brush.Style := bsClear;
    if not Edit.IsVerticalText then
      DrawHorizontalTextCaption(ACanvas)
    else
      DrawVerticalTextCaption(ACanvas);
  finally
    ACanvas.RestoreClipRegion;
  end;
end;

function TcxGroupBoxViewInfo.GetButtonViewInfoClass: TcxEditButtonViewInfoClass;
begin
  Result := TcxGroupBoxButtonViewInfo;
end;

procedure TcxGroupBoxViewInfo.InternalPaint(ACanvas: TcxCanvas);
begin
  if IsInplace then
  begin
    if Edit = nil then
      inherited InternalPaint(ACanvas)
    else
      if IsCustomBackground then
        DrawBackground(ACanvas)
      else
        cxEditFillRect(ACanvas, Bounds, BackgroundColor);
    Exit;
  end;