| 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
The script is inserted into 2 events - CurItemChanged and OnAfterCheckViewEdit
| Code Block | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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
...
| Code Block | ||
|---|---|---|
| ||
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 | ||
|---|---|---|
| ||
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 <> 0 then 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 > > 00) then 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 | ||
|---|---|---|
| ||
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 ChangeCode1 thenthen 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 CheckView = Nil then Exit 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 thenDiscCode then begin if absif abs(TDiscountItem(it).SrcAmount) = a then aa then a := 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 it <> Nil then CheckViewif it <> 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 then> 0)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 thenetInsert then 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 | ||
|---|---|---|
| ||
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] |