{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          P R I C E   L I S T S                       ***
 ***                                                                      ***
 *** M Hill                                                        Dec 94 ***
 ****************************************************************************}
{Provides a way of producing standard price lists, picking up the most
recent prices from the products list.  Price lists are kept in the documents
list.  Assumes products included}
{$I compdirs}  {Compiler directives}

unit KPLists;

INTERFACE

uses kdocs, nodes, files, objects, output, edit, scodes, menus, views;

const
	TPriceListSize =  TDocumentSize + 50;

type
	PPriceList = ^TPriceList;
	TPriceList = object(TDocument)

		Band		: TSCode;							{Price banding for this print - from directory search categories}

		ItemTree : TNodeTree;

		{-- Methods --}
		constructor Init;
		procedure CommonInit; virtual;
		destructor Done; virtual;

		function DisplayLine(Maxlen : integer; View : word) : string; virtual;

		{Database stuff}
		constructor Load(var S : TStream);
		procedure   Store(var S : TSTream);

		{Processing stuff}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(OutputStream : POutputStream; Prefix : string);  virtual; {Sets standard PriceList codes}

		function Print(prType : word; Output : POutputStream) : word; virtual;
end;

const
	TCodedPriceListSize = TDocumentSize + 50;

type
	PCodedPriceList = ^TCodedPriceList;
	TCodedPriceList = object(TDocument)

		Band		: TSCode;							{Price banding for this print - from directory search categories}

    ProductCat : TSCode; 			{product categories}

		{-- Methods --}
		constructor Init;
		procedure CommonInit; virtual;
		destructor Done; virtual;

		function DisplayLine(Maxlen : integer; View : word) : string; virtual;

		{Database stuff}
		constructor Load(var S : TStream);
		procedure   Store(var S : TSTream);

		{Processing stuff}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(OutputStream : POutputStream; Prefix : string);  virtual; {Sets standard PriceList codes}

		function Print(prType : word; Output : POutputStream) : word; virtual;
end;

var {Task lists}
		PriceListMenu : PMenu;

{***************************************************************************
 ***                 IMPLEMENTATION                                      ***
 ***************************************************************************}
IMPLEMENTATION

uses	indexes, idxjimmy, jimmys,
			errors,
      money,
			minilib,
			mlist,
			displays, kamapp, app, tasks,
			kproduct, inpprod,
			jimhooks,
			kinvnode,
			global;



