unit uButtonleiste;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Contnrs;
const
C_Top = 8;
C_WidthButton = 75;
C_WidthButtonSpace = 5;
type
TButtonType = (fbtSchliessen,
fbtUebernehmen,
fbtHilfe,
fbtAktualisieren,
fbtVerwerfen,
fbtPruefen,
fbtZuruecksetzen,
fbtLoeschen,
fbtHinzufuegen,
fbtEntfernen,
fbtZielwert,
fbtErzeugen,
fbtAttributieren);
TButtonTypeSet =
set of TButtonType;
resourcestring
// Captions für die Buttons
rcButton_fbtSchliessen = '
&Schließen';
rcButton_fbtUebernehmen = '
Ü&bernehmen';
rcButton_fbtHilfe = '
&Hilfe';
rcButton_fbtAktualisieren = '
&Aktualisieren';
rcButton_fbtVerwerfen = '
&Verwerfen';
rcButton_fbtPruefen = '
&Prüfen';
rcButton_fbtZuruecksetzen = '
&Zurücksetzen';
rcButton_fbtLoeschen = '
&Löschen';
rcButton_fbtHinzufuegen = '
&Hinzufügen';
rcButton_fbtEntfernen = '
&Entfernen';
rcButton_fbtZielwert = '
Ziel&wert';
rcButton_fbtErzeugen = '
&Erzeugen';
rcButton_fbtAttributieren = '
A&ttributieren';
type
TC_ButtonNames =
array[TButtonType]
of string;
TButtonItem =
class
public
FControl : TControl;
FButtonType : TButtonType;
FCaption :
string;
FOnClick : TNotifyEvent;
end;
TfraButtonleiste =
class;
TButtonCollectionItem =
class(TCollectionItem)
private
FButtonType : TButtonType;
protected
function GetDisplayName :
String;
override;
public
procedure Assign(SButtonce: TPersistent);
override;
published
property ButtonType : TButtonType
read FButtonType
write FButtonType;
end;
TButtonCollection =
class(TCollection)
private
FOwner : TfraButtonleiste;
FOnAfterChange: TNotifyEvent;
protected
function GetOwner : TPersistent;
override;
function GetItem(
Index: Integer): TButtonCollectionItem;
procedure SetItem(
Index: Integer; Value: TButtonCollectionItem);
procedure Update(Item: TButtonCollectionItem);
public
constructor Create(AOwner : TfraButtonleiste);
function Add : TButtonCollectionItem;
function Insert(
Index: Integer): TButtonCollectionItem;
property Items[
Index: Integer]: TButtonCollectionItem
read GetItem
write SetItem;
property OnAfterChange : TNotifyEvent
read FOnAfterChange
write FOnAfterChange;
published
end;
TfraButtonleiste =
class(TFrame)
private
FButtonListe : TObjectList;
FButtonCollection : TButtonCollection;
FOnClickSchliessen : TNotifyEvent;
FOnClickUebernehmen : TNotifyEvent;
FOnClickHilfe : TNotifyEvent;
FOnClickAktualisieren : TNotifyEvent;
FOnClickVerwerfen : TNotifyEvent;
FOnClickPruefen : TNotifyEvent;
FOnClickZuruecksetzen : TNotifyEvent;
FOnClickLoeschen : TNotifyEvent;
FOnClickHinzufuegen : TNotifyEvent;
FOnClickEntfernen : TNotifyEvent;
FOnClickZielwert : TNotifyEvent;
FOnClickErzeugen : TNotifyEvent;
FOnClickAttributieren : TNotifyEvent;
function GetButton(fButtonType: TButtonType): TButton;
procedure HelpButtonClick(Sender: TObject);
function GetButtons: TButtonTypeSet;
procedure SetButtonCollection(
const Value: TButtonCollection);
function GetButtonExists(fButtonType: TButtonType): boolean;
procedure Update(Sender : TObject);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure AddButton(Button : TButtonType;
OnClick : TNotifyEvent =
nil;
Caption :
string = '
');
procedure InsertButton(Button : TButtonType;
AfterButton : TButtonType;
OnClick : TNotifyEvent =
nil;
Caption :
string = '
');
procedure DeleteButton(Button : TButtonType);
procedure ClearButtons;
property Button[fButtonType : TButtonType] : TButton
read GetButton;
property ButtonExists[fButtonType : TButtonType] : boolean
read GetButtonExists;
published
property ButtonCollection : TButtonCollection
read FButtonCollection
write SetButtonCollection;
property OnClickSchliessen : TNotifyEvent
read FOnClickSchliessen
write FOnClickSchliessen;
property OnClickUebernehmen : TNotifyEvent
read FOnClickUebernehmen
write FOnClickUebernehmen;
property OnClickHilfe : TNotifyEvent
read FOnClickHilfe
write FOnClickHilfe;
property OnClickAktualisieren : TNotifyEvent
read FOnClickAktualisieren
write FOnClickAktualisieren;
property OnClickVerwerfen : TNotifyEvent
read FOnClickVerwerfen
write FOnClickVerwerfen;
property OnClickPruefen : TNotifyEvent
read FOnClickPruefen
write FOnClickPruefen;
property OnClickZuruecksetzen : TNotifyEvent
read FOnClickZuruecksetzen
write FOnClickZuruecksetzen;
property OnClickLoeschen : TNotifyEvent
read FOnClickLoeschen
write FOnClickLoeschen;
property OnClickHinzufuegen : TNotifyEvent
read FOnClickHinzufuegen
write FOnClickHinzufuegen;
property OnClickEntfernen : TNotifyEvent
read FOnClickEntfernen
write FOnClickEntfernen;
property OnClickZielwert : TNotifyEvent
read FOnClickZielwert
write FOnClickZielwert;
property OnClickErzeugen : TNotifyEvent
read FOnClickErzeugen
write FOnClickErzeugen;
property OnClickAttributieren : TNotifyEvent
read FOnClickAttributieren
write FOnClickAttributieren;
end;
procedure Register;
implementation
{$R *.dfm}
// holt die Namen der Buttons
function C_A_ButtonNames : TC_ButtonNames;
begin
Result[fbtSchliessen] := rcButton_fbtSchliessen;
Result[fbtUebernehmen] := rcButton_fbtUebernehmen;
Result[fbtHilfe] := rcButton_fbtHilfe;
Result[fbtAktualisieren] := rcButton_fbtAktualisieren;
Result[fbtVerwerfen] := rcButton_fbtVerwerfen;
Result[fbtPruefen] := rcButton_fbtPruefen;
Result[fbtZuruecksetzen] := rcButton_fbtZuruecksetzen;
Result[fbtLoeschen] := rcButton_fbtLoeschen;
Result[fbtHinzufuegen] := rcButton_fbtHinzufuegen;
Result[fbtEntfernen] := rcButton_fbtEntfernen;
Result[fbtZielwert] := rcButton_fbtZielwert;
Result[fbtErzeugen] := rcButton_fbtErzeugen;
Result[fbtAttributieren] := rcButton_fbtAttributieren;
end;
{ TfraButtonleiste }
procedure TfraButtonleiste.AddButton(Button: TButtonType; OnClick: TNotifyEvent; Caption:
string);
var
FButton : TButtonItem;
NewLeft : integer;
begin
NewLeft := FButtonListe.Count * (C_WidthButton + C_WidthButtonSpace);
FButton := TButtonItem.Create;
if Caption <> EmptyStr
then
begin
FButton.FCaption := Caption;
end
else
begin
FButton.FCaption := C_A_ButtonNames[Button];
end;
FButton.FButtonType := Button;
FButton.FControl := TButton.Create(Self);
FButton.FControl.
Name := '
Button' + IntToStr(FButtonListe.Count);
TButton(FButton.FControl).Caption := FButton.FCaption;
FButton.FControl.Left := NewLeft;
FButton.FControl.Width := C_WidthButton;
FButton.FControl.Top := C_Top;
FButton.FControl.HelpKeyword := '
none';
FButton.FControl.HelpType := htKeyword;
FButton.FOnClick := OnClick;
if Button = fbtHilfe
then
TButton(FButton.FControl).OnClick := HelpButtonClick
else
TButton(FButton.FControl).OnClick := OnClick;
FButtonListe.Add(FButton);
Self.Width := FButtonListe.Count * (C_WidthButton + C_WidthButtonSpace) - C_WidthButtonSpace;
end;
procedure TfraButtonleiste.ClearButtons;
var
FButton : TButtonItem;
i : integer;
begin
for i := FButtonListe.Count - 1
downto 0
do
begin
FButton := TButtonItem(FButtonListe.Items[i]);
FButton.FControl.Free;
FButtonListe.Delete(i);
end;
end;
constructor TfraButtonleiste.Create(AOwner: TComponent);
begin
inherited;
FButtonListe := TObjectList.Create;
FButtonCollection := TButtonCollection.Create(Self);
FButtonCollection.OnAfterChange := Update;
end;
procedure TfraButtonleiste.DeleteButton(Button: TButtonType);
var
FButton : TButtonItem;
i, iButton : integer;
begin
for i := 0
to FButtonListe.Count - 1
do begin
if TButtonItem(FButtonListe.Items[i]).FButtonType = Button
then
begin
FButton := TButtonItem(FButtonListe.Items[i]);
iButton := i;
Break;
end;
end;
if Assigned(FButton)
then
begin
TButtonItem(FButtonListe.Items[iButton]).Free;
FButtonListe.Delete(iButton);
for i := 0
to FButtonListe.Count - 1
do
begin
FButton := TButtonItem(FButtonListe.Items[i]);
FButton.FControl.Left := i * (C_WidthButton + C_WidthButtonSpace);
end;
end;
Self.Width := FButtonListe.Count * (C_WidthButton + C_WidthButtonSpace);
FButton :=
nil;
end;
destructor TfraButtonleiste.Destroy;
begin
while FButtonListe.Count > 0
do begin
TButtonItem(FButtonListe.Items[FButtonListe.Count - 1]).Free;
FButtonListe.Delete(FButtonListe.Count - 1);
end;
FButtonListe.Free;
FButtonCollection.Free;
inherited;
end;
procedure TfraButtonleiste.HelpButtonClick(Sender: TObject);
begin
if Assigned(FOnClickHilfe)
then
FOnClickHilfe(Sender)
else
try
Application.HelpKeyword('
');
except
MessageDlg('
Hilfe nicht vorhanden', mtInformation, [mbOK], 0);
end;
end;
procedure TfraButtonleiste.InsertButton(Button, AfterButton: TButtonType; OnClick: TNotifyEvent; Caption:
string);
var
FAfterButton,
FButton : TButtonItem;
NewLeft : integer;
i, iAfterButton : integer;
begin
for i := 0
to FButtonListe.Count - 1
do begin
if TButtonItem(FButtonListe.Items[i]).FButtonType = AfterButton
then
begin
FAfterButton := TButtonItem(FButtonListe.Items[i]);
iAfterButton := i;
Break;
end;
end;
if iAfterButton = FButtonListe.Count
then
begin
AddButton(Button, OnClick, Caption);
end
else
begin
NewLeft := iAfterButton * (C_WidthButton + C_WidthButtonSpace);
FButton := TButtonItem.Create;
if Caption <> EmptyStr
then
begin
FButton.FCaption := Caption;
end
else
begin
FButton.FCaption := C_A_ButtonNames[Button];
end;
FButton.FButtonType := Button;
FButton.FControl := TButton.Create(Self);
FButton.FControl.
Name := '
Button' + IntToStr(FButtonListe.Count);
TButton(FButton.FControl).Caption := FButton.FCaption;
FButton.FControl.Left := NewLeft;
FButton.FControl.Width := C_WidthButton;
FButton.FControl.Top := C_Top;
FButton.FControl.HelpKeyword := '
none';
FButton.FControl.HelpType := htKeyword;
FButton.FOnClick := OnClick;
if Button = fbtHilfe
then
TButton(FButton.FControl).OnClick := HelpButtonClick
else
TButton(FButton.FControl).OnClick := OnClick;
FButtonListe.Insert(iAfterButton + 1, FButton);
Self.Width := FButtonListe.Count * (C_WidthButton + C_WidthButtonSpace);
for i := 0
to FButtonListe.Count - 1
do
begin
FAfterButton := TButtonItem(FButtonListe.Items[i]);
FAfterButton.FControl.Left := (i) * (C_WidthButton + C_WidthButtonSpace);
end;
end;
end;
procedure TfraButtonleiste.SetButtonCollection(
const Value: TButtonCollection);
begin
FButtonCollection.Assign(Value);
end;
procedure TfraButtonleiste.Update(Sender: TObject);
var
i : integer;
begin
ClearButtons;
for i := 0
to FButtonCollection.Count - 1
do
begin
case FButtonCollection.Items[i].ButtonType
of
fbtSchliessen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickSchliessen);
fbtUebernehmen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickUebernehmen);
fbtHilfe : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickHilfe);
fbtAktualisieren : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickAktualisieren);
fbtVerwerfen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickVerwerfen);
fbtPruefen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickPruefen);
fbtZuruecksetzen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickZuruecksetzen);
fbtLoeschen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickLoeschen);
fbtHinzufuegen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickHinzufuegen);
fbtEntfernen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickEntfernen);
fbtZielwert : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickZielwert);
fbtErzeugen : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickErzeugen);
fbtAttributieren : AddButton(FButtonCollection.Items[i].ButtonType, FOnClickAttributieren);
end;
end;
end;
function TfraButtonleiste.GetButton(fButtonType: TButtonType): TButton;
var
i : integer;
begin
for i := 0
to FButtonListe.Count - 1
do
begin
if TButtonItem(FButtonListe.Items[i]).FButtonType = fButtonType
then
begin
Result := TButton(TButtonItem(FButtonListe.Items[i]).FControl);
Break;
end;
end;
end;
function TfraButtonleiste.GetButtonExists(fButtonType: TButtonType): boolean;
var
i : integer;
begin
Result := false;
for i := 0
to FButtonListe.Count - 1
do begin
if TButtonItem(FButtonListe.Items[i]).FButtonType = fButtonType
then
begin
Result := true;
Break;
end;
end;
end;
function TfraButtonleiste.GetButtons: TButtonTypeSet;
var
i : integer;
begin
Result := [];
for i := 0
to FButtonListe.Count - 1
do
begin
Result := Result + [TButtonItem(FButtonListe[i]).FButtonType];
end;
end;
{ TButtonCollectionItem }
procedure TButtonCollectionItem.Assign(SButtonce: TPersistent);
begin
if SButtonce
is TButtonCollectionItem
then
ButtonType := TButtonCollectionItem(SButtonce).ButtonType
else
inherited;
//raises an exception
end;
function TButtonCollectionItem.GetDisplayName:
String;
begin
Result := Format('
Item %d',[
Index]);
end;
{ TButtonCollection }
function TButtonCollection.Add: TButtonCollectionItem;
begin
Result := TButtonCollectionItem(
inherited Add);
if Assigned(FOnAfterChange)
then
FOnAfterChange(Self);
end;
constructor TButtonCollection.Create(AOwner: TfraButtonleiste);
begin
inherited Create(TButtonCollectionItem);
FOwner := AOwner;
end;
function TButtonCollection.GetItem(
Index: Integer): TButtonCollectionItem;
begin
Result := TButtonCollectionItem(
inherited GetItem(
Index));
end;
function TButtonCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TButtonCollection.Insert(
Index: Integer): TButtonCollectionItem;
begin
Result := TButtonCollectionItem(
inherited Insert(
Index));
if Assigned(FOnAfterChange)
then
FOnAfterChange(Self);
end;
procedure TButtonCollection.SetItem(
Index: Integer; Value: TButtonCollectionItem);
begin
inherited SetItem(
Index, Value);
end;
procedure TButtonCollection.Update(Item: TButtonCollectionItem);
begin
inherited Update(Item);
if Assigned(FOnAfterChange)
then
FOnAfterChange(Self);
end;
procedure Register;
begin
RegisterComponents('
Samples', [TfraButtonleiste]);
end;
end.