TObjectList: Event nach dem hinzufügen eines Objects

[fränk0815]

Folgende Problemstellung:

Ich habe eine TObjectList als Container der x Einträge aufnehmen soll.

Nun möchte ich nach jedem

Delphi-Quellcode:

TObjectList.Add(TObject.Create);

eine Event erstellen der meiner Anwendung mitteilt das ein Item hinzugefügt wurde.

Das ist nötig da aus einem Proberty des Objects ein Wert berechnet werden soll.
(Nach jedem hinzufügen eines Objects).

Bisher mache ich das direkt in der AddFunction per NotifyEvent, jedoch musste ich festellen das es so nicht funktioniert da
das Object an dieser Stelle zwar erzeugt ist, die Werte aber noch nicht "befüllt" sind.


Hat jemand eine Idee wie man das lösen kann ?



Vielen Dank für eure Hilfe,

Frank

[Kroko1999]

da wirst Du wohl eine eigene Klasse schreiben müssen die Add, Insert etc. überschreibt und ein OnChange auslöst oder Du rufst

Delphi-Quellcode:

  TObjectList.Add(TObject.Create);
  MyChange;

auf :!:

[fränk0815]

Eine eigene Klasse habe ich ja schon.

Deine Methode funktioniert zwar, ist aber nich das was ich möchte.

Ich möchte das meine Klasse ( welche auf TObjectList basiert ) selbständig nach dem hinzufügen eines Objects
diverse Berechnungen mit den Werten der in ihr enthaltenen Objekte durchführt, ohne das ich das im Hauptprogramm aufrufen müsste.




Trotzdem, hab Dank für deinen Hinweis :)

[Kroko1999]

dann bleibt nur das überschreiben der Methoden, dafür ist ja OOP auch gedacht!

[fränk0815]

Leider stosse ich hier an meine Grenzen, ich poste hier mal den Code der Klasse, eventuell kannst du mir weiterhelfen ?

(Die relevante Stelle ist mit einem Kommentar markiert ...)

Delphi-Quellcode:

unit uPositionen;

interface

uses Contnrs, classes, SysUtils, uMysqlClient, Dialogs;

type

  TPosition = class(TObject)
    protected
      FNummer      : Integer;
      FMenge       : Integer;
      FBezeichnung : WideString;
      FEinzelpreis : Currency;
    public
      property Nummer      : integer read FNummer write FNummer;
      property Menge       : integer read FMenge write FMenge;
      property Bezeichnung : WideString read FBezeichnung write FBezeichnung;
      property Einzelpreis : Currency read FEinzelpreis write FEinzelpreis;
    end;

  TPosList = class(TObjectList)
    private
      FExecuted   : Boolean;
      FSqlClient  : TMysqlClient;
      FSqlResult  : TMySqlResult;
      FVN : String;
      FNO : String;
      FTBL : String;
      FProzent : Integer;
      FNetto : Currency;
      FSkonto: Currency;
      FMwSt : Currency;
      FGesamt : Currency;
      FZwischensumme : Currency;

      FChange  : TNotifyEvent;
      FDestroy : TNotifyEvent;
      FLeer    : TNotifyEvent;

    protected
      function GetItem(Index: Integer): TPosition;
      procedure SetItem(Index: Integer; AObject: TPosition);
      procedure Notify(Ptr: Pointer; Action : TListNotification); override;
    public
      function Add(AObject: TPosition): Integer;
      function last(): TPosition;
      function Remove(AObject: TPosition): Integer;

      function LoadList : Boolean;
      procedure Renumber;
      procedure BuildSum;

      property SProzent : Integer read FProzent write FProzent;
      property Netto : Currency read FNetto write FNetto;
      property Skonto : Currency read FSkonto write FSkonto;
      property MwSt : Currency read FMwSt write FMwSt;
      property Gesamt : Currency read FGesamt write FGesamt;
      property ZS : Currency read FZwischensumme write FZwischensumme;
      property Vorgang: String read FVN Write FVN;
      property Nummer : String read FNO write FNO;
      property Tabelle : String read FTBL write FTBL;

      property Items[Index: Integer]: TPosition read GetItem write SetItem; default;

      property OnChange : TNotifyEvent read FChange write FChange;
      property OnDestroy : TNotifyEvent read FDestroy write FDestroy;
      property OnEmpty : TNotifyEvent read FLeer write FLeer;

      constructor create;
      destructor Destroy; override;
    end;

var
  Positionen : TPosList = Nil;

implementation

uses Globals;

function TPosList.LoadList;
var
  q : String;
begin
  Result := False;
  Capacity := Count;
  FSqlClient := TMySqlClient.create;
  FSqlClient.Host           := 'localhost';
  FSqlClient.port           := 3306;
  FSqlClient.user           := 'root';
  FSqlClient.Db             := 'gastrofaktura';
  FSqlClient.Compress       := False;
  FSqlClient.ConnectTimeout := 4;

  if FSqlClient.connect then
  begin
    q := 'Select * from `' + FTBL +'` where vnr =  ' + FVN + ' and nummer = ' + FNO + ' ORDER BY pos';
    FSqlResult := FSqlClient.query(q,False,FExecuted);

    if FSqlResult.RowsCount <= 0 then exit else
    begin
    FSqlResult.First;
      while not FSqlResult.EOF do
      begin
        Add(TPosition.Create);
        last.Nummer      := StrToInt(FSqlResult.FieldValueByName('pos',False));
        last.Menge       := StrToInt(FSqlResult.FieldValueByName('menge',False));
        last.Bezeichnung := Utf8Decode(FSqlResult.FieldValueByName('bezeichnung',False));
        last.Einzelpreis := DecRep(FSqlResult.FieldValueByName('ep',False));
        FSqlResult.Next;
      end;
      FreeAndNil(FSqlResult);
    end;
  end;
  FSqlClient.close;
  FreeAndNil(FSqlClient);
  if Assigned(FChange) then FChange(Self);
