fcbuttongroup.pas

一套及时通讯的原码

{  if csDesigning in ButtonGroup.ComponentState then
  begin
    ParForm := GetParentForm(ButtonGroup);
    if (ParForm <> nil) and (ParForm.Designer <> nil) then
      ParForm.Designer.Modified;
  end;}
end;

procedure TfcButtonGroupItem.Loaded;
begin
  FButton.OnSetName := SetButtonName;
  FButton.ShowDownAsUp := ButtonGroup.ShowDownAsUp;
end;

procedure TfcButtonGroupItem.SetIndex(Value: Integer);
begin
  inherited;
//  ShowMessage(Button.Name + '|' + InttoStr(Value));
  if not (csLoading in ButtonGroup.ComponentState) then ButtonGroup.SetChildOrder(Button, Value);
end;

function TfcButtonGroupItem.GetDisplayName: string;
begin
  if Button <> nil then result := Button.Name;
end;

function TfcButtonGroupItem.GetInstance(const PropertyName: string): TPersistent;
begin
  result := Button;
end;

// TfcButtonGroupItems

constructor TfcButtonGroupItems.Create(AButtonGroup: TfcCustomButtonGroup; ACollectionItemClass: TfcButtonGroupItemClass);
begin
  inherited Create(ACollectionItemClass);
  FButtonGroup := AButtonGroup;
end;

function TfcButtonGroupItems.GetOwner: TPersistent;
begin
  result := FButtonGroup;
end;

procedure TfcButtonGroupItems.Update(Item: TCollectionItem);
begin
  inherited;
  ArrangeControls;
end;

function TfcButtonGroupItems.GetButtonGroup: TfcCustomButtonGroup;
begin
  result := FButtonGroup;
end;

function TfcButtonGroupItems.GetItems(Index: Integer): TfcButtonGroupItem;
begin
  result := TfcButtonGroupItem(inherited Items[Index]);
end;

function TfcButtonGroupItems.GetVisibleCount: Integer;
var i: Integer;
begin
  result := 0;
  for i := 0 to Count - 1 do if Items[i].Button.Visible or (csDesigning in ButtonGroup.ComponentState) then inc(result);
end;

function TfcButtonGroupItems.GetVisibleItems(Index: Integer): TfcButtonGroupItem;
var i: Integer;
    CurIndex: Integer;
begin
  result := nil;
  CurIndex := 0;
  for i := 0 to Count - 1 do if Items[i].Button.Visible or (csDesigning in ButtonGroup.ComponentState) then
  begin
    if Index = CurIndex then
    begin
      result := Items[i];
      Break;
    end;
    inc(CurIndex);
  end;
end;

function TfcButtonGroupItems.Add: TfcButtonGroupItem;
  function GetHighestGroupIndex: Integer;
  var i: Integer;
  begin
    result := 0;
    for i := 0 to Count - 1 do
      if Items[i].GroupIndex > result then result := Items[i].GroupIndex;
  end;
begin
  AddingControls := True;
  result := TfcButtonGroupItem(inherited Add);
  if (result.Button <> nil) then
  begin
    if (csDesigning in ButtonGroup.ComponentState) then
      result.Button.Name := fcGenerateName(result.Button.Owner, ButtonGroup.Name + Copy(ButtonGroup.ButtonClassName, 2, Length(ButtonGroup.ButtonClassName)));
    if Count > 1 then result.Button.Assign(Items[0].Button);
    if ButtonGroup.ClickStyle = bcsCheckList then
    begin
      result.Button.GroupIndex := GetHighestGroupIndex + 1;
      result.Button.AllowAllUp := True;
    end;
  end;
  AddingControls := False;
  ArrangeControls;
end;

function TfcButtonGroupItems.AddItem: TfcCollectionItem;
begin
  result := Add;
end;

procedure TfcButtonGroupItems.Clear;
var i: Integer;
begin
  for i := Count - 1 downto 0 do
    Items[i].Free;
end;

