Eigene Komponente - Probleme bei Entwurfsansicht

[e-gon]

Hallo!

Ich erstelle mal wieder eine eigene Komponente. Darin sollen SpeedButtons gruppiert werden. Zunächst nahm ich als Basis eine TGroupBox und es hat alles prima funktioniert. Aus Platzgründen kam dann der Wunsch auf per Switch den Groupbox-Rahmen auch ausblendbar zu machen. Leider ging das nicht mit einer GroupBox und so musste ich als Basis ein TPanel nehmen und mit Hilfe eines Labels und Bevels den Rahmen einer Groupbox nachahmen. Generell funktioniert das ganze auch, nur die Entwurfsansicht macht Probleme.

Zwei Dinge bekomme ich einfach nicht in den Griff:
1. Wie leite ich den in der Entwurfsansicht automatisch vergebenen Namen (z. B. SpeedButtonGroup1) auf die Caption des Labels FLabel um? Mit

Delphi-Quellcode:

ControlStyle:= ControlStyle-[csSetCaption]

kann ich zwar verhindern, dass die Caption des Basis-Panels diesen Namen anzeigt, aber den Namen auf Caption meines Objekts kann ich nicht umleiten.
2. Über die Eigenschaft ShowBorder kann man den Rahmen ein- und ausblenden. Dabei wird bei FLabel und FBevel die Eigenschaft Visible eben auf True oder False gesetzt. Beim Entwurf scheinen sich die beiden Objekte jedoch nur einblenden, nicht aber ausblenden zu lassen. Visible ist zwar auf False, sie werden aber dennoch angezeigt. Kann mir jemand sagen warum?


Und hier der Quelltext:

Delphi-Quellcode:

unit SpeedButtonGroup;

interface

  uses
    StdCtrls, Classes, Messages, Controls, ImgList, ExtCtrls;

  type
    TGroupOrientationStyle = (gsVertical, gsHorizontal);
    TOrientationStyle = gsVertical..gsHorizontal;

    TCustomSpeedButtonGroup = class(TCustomPanel)
    private
      FButtons: TList;
      FItems: TStrings;
      FItemIndex: Integer;
      FColumns: Integer;
      FOrientationStyle: TOrientationStyle;
      FButtonSquarish: Boolean;
      FAutoRange: Boolean;
      FReading: Boolean;
      FUpdating: Boolean;
      FSpacing: Word;
      FNumGlyphs: Byte;
      FImages: TCustomImageList;
      FImageChangeLink: TChangeLink;
      FButtonWidth: Word;
      FButtonHeight: Word;
      FShowBorder: Boolean;
      FCaption: TCaption;
      FBevel: TBevel;
      FLabel: TLabel;
      procedure ArrangeButtons;
      procedure ButtonClick(Sender: TObject);
      procedure ItemsChange(Sender: TObject);
      procedure SetButtonCount(Value: Integer);
      procedure SetColumns(Value: Integer);
      procedure SetItemIndex(Value: Integer);
      procedure SetItems(Value: TStrings);
      procedure SetSpacing(Value: Word);
      procedure SetNumGlyphs(Value: Byte);
      procedure UpdateButtons;
      procedure SetOrientationStyle(Value: TOrientationStyle);
      procedure SetButtonSquarish(Value: Boolean);
      procedure SetAutoRange(Value: Boolean);
      procedure SetShowBorder(Value: Boolean);
      procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
      procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
      procedure WMSize(var Message: TWMSize); message WM_SIZE;
      procedure ImageListChange(Sender: TObject);
      procedure SetImageList;
      procedure SetImages(Value: TCustomImageList);
      procedure SetCaption(Value: TCaption);
  protected
      procedure Loaded; override;
      procedure ReadState(Reader: TReader); override;
      function CanModify: Boolean; virtual;
      procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
      property Columns: Integer read FColumns write SetColumns default 1;
      property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
      property Items: TStrings read FItems write SetItems;
      property Spacing: Word read FSpacing write SetSpacing default 4;
      property Images: TCustomImageList read FImages write SetImages;
      property Orientation: TOrientationStyle read FOrientationStyle write SetOrientationStyle default gsVertical;
      property ButtonSquarish: Boolean read FButtonSquarish write SetButtonSquarish default True;
      property AutoRange: Boolean read FAutoRange write SetAutoRange default False;
      property NumGlyphs: Byte read FNumGlyphs write SetNumGlyphs default 1;
      property ShowBorder: Boolean read FShowBorder write SetShowBorder default True;
      property Caption: TCaption read FCaption write SetCaption;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure FlipChildren(AllLevels: Boolean); override;
      property ButtonWidth: Word read FButtonWidth;
      property ButtonHeight: Word read FButtonHeight;
    end;

    TSpeedButtonGroup = class(TCustomSpeedButtonGroup)
    published
      property Align;
      property Anchors;
      property AutoRange;       // nur bei ButtonSquarish: Buttons werden auf die Fläche verteilt
      property BiDiMode;
      property ButtonSquarish;  // Buttons quadratsich oder vollflächig anzeigen
      property Caption;
      property Color;
      property Columns;
      property Ctl3D;
      property DragCursor;
      property DragKind;
      property DragMode;
      property Enabled;
      property Font;
      property Images;
      property ItemIndex;
      property Items;
      property Constraints;
      property NumGlyphs;       // wird für die Icons von ImageList benötigt
      property Orientation;     // waagerechte oder senkrechte Anordnung der Buttons
      property ParentBiDiMode;
      property ParentColor;
      property ParentCtl3D;
      property ParentFont;
      property PopupMenu;
      property ShowBorder;      // Rahmen ein- und ausblenden
      property Spacing;         // Abstand zwischen den Buttons
      property TabOrder;
      property TabStop;
      property Visible;
      property OnClick;
      property OnContextPopup;
      property OnDragDrop;
      property OnDragOver;
      property OnEndDock;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnStartDock;
      property OnStartDrag;
    end;

  procedure Register;