{****************************************************************************
 ***                                                                      ***
 ***                THE PriceList OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

function CreatePriceList(P : pointer) : pointer; far;
begin	CreatePriceList := New(PPriceList, init); end;

constructor TPriceList.Init;
begin
	inherited Init;
	Band := '';
end;

procedure TPriceList.CommonInit;
begin
	inherited CommonInit;

	ItemTree.init(fiInvoiceNodes);

	ScodeAdmin[scDirectorySearch]^.LogOn;
end;


destructor TPriceList.Done;
begin
	ScodeAdmin[scDirectorySearch]^.LogOff;

	Itemtree.Done;

	inherited Done;
end;


function TPriceList.DisplayLine;
begin
	DisplayLine := Desc;
end;


{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
{THE LOAD AND STORE *MUST* MATCH, AS THE INDEX IS CALCULATED ASSUMING
RECORDS ALL OF THE SAME LENGTH. SEE ABOVE "TDatSIZE" CONSTANT TO SET
THE SIZE}
 const
	 {--- Required for Stream ----}
	 RPriceList : TStreamRec = (
		 ObjType : srPriceList;
		 VmtLink : Ofs(TypeOf(TPriceList)^);
		 Load : @TPriceList.Load;
		 Store : @TPriceList.Store
	 );

{------- LOAD MAIN DATA ----------}
constructor TPriceList.Load;
var Ver : byte;
begin
	inherited Load(S);

	S.Read(Ver,1);

	S.Read(Band, sizeof(Band));

	itemtree.load(s);

end;

{-------- STORE MAIN DATA ----------}
procedure TPriceList.Store;
var	StartPos : longint;
		Ver : byte;

begin
	StartPos := S.GetPos;

  inherited Store(S);

	Ver := 1; S.Write(Ver, 1);

	S.Write(Band, sizeof(Band));

	itemtree.store(s);

	TopUpRecord(S, TPriceListSize, STartpos);
end;



{***************************************************************************
 ***                EDIT PRICE LIST                                      ***
 ***************************************************************************}
procedure TPriceList.MakeEditBox;
var R : TRect;
		NodeViewer : PNodeViewer;
begin
	if not ItemTree.Loaded then ItemTree.LoadTree;

	R.Assign(0, 0, 55, 20); {Size of box}
	New(EditBox, Init(R, 'Price List Registration',Caller));

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

    insert(New(PSkipBytes, init(sizeof(TDocument)-sizeof(TJimmy)-sizeof(DocType)-sizeof(Desc))));

		InsTitledField(14, 2,30, 1, 'Type', New(PInputSCLine, init(R,11, scDocument)));
		InsTitledField(14, 3,20, 1, 'Desc', New(PInputELine, init(R,20)));

		InsTitledField(14, 4,20, 1, 'Price Band', New(PInputSCode, init(R, scDirectorySearch)));

		R.Assign(1,6,50,15);
		New(NodeViewer, init(R, 0, PriceListMenu));
		Insert(NodeViewer);
		Insert(NodeViewer^.VSCrollBar);   	{Scroll bar}
		InsLabel(11,  R.A.Y-1, 'Item ~L~ist', Current);

		{-- Buttons --}
		Insert(New(PJimmyPrintButton, init(15,17, @Self)));
		Insert(New(PJimmyOKButton, Init(26,17, @Self)));
		InsCancelButton(37,17);

		EndInit;

	end;
end;

{**********************************************************
 ***                    SET FORM CODES                  ***
 **********************************************************}
procedure TPriceList.SetFormCodes;
begin
  inherited SetFormCodes(OutputStream, Prefix);
	with OutputStream^ do begin
    SetCode(Prefix+'BAND', ExpandSCode(scDirectorySearch, Band));
    SetCode(Prefix+'BANDSC', Band); {set band short code for product items to print right price}

		OutputStream^.SetCodedFunc('ITEMS',PrintInvoiceTree, @ItemTree);
{		SetInvoiceItemsCode(ItemTree, OutputStream);{}
	end;
end;


{*****************************************************************
 ***                      PRINT                                ***
 *****************************************************************}
function TPriceList.Print;
begin
  if prType <> (prFullPage+prOutput+prNow) then begin
		Print := inherited Print(prType, Output);
		exit;
	end;

  SetFormCodes(Output, '');
	Output^.StartPrint('PLIST','');
  SetFormCodes(Output, ''); {in case printing items has changed any}
  Output^.EndPrint;
end;


{****************************************************************************
 ***                                                                      ***
 ***                THE CodedPriceList OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

function CreateCodedPriceList(P : pointer) : pointer; far;
begin	CreateCodedPriceList := New(PCodedPriceList, init); end;

constructor TCodedPriceList.Init;
begin
	inherited Init;
	Band := '';
	ProductCat := '';
end;

procedure TCodedPriceList.CommonInit;
begin
	inherited CommonInit;

	ScodeAdmin[scDirectorySearch]^.LogOn;
  ScodeAdmin[scProductCategory]^.LogOn;
end;


destructor TCodedPriceList.Done;
begin
	ScodeAdmin[scDirectorySearch]^.LogOff;
  ScodeAdmin[scProductCategory]^.LogOff;
	inherited Done;
end;


function TCodedPriceList.DisplayLine;
begin
	DisplayLine := inherited Displayline(Maxlen, View)
									+ ' '+ExpandSCode(scDirectorySearch, band)
									+ ' '+ExpandScode(scProductCategory, ProductCat);
end;



{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
{THE LOAD AND STORE *MUST* MATCH, AS THE INDEX IS CALCULATED ASSUMING
RECORDS ALL OF THE SAME LENGTH. SEE ABOVE "TDatSIZE" CONSTANT TO SET
THE SIZE}
 const
	 {--- Required for Stream ----}
	 RCodedPriceList : TStreamRec = (
		 ObjType : srCodedPriceList;
		 VmtLink : Ofs(TypeOf(TCodedPriceList)^);
		 Load : @TCodedPriceList.Load;
		 Store : @TCodedPriceList.Store
	 );

{------- LOAD MAIN DATA ----------}
constructor TCodedPriceList.Load;
var Ver : byte;
begin
  inherited Load(S);

	S.Read(Ver,1);

	S.Read(Band, sizeof(Band));
  s.Read(ProductCat, sizeof(ProductCat));
end;

{-------- STORE MAIN DATA ----------}
procedure TCodedPriceList.Store;
var	StartPos : longint;
		Ver : byte;

begin
	StartPos := S.GetPos;

  inherited Store(S);

	Ver := 1; S.Write(Ver, 1);

	S.Write(Band, sizeof(Band));

  S.Write(ProductCat, sizeof(ProductCat));

	TopUpRecord(S, TCodedPriceListSize, STartpos);
end;



{***************************************************************************
 ***                EDIT DIRECTORY ITEM                                  ***
 ***************************************************************************}
procedure TCodedPriceList.MakeEditBox;
var R : TRect;
		NodeViewer : PNodeViewer;
begin
	R.Assign(0, 0, 50, 11); {Size of box}
	New(EditBox, Init(R, 'Price List Registration',Caller));

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller);

    Insert(New(PSkipBytes, init(sizeof(TDocument)-sizeof(Tjimmy)-sizeof(DocType)-sizeof(Desc))));

		InsTitledField(14, 2,30, 1, 'Type', New(PInputSCLine, init(R,11, scDocument)));
		InsTitledField(14, 3,20, 1, 'Desc', New(PInputELine, init(R,20)));

		InsTitledField(14, 4,20, 1, 'Price Band', New(PInputSCode, init(R, scDirectorySearch)));

		InsTitledField(14, 6,30, 1, 'Categories', New(PInputSCLine, init(R,11, scProductCategory)));

		{-- Buttons --}
		Insert(New(PJimmyPrintButton, init(15, 8, @Self)));
		Insert(New(PJimmyOKButton, Init(26, 8, @Self)));
		InsCancelButton(37, 8);

		EndInit;
	end;

end;

{**********************************************************
 ***                    SET FORM CODES                  ***
 **********************************************************}
procedure TCodedPriceList.SetFormCodes;
begin
	inherited SetFormCodes(OutputStream, '');
	with OutputStream^ do begin
    SetCode(Prefix+'BAND', ExpandSCode(scDirectorySearch, Band));
		SetCode(Prefix+'CAT', ExpandSCode(scProductCategory, ProductCat));
  	SetCode(Prefix+'ITEMS', ''); {blank out - same form used for selected price lists}
	end;
end;



{*****************************************************************
 ***                      PRINT                                ***
 *****************************************************************}
function TCodedPriceList.Print;
var Product : PProduct;
		Rec : longint;
    Prices : string;
    U : byte;

begin
  if prType <> (prFullPage+prOutput+prNow) then begin
		Print := inherited Print(prType, Output);
		exit;
	end;

  {-- print header ---}
  SetFormCodes(Output, '');
	Output^.StartRpt('PLIST');

  {--- run through product list extracting items -----}
  FileAdmin(fiCatProdIdx)^.LogOn;

  for Rec := 0 to IndexStream(fiCatProdIdx)^.NoRecs - 1 do begin

  	Product := PProduct(IndexStream(fiCatProdIdx)^.GetJimmyAtIdx(Rec));

    if Product<>nil then begin

    	{only print if got by #1 ix (so we don't duplicate) and match}
    	if (Product^.gotbyix=1) and (pos(ProductCat, Product^.Categories)>0) then begin

    		Product^.SetFormCodes(Output, '');

        {set up pricing structure}
        Prices := '';

      	for U := 0 to 3 do
          	Prices := Prices +Product^.PriceBand[Product^.GetArrayPosOfBand(Band)].Price[U].Text(mtPoundsPence)+ CRLF;

        Output^.SetCode('PRICES', Prices);

    		Output^.PrintForm('PLIST.FRM');

      end;

    	dispose(Product, done);
    end;
  end;

	FileAdmin(fiCatProdIdx)^.LogOff;

  {-- print footer ----}
  SetFormCodes(Output, ''); {in case printing items has changed any}
  Output^.EndPrint;
end;


{**************************************************************
 ***                                                        ***
 ***         JIMMY FOR SELECTING PRODUCT ITEM               ***
 ***                                                        ***
 **************************************************************}

const
	TProductItemSize = TInvoiceNodeSize + 10;

type
	PProductItem = ^TProductItem;
	TProductItem = object(TInvoiceNode)

		ProductID : longint;

		{-- Methods --}
		constructor Init;

		{Display}
		function DisplayLine(Maxlen : integer) : string; virtual;

		{DataBase}
		constructor Load(var S : TDataStream);
		procedure   Store(var S : TDataSTream);

		function Edit(Caller : PView; Focused : PObject) : word; virtual;

		procedure SetFormCodes(Output : POutputStream; PreviousItem : PInvoiceNode); virtual;
		function Print(prType : word; Output : POutputStream; PreviousItem : PNodeItem) : word;  virtual;
	end;

function CreateProductItem(P : pointer) : pointer; far;
begin	CreateProductItem := New(PProductItem, init); end;


const
	{--- Required for Stream ----}
	RProductItem : TStreamRec = (
		ObjType : srProductItem;
		VmtLink : Ofs(TypeOf(TProductItem)^);
		Load : @TProductItem.Load;
		Store : @TProductItem.Store
	);

constructor TProductItem.Init;
begin
	inherited Init;
	ProductID := -1;
end;

{******************************
*** DISPLAY LINE           ***
******************************}

function TProductItem.DisplayLine;
begin
	DisplayLine := GetJimmyIDName(ProductID, naDisplay, Maxlen);
end;


{*******************************************
 ***            EDIT                     ***
 *******************************************}
{unused - goes straight to list}
{procedure TProductItem.StartEditBox;{}

function  TProductItem.Edit;
var	R : TRect;
		ProductList : PProductList;
		Inputproduct : PInputproduct;

begin
	ProductID := -1;

	{Don't use an edit box - just go straight to list}
	R.Assign(0,0,50,15);
	New(ProductList, init(R, 'PRODUCT LIST', fiCatProdIdx));

	if productList <> nil then begin	{ie Directory not locked, etc}
		{Centre on caller}
		CascadeInView(Caller, ProductList^);

		{Set acceptor link to inputhardware - it's not displayed, but it will provide the "accept" methods}
		New(InputProduct, init(R, 10));
		InputProduct^.SetState(sfSelected, True); {to fool jimmy acceptor part of inherited into
														thinking this is the currently selected view}
		ProductList^.List^.AcceptorLink := InputProduct;

		{Make modal and input}
		Desktop^.ExecView(ProductList);
		Dispose(ProductList, Done);

		{retrieve accepted number, if there is one}
		InputProduct^.GetData(ProductID);
		dispose(InputProduct, done);
	end;

	if ProductID = -1 then Edit := cmCancel else Edit := cmOK;
end;


{************************
 *** LOAD            ****
 ************************}
constructor TProductItem.Load;
var Ver : byte;
begin
	S.Read(Ver, 1);

	inherited Load(S);

	case Ver of
		1 : begin
			S.Read(ProductID,4);
		end;
	else
		DBaseError(@S,'Version '+L2Str(Ver)+' not known','Retrieving Product Invoice Item')
	end;
end;

procedure TProductItem.Store;
var
	StartPos : longint;
	ver : byte;

begin
	StartPos := S.GetPos;
	Ver := 1; S.Write(Ver, 1);

	inherited Store(S);
	S.Write(ProductID, 4);

	CheckRecOver(S, TProductItemSize, StartPos);
end;


{***************************
 *** PRINT               ***
 ***************************}
procedure TProductItem.SetFormCodes;
var U : byte;
		Prices, Band : string;
    Product : PProduct;
begin
	inherited SetFormCodes(Output, PInvoiceNode(PreviousItem));

  Product := PProduct(JimmyStream^.GetAt(ProductID));
	Product^.SetFormCodes(Output, '');

	{set up pricing structure}

  Output^.Decode('BANDSC','',Band);  {get price band}

	Prices := '';

	for U := 0 to 3 do
		Prices := Prices +Product^.PriceBand[Product^.GetArrayPosOfBand(Band)].Price[U].Text(mtPoundsPence)+ CRLF;

  Output^.SetCode('PRICES', Prices);

  dispose(Product, done);

end;


function TProductItem.Print;
begin
	Print := cmOK; {didn't print}

	SetFormCodes(Output, nil);

  Output^.PrintForm('PLISTPI.FRM');

end;


{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
	AddItemEnd(DocumentsNewMenu, NewItem('~P~rice List', '', kbNone, cmNewpriceList, hcNoContext, nil));
	RegisterCreator(cmNewPriceList, CreatePriceList);
	RegisterType(RPriceList);

	PriceListMenu := nil;
	AddItemEnd(PriceListMenu, NewItem('~P~roduct', '', kbNone, cmNewProductItem, hcNoContext, nil));
	RegisterCreator(cmNewProductItem, CreateProductItem);

	AddItemEnd(DocumentsNewMenu, NewItem('~C~oded Price List', '', kbNone, cmNewCodedpriceList, hcNoContext, nil));
	RegisterCreator(cmNewCodedPriceList, CreateCodedPriceList);
	RegisterType(RCodedPriceList);

	RegisterType(RProductItem);
end.


