Einzelnen Beitrag anzeigen

fränk0815

Registriert seit: 12. Sep 2002
Ort: München
33 Beiträge
 
Delphi 2006 Professional
 
#5

Re: TObjectList: Event nach dem hinzufügen eines Objects

  Alt 4. Jan 2006, 09:44
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.
Frank Engelbrecht
  Mit Zitat antworten Zitat