fcbuttongroup.pas

一套及时通讯的原码

unit fcButtonGroup;
{
//
// Components : TfcButtonGroup
//
// Copyright (c) 1999 by Woll2Woll Software
//
// 5/13/99 - RSW - When transparent, paint should also paint the button area
// 3/24/2000 - PYW - Need to check both Horizontal and Vertical
// 9/5/00 - Index based on visible buttons only
}

interface

{$i fcIfDef.pas}

uses
  Windows, Messages, SysUtils, Classes, TypInfo, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Math, fcChangeLink,
  fcButton, fcClearPanel, fcCommon, fcShapeBtn, fcImgBtn, fcCollection;

type
  TfcButtonGroupItem = class;
  TfcButtonGroupItems = class;
  TfcCustomButtonGroup = class;
  TfcButtonGroupItemClass = class of TfcButtonGroupItem;
  TfcButtonGroupItemsClass = class of TfcButtonGroupItems;
{
// - TfcButtonGroupItem
//
// Properties:
// - GroupIndex: Wrapper to GroupIndex property of the Item's control.
//               This property is dependent on the GroupIndexPropName
//               property of TfcButtonGroupItems.
//
// - Selected:   Wrapper to the property of the the Item's property that
//               signifies selection.  This is usually the "Down" property.
//
// - PointerTag: The pointer equivalent to the Tag property.  (Yes, the
//               Tag property can be used for this purpose also, but that
//               looks really ugly in code.
//
// - Tag:        The standard Tag property.
//
// - Control:    The "Control" of the control group.  The type of this
//               component is determined by the ControlClass property of
//               the control group.  This property can NOT be published
//               or Delphi's IDE will mistake the ButtonGroup for a form
//               and generate errors.
}

  TfcButtonGroupItem = class(TfcCollectionItem)
  private
    // Property storage variables
    FButton: TfcCustomBitBtn;

    // Property access methods
    function GetButtonGroup: TfcCustomButtonGroup; virtual;
    function GetGroupIndex: Integer; virtual;
    function GetSelected: Boolean; virtual;
    procedure SetGroupIndex(Value: Integer); virtual;
    procedure SetSelected(Value: Boolean); virtual;
  protected
    // Virtual Methods
    function GetDisplayName: string; override;
    procedure Loaded; virtual;
    procedure SetIndex(Value: Integer); override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    function GetInstance(const PropertyName: string): TPersistent; override;

    property Button: TfcCustomBitBtn read FButton;
    property ButtonGroup: TfcCustomButtonGroup read GetButtonGroup;
    property GroupIndex: Integer read GetGroupIndex write SetGroupIndex;
    property Selected: Boolean read GetSelected write SetSelected;
  end;

{
// - TfcButtonGroupItems
// Properties:
// - Items:       The indexed array property that returns the
//                TfcButtonGroupItem corresponding to the Index
//                parameter.
//
// - Selected:    Returns the control that currently has its "Selected"
//                property set to true.  If none, then returns nil.
//
// Methods:
// - Add:         Adds a new item to the control group and returns the newly
//                created item.
//
// - Clear:       Deletes all of the items in the TfcButtonGroupItems array
//                and each of the associated Controls.
//
// - FindControl: Searches through the array of TfcButtonGroupItems and
//                returns the item that has its Control property pointing
//                to the AControl parameter.
//
// - FindPointerTag: Searches through the array of TfcButtonGroupItems
//                and returns the item that has its PointerTag property
//                pointing to the APointerTag parameter.
}

  TfcButtonGroupItems = class(TfcCollection)
  private
    FButtonGroup: TfcCustomButtonGroup;
  protected
    // Overriden methods
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;

    // Property access methods
    function GetButtonGroup: TfcCustomButtonGroup; virtual;
    function GetItems(Index: Integer): TfcButtonGroupItem;
    function GetVisibleCount: Integer;
    function GetVisibleItems(Index: Integer): TfcButtonGroupItem;
  public
    ArrangingControls: Boolean;
    AddingControls: Boolean;
    DeletingControl: Boolean;

    constructor Create(AButtonGroup: TfcCustomButtonGroup; ACollectionItemClass: TfcButtonGroupItemClass); virtual;

    function Add: TfcButtonGroupItem;
