Eigene Komponente (Toolbar) programmieren

[Metallicwar]

Wenn ich das so mache, wie von dir vorgeschlagen kann ich

A: keine Events mit den erzeugten Buttons auslösen(sind nichtmal anklickbar)

B: Beim Ausführen der Anwendung meint er dass eine Komponenten mit dem Namen TToolButton bereits existiert.

Hast du's mal bei dir getestet?

[himitsu]

Ich dachte ja, daß man über irgendeinen ComponentState sagen kann, daß die Buttons designbar sind, aber ich fand nichts ... nja

Delphi-Quellcode:

unit ToolBar1;

interface

uses
  SysUtils, Classes, Controls, ToolWin, ComCtrls;

type
  TTestToolBar = class(TToolBar)
  private
    { Private-Deklarationen }
  protected
    { Protected-Deklarationen }
    procedure Loaded; override;
  public
    { Public-Deklarationen }
    constructor Create(aOwner: TComponent); override;
  published
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure TTestToolBar.Loaded;
var
  Button: TToolButton;
begin
  inherited;
  if ControlCount = 0 then
  begin
    Button := TToolButton.Create(Owner);
    Button.Parent := Self;
    Button.Caption := 'Speichern';

    Button := TToolButton.Create(Owner);
    Button.Parent := Self;
    Button.Caption := 'Zurück';

    Button := TToolButton.Create(Owner);
    Button.Parent := Self;
    Button.Caption := 'Vor';

    Button := TToolbutton.Create(Owner);
    Button.Parent := Self;
    Button.Caption := 'Neu';
  end;
end;

constructor TTestToolbar.Create(aOwner: TComponent);
begin
  inherited;
  Parent := aOwner as TWinControl;
  ShowCaptions := True;
  if not (csLoading in ComponentState) then
    Loaded;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TTestToolBar]);
end;

end.

[Metallicwar]

Hallo, hier erstmal mein bisheriger Zwischenstand:
- Komponene lässt sich auf Formular ziehen
- Eigenschaft erstellt (Toolbartype), die unterschiedliche Standardtoolbars anlegt.

Delphi-Quellcode:

unit ZTestToolbar;

interface

uses
  SysUtils, Classes, Controls, ToolWin, ComCtrls, ImgList, cxGraphics, cxStyles,
  StdCtrls, Dialogs;

type
  TToolbarType = (ttStandard1, ttStandard2, ttStandard3);
type
  TTestToolbar = class(TToolBar)
  private
    FToolbarType: TToolbarType;
    Buttons : TToolbutton;
    ImageList: TcxImageList;
    function GetNextName(AName: String): String;
    procedure SetToolButtons();
    procedure SetToolbarType(Value: TToolbarType);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor create(aOwner: TComponent); override;
    destructor Destroy; override;
    { Private-Deklarationen }
  published
    property ToolbarType: TToolbarType read FToolbarType write SetToolbarType
          default ttStandard1;
end;

procedure Register;

implementation

procedure TTestToolbar.SetToolButtons();
var
  i: Integer;
begin
  for i := Self.ControlCount -1 downto 0 do
    Self.Controls[i].Free;

  case FToolbarType of
    ttStandard1:
    begin
      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnEnde');
      Buttons.Parent := self;
      Buttons.Caption := 'Ende';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnKopieren');
      Buttons.Parent := self;
      Buttons.Caption := 'Kopieren';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnSichern');
      Buttons.Parent := self;
      Buttons.Caption := 'Sichern';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnLöschen');
      Buttons.Parent := self;
      Buttons.Caption := 'Löschen';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnNeu');
      Buttons.Parent := self;
      Buttons.Caption := 'Neu';
    end;
    ttStandard2:
    begin
      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnEnde');
      Buttons.Parent := self;
      Buttons.Caption := 'Ende';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextNAme('btnLöschen');
      Buttons.Parent := self;
      Buttons.Caption := 'Löschen';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnVor');
      Buttons.Parent := self;
      Buttons.Caption := 'Vor';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnZurück');
      Buttons.Parent := self;
      Buttons.Caption := 'Zurück';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnSichern');
      Buttons.Parent := self;
      Buttons.Caption := 'Sichern';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnNeu');
      Buttons.Parent := self;
      Buttons.Caption := 'Neu';
    end;
    ttStandard3:
    begin
      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextNAme('btnEnde');
      Buttons.Parent := self;
      Buttons.Caption := 'Ende';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnLöschen');
      Buttons.Parent := self;
      Buttons.Caption := 'Löschen';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnKopieren');
      Buttons.Parent := self;
      Buttons.Caption := 'Kopieren';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnSpeichern');
      Buttons.Parent := self;
      Buttons.Caption := 'Speichern';

      Buttons := TToolbutton.Create(self.Parent);
      Buttons.Name := GetNextName('btnNeu');
      Buttons.Parent := self;
      Buttons.Caption := 'Neu';
    end;
  end;
end;


procedure TTestToolbar.SetToolbarType(Value: TToolbarType);
begin
  if FToolbarType <> Value then
  begin
    FToolbarType := Value;

    SetToolButtons();
    Invalidate;
  end;
end;

function TTestToolbar.GetNextName(AName: String): String;
var
  i: Integer;
begin
  i := 1;
  while (Self.Owner.FindComponent(AName + IntToStr(i))) <> nil do
    i := i + 1;
  Result :=(AName + IntToStr(i));
end;

constructor TTestToolbar.Create;
begin
  inherited;
  Parent := Owner as TWinControl;

  if Assigned(Buttons) then
    Exit;

  if csDesigning in ComponentState then
  begin
    SetToolButtons();
  end;

  //Standardeigenschaften für Toolbar setzten
  Self.ShowCaptions := True;
end;

destructor TTestToolbar.Destroy;
begin
  Buttons.Free;
  inherited;
end;

procedure TTestToolbar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = Buttons) and (Operation = opRemove) then
    Buttons := nil;
end;

procedure Register;
begin
  RegisterComponents('ZTestKomponenten', [TTestToolbar]);
end;

end.

sooo und nun zu meinem Hauptproblem....
Ich möchte die Toolbuttons mit PNG's versehen. Zur Laufzeit möchte ich eine ImageList erstellen und meine PNG's der Liste hinzufüge und anschließend den Toolbuttons zuweisen.
Problem:
- Die Standard ImageList bietet ja Funktion DELPHI]ImageList.Add[/DELPHI] an, aber diese erwartet ja ein Bitmap, also wandelte ich mein PNG in ein Bitmap um dadurch geht ja aber leider der Alphachannel verloren und mein PNG auf dem Toolbutton, besitzt einen schööönen schwarzen Background... Andere haben ja auch das Problem, wie ich schon gelesen habe.
Mich wundert es nur, dass es auch über die PngComponents nicht funktioniert, wieso gibts dort auch nur die Funktion Imagelist.Add (TImage: TBitmap...) ...
Kennt/ habt ihr eine Möglichkeit, um PNG über eine ImageList den Toolbuttons zuzuweisen, ohne den Alphachannel zu verlieren?

MfG