AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi TObjectList: Event nach dem hinzufügen eines Objects
Thema durchsuchen
Ansicht
Themen-Optionen

TObjectList: Event nach dem hinzufügen eines Objects

Ein Thema von fränk0815 · begonnen am 4. Jan 2006 · letzter Beitrag vom 4. Jan 2006
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:42 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz