fcbuttongroup.pas

一套及时通讯的原码

     (csLoading in ComponentState) and not FItems.AddingControls then
  begin
     curItem:= ButtonItems.Add;

     with curItem do begin
       FItems.AddingControls := True;
       FButton := Message.Control as TfcCustomBitBtn;
       FItems.AddingControls := False;
     end
  end;
end;

procedure TfcCustomButtonGroup.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.result := DLGC_WANTARROWS;
end;

function TfcCustomButtonGroup.GetCollectionClass: TfcButtonGroupItemsClass;
begin
  result := TfcButtonGroupItems;
end;

procedure TfcCustomButtonGroup.ButtonPressing(Sender: TObject);
  function CalcSelected: TfcButtonGroupItem;
  var i: Integer;
  begin
    result := FOldSelected;
    for i := 0 to FItems.Count - 1 do
      if FItems[i].Selected then
      begin
        result := FItems[i];
        Break;
      end;
  end;
begin
  if not (csLoading in ComponentState) then
  begin
    FOldSelected := CalcSelected;
    DoChanging(FOldSelected, FItems.FindButton(Sender as TfcCustomBitBtn));
  end;
end;

procedure TfcCustomButtonGroup.MouseMoveInLoop(Sender: TObject);
var i: Integer;
begin
  for i := 0 to FItems.Count - 1 do
    if FItems[i].Button <> Sender then Perform(CM_MOUSELEAVE, 0, 0);
end;

procedure TfcCustomButtonGroup.ButtonPressed(Sender: TObject);
var NewSelected: TfcButtonGroupItem;
begin
  if not (csLoading in ComponentState) then
  begin
    NewSelected := FItems.FindButton(Sender as TfcCustomBitBtn);
    if (Sender as TfcCustombitBtn).Selected then
    begin
      FItems.ArrangeControls;
      UpdateBold(AutoBold);
      if FOldSelected <> NewSelected then DoChange(FOldSelected, NewSelected);
    end;
  end;
end;

procedure TfcCustomButtonGroup.DoChanging(OldSelected, Selected: TfcButtonGroupItem);
begin
  if Assigned(FOnChanging) then FOnChanging(self, OldSelected, Selected);
end;

procedure TfcCustomButtonGroup.DoChange(OldSelected, Selected: TfcButtonGroupItem);
begin
  if Assigned(FOnChange) then FOnChange(self, OldSelected, Selected);
end;

function TfcCustomButtonGroup.ResizeToControl(Control: TControl; DoResize: Boolean): TSize;
begin
  if FItems.Count = 0 then Exit;
  if Control = nil then Control := FItems[0].Button;
  if Control = nil then Exit;

  if Layout = loVertical then
  begin
    result.cx := ((Control.Width + ControlSpacing) * Columns);
    result.cy := (Control.Height + ControlSpacing) * Ceil(FItems.Count/Columns); { 10/24/99 - RSW - Changed div to / }
  end else begin
    result.cx := (Control.Width + ControlSpacing) * Ceil(FItems.Count/Columns);
    result.cy := ((Control.Height + ControlSpacing) * Columns);
  end;
  dec(result.cx, ControlSpacing);
  dec(result.cy, ControlSpacing);
  if DoResize then
  begin
    Width := result.cx;
    Height := result.cy;
  end;
end;

function TfcCustomButtonGroup.GetButtonClassName: string;
begin
  result := ButtonClass.ClassName;
end;

function TfcCustomButtonGroup.GetSelected: TfcButtonGroupItem;
var i: Integer;
begin
  result := nil;
  for i := 0 to FItems.Count - 1 do
    if FItems[i].Selected then
    begin
      result := FItems[i];
      break;
    end;
end;

procedure TfcCustomButtonGroup.SetButtonClass(Value: TfcCustomBitBtnClass);
begin
  if FButtonClass <> Value then
  begin
    FButtonClass := Value;
    if not (csLoading in ComponentState) then
    begin
      FItems.BeginUpdate;
      FItems.Clear;
      FItems.EndUpdate;
    end;
    if FItems.Designer <> nil then FItems.Designer.Update;
  end;
