Page History

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

Code Block

language	delphi

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:

Code Block

language	delphi

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:

Code Block

language	delphi

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

Code Block

language	delphi

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.

Code Block

language	delphi

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

Code Block

language	delphi

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

...

Code Block

language	delphi

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

Code Block

language	delphi

procedure AddEveryOtherDiscountprocedure AddEveryOtherDiscount(DiscCode: integer integer);
 
var ivar i, ii, j, k, numcateg, PrevCode: integer integer;
 
it, it2, CurItem: TCheckItem;
 
SL: TStringList;
 
a, q, Price, disk1, disk2, disk3: double double;
 
d: TDish;
 
CheckView: TCheckView;
 
Categ: TClassificatorGroup;
 
begin
 
//************************** Set parameters **********************************//
 
numcateg := 8 8;  // category code
 
disk1 := 1 1;
 
//************************** Set parameters **********************************//
 
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
 
if CheckViewif CheckView = Nil then Exit Nil then Exit;
 
CurItem := RKCheck.CurrentCheckItem;
 
SL := TStringList.Create;
 
try
 
// Create list of the dishes, as is
 
SL.Sorted := True True;
 
for ifor i := 0 to RKCheck 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 1 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
 
Categ := TClassificatorGroup(getitemBycodeNum('ClassificatorGroups', numcateg));
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDish') then  then //Check dish lines only
 
if Categif Categ.IsChild(it.RefItem) then  then //Check category of the dish
 
if if ((it.State = disOpened) or  or (it.State = disPrinted)) then then
 
begin
 
if if (TDish(it. Quantity > > 00) then then
 
SL.AddObject(FormatFloat('00000000.00', TDish(it).Code*1000000+TDish(it).Number) + IntToStr(TDish(it).UNI), TObject(it));
 
begin
 
// Delete discount
 
for jfor j := RKCheck.CheckItemCount(TObject(TDish(it).Discounts)) - 1 downto 0 do 1 downto 0 do
 
begin
 
it2 := RKCheck.CheckItemByNumber(TObject(TDish(it).Discounts), j);
 
if if (it2.Code = DiscCode) then then
 
RKCheck.DeleteCheckItem(it2);
 
end;
 
end;
 
end;
 
end;
 
 
//Magic
 
PrevCode := 0 0;
 
// k := 1;
 
for ifor i:= 0 to SL 0 to SL.Count - 1 do 1 do
 
begin
 
d:= TDish(SL.Objects\[i\]);
 
a:= 0 0;
 
if PrevCodeif PrevCode <> d.Code thenCode then
 
k := 1 1
 
else
 
k := k + 1 1;
 
 
if if (d.Quantity = 0) or  0) or (d.PRListSum = 0) then Price 0) then Price := d.Price
 
else Priceelse Price := d.PRListSum/d.Quantity;
 
if (k mod 2if (k mod 2) = 0 then 0 then
 
a:= a + Price*disk1;
 
// Delete discount, if a sum changed
 
for jfor j := RKCheck.CheckItemCount(TObject(d.Discounts)) - 1 downto 0 do 1 downto 0 do
 
begin
 
it := RKCheck.CheckItemByNumber(TObject(d.Discounts), j);
 
if if (it.Code = DiscCode) then then
 
begin
 
if absif abs(TDiscountItem(it).SrcAmount) = a then aa then a := 0 0
 
else RKCheckelse RKCheck.DeleteCheckItem(it);
 
break;
 
end;
 
end;
 
// Create discount to a dish
 
if a > 0 thenif 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 CheckViewif CurItem <> Nil then CheckView.GotoItem(CurItem);
 
end;
 
RKCheck.CurrentOrder.Recalc();
 
end;
Script for the timer:
procedure userTimer1OnTimer

A script for the timer:

Code Block

language	delphi

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

Insert this script for the MainSelector object in the OnSuitableItemScript event in the order editing form:

Code Block

language	delphi

procedure MainSelectorOnSuitableItemScript(Sender: TBasePanel; item: TReferentItem; var Suitable: boolean 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>

Note
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 a dish only.

A script for the promotion "Second course at a lower (or the same) price with a 50% discount"

Code Block

language	delphi

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)

...

caters to the organization's 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

...

snack, an employee can take only one dish of each category at a discount, the second one is at full cost.

Code Block

language	delphi

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

Code Block

language	delphi

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

...

unmigrated-wiki-markup

Code Block

language	delphi

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:

Code Block

language	delphi

procedure AddEveryOtherDiscount
procedure AddEveryOtherDiscount(DiscCode: integer integer);
 
var ivar i, j, cntDisc: integer integer;
 
it, CurItem: TCheckItem;
 
Categ: TClassificatorGroup;
 
a, q, ChargeSum, DiscPerc: double double;
 
CheckView: TCheckView;
 
ed: TObject;
 
begin
 
DiscPerc := 10 10;  / / % of a discount
 
ChargeSum := 0 0;
 
cntDisc := 0 0;
 
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
 
if CheckViewif CheckView = Nil then Exit Nil then Exit;
 
for ifor i := 0 to RKCheck 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do begin 1 do begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDiscountItem') then then
 
begin
 
if if (TDiscountItem(it).Code <> DiscCode) then then
 
ChargeSum := ChargeSum + TDiscountItem(it).CalcAmount;
 
end;
 
end;
 
a := (RKCheck.CurrentOrder.PriceListSum + ChargeSum)*DiscPerc/100;
 
 
// Delete discount, if a sum changed
 
for jfor j := RKCheck.CurrentOrder.Sessions.LinesCount - 1 downto 0 do 1 downto 0 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[j\];
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDiscountItem') then then
 
if if (TDiscountItem(it).Code = DiscCode) then then
 
if TDiscountItemif TDiscountItem (it).CalcAmount <> <> 0 then <> 0 then / / not deleted
 
begin
 
cntDisc := cntDisc + 1 1;
 
if absif abs(TDiscountItem(it).SrcAmount) = abs abs(a) then then
 
a := 0 0
 
else
 
begin
 
if if ((it.State = disOpened) or  or (it.State = disPrinted)) then then
 
begin
 
TDiscountItem(it).SrcAmount := a;
 
a := 0 0;
 
end
 
else
 
if absif abs(TDiscountItem(it).CalcAmount)>0 then>0 then
 
begin
 
RKCheck.DeleteCheckItem(it);
 
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
 
end;
 
end;
 
// break;
 
end;
 
end;
 
 
// Create discount to a dish
 
if if (a > 0) then> 0) then
 
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
 
