A script to apply a discount (15% of the price per serving) to the second serving of a dish from a certain category
The script is inserted into 2 events - CurItemChanged and OnAfterCheckViewEdit
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, k: integer;
it, CurItem: TCheckItem;
SL: TStringList;
a, q, Price: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, as is
SL.Sorted := False;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', 5)); //5 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', Price) + IntToStr(TDish(it).UNI),
TObject(it));
end;
end;
//Magic
k:= -1;
q:=0;
for i:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects[i]);
a:= 0;
q:=q+ d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
if q + 0.0001 > 2 then
if k = -1 then
begin
a:= a + Price*0.15; //0.15=15% discount
k:= 0;
end;
// Delete discount, if a sum changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
A script to add a 100% discount on dishes of a certain category, if there is a dish with the code "N"
When a dish with the code "N" is added to a new order, a 100% discount is assigned to dishes of a certain category. If a dish with the "N" code is deleted, the free dishes are deleted as well.
On the receipt editing form of the CheckView object, insert the following script in the CurItemChanged event:
procedure CheckViewCurItemChangedScript(Sender: TObject); begin AddEveryOtherDiscount(11); / / the code of the opened fixed amount discount on a dish end;
Place the following script before the abovementioned one:
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j: integer;
it, CurItem: TCheckItem;
DishCode, CntDish2: integer;
Categ: TClassificatorGroup;
CategCode: integer;
evr, qntdsc: integer;
d: TDish;
a, q, Price: double;
SL: TStringList;
CheckView: TCheckView;
begin
DishCode := 13; / / bonus dish code (if available, discount will be added)
CntDish2 := 0;
evr := 1; // make discount every this count
qntdsc := 0;
CategCode := 8; //8 - paste your category code
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, sorted by price
SL.Sorted := True;
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', CategCode));
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then
begin
if (TDish(it).Code = DishCode) then
CntDish2 := CntDish2 + trunc(TDish(it).Quantity);
if Categ.IsChild(it.RefItem) then //Check category of the dish
if not(TDish(it).IsComboComp) then
if ((it.State = disOpened) or (it.State = disPrinted)) then begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', Price) + IntToStr(TDish(it).UNI), TObject(it));
end;
end;
end;
if evr > 0 then
qntdsc := SL.Count div evr;
if (SL.Count >= evr) then
for i := 0 to SL.Count - 1 do begin
d := TDish(SL.Objects\[i\]);
a := 0;
q := d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
while q + 0.0001 > 1 do begin
//if (i+1) mod evr = 0 then
if ((i+1)<=qntdsc)and(qntdsc>0) then
a := a + Price;
q := q - 1;
end;
if CntDish2=0 then
a := 0;
// Delete discount, if a sum changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then begin
if abs(TDiscountItem(it).SrcAmount) = a then
a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if (a > 0)and(CntDish2>0) then begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then
CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
A Promotion script 2+1 and 3+1
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, every, qnt: integer;
it, CurItem: TCheckItem;
SL: TStringList;
a, q, AllQuantity, Price: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, sorted by price
SL.Sorted := True;
AllQuantity := 0;
every := 10000000;
if (TRk7Table(RK7.FindItemBySifr(rkrefTables, RKCheck.CurrentOrder.TableID)).TableGroup = 1010443) then // different discounts for different tables
every := 2; // àêöèÿ 2+1
if (TRk7Table(RK7.FindItemBySifr(rkrefTables, RKCheck.CurrentOrder.TableID)).TableGroup = 1009643) then
every := 3; // àêöèÿ 3+1, ýòî äîñòàâêà. Åññëè íóæíî êàæäóþ 3 - ñòàâèòüñÿ 3, åñëè 2-þ, òî çí-å 2
// every := 2;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', 11)); //5 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
//if Categ.IsChild(it.RefItem) then //Check category of the dish
if (it.RefItem.MainParent.code =11 ) then // if dish from category of menu and have same code
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', Price) + IntToStr(TDish(it).UNI), TObject(it));
AllQuantity := AllQuantity + TDish(it).Quantity;
end;
end;
//Magic
q:=0;
AllQuantity := (Trunc(AllQuantity) div every);
for i:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[i\]);
a:= 0;
q:= d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
if q>=AllQuantity then
qnt := int64(Trunc(AllQuantity))
else
qnt := Int64(Trunc(q));
a:= a + Price*qnt;
AllQuantity := Trunc(AllQuantity - qnt);
if AllQuantity<0 then AllQuantity := 0;
// Delete discount if a sum is changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
gui.showmessage('a='+FloattoStr(a)+' Price='+FloattoStr(Price)+' qnt='+FloattoStr(qnt)+' SL.Count='+FloattoStr(SL.Count)+' AllQuantity='+FloattoStr(AllQuantity));
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
procedure CheckViewCurItemChangedScript(Sender: TObject);
begin
// AddEveryOtherDiscount(17); / / the code of the opened fixed amount discount
end;
procedure CheckViewOnOrderVerify(Sender: TObject; AVerifyType: TVerifyType; oper: integer; var AContinue: boolean);
begin
if (AVerifyType=vtBill) then // ïðå÷åê
AddEveryOtherDiscount(17); / / the code of the opened fixed amount discount
end;
A script to create a discount on one serving of a dish from a category
There is a 100% discount on the category. This discount should be applied to dishes of the category, only to one item. The discount will be calculated when the bill is created.
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, numcateg: integer;
it, CurItem: TCheckItem;
SL: TStringList;
a, q, Price: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
skip: boolean;
begin
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, sorted by price
SL.Sorted := True;
numcateg := 8; //5 - category code
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg)); //5 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
// if (it.RefItem.MainParent.code =11 ) then // if dish from category of menu and have same code
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
skip := false;
for j:=0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[j\]);
if d.code=it.code then
Skip := True;
end;
if not(skip) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', Price) + IntToStr(TDish(it).UNI), TObject(it));
end;
end;
end;
//Magic
q:=0;
for i:= 0 to SL.Count - 1 do
begin
a:= 0;
d:= TDish(SL.Objects\[i\]);
q:= d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
a:= a + Price;
// Delete discount, if a sum changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
procedure CheckViewOnOrderVerify(Sender: TObject; AVerifyType: TVerifyType; oper: integer; var AContinue: boolean);
begin
if (AVerifyType=vtBill) then
AddEveryOtherDiscount(11); // Êîä ñóììîâîé ñêèäêè
end;
A script to create a discount on each pair of dishes
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, k, numcateg: integer;
it, CurItem: TCheckItem;
SL: TStringList;
a, q, qnt, Price, discperc: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
try
//******************************************************************
numcateg := 8; //8 - category code
discperc := 20; // discount %
//******************************************************************
// Create list of the dishes, sorted by price
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
SL.Sorted := False;
qnt := 0;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg)); //5 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
// if (it.RefItem.MainParent.code =11 ) then // if dish from category of menu and have same code
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', Price) + IntToStr(TDish(it).UNI), TObject(it));
qnt := qnt + TDish(it).Quantity;
end;
end;
//Magic
q:=0;
if (trunc(qnt/2))=(qnt/2) then k := SL.Count - 1
else
k := SL.Count - 2;
for i:= 0 to k do
begin
a:= 0;
d:= TDish(SL.Objects\[i\]);
q:= d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
a:= Price*discperc/100;
// Delete discount if a sum is changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
A script for the timer!!!!!!
procedure userTimer1OnTimer(Sender: TObject);
var CheckView: TCheckView;
begin
// Ensuring bill validity
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
if not RKCheck.Valid then Exit;
if (GUI.CheckFormInPayMode) then exit;
AddEveryOtherDiscount(12); // set discount code
end;
A script for a discount on every second identical dish of the specified category by timer
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, ii, j, k, numcateg, PrevCode: integer;
it, it2, CurItem: TCheckItem;
SL: TStringList;
a, q, Price, disk1, disk2, disk3: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
//************************** Set parameters **********************************//
numcateg := 8; // category code
disk1 := 1;
//************************** Set parameters **********************************//
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, as is
SL.Sorted := True;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg));
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it. Quantity > 0) then
SL.AddObject(FormatFloat('00000000.00', TDish(it).Code*1000000+TDish(it).Number) + IntToStr(TDish(it).UNI), TObject(it));
begin
// Delete discount
for j := RKCheck.CheckItemCount(TObject(TDish(it).Discounts)) - 1 downto 0 do
begin
it2 := RKCheck.CheckItemByNumber(TObject(TDish(it).Discounts), j);
if (it2.Code = DiscCode) then
RKCheck.DeleteCheckItem(it2);
end;
end;
end;
end;
//Magic
PrevCode := 0;
// k := 1;
for i:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[i\]);
a:= 0;
if PrevCode <> d.Code then
k := 1
else
k := k + 1;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
if (k mod 2) = 0 then
a:= a + Price*disk1;
// Delete discount, if a sum changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
PrevCode := d.Code;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
Script for the timer:
procedure userTimer1OnTimer(Sender: TObject);
var CheckView: TCheckView;
begin
// Ensuring bill validity
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
if not RKCheck.Valid then Exit;
if (GUI.CheckFormInPayMode) then exit;
AddEveryOtherDiscount(12);
end;
<span style="color: #003366">Insert this script for the MainSelector object in the OnSuitableItemScript event in the order editing form:</span>
procedure MainSelectorOnSuitableItemScript(Sender: TBasePanel; item: TReferentItem; var Suitable: boolean);
var tt: TTimer;
begin
tt := TTimer(GUI.findComponentByName('userTimer1'));
if SYS.ObjectInheritsFrom(item, 'TModifier') or(SYS.ObjectInheritsFrom(item, 'TKurs')) then
tt.enabled := false
else
tt.enabled := true;
end;
<span style="color: #336299">The script only works with the input of dishes in a separate line. It is configured in the properties of the dish: Servings — Add to order = "Separate line for each serving". The discount should be applied to</span> <span style="color: #336299">a dish only.</span>
A script for the promotion "Second course at a lower (or the same) price with a 50% discount"
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, k: integer;
it, CurItem: TCheckItem;
SL: TStringList;
a, q, Price: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
SL := TStringList.Create;
try
// Create list of the dishes, sorted by price
SL.Sorted := True;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', 44)); //44 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
if TDish(it).Quantity > 0 then
// if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
SL.AddObject(FormatFloat('00000000.00', 100000000-Price) + IntToStr(TDish(it).UNI),
TObject(it));
end;
end;
//Magic
k:= 0; / / -1 to start with the first course
q:=0;
for i:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[i\]);
a:= 0;
q:=q+ d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
if k = -1 then
begin
a:= a + Price*0.5; //0.5=50% discount
k:= 0;
end
else k := -1;
// Delete discount, if a sum changed
for j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do
begin
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
if (it.Code = DiscCode) then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else RKCheck.DeleteCheckItem(it);
break;
end;
end;
// Create discount to a dish
if a > 0 then
begin
CheckView.GotoItem(TObject(d));
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
procedure CheckViewCurItemChangedScript(Sender: TObject);
begin
AddEveryOtherDiscount(15);
end;
procedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
begin
AddEveryOtherDiscount(15);
end;
procedure userTimer1OnTimer(Sender: TObject);
var CheckView: TCheckView;
begin
// Checking valid check
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
if not RKCheck.Valid then Exit;
if (GUI.CheckFormInPayMode) then exit;
AddEveryOtherDiscount(22);
end;
A script for a flexible 50% discount
The customer (factory) feeds the organization employees. For employees, there is a 50% discount on lunch dishes (soup, salad, main course, drink) and afternoon snack (porridge, pastries, pancakes). At the same time, within one meal (lunch or afternoon tea), an employee can take only one dish of each category at a discount, the second one is at full cost.
procedure AddEveryOtherDiscount(Discount: TDiscountItem);
var
i, j, z, CategoryCodeNum, Disc1Code, Disc2Code: integer;
it, CurItem: TCheckItem;
SL, CategoryCode: TStringList;
a, CalcDiscount, q, Price, DiscPrc, Disc1Prc, Disc2Prc, Added: double;
d: TDish;
CheckView: TCheckView;
Categ: TClassificatorGroup;
begin
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
//********** Set parameters ***********//
Disc1Code := 50;
Disc2Code := 60;
Disc1Prc := 0.5;
Disc2Prc := 0.625;
DiscPrc := 0;
CategoryCode := TStringList.Create;
CategoryCode.Add('14');
CategoryCode.Add('15');
CategoryCode.Add('16');
// CategoryCode.Add('8');
//********** Set parameters ***********//
CurItem := RKCheck.CurrentCheckItem;
CalcDiscount:= 0;
SL := TStringList.Create;
try
if TDiscountItem(Discount).Code = Disc1Code then
DiscPrc := Disc1Prc;
if TDiscountItem(Discount).Code = Disc2Code then
DiscPrc := Disc2Prc;
for z := 0 to CategoryCode.Count-1 do
begin
CategoryCodeNum := StrToInt(CategoryCode.Strings\[z\]);
// Create list of the dishes, as is
SL.Sorted := True;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', CategoryCodeNum)); //5 - category code
if SYS.ObjectInheritsFrom(TObject(it), 'TDish') then //Check dish lines only
if Categ.IsChild(it.RefItem) then //Check category of the dish
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
if (TDish(it).Quantity = 0) or (TDish(it).PRListSum = 0) then Price := TDish(it).Price
else Price := TDish(it).PRListSum/TDish(it).Quantity;
if (TDish(it).Quantity > 0) and (TDish(it).Quantity <= 1) then
Price := TDish(it).PRListSum;
Added := 0;
for j:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[j\]);
if Categ.IsChild(d.RefItem) then
Added := Added + (d.Quantity);
end;
if Added = 0 then
SL.AddObject(FormatFloat('00000000.00', 20000000-Price) + IntToStr(TDish(it).UNI), TObject(it));
end;
end;
end;
//Magic
q:=0;
for i:= 0 to SL.Count - 1 do
begin
d:= TDish(SL.Objects\[i\]);
q:=q+ d.Quantity;
if (d.Quantity = 0) or (d.PRListSum = 0) then Price := d.Price
else Price := d.PRListSum/d.Quantity;
if (d.Quantity > 0) and (d.Quantity <= 1) then
Price := d.PRListSum;
CalcDiscount:= CalcDiscount + Price*DiscPrc; // DiscPrc % discount
end;
// Create discount to CalcDiscount dish
if CalcDiscount > 0 then
begin
TDiscountItem(Discount).SrcAmount := CalcDiscount;
TDiscountItem(Discount).ValueChanged := True;
end;
finally
SL.Free();
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
A script to recalculate a discount for two types of cards
procedure CheckViewOnBeforeCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject; var AAllow:boolean; var AMessage: string);
begin
if SYS.ObjectInheritsFrom(AObjectAft, 'TDiscountItem') then
begin
if TDiscountItem(AObjectAft).code = 50 then / / PDS discount code 1
begin
AddEveryOtherDiscount(TDiscountItem(AObjectAft));
end;
if TDiscountItem(AObjectAft).code = 60 then / / PDS discount code 2
begin
AddEveryOtherDiscount(TDiscountItem(AObjectAft));
end;
end;
end;
A script to recalculate a discount when the selected line is changed
procedure CheckViewCurItemChangedScript(Sender: TObject);
var i,HaveDisc: integer;
it,DiskItem: TCheckItem;
begin
// recalculate the discount when the selected item is changed
begin
dbg.dbgprint('change');
HaveDisc := 0;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then //Check discounts lines only
if (TDiscountItem(it).code = 50)or(TDiscountItem(it).code = 60) then //Check discount code
begin
HaveDisc := 1;
DiskItem := it;
end;
end;
if HaveDisc > 0 then
AddEveryOtherDiscount(TDiscountItem(DiskItem));
end;
end;
A script to combine discounts and extra charges
On the order editing form for the CheckView object, insert the scripts in the CurItemChanged and OnAfterCheckViewEdit events:
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, cntDisc: integer;
it, CurItem: TCheckItem;
Categ: TClassificatorGroup;
a, q, ChargeSum, DiscPerc: double;
CheckView: TCheckView;
ed: TObject;
begin
DiscPerc := 10; / / % discount
ChargeSum := 0;
cntDisc := 0;
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then
begin
if (TDiscountItem(it).Code <> DiscCode) then
ChargeSum := ChargeSum + TDiscountItem(it).CalcAmount;
end;
end;
a := (RKCheck.CurrentOrder.PriceListSum + ChargeSum)*DiscPerc/100;
// Delete discount, if a sum changed
for j := RKCheck.CurrentOrder.Sessions.LinesCount - 1 downto 0 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[j];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then
if (TDiscountItem(it).Code = DiscCode) then
if TDiscountItem (it).CalcAmount <> <> 0 then / / not deleted
begin
cntDisc := cntDisc + 1;
if abs(TDiscountItem(it).SrcAmount) = abs(a) then
a := 0
else
begin
if ((it.State = disOpened) or (it.State = disPrinted)) then
begin
TDiscountItem(it).SrcAmount := a;
a := 0;
end
else
if abs(TDiscountItem(it).CalcAmount)>0 then
begin
RKCheck.DeleteCheckItem(it);
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
end;
end;
// break;
end;
end;
// Create discount to a dish
if (a > 0) then
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
RKCheck.CurrentOrder.Recalc();
end;
procedure CheckViewCurItemChangedScript(Sender: TObject);
begin
AddEveryOtherDiscount(33); / / the code of the opened fixed amount discount on a dish
end;
procedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
begin
if SYS.ObjectInheritsFrom(AObjectAft, 'TDiscountItem') then
if TDiscountItem(AObjectAft).code = 33 then
exit;
AddEveryOtherDiscount(33); / / the code of the opened fixed amount discount on a dish
end;
A script to add an extra charge to the amount after the discount
Scripts for the receipt editing form:
procedure AddEveryOtherDiscount(DiscCode: integer);
var i, j, ChangeCode1,ChangeCode2,ChangeCode3: integer;
it, CurItem: TCheckItem;
a, PriceSum, DiscountSum, DiscPerc, DiscPerc1,DiscPerc2,DiscPerc3: double;
CheckView: TCheckView;
ed: TObject;
NeedAddDiscount: boolean;
begin
//************************** Set parameters **********************************//
ChangeCode1 := 36; // Code of charge
DiscPerc1 := 10; // 10%
ChangeCode2 := 37; // Code of charge
DiscPerc2 := 10; // 10%
ChangeCode3 := 2014; // Code of charge
DiscPerc3 := 10; // 10%
//************************** Set parameters **********************************//
if DiscCode = ChangeCode1 then
DiscPerc := DiscPerc1
else
if DiscCode = ChangeCode2 then
DiscPerc := DiscPerc2
else
if DiscCode = ChangeCode3 then
DiscPerc := DiscPerc3;
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
if CheckView = Nil then Exit;
CurItem := RKCheck.CurrentCheckItem;
NeedAddDiscount := true;
try
PriceSum := 0;
DiscountSum := 0;
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then
if TDiscountItem(it).code <> DiscCode then
DiscountSum := DiscountSum + TDiscountItem(it).CalcAmount;
end;
PriceSum := RKCheck.CurrentOrder.PriceListSum;
a:= (PriceSum + DiscountSum)* DiscPerc/100; // "+" because the discount amount is marked with "-"
// Delete or change discount, if sum changed
for j := RKCheck.CurrentOrder.Sessions.LinesCount - 1 downto 0 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[j];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then
if TDiscountItem(it).code = DiscCode then
begin
if abs(TDiscountItem(it).SrcAmount) = a then a := 0
else
begin
if not(TDiscountItem(it).State = disOpened) then
begin
RKCheck.DeleteCheckItem(it);
NeedAddDiscount := true;
end
else
begin
NeedAddDiscount := False;
if it <> Nil then CheckView.GotoItem(it);
ed := TObject(gui.FindComponentByName('Editor'));
TNumEditor(ed).Text := FloatToStr(a);
RK7.PerformOperation(rkoEditOpenPrice, 0);
end;
end
break;
end;
end;
// Create discount to a dish
if (a > 0)and NeedAddDiscount then
begin
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
NeedAddDiscount := False;
end;
finally
if CurItem <> Nil then CheckView.GotoItem(CurItem);
end;
RKCheck.CurrentOrder.Recalc();
end;
procedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
begin
if AEditType = etInsert then
if SYS.ObjectInheritsFrom(TObject(AObjectAft), 'TDiscountItem') then
AddEveryOtherDiscount(TDiscountItem(AObjectAft). code); / / extra charge code
end;
procedure CheckViewCurItemChangedScript(Sender: TObject);
var i, j, ChangeCode1,ChangeCode2,ChangeCode3: integer;
it, CurItem: TCheckItem;
a, PriceSum, DiscountSum, DiscPerc, DiscPerc1,DiscPerc2,DiscPerc3: double;
CheckView: TCheckView;
begin
//************************** Set parameters **********************************//
ChangeCode1 := 36; // Code of charge
DiscPerc1 := 10; // 10%
ChangeCode2 := 37; // Code of charge
DiscPerc2 := 10; // 10%
ChangeCode3 := 2014; // Code of charge
DiscPerc3 := 10; // 10%
//************************** Set parameters **********************************//
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
if SYS.ObjectInheritsFrom(TObject(it), 'TDiscountItem') then
if (it.code = ChangeCode1)or(it.code = ChangeCode2)or(it.code = ChangeCode3) then
AddEveryOtherDiscount(it.code); / / extra charge code
end;
end;
A script to configure consumators
The customer wants to pay waiters a percentage of the orders as a fee.
On the check editing form, insert the script for the CheckView object in the CurItemChanged event:
procedure CheckViewCurItemChangedScript(Sender: TObject);
var
i, ConsumCode: integer;
it: TCheckItem;
begin
ConsumCode := 0;
if RKCheck.currentOrder.MainWaiterCode = 2 then / / condition for employee with code 2
ConsumCode := 2; / / apply consumant with code 2
if RKCheck.currentOrder.MainWaiterCode = 3 then / / condition for employee with code 3
ConsumCode := 3; / / apply consumant with code 3
if ConsumCode <> 0 then
for i := 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do
begin
it := RKCheck.CurrentOrder.Sessions.Lines[i];
if SYS.ObjectInheritsFrom(it, 'TDish') then
// checking by Consumators
if TDish(it).Consumators.Count = 0 then
RKCheck.CreateCheckItem(rkrefConsumators, IntToStr(ConsumCode), '1');
end;
end;
[<span style="color: #0000ff"><span style="text-decoration: underline; "> DesignFormOnRef </span></span>][<span style="color: #0000ff"><span style="text-decoration: underline; "> MainSelectorOnSuitableItem, MainSelectorOnSuitableObject, MainSelectorAfterConnectObject, userGOperationButton</span></span>]