end;

procedure TfcCustomButtonGroup.SetButtonClassName(Value: string);
begin
  if (csLoading in ComponentState) or not (csDesigning in ComponentState) or
     (FItems.Count = 0) or
     ((FItems.Count > 0) and (MessageDlg('Setting this property will clear your items. Continue?',
     mtConfirmation, [mbYes, mbNo], 0) = mrYes)) then
    ButtonClass := TfcCustomBitBtnClass(FindClass(Value));
end;

procedure TfcCustomButtonGroup.SetMaxControlSize(Value: Integer);
begin
  if FMaxControlSize <> Value then
  begin
    FMaxControlSize := Value;
    FItems.ArrangeControls;
  end;
end;

procedure TfcCustomButtonGroup.SetLastButtonRect(Value: TRect);
begin
  if not IsRectEmpty(FLastButtonRect) and (Parent <> nil) then
  begin
    OffsetRect(FLastButtonRect, Left, Top);
    InflateRect(FLastButtonRect, 3, 3);
    InvalidateRect(Parent.Handle, @FLastButtonRect, True);
  end;
  FLastButtonRect := Value;
end;

procedure TfcCustomButtonGroup.SetItems(Value: TfcButtonGroupItems);
begin
  FItems.Assign(Value);
end;

procedure TfcCustomButtonGroup.SetLayout(Value: TfcLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    if not (csLoading in ComponentState) then
      FItems.ArrangeControls;
  end;
end;

procedure TfcCustomButtonGroup.SetShowDownAsUp(Value: boolean);
var i:integer;
begin
   if FShowDownAsUp <> Value then
   begin
      FShowDownAsUp := Value;
      for i:= 0 to Buttonitems.count-1 do begin
         ButtonItems[i].Button.ShowDownAsUp := Value;
      end;
   end;
end;

procedure TfcCustomButtonGroup.SetSelected(Value: TfcButtonGroupItem);
begin
  if Value <> nil then Value.Selected := True;
end;

function TfcCustomButtonGroup.GetButton(Name: string): TfcCustomBitBtn;
begin
            //8/5/99- PYW- Check the owner for the button control.
  result := Owner.FindComponent(Name) as TfcCustomBitBtn;
end;

procedure TfcCustomButtonGroup.SetAutoBold(Value: Boolean);
begin
  if FAutoBold <> Value then
  begin
    FAutoBold := Value;
    UpdateBold(True);
  end;
end;

procedure TfcCustomButtonGroup.SetClickStyle(Value: TfcButtonGroupClickStyle);
var i: Integer;
begin
  if FClickStyle <> Value then
  begin
    FClickStyle := Value;
    for i := 0 to FItems.Count - 1 do with FItems[i].Button do
    begin
      case FClickStyle of
        bcsCheckList: begin
          GroupIndex := i + 1;
          AllowAllUp := True;
        end;
        bcsRadioGroup: begin
          GroupIndex := 1;
          AllowAllUp := False;
        end;
        bcsClick: begin
          GroupIndex := 0;
          AllowAllUp := False;
        end;
      end;
    end;
//    if (Items.Count > 0) and (FClickStyle = bcsRadioGroup) then Items[0].Selected := True;
  end;
end;

procedure TfcCustomButtonGroup.SetControlSpacing(Value: Integer);
begin
  if FControlSpacing <> Value then
  begin
    FControlSpacing := Value;
    FItems.ArrangeControls;
  end;
end;

procedure TfcCustomButtonGroup.SetColumns(Value: Integer);
begin
  if FColumns <> Value then
  begin
    if Value < 0 then Exit;
    FColumns := Value;
    if not (csLoading in ComponentState) then
      FItems.ArrangeControls;
  end;
end;

procedure TfcCustomButtonGroup.SetName(const NewName: TComponentName);
var i: Integer;
begin
  for i := 0 to FItems.Count - 1 do
  begin
    if (Copy(FItems[i].Button.Name, 1, Length(Name)) = Name) and (Name <> '') and (csDesigning in ComponentState) then
      FItems[i].Button.Name := NewName + fcSubstring(FItems[i].Button.Name, Length(Name) + 1, 0);
  end;
  inherited;
end;

function TfcCustomButtonGroup.GetChildOwner: TComponent;
begin
  result := inherited GetChildOwner;
end;

procedure TfcCustomButtonGroup.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited;
  if FItems.DeletingControl then Exit;
  if (not FItems.AddingControls) and (not FItems.ArrangingControls) and
     not (csLoading in ComponentState) then
    if (AControl <> nil) and (AControl is ButtonClass) then ResizeToControl(AControl, True);
  if (not FItems.ArrangingControls) and not FItems.DeletingControl and (AControl is TfcCustomBitBtn) then
    FItems.ArrangeControls;
end;

procedure TfcCustomButtonGroup.KeyDown(var Key: Word; Shift: TShiftState);
var NextIndex: Integer;
begin
  inherited;
  if Key in [VK_RIGHT, VK_DOWN, VK_LEFT, VK_UP, VK_HOME, VK_END] then
  begin
    NextIndex := 0;
    if Selected <> nil then
      case Key of
        VK_RIGHT, VK_DOWN: NextIndex := Selected.Index + 1;
        VK_LEFT, VK_UP: NextIndex := Selected.Index - 1;
        VK_HOME: NextIndex := 0;
        VK_END: NextIndex := FItems.Count - 1;
      end;
    if NextIndex < 0 then NextIndex := FItems.Count - 1
    else if NextIndex >= FItems.Count then NextIndex := 0;
    FItems[NextIndex].Selected := True;
  end;
end;

procedure TfcCustomButtonGroup.Loaded;
var i, j: Integer;
begin
  inherited;
  for i := 0 to ControlCount - 1 do if Controls[i] is TWinControl then
    if Controls[i] is ButtonClass then
      for j := 0 to FItems.Count - 1 do begin
        if FItems[j].Button = nil then
        begin
          FItems[j].FButton := Controls[i] as TfcCustomBitBtn;
          Break;
        end;
        FItems[j].Button.ShowDownAsUp := ShowDownAsUp;
      end;

  FItems.ArrangingControls := False;
  FItems.ArrangeControls; // Make sure controls are arranged in case it skipped arrangecontrols earlier
  for i := 0 to FItems.Count - 1 do FItems[i].Loaded;
end;

procedure TfcCustomButtonGroup.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
end;

procedure TfcCustomButtonGroup.Paint;
var i: integer;
begin
  if (not Transparent) and fcUseThemes(self) then
  begin
    Canvas.Brush.Color:= Color;
    Canvas.FillRect(ClientRect);
  end;

  inherited;
  
  { 5/13/99 - RSW - When transparent, paint should also paint the button area }
  if IsTransparent then
     for i:= 0 to ButtonItems.Count-1 do
     begin
        ButtonItems[i].Button.invalidate;
     end;

  if (csDesigning in ComponentState) and
     (BorderStyle = bsNone) and (BevelInner = bvNone) and
     (BevelOuter = bvNone) and (FItems.Count = 0) then with Canvas do
  begin
    Pen.Color := clBlack;
    Pen.Style := psDash;
    if IsTransparent then Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
  end;
end;

procedure TfcCustomButtonGroup.Resize;
begin
  inherited;
  if not (csDestroying in ComponentState) then FItems.ArrangeControls;
end;

procedure TfcCustomButtonGroup.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
//  Filer.DefineProperty('Item', nil, nil, True);
end;

procedure TfcCustomButtonGroup.WriteState(Writer: TWriter);
var i: Integer;
begin
  for i := FItems.Count - 1 downto 0 do SetChildOrder(FItems[i].Button, 0);
  inherited;
end;

Function TfcCustomButtonGroup.IsTransparent: boolean;
begin
   result:= (inherited IsTransparent)  and not (csDesigning in ComponentState);
end;

procedure TfcCustomButtonGroup.WndProc(var Message: TMessage);
begin
  inherited;
end;

initialization
  RegisterClasses([TfcShapeBtn, TfcImageBtn]);
end.