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