unit ZTestToolbar;
interface
uses
SysUtils, Classes, Controls, Graphics, ToolWin, ComCtrls, ImgList, cxGraphics, cxStyles,
StdCtrls, Dialogs, pngImage;
type
TToolbarType = (ttStandard1, ttStandard2, ttStandard3);
type
TTestToolbar =
class(TToolBar)
private
FToolbarType: TToolbarType;
Buttons : TToolbutton;
cxImageList: TcxImagelist;
function GetNextName(AName:
String):
String;
procedure SetToolButtons();
procedure SetPNGImages();
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
constructor TTestToolbar.Create;
begin
inherited;
Parent := Owner
as TWinControl;
if Assigned(Buttons)
then
Exit;
//Standardeigenschaften für Toolbar setzten
SetPNGImages;
Self.ShowCaptions := True;
Self.AutoSize := True;
Self.Images := cxImageList;
{
if csLoading in ComponentState then Showmessage('csLoading');
if csReading in ComponentState then showmessage('csReading');
if csWriting in ComponentState then Showmessage('csWriting');
if csDestroying in ComponentState then Showmessage('csDestroying');
if csDesigning in ComponentState then Showmessage('csDesigning');
if csAncestor in ComponentState then Showmessage('csAncestor');
if csUpdating in ComponentState then Showmessage('csUpdating');
if csFixups in ComponentState then Showmessage('csFixups');
if csFreeNotification in ComponentState then Showmessage('csFreeNotification');
if csInline in ComponentState then Showmessage('csInline');
if csDesignInstance in ComponentState then Showmessage('csDesignInstance');
}
if csDesigning
in ComponentState
then
begin
SetToolButtons();
end;
end;
procedure TTestToolbar.SetPNGImages();
var
PNG: TPngImage;
Bitmap: TBitmap;
i: Integer;
PNGListe:
array [0..6]
of string;
begin
cxImageList := TcxImageList.Create(Self);
cxImageList.ColorDepth := cd32bit;
cxImageList.Height := 32;
cxImageList.Width := 32;
PNGListe[0] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\delete.png';
PNGListe[1] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\element_add.png';
PNGListe[2] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\elements.png';
PNGListe[3] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\exit.png';
PNGListe[4] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\hard_drive.png';
PNGListe[5] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\navigate_left.png';
PNGListe[6] := '
C:\Users\ZMI GmbH\Desktop\Imagelist umwandeln\png\navigate_right.png';
for i := 0
to High(PNGListe)
do
begin
PNG := TPngImage.Create;
PNG.LoadFromFile(PNGListe[i]);
Bitmap := TBitmap.Create;
Bitmap.Assign(PNG);
Bitmap.PixelFormat := pf32bit;
cxImageList.Add(Bitmap,
nil);
Bitmap.Free;
PNG.Free;
end;
end;
procedure TTestToolbar.SetToolButtons();
var
i: Integer;
begin
showmessage('
SetToolButtons');
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.AutoSize := True;
Buttons.ImageIndex := 3;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnKopieren');
Buttons.Parent := self;
Buttons.Caption := '
Kopieren';
Buttons.AutoSize := True;
Buttons.ImageIndex := 2;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnSichern');
Buttons.Parent := self;
Buttons.Caption := '
Sichern';
Buttons.AutoSize := True;
Buttons.ImageIndex := 4;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnLöschen');
Buttons.Parent := self;
Buttons.Caption := '
Löschen';
Buttons.AutoSize := True;
Buttons.ImageIndex := 0;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnNeu');
Buttons.Parent := self;
Buttons.Caption := '
Neu';
Buttons.AutoSize := True;
Buttons.ImageIndex := 1;
end;
ttStandard2:
begin
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnEnde');
Buttons.Parent := self;
Buttons.Caption := '
Ende';
Buttons.ImageIndex := 3;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextNAme('
btnLöschen');
Buttons.Parent := self;
Buttons.Caption := '
Löschen';
Buttons.ImageIndex := 0;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnVor');
Buttons.Parent := self;
Buttons.Caption := '
Vor';
Buttons.ImageIndex := 6;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnZurück');
Buttons.Parent := self;
Buttons.Caption := '
Zurück';
Buttons.ImageIndex := 5;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnSichern');
Buttons.Parent := self;
Buttons.Caption := '
Sichern';
Buttons.ImageIndex := 4;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnNeu');
Buttons.Parent := self;
Buttons.Caption := '
Neu';
Buttons.ImageIndex := 1;
end;
ttStandard3:
begin
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextNAme('
btnEnde');
Buttons.Parent := self;
Buttons.Caption := '
Ende';
Buttons.ImageIndex := 3;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnLöschen');
Buttons.Parent := self;
Buttons.Caption := '
Löschen';
Buttons.ImageIndex := 0;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnKopieren');
Buttons.Parent := self;
Buttons.Caption := '
Kopieren';
Buttons.ImageIndex := 2;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnSpeichern');
Buttons.Parent := self;
Buttons.Caption := '
Speichern';
Buttons.ImageIndex := 4;
Buttons := TToolbutton.Create(self.Parent);
Buttons.
Name := GetNextName('
btnNeu');
Buttons.Parent := self;
Buttons.Caption := '
Neu';
Buttons.ImageIndex := 1;
end;
end;
if not (csLoading
in ComponentState)
then
RecreateWnd;
AdjustSize;
end;
procedure TTestToolbar.SetToolbarType(Value: TToolbarType);
begin
if FToolbarType <> Value
then
begin
FToolbarType := Value;
SetToolButtons();
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;
procedure TTestToolbar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = Buttons)
and (Operation = opRemove)
then
Buttons :=
nil;
end;
destructor TTestToolbar.Destroy;
begin
Buttons.Free;
inherited;
end;
procedure Register;
begin
RegisterComponents('
ZTestKomponenten', [TTestToolbar]);
end;
end.