procedure TfcButtonGroupItems.ArrangeControls;
var i: Integer;
    Rows, Cols: Integer;
    BtnWidth, BtnHeight: Integer;
    RemainHeight, RemainWidth, PadHeight, PadWidth: Integer;
    ExtraRows, ExtraCols: Integer;
    ButtonGroupWidth, ButtonGroupHeight: Integer;
    NewLeft, NewTop, NewWidth, NewHeight: Integer;
    BtnSpacing: Integer;
    OldTransparent: Boolean;
  function Coord: TPoint;
  begin
    if ButtonGroup.Layout = loVertical then
    begin
      // Caculate Column
      if i <= ExtraRows * (Rows + 1) then
        result.x := (i - 1) div (Rows + 1)
      else
        result.x := ExtraRows +
          (((i - 1) - (ExtraRows * (Rows + 1))) div Rows);
      // Calculate Row
      if i <= ExtraRows * (Rows + 1) then
        result.y := (i - 1) mod (Rows + 1)
      else
        result.y := ((i - 1) - (ExtraRows * (Rows + 1))) mod Rows;
    end else begin
      result := Point(
        (i - 1) div Rows,
        (i - 1) mod Rows)
    end;
  end;
  function ControlAtCoord(x, y: Integer): TControl;
  var Index, i: Integer;
  begin
    if ButtonGroup.Layout = loVertical then
    begin
      if x < ExtraRows then
        Index := (x * (Rows + 1)) + (y mod (Rows + 1))
      else
        Index := ((ExtraRows * (Rows + 1)) + ((x - ExtraRows) * Rows)) + (y mod Rows);

      // 9/5/00 - Index based on visible buttons only
      for i:= 0 to Index do
      begin
         if not Items[i].Button.visible then Index:= Index+1;
      end;
      result:= Items[Index].Button;
    end else begin
      result := Items[x * Rows + y].Button;
    end;
  end;
  function GetRows: Integer;
  begin
    result := Rows + ord(ExtraRows > 0);
  end;
  function GetCols: Integer;
  begin
    result := Cols + ord(ExtraCols > 0);
  end;
begin
  if (Count = 0) or (ArrangingControls) or AddingControls then Exit;
  ArrangingControls := True;
  OldTransparent := ButtonGroup.FTransparent;
  ButtonGroup.FTransparent := False;

  BtnSpacing := ButtonGroup.ControlSpacing;

  PadHeight := 0; RemainHeight := 0;
  PadWidth := 0; RemainWidth := 0;

  Rows := Count div ButtonGroup.Columns;
  Cols := ButtonGroup.Columns;
  ExtraRows := Count mod ButtonGroup.Columns;
  ExtraCols := 0;
  if ButtonGroup.Layout <> loVertical then
    with Rect(Rows, Cols, ExtraRows, ExtraCols) do
    begin
      Rows := Top;
      Cols := Left;
      ExtraRows := Bottom;
      ExtraCols := Right;
    end;

  ButtonGroupWidth := fcRectWidth(ButtonGroup.ClientRect) - 2 * ButtonGroup.BorderWidth;
  ButtonGroupHeight := fcRectHeight(ButtonGroup.ClientRect) - 2 * ButtonGroup.BorderWidth;

  BtnWidth := (ButtonGroupWidth - (BtnSpacing * (GetCols - 1))) div GetCols;
  BtnHeight := (ButtonGroupHeight - (BtnSpacing * (GetRows - 1))) div GetRows;
  if ButtonGroup.MaxControlSize > 0 then
  begin
    if ButtonGroup.Layout = loVertical then
      BtnHeight := fcMin(BtnHeight, ButtonGroup.MaxControlSize)
    else BtnWidth := fcMin(BtnWidth, ButtonGroup.MaxControlSize);
  end;
  // 3/24/2000 - PYW - Need to check both Horizontal and Vertical
  if ((ButtonGroup.Layout=loHorizontal) and (BtnWidth <> ButtonGroup.MaxControlSize)) or
     ((ButtonGroup.Layout=loVertical) and (BtnHeight <> ButtonGroup.MaxControlSize)) then begin
    RemainHeight := ButtonGroupHeight - ((GetRows * BtnHeight) + ((GetRows - 1) * BtnSpacing));
    PadHeight := Ceil(RemainHeight / GetRows);
    RemainWidth := ButtonGroupWidth - ((GetCols * BtnWidth) + ((GetCols - 1) * BtnSpacing));
    PadWidth := Ceil(RemainWidth / GetCols);
  end;

  for i := 1 to VisibleCount do with VisibleItems[i - 1].Button do
  begin
    with Coord do
    begin
      // Calc Left
      if (x = 0) and (y = 0) then NewLeft := ButtonGroup.BorderWidth
      else if y = 0 then NewLeft := ControlAtCoord(x - 1, y).BoundsRect.Right + BtnSpacing
      else NewLeft := ControlAtCoord(x, y - 1).Left;

      // Calc Top
      if y = 0 then NewTop := ButtonGroup.BorderWidth
      else NewTop := ControlAtCoord(x, y - 1).BoundsRect.Bottom + BtnSpacing;

      // Calc Width
      if y = 0 then
      begin
        NewWidth := BtnWidth + fcMin(PadWidth, RemainWidth);
        dec(RemainWidth, PadWidth);
        if RemainWidth < 0 then RemainWidth := 0;
      end else NewWidth := ControlAtCoord(x, y - 1).Width;

      // Calc Height
      if x = 0 then
      begin
        NewHeight := BtnHeight + fcMin(PadHeight, RemainHeight);
        dec(RemainHeight, PadHeight);
        if RemainHeight < 0 then RemainHeight := 0;
      end else NewHeight := ControlAtCoord(x - 1, y).Height;

      SetBounds(NewLeft, NewTop, NewWidth, NewHeight)
