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.