implementation

  uses
    {Dialogs,}  Buttons, Windows, Forms, SysUtils;

  procedure Register;
  begin
    RegisterComponents('Beispiele', [TSpeedButtonGroup]);
  end;


  function BoolToStr(const b: Boolean): string;
  begin
    if b then  Result:= 'TRUE'
    else  Result:= 'FALSE';
  end;


  function BoolToInt(const b: Boolean): Integer;
  begin
    if b then  Result:= 1
    else  Result:= 0;
  end;


  { TGroupButton }

  type
    TGroupButton = class(TSpeedButton)
    private
      FInClick: Boolean;
      procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    protected
    public
      constructor InternalCreate(CheckGroup: TCustomSpeedButtonGroup);
      destructor Destroy; override;
    end;


  constructor TGroupButton.InternalCreate(CheckGroup: TCustomSpeedButtonGroup);
  begin
    inherited Create(CheckGroup);
    CheckGroup.FButtons.Add(Self);
    Visible:= False;
    Enabled:= CheckGroup.Enabled;
    ParentShowHint:= False;
    OnClick:= CheckGroup.ButtonClick;
    Parent:= CheckGroup;
    GroupIndex:= 1;
  end;


  destructor TGroupButton.Destroy;
  begin
    TCustomSpeedButtonGroup(Owner).FButtons.Remove(Self);
    inherited Destroy;
  end;

  
  procedure TGroupButton.CNCommand(var Message: TWMCommand);
  begin
    if not FInClick then begin
      FInClick:= True;
      try
        if ((Message.NotifyCode = BN_CLICKED) or
           (Message.NotifyCode = BN_DOUBLECLICKED)) and
           TCustomSpeedButtonGroup(Parent).CanModify then
          inherited;
      except
        Application.HandleException(Self);
      end;

      FInClick:= False;
    end;
  end;


  { TCustomCheckGroup }

  constructor TCustomSpeedButtonGroup.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    FReading:= True;
    FButtons:= TList.Create;
    FItems:= TStringList.Create;
    TStringList(FItems).OnChange:= ItemsChange;
    FItemIndex := -1;
    FColumns:= 1;
    FSpacing:= 4;
    FNumGlyphs:= 1;
    FOrientationStyle:= gsVertical;
    ButtonSquarish:= True;
    AutoRange:= False;
    FShowBorder:= True;
    FImageChangeLink:= TChangeLink.Create;
    FImageChangeLink.OnChange:= ImageListChange;
    BevelOuter:= bvNone;
    Height:= 105;

    FBevel:= TBevel.Create(Self);
    FBevel.Parent:= Self;
    FBevel.Left:= 0;
    FBevel.Shape:= bsFrame;
    FBevel.Visible:= True;

    FLabel:= TLabel.Create(Self);
    FLabel.Parent:= Self;
    FLabel.Top:= 0;
    FLabel.Left:= 8;
    FLabel.Visible:= True;
// Tut alles nicht!  :(
//    FLabel.Caption:= Caption;
//    FLabel.ControlStyle:= FLabel.ControlStyle+[csSetCaption];
//    FLabel.ControlStyle:= ControlStyle;

    ControlStyle:= ControlStyle-[csSetCaption];
    FReading:= False;
  end;


  destructor TCustomSpeedButtonGroup.Destroy;
  begin
    SetButtonCount(0);
    TStringList(FItems).OnChange:= nil;
    FItems.Free;
    FButtons.Free;
    FImageChangeLink.Free;
    inherited Destroy;
  end;


  procedure TCustomSpeedButtonGroup.FlipChildren(AllLevels: Boolean);
  begin
    { The check buttons are flipped using BiDiMode }
  end;


  procedure TCustomSpeedButtonGroup.ArrangeButtons;
  var  i,RowCount,TopMargin,GBClientHeight,GBClientWidth,ButtonWid,ButtonHei,
       AddLeft,AddTop,ShowBorderInt: Integer;
       DC: HDC;
       SaveFont: HFont;
       Metrics: TTextMetric;
  begin
    if not FReading then begin
      DC:= GetDC(0);
      SaveFont:= SelectObject(DC,Font.Handle);
      GetTextMetrics(DC,Metrics);
      SelectObject(DC,SaveFont);
      ReleaseDC(0,DC);

      FBevel.Top:= (Metrics.tmHeight div 2)-1;
      FBevel.Height:= Height-FBevel.Top;
      FBevel.Width:= Width;

      if FShowBorder then begin
        TopMargin:= Metrics.tmHeight+1+BoolToInt(Metrics.tmHeight<16);
        ShowBorderInt:= 1;

        // Notbehelf, weil FBevel.Visible:= False in der Entwurftsansicht nicht tut!
        FBevel.Left:= 0;
        FLabel.Left:= 8;
      end
      else begin
        TopMargin:= 0;
        ShowBorderInt:= 0;

        // Notbehelf, weil FBevel.Visible:= False in der Entwurftsansicht nicht tut!
        FBevel.Left:= FBevel.Width*-1;
        FLabel.Left:= FLabel.Width*-1;
      end;

      RowCount:= ((FButtons.Count-1) div FColumns)+1;
      if RowCount=0 then  Inc(RowCount);
      GBClientWidth:= Width-((18-FColumns)*ShowBorderInt)-FColumns;
      GBClientHeight:= Height-TopMargin-(7*ShowBorderInt);
      ButtonWid:= (GBClientWidth+FSpacing) div FColumns;
      ButtonHei:= (GBClientHeight+FSpacing) div RowCount;
      AddLeft:= 0;
      AddTop:= 0;

      if ButtonSquarish then begin
        if ButtonHei>ButtonWid then begin
          if AutoRange then  AddTop:= ButtonHei-ButtonWid;
          ButtonHei:= ButtonWid;
        end
        else begin
          if AutoRange then  AddLeft:= ButtonWid-ButtonHei;
          ButtonWid:= ButtonHei;
        end;
      end;
      Inc(ButtonWid);
      FButtonWidth:= ButtonWid-FSpacing;
      FButtonHeight:= ButtonHei-FSpacing;

      if FOrientationStyle=gsVertical then begin
        for i:= 0 to FButtons.Count-1 do begin
          with TGroupButton(FButtons[i]) do begin
            BiDiMode:= Self.BiDiMode;
            Left:= (i div RowCount)*(ButtonWid+AddLeft)+(8*ShowBorderInt);
            Top:= (i mod RowCount)*(ButtonHei+AddTop)+TopMargin;
            Width:= FButtonWidth;
            Height:= FButtonHeight;
            Visible:= True;
            ShowHint:= Glyph.Width>0;
          end;
        end;
      end
      else begin
        for i:= 0 to FButtons.Count-1 do begin
          with TGroupButton(FButtons[i]) do begin
            BiDiMode:= Self.BiDiMode;
            Left:= (i mod FColumns)*(ButtonWid+AddLeft)+(8*ShowBorderInt);
            Top:= (i div FColumns)*(ButtonHei+AddTop)+TopMargin;
            Width:= FButtonWidth;
            Height:= FButtonHeight;
            Visible:= True;
            ShowHint:= Glyph.Width>0;
          end;
        end;
      end;
    end;
  end;


  procedure TCustomSpeedButtonGroup.ButtonClick(Sender: TObject);
  begin
    if not FUpdating then begin
      FItemIndex:= FButtons.IndexOf(Sender);
      Changed;
      Click;
    end;
  end;


  procedure TCustomSpeedButtonGroup.ItemsChange(Sender: TObject);
  begin
    if not FReading then  UpdateButtons;
  end;


  procedure TCustomSpeedButtonGroup.Loaded;
  begin
    inherited Loaded;
    ArrangeButtons;
  end;

  
  procedure TCustomSpeedButtonGroup.ReadState(Reader: TReader);
  begin
    FReading:= True;
    inherited ReadState(Reader);
    FReading:= False;
    UpdateButtons;
  end;


  procedure TCustomSpeedButtonGroup.SetButtonCount(Value: Integer);
  begin
    while FButtons.Count<Value do  TGroupButton.InternalCreate(Self);
    while FButtons.Count>Value do  TGroupButton(FButtons.Last).Free;
  end;


  procedure TCustomSpeedButtonGroup.SetColumns(Value: Integer);
  begin
    if Value<1 then Value:= 1;
    if Value>16 then Value:= 16;
    if FColumns<>Value then begin
      FColumns:= Value;
      ArrangeButtons;
      Invalidate;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetItemIndex(Value: Integer);
  begin
    if FReading then FItemIndex:= Value
    else begin
      if Value<-1 then Value:= -1;
      if Value>=FButtons.Count then Value:= FButtons.Count-1;
      if FItemIndex<>Value then begin
        if FItemIndex>=0 then  TGroupButton(FButtons[FItemIndex]).Down:= False;
        FItemIndex:= Value;
        if FItemIndex>=0 then  TGroupButton(FButtons[FItemIndex]).Down:= True;
      end;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetItems(Value: TStrings);
  begin
    FItems.Assign(Value);
  end;


  procedure TCustomSpeedButtonGroup.SetSpacing(Value: Word);
  begin
    if FSpacing<>Value then begin
      FSpacing:= Value;
      ArrangeButtons;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetNumGlyphs(Value: Byte);
  var  i: Integer;
  begin
    if (Value<1) or (Value>4) then  Value:= 1;
    
    if FNumGlyphs<>Value then begin
      FNumGlyphs:= Value;
      for i:= 0 to FButtons.Count-1 do begin
        if (FImages<>nil) and (FImages.Count>i) then
          TGroupButton(FButtons[i]).NumGlyphs:= FNumGlyphs;
      end;
    end;
  end;


  procedure TCustomSpeedButtonGroup.UpdateButtons;
  var  i: Integer;
  begin
    SetButtonCount(FItems.Count);
    for i:= 0 to FButtons.Count-1 do begin
      with TGroupButton(FButtons[i]) do begin
        Caption:= FItems[i];
        Hint:= FItems[i];

        if (FImages<>nil) and (FImages.Count>i) then begin
          FImages.GetBitmap(i,Glyph);
          NumGlyphs:= FNumGlyphs;
          Caption:= '';
          ShowHint:= True;
        end
        else begin
          Glyph:= nil;
          Caption:= Hint;
          ShowHint:= False;
        end;
      end;
    end;

    if FItemIndex>=0 then begin
      FUpdating:= True;
      TGroupButton(FButtons[FItemIndex]).Down:= True;
      FUpdating:= False;
    end;

    ArrangeButtons;
    Invalidate;
  end;


  procedure TCustomSpeedButtonGroup.ImageListChange(Sender: TObject);
  begin
    SetImageList;
  end;


  procedure TCustomSpeedButtonGroup.SetImageList;
  var  i: Integer;
  begin
    for i:= 0 to FButtons.Count-1 do begin
      with TGroupButton(FButtons[i]) do begin
        if (FImages<>nil) and (FImages.Count>i) then begin
          FImages.GetBitmap(i,Glyph);
          NumGlyphs:= FNumGlyphs;
          Caption:= '';
          ShowHint:= True;
        end
        else begin
          Glyph:= nil;
          Caption:= Hint;
          ShowHint:= False;
        end;
      end;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetImages(Value: TCustomImageList);
  begin
    if Images<>nil then  Images.UnRegisterChanges(FImageChangeLink);
    FImages:= Value;

    if Images<>nil then begin
      Images.RegisterChanges(FImageChangeLink);
      Images.FreeNotification(Self);
    end;

    SetImageList;
  end;


  procedure TCustomSpeedButtonGroup.SetOrientationStyle(Value: TOrientationStyle);
  begin
    if FOrientationStyle<>Value then begin
      FOrientationStyle:= Value;
      ArrangeButtons;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetButtonSquarish(Value: Boolean);
  begin
    if FButtonSquarish<>Value then begin
      FButtonSquarish:= Value;
      ArrangeButtons;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetAutoRange(Value: Boolean);
  begin
    if FAutoRange<>Value then begin
      FAutoRange:= Value;
      ArrangeButtons;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetShowBorder(Value: Boolean);
  begin
    if FShowBorder<>Value then begin
      FShowBorder:= Value;
      FBevel.Visible:= FShowBorder;
      FLabel.Visible:= FShowBorder;