RKCheck.CurrentOrder.Recalc();
 
end;
 
 
procedure CheckViewCurItemChangedScriptprocedure CheckViewCurItemChangedScript(Sender: TObject);
 
begin
 
AddEveryOtherDiscount(33);  / / the code of the opened fixed amount discount on a dish
 
end;
 
 
procedure CheckViewOnAfterCheckViewEditprocedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
 
begin
 
if SYSif SYS.ObjectInheritsFrom(AObjectAft,  'TDiscountItem') then then
 
if TDiscountItemif TDiscountItem(AObjectAft).code = 33 then 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:

Code Block

language	delphi

procedure AddEveryOtherDiscount
procedure AddEveryOtherDiscount(DiscCode: integer integer);
 
var ivar i, j, ChangeCode1,ChangeCode2,ChangeCode3: integer integer;
 
it, CurItem: TCheckItem;
 
a, PriceSum, DiscountSum, DiscPerc, DiscPerc1,DiscPerc2,DiscPerc3: double double;
 
CheckView: TCheckView;
 
ed: TObject;
 
NeedAddDiscount: boolean boolean;
 
begin
 
//************************** Set parameters **********************************//
 
ChangeCode1 := 36 36;  // Code of charge
 
DiscPerc1 := 10 10;  // 10%
 
ChangeCode2 := 37 37;  // Code of charge
 
DiscPerc2 := 10 10;  // 10%
 
ChangeCode3 := 2014 2014;  // Code of charge
 
DiscPerc3 := 10 10;  // 10%
 
//************************** Set parameters **********************************//
 
if DiscCodeif DiscCode = ChangeCode1 thenChangeCode1 then
 
DiscPerc := DiscPerc1
 
else
 
if DiscCodeif DiscCode = ChangeCode2 thenChangeCode2 then
 
DiscPerc := DiscPerc2
 
else
 
if DiscCodeif DiscCode = ChangeCode3 ChangeCode3 thenthen
 
DiscPerc := DiscPerc3;
 
CheckView := TCheckView(GUI.FindComponentByName('CheckView'));
 
if CheckViewif = Nil then ExitCheckView = Nil then Exit;
 
CurItem := RKCheck.CurrentCheckItem;
 
NeedAddDiscount := true true;
 
try
 
PriceSum := 0 0;
 
DiscountSum := 0 0;
 
for ifor i := 0 to RKCheck 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 1 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDiscountItem') then then
 
if TDiscountItemif TDiscountItem(it).code <> DiscCode thenDiscCode 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 jfor j := RKCheck.CurrentOrder.Sessions.LinesCount - 1 downto 0 do 1 downto 0 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[j\];
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDiscountItem') then then
 
if TDiscountItemif TDiscountItem(it).code = DiscCode DiscCode thenthen
 
begin
 
if absif abs(TDiscountItem(it).SrcAmount) = a then a then aa := 0 0
 
else
 
begin
 
