| Table of Contents |
|---|
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
| 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 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; |
...
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; |
...
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 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; |
...
| 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(DiscCode: |
...
integer); |
...
var i, j, cntDisc: |
...
integer; it, CurItem: TCheckItem; Categ: TClassificatorGroup; a, q, ChargeSum, DiscPerc: |
...
double; CheckView: TCheckView; ed: TObject; begin DiscPerc := |
...
10; |
...
/ / % of a 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:
...
| Code Block | ||
|---|---|---|
| ||
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:
...
| Code Block | ||
|---|---|---|
| ||
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 |
...
; |
...