//MessageDLG('FLabel.Visible: '+BoolToStr(FLabel.Visible),mtInformation,[mbOk],0);
      ArrangeButtons;
    end;
  end;


  procedure TCustomSpeedButtonGroup.SetCaption(Value: TCaption);
  begin
    FCaption:= Value;
    FLabel.Caption:= Value;
  end;


  procedure TCustomSpeedButtonGroup.CMEnabledChanged(var Message: TMessage);
  var  i: Integer;
  begin
    inherited;
    for i := 0 to FButtons.Count-1 do  TGroupButton(FButtons[i]).Enabled:= Enabled;
  end;


  procedure TCustomSpeedButtonGroup.CMFontChanged(var Message: TMessage);
  begin
    inherited;
    ArrangeButtons;
  end;


  procedure TCustomSpeedButtonGroup.WMSize(var Message: TWMSize);
  begin
    inherited;
    ArrangeButtons;
  end;


  function TCustomSpeedButtonGroup.CanModify: Boolean;
  begin
    Result:= True;
  end;


  procedure TCustomSpeedButtonGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
  begin
  end;

end.

Gruß
e-gon

[DeddyH]

Zu 1.: IIRC musst Du SetName der Hauptkomponente überschreiben und dort dann die Caption setzen.
Zu 2.: Was geschieht, wenn Du die "default"-Zuweisung der Property einmal weglässt?