if notif not(TDiscountItem(it).State = disOpened) then then
 
begin
 
RKCheck.DeleteCheckItem(it);
 
NeedAddDiscount := true true;
 
end
 
else
 
begin
 
NeedAddDiscount := False False;
 
if itif <> Nil then CheckView.GotoItem(itit <> Nil then CheckView.GotoItem(it);
 
ed := TObject(gui.FindComponentByName('Editor'));
 
TNumEditor(ed).Text := FloatToStr(a);
 
RK7.PerformOperation(rkoEditOpenPrice, 0 0);
 
end;
 
end
 
break;
 
end;
 
end;
 
 
// Create discount to a dish
 
if if (a > > 0)and NeedAddDiscount then0)and NeedAddDiscount then
 
begin
 
RKCheck.CreateCheckItem(rkrefDiscounts, IntToStr(DiscCode), FloatToStr(a));
 
NeedAddDiscount := False False;
 
end;
 
finally
 
if CurItem <> Nil then CheckViewif CurItem <> Nil then CheckView.GotoItem(CurItem);
 
end;
 
RKCheck.CurrentOrder.Recalc();
 
end;
 
 
 
procedure CheckViewOnAfterCheckViewEditprocedure CheckViewOnAfterCheckViewEdit(Sender: TObject; AEditType: TEditType; AObjectBef, AObjectAft: TObject);
 
begin
 
if AEditTypeif AEditType = etInsert etInsert thenthen
 
if SYSif SYS.ObjectInheritsFrom(TObject(AObjectAft),  'TDiscountItem') then then
 
AddEveryOtherDiscount(TDiscountItem(AObjectAft). code);  / / extra charge code
 
end;
 
 
 
procedure CheckViewCurItemChangedScriptprocedure CheckViewCurItemChangedScript(Sender: TObject);
 
var ivar i, j, ChangeCode1,ChangeCode2,ChangeCode3: integer integer;
 
it, CurItem: TCheckItem;
 
a, PriceSum, DiscountSum, DiscPerc, DiscPerc1,DiscPerc2,DiscPerc3: double double;
 
CheckView: TCheckView;
 
begin
 
//************************** Set parameters **********************************//
 
ChangeCode1 := 36 36;  // Code of charge
 
DiscPerc1 := 10 10;  // 10%
 
ChangeCode2 := 37 37;  // Code of charge
 
DiscPerc2 := 10 10;  // 10%
 
ChangeCode3 := 2014 2014;  // Code of charge
 
DiscPerc3 := 10 10;  // 10%
 
//************************** Set parameters **********************************//
 
for ifor i := 0 to RKCheck 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 1 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
 
if SYSif SYS.ObjectInheritsFrom(TObject(it),  'TDiscountItem') then then
 
if if (it.code = ChangeCode1)or(it.code = ChangeCode2)or(it.code = ChangeCode3) then 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:

Code Block

language	delphi

procedure CheckViewCurItemChangedScript
procedure CheckViewCurItemChangedScript(Sender: TObject);
 
var
 
i, ConsumCode: integer integer;
 
it: TCheckItem;
 
begin
 
ConsumCode := 0 0;
 
if RKCheckif RKCheck.currentOrder.MainWaiterCode = 2 then  2 then / / condition for employee with code 2
 
ConsumCode := 2 2;  / / apply consumant with code 2
 
if RKCheckif RKCheck.currentOrder.MainWaiterCode = 3 then / / 3 then / / condition for employee with code 3
 
ConsumCode := 3 3;  / / apply consumant with code 3
 
if ConsumCode <> 0 thenif ConsumCode <> 0 then
 
for ifor i := 0 to RKCheck 0 to RKCheck.CurrentOrder.Sessions.LinesCount - 1 do 1 do
 
begin
 
it := RKCheck.CurrentOrder.Sessions.Lines\[i\];
 
if SYSif SYS.ObjectInheritsFrom(it,  'TDish') then then
 
// checking by Consumators
 
if TDishif TDish(it).Consumators.Count = 0 then 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]

Child pages

Versions Compared

Old Version 3

New Version 4

Key

Table of Contents

A script to apply a discount (15% of the price per serving) to the second serving of a dish from a certain category

A script to add a 100% discount on dishes of a certain category, if there is a dish with the code "N"

A

promotion script 2+1 and 3+1

A script to create a discount on one serving of a dish from a category

A script to create a discount on each pair of dishes

A script for a discount on every second identical dish of the specified category by timer

A script for the promotion "Second course at a lower (or the same) price with a 50% discount"

A script for a flexible 50% discount

A script to recalculate a discount for two types of cards

A script to recalculate a discount when the selected line is changed

A script to combine discounts and extra charges

A script to add an extra charge to the amount after the discount

A

script to configure consumators