//      SetWindowPos(Handle, 0, NewLeft, NewTop, NewWidth, NewHeight, SWP_NOREDRAW or SWP_NOZORDER);
    end;
  end;
//  ButtonGroup.Invalidate;
  ButtonGroup.FTransparent := OldTransparent;
  ArrangingControls := False;
end;

function TfcButtonGroupItems.FindButton(AButton: TfcCustomBitBtn): TfcButtonGroupItem;
var i: Integer;
begin
  result := nil;
  for i := 0 to Count - 1 do
    if Items[i].Button = AButton then
    begin
      result := Items[i];
      Break;
    end;
end;

function TfcButtonGroupItems.FindPointerTag(APointerTag: Pointer): TfcButtonGroupItem;
var i: Integer;
begin
  result := nil;
  for i := 0 to Count - 1 do
    if Items[i].PointerTag = APointerTag then
    begin
      result := Items[i];
      Break;
    end;
end;

// TfcCustomButtonGroup

constructor TfcCustomButtonGroup.Create(Owner: TComponent);
begin
  inherited;

  FButtonClass := TfcShapeBtn;

  FAutoBold := True;
  FItems := GetCollectionClass.Create(self, TfcButtonGroupItem);
  FItems.ArrangingControls := True;
  FClickStyle := bcsRadioGroup;
  FColumns := 1;
  FControlSpacing := 1;

  FChangeLink := TfcChangeLink.Create;
  FChangeLink.OnChange := ButtonPressed;
  FChangeLink.OnChanging := ButtonPressing;

  BevelInner := bvNone;
  BevelOuter := bvNone;
  ControlStyle := ControlStyle - [csSetCaption{, csAcceptsControls}];
  Height := 100;
  TabStop := True;
  Transparent := False;
  Width := 75;
end;

destructor TfcCustomButtonGroup.Destroy;
begin
  FItems.ArrangingControls := True;
  FChangeLink.Free;
  FItems.Free;
  FItems := nil;
  inherited;
end;

{function TfcCustomButtonGroup.ControlSelected: Boolean;
var i: Integer;
    Selections: TComponentList;
begin
  result := False;
  Selections := TComponentList.Create;
  TFormDesigner(GetParentForm(self).Designer).GetSelections(Selections);
  for i := 0 to Selections.Count - 1 do
    if (Selections[i] is ButtonClass) and
       ((Selections[i] as ButtonClass).Parent = self) then
    begin
      result := True;
      Exit;
    end;
end;
}

procedure TfcCustomButtonGroup.UpdateBold(AAutoBold: Boolean);
var i: Integer;
begin
  if not AAutoBold then Exit;
  for i := 0 to FItems.Count - 1 do with FItems[i].Button.Font do
    Style := Style - [fsBold];
  if (Selected <> nil) and AutoBold and (ClickStyle = bcsRadioGroup) then with Selected.Button.Font do
    Style := Style + [fsBold];
end;

{$ifdef fcDelphi4Up}
procedure TfcCustomButtonGroup.CMBorderChanged(var Message: TMessage);
begin
  inherited;
  FItems.ArrangeControls;
end;
{$endif}

procedure TfcCustomButtonGroup.CMControlListChange(var Message: TCMControlListChange);
var i: Integer;
begin
  if (Message.Control is TfcCustomBitBtn) then with (Message.Control as TfcCustomBitBtn) do
  begin
    if Message.Inserting then RegisterChanges(FChangeLink)
    else UnRegisterChanges(FChangeLink);
  end;

  if (FItems <> nil) and not SuspendNotification and not (Message.Inserting) then
    for i := 0 to FItems.Count - 1 do
      if FItems[i].Button = Message.Control then
      begin
        FItems.DeletingControl := True;
        FItems[i].FButton := nil;  // Prevent access violations, otherwise random memory would be attempted to be freed in the destructor of the item
        FItems[i].Free;
        FItems.DeletingControl := False;
        Invalidate;
        Break;
      end;

  inherited;
end;

procedure TfcCustomButtonGroup.CMControlChange(var Message: TCMControlChange);
var curItem: TfcButtonGroupItem;
begin
  inherited;
  if Message.Inserting and (Message.Control is TfcCustomBitBtn) and