[e-gon]

Hallo DeddyH,

vielen Dank für die schnelle Antwort.

1. Das war die Lösung. Danke!!!
2. Leider ändert das nichts am Problem.

Gruß
e-gon

[DeddyH]

Nunja, wenn ich ein "normales" Label auf ein VCL-Formular packe, dann wird das ja auch nicht unsichtbar, wenn ich Visible auf false stelle. Ich fürchte, damit musst Du leben (oder alternativ keine bzw. weniger Subkomponenten verwenden und stattdessen selber zeichnen).

[e-gon]

Das stimmt allerdings. Wahrscheinlich kann man beim Entwurf gar keine Objekte ausblenden.

Dann ist wohl meine Lösung

Delphi-Quellcode:

FBevel.Left:= FBevel.Width*-1;
FLabel.Left:= FLabel.Width*-1;

doch nicht so falsch...

Gruß
e-gon

[e-gon]

Ok, dann mal vielen Dank für Deine Hilfe!

Gruß
e-gon

[DeddyH]

Da nich für ;)

[himitsu]

Bei Subkomponenten gibt es die die Variante, dass man Parent der Subkompoente auf nil setzt, wenn in der Überkomponente ein Property dafür auf False steht, dann ist das auch im FormDesigner weg.

Ansonsten muß man die Komponenten halt ableiten und das Verhalten ändern, dass die Komponente im Designmodus immer sichtbar ist.
Grund für sowas, damit man im FormDesigner halt alles sieht und Kompoenten sich nicht verstecken oder man sie erst suchen muß (Struktur-Ansicht oder IDE-Insight).