RK7 

[

r_keeper 7|file:///D:\profile\Documents%D0%9A%D0%B8%D1%80%D0%B8%D0%BB%D0%BB%D0%A2%D0%B5%D1%85%D0%BD%D0%B8%D1%87%D0%B5%D1%81%D0%BA%D0%B0%D1%8F%20%D0%B4%D0%BE%D0%BA%D1%83%D0%BC%D0%B5%D0%BD%D1%82%D0%B0%D1%86%D0%B8%D1%8F.html]

*

CurItemChanged

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;

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;
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>|D:\profile\Documents\Кирилл\DesignFormOnRef.html][<span style="color: #0000ff"><span style="text-decoration: underline; "> MainSelectorOnSuitableItem, MainSelectorOnSuitableObject, MainSelectorAfterConnectObject, userGOperationButton</span></span>|D:\profile\Documents\Кирилл\MainSelectorOnSuitableItem, MainSelectorOnSuitableObject, MainSelectorAfterConnectObject, userGOperationButton.html]