//    function AddInLoading: TfcButtonGroupItem; { RSW - Don't check loading state }
    function AddItem: TfcCollectionItem; override;
    procedure ArrangeControls; virtual;
    function FindButton(AButton: TfcCustomBitBtn): TfcButtonGroupItem; virtual;
    function FindPointerTag(APointerTag: Pointer): TfcButtonGroupItem; virtual;

    procedure Clear; virtual;

    property ButtonGroup: TfcCustomButtonGroup read GetButtonGroup;
    property Items[Index: Integer]: TfcButtonGroupItem read GetItems {stored False}; default;
    property VisibleCount: Integer read GetVisibleCount;
    property VisibleItems[Index: Integer]: TfcButtonGroupItem read GetVisibleItems;
  end;

  TfcButtonGroupChangeEvent = procedure(ButtonGroup: TfcCustomButtonGroup;
    OldSelected, Selected: TfcButtonGroupItem) of object;

{
// - TfcCustomButtonGroup
// Properties:
// - ControlSpacing: The spacing between each of the controls.  This does
//                   not include spacing on the outer edge; for that use
//                   the standard BorderWidth property.
//
// - Columns:        This effect of this property is dependent on the
//                   Layout property.  If Layout is vertical (the default),
//                   then this property specifies the number of columns;
//                   otherwise it specifies the number of rows.
//
// - Items:          The TfcButtonGroupItems array property.
//
// - Layout:         Determines the orientation of the controls -- how they
//                   are arranged.  If this property is set to cglVertical,
//                   then controls arranged in a top-down, left-to-right
//                   fashion.  Otherwise, they are arranged in a left-to-
//                   right, top-down fashion.
//
// - MaxControlSize: Normally, controls are sized to take the maximum amount
//                   of space available given the size of the control group.
//                   This property allows the user to specify the maximum size
//                   of a button. (For example, the buttons on the Win95 Task
//                   Bar can only be a maximum of ~150 pixels.
//
// Events:
// - OnChange:             Occurs immediately after the currently selected
//                         control has changed.
//
// - OnChanging:           Occurs immediately before the currently
//                         selected control changes.
}

  TfcButtonGroupClickStyle = (bcsCheckList, bcsRadioGroup, bcsClick);

  TfcCustomButtonGroup = class(TfcCustomTransparentPanel)
  private
    // Property storage variables
    FAutoBold: Boolean;
    FClickStyle: TfcButtonGroupClickStyle;
    FControlSpacing: Integer;
    FColumns: Integer;
    FLayout: TfcLayout;
    FMaxControlSize: Integer;
    FOldSelected: TfcButtonGroupItem;
    FOnChange: TfcButtonGroupChangeEvent;
    FOnChanging: TfcButtonGroupChangeEvent;

    FButtonClass: TfcCustomBitBtnClass;
    FLastButtonRect: TRect;
    FChangeLink: TfcChangeLink;
    FShowDownAsUp:boolean;
    FDisableThemes: boolean;

    // Property Access Methods
    function GetButton(Name: string): TfcCustomBitBtn;
    function GetSelected: TfcButtonGroupItem; virtual;
    procedure SetAutoBold(Value: Boolean);
    procedure SetClickStyle(Value: TfcButtonGroupClickStyle);
    procedure SetControlSpacing(Value: Integer);
    procedure SetColumns(Value: Integer);
    procedure SetItems(Value: TfcButtonGroupItems);
    procedure SetLastButtonRect(Value: TRect);
    procedure SetLayout(Value: TfcLayout);
    procedure SetSelected(Value: TfcButtonGroupItem);

    // Message Handlers
    {$ifdef fcDelphi4Up}
    procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED;
    {$endif}
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
    procedure CMControlListChange(var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure SetShowDownAsUp(Value: boolean);
  protected
    SuspendNotification: Boolean;  // Flag to prevent access violations on notification method
    FItems: TfcButtonGroupItems;

    function GetCollectionClass: TfcButtonGroupItemsClass; virtual;
    function ResizeToControl(Control: TControl; DoResize: Boolean): TSize; virtual;
    procedure ButtonPressed(Sender: TObject); virtual;
    procedure ButtonPressing(Sender: TObject); virtual;
    procedure MouseMoveInLoop(Sender: TObject); virtual;
    procedure DoChanging(OldSelected, Selected: TfcButtonGroupItem); virtual;
    procedure DoChange(OldSelected, Selected: TfcButtonGroupItem); virtual;

    // Overridden methods
    function GetChildOwner: TComponent; override;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    procedure Resize; override;
    procedure WriteState(Writer: TWriter); override;

    // Virtual Property access methods
    procedure SetName(const NewName: TComponentName); override;

    function GetButtonClassName: string; virtual;
    procedure SetButtonClass(Value: TfcCustomBitBtnClass); virtual;
    procedure SetButtonClassName(Value: string); virtual;
    procedure SetMaxControlSize(Value: Integer); virtual;
    procedure UpdateBold(AAutoBold: Boolean); virtual;
    procedure DefineProperties(Filer: TFiler);override;
    function IsTransparent: boolean; override;
    procedure WndProc(var Message: TMessage); override;

    property ButtonClass: TfcCustomBitBtnClass read FButtonClass write SetButtonClass;
    property OldSelected: TfcButtonGroupItem read FOldSelected;
  public
    ButtonGroupPatch: Variant;
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;

//    function ControlSelected: Boolean; virtual;

    property AutoBold: Boolean read FAutoBold write SetAutoBold;
    property Buttons[Name: string]: TfcCustomBitBtn read GetButton;
    property ClickStyle: TfcButtonGroupClickStyle read FClickStyle write SetClickStyle;
    property ControlSpacing: Integer read FControlSpacing write SetControlSpacing;
    property Columns: Integer read FColumns write SetColumns;
    property ButtonItems: TfcButtonGroupItems read FItems write SetItems stored False;
    property Layout: TfcLayout read FLayout write SetLayout;
    property MaxControlSize: Integer read FMaxControlSize write SetMaxControlSize;
    property ShowDownAsUp: boolean read FShowDownAsUp write SetShowDownAsUp default False;
    property Selected: TfcButtonGroupItem read GetSelected write SetSelected;
    property OnChange: TfcButtonGroupChangeEvent read FOnChange write FOnChange;
    property OnChanging: TfcButtonGroupChangeEvent read FOnChanging write FOnChanging;

    property ButtonClassName: string read GetButtonClassName write SetButtonClassName;
    property LastButtonRect: TRect write SetLastButtonRect;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  end;

  TfcButtonGroup = class(TfcCustomButtonGroup)
  published
    property DisableThemes;

    {$ifdef fcDelphi4Up}
    property Anchors;
    property Constraints;
    {$endif}

    property Align;
    property AutoBold;
    property BevelInner;
    property BevelOuter;
    property BorderStyle;
    property BorderWidth;
    property ButtonClassName;
    property ClickStyle;
    property ControlSpacing;
    property Columns;
    property Color;
    property Font;
    property ParentFont;
    property ButtonItems;
    property Layout;
    property MaxControlSize;
    property PopupMenu;
    property ShowDownAsUp;
    property TabOrder;
    property TabStop default True;
    property Transparent;
    property Visible;

    property OnChange;
    property OnChanging;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;

implementation

//{$ifdef fcDelphi4Up}
//type TFormDesigner = IFormDesigner;
//{$endif}

// TfcButtonGroupItem

constructor TfcButtonGroupItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  if not (csLoading in ButtonGroup.ComponentState) then
  begin
    ButtonGroup.FItems.ArrangingControls := True;
    FButton := ButtonGroup.ButtonClass.Create(ButtonGroup.Owner);
    FButton.Top := ButtonGroup.Height;
    FButton.Parent := ButtonGroup;
    FButton.ShowDownAsUp := ButtonGroup.ShowDownAsUp;
    SetGroupIndex(1);
    ButtonGroup.FItems.ArrangingControls := False;
  end
  else begin
    if Button<>nil then Button.ShowDownAsUp := ButtonGroup.ShowDownAsUp;
  end;
end;

destructor TfcButtonGroupItem.Destroy;
begin
  ButtonGroup.SuspendNotification := True;
  ButtonGroup.FItems.DeletingControl := True;
  FButton.Free;
  ButtonGroup.FItems.DeletingControl := False;
  ButtonGroup.SuspendNotification := False;
  inherited;
end;

function TfcButtonGroupItem.GetButtonGroup: TfcCustomButtonGroup;
begin
  result := TfcButtonGroupItems(Collection).ButtonGroup;
end;

function TfcButtonGroupItem.GetGroupIndex: Integer;
begin
  result := Button.GroupIndex;
end;

function TfcButtonGroupItem.GetSelected: Boolean;
begin
  if Button=nil then result:= false  { Delphi 5 calls GetActivePage before button is initialized }
  else result := Button.Selected;
end;

procedure TfcButtonGroupItem.SetGroupIndex(Value: Integer);
begin
  Button.GroupIndex := Value;
end;

procedure TfcButtonGroupItem.SetSelected(Value: Boolean);
//var ParForm: TCustomForm;
begin
  Button.Down := Value;
  ButtonGroup.FItems.ArrangeControls;