end;

constructor TPosList.Create;
begin
  inherited Create(True);
end;

destructor TPosList.Destroy;
begin
  if Assigned(FDestroy) then FDestroy(Self);
  inherited Destroy;
end;

function TPosList.Add(AObject: TPosition): Integer;
begin
  Result := inherited Add(AObject);

  //
  // Hier sollte der Event ausgelöst werden, was aber leider nicht richtig funktioniert ....
  //

end;

function TPosList.GetItem(Index: Integer): TPosition;
begin
  Result := TPosition(inherited Items[Index]);
end;

function TPosList.last: TPosition;
begin
  Result := TPosition(inherited Items[Count-1]);
end;

procedure TPosList.SetItem(Index: Integer; AObject: TPosition);
begin
  inherited Items[Index] := AObject;
end;

procedure TPosList.Notify(Ptr: Pointer; Action : TListNotification);
begin
  case Action of          
    lnAdded: FChange(Self);
  end;
end;

function TPosList.Remove(AObject: TPosition): Integer;
begin
   Result := inherited Remove(AObject);
  if inherited Count > 0 then Renumber else if Assigned(FLeer) then FLeer(Self);
end;

procedure TPosList.renumber;
var
  i : Integer;
  q : String;
begin
  if inherited Count > 0 then
  begin
    FSqlClient := TMySqlClient.create;
    FSqlClient.Host           := 'localhost';
    FSqlClient.port           := 3306;
    FSqlClient.user           := 'root';
    FSqlClient.Db             := 'gastrofaktura';
    FSqlClient.Compress       := False;
    FSqlClient.ConnectTimeout := 4;

    FSqlClient.connect;
    for i := 0 to inherited count - 1 do
    begin
      q := 'Update `'+ FTBL +'` SET `pos` = ' + QuotedStr(IntToStr(i +1))
                                                    + ' WHERE `vnr` = ' + QuotedStr(FVN)
                                                    + ' AND `nummer` = ' + QuotedStr(FNO)
                                                    + ' AND `pos` = ' + QuotedStr(IntToStr(TPosition(inherited Items[i]).Nummer))
                                                    + ' LIMIT 1;';
      FSqlResult := FSqlClient.query(q, False, FExecuted);
      FreeAndNil(FSqlResult);
      TPosition(inherited Items[i]).Nummer := i+1;
    end;
  end;
  FSqlClient.close;
  FreeAndNil(FSqlClient);
  if Assigned(FChange) then FChange(Self);
end;

procedure TPosList.BuildSum;
var
  i : Integer;
begin
  FNetto := 0;
  for i := Pred(inherited Count) downto 0 do
    FNetto := FNetto + TPosition(inherited Items[i]).Einzelpreis * TPosition(inherited Items[i]).Menge;

    if FNetto > 0 then
    begin
      if FProzent > 0 then
      begin
        FZwischensumme := FNetto;
        FSkonto := (FNetto / 100) * FProzent;
        FNetto := FNetto - FSkonto;
        FMwSt := (FNetto / 100) * 16;
        FGesamt := FNetto + FMwSt;
      end else
      begin
        FZwischensumme := FNetto;
        FMwSt := (FNetto / 100) * 16;
        FGesamt := FNetto + FMwSt;
      end;
    end;
end;


end.

[Khabarakh]

Zitat:

Zitat von fränk0815

Bisher mache ich das direkt in der AddFunction per NotifyEvent, jedoch musste ich festellen das es so nicht funktioniert da das Object an dieser Stelle zwar erzeugt ist, die Werte aber noch nicht "befüllt" sind.

Meinst du damit diese Stelle?

Delphi-Quellcode:

while not FSqlResult.EOF do
      begin
        Add(TPosition.Create); // Hier wird das Event gefeuert
        last.Nummer      := StrToInt(FSqlResult.FieldValueByName('pos',False));
        last.Menge       := StrToInt(FSqlResult.FieldValueByName('menge',False));
        last.Bezeichnung := Utf8Decode(FSqlResult.FieldValueByName('bezeichnung',False));
        last.Einzelpreis := DecRep(FSqlResult.FieldValueByName('ep',False));
        // aber hier sind die Properties erst gefüllt
        FSqlResult.Next;
      end;
      FreeAndNil(FSqlResult);

Dann füge das Add einfach erst bei meinem Kommentar ein:

Delphi-Quellcode:

NewPos: TPosition;
[...]
while not FSqlResult.EOF do
      begin
        NewPos := TPosition.Create; 
        NewPos.Nummer      := StrToInt(FSqlResult.FieldValueByName('pos',False));
        NewPos.Menge       := StrToInt(FSqlResult.FieldValueByName('menge',False));
        NewPos.Bezeichnung := Utf8Decode(FSqlResult.FieldValueByName('bezeichnung',False));
        NewPos.Einzelpreis := DecRep(FSqlResult.FieldValueByName('ep',False));
        Add(NewPos);
        FSqlResult.Next;
      end;
      FreeAndNil(FSqlResult);

[fränk0815]

Vielen Dank, das war die Lösung.

:wall: Hätte ich auch selbst drauf kommen können, mit ein bissel mehr Hirnschmalz :-D


Danke dir nochmal, du hast meinen Tag gerettet !

LG
Frank