{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          S U P P L I E S                             ***
 ***                                                                      ***
 *** M Hill                                                      Sep 1996 ***
 ****************************************************************************}
{To provide objects for three sorts of supplies:
	Goods - ie stocked items that are re-sold
	Services - ie etheral items charged base price + per unit
	Products - things the company produces

Should also, at some stage, provide a root?}

{$I compdirs}  {Compiler directives}

unit KForSale;

INTERFACE

uses
	tuiedit,
	objects, scodes, dattime, files, global, tasks,
	multcurr,
	devices, forms,
	views,
	ordproc, {for productorderitem}
	jimmys, jimindxs;


{**************************************
 ***           Goods               ***
 **************************************}

type

	PGoods = ^TGoods;
	TGoods = object(TJimmy)

		CategoryIdx : array[1..3] of longint;
		CodeIdx : longint;

		Categories : string[11];
		Desc : string[20];
		Code : string[20];			{for catalogue code/etc reference}

		SupplierID : longint;
		VATCode : TSCode;
		IncAccCode : TSCode;

		Price : TMoney;

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

		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;
		function recsize : word; virtual;
		function srtype : word; virtual;

		{for fixit, etc}
		function NumIDs : byte; virtual; {the number of jimmy ID ptrs in the data}
		function GetJimmyID(const jiType : byte) : PLongint; virtual; {each jimmy ID}

		{--- Indexing ----}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- special methods ----}
		procedure GetPriceFor(const UnitCode : TSCode; const BandCode : string; var Money : TMoney); virtual;
		procedure GetCostFor(const UnitCode : TScode; var Money : TMoney); virtual;
	end;


	PGoodsOrderItem = ^TGoodsOrderItem;
	TGoodsOrderItem = object(TOrderItem)

		GoodsID : longint;

		Quantity : string[10];
		Units    : TScode;

		PriceEach : TMoney;

		{-- Methods --}
		constructor Init(Param : PJimmyInitParam);
		procedure COmmonInit; virtual;
		destructor Done; virtual;

		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{Other Jimmy ID ptrs - for fixit, etc}
		function NumIDs : byte; virtual; {the number of jimmy ID ptrs in the data}
		function GetJimmyID(const jiType : byte) : PLongint; virtual; {each jimmy ID}

		{for setting a small getkey, just so that it gets sorted ok}
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint;
												var hkType : byte; var Key : longint; var InsertBias : boolean); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
		function FormRoot : string; virtual;
	end;

	PUnitScodeItem = ^TUnitScodeItem;
	TUnitScodeItem = object(TScodeItem)
		Plural : PString; {ordinary descriptor is for singular unit}
		constructor Init(const NCode, NDesc : string);
		destructor Done; virtual;
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream); virtual;
		procedure AddEditFields(P : PObjectEditBox);           virtual;
	end;

	function ExpandUnitSCode(Code : string; Plural : boolean) : string;

IMPLEMENTATION

uses 	minilib,
			tuimsgs,
			help,
			tui,
			tuijimmy,
			inpjimmy,
			inplist,
			kamsetup,
			{$IFDEF KBooks} kbooks, {$ENDIF}

			kdirctry,
			app, dialogs;

{**************************************************
 ***             UNIT SHORT-CODE                ***
 **************************************************}
{copes with plurals}

const
 RUnitSCode : TStreamRec = (
	 ObjType : srUnitScodeItem;
	 VmtLink : Ofs(TypeOf(TUnitScodeItem)^);
	 Load : @TUnitScodeItem.Load;
	 Store : @TUnitScodeItem.Store
 );


constructor TUnitScodeItem.Init;
begin
	inherited Init(NCode, NDesc);
	Plural := NewStr(Description^);
end;

destructor TUnitSCodeItem.Done;
begin
	inherited Done;
	DisposeStr(Plural);
end;

constructor TUnitScodeItem.Load;
begin
	inherited Load(S);
	Plural := NewStr(S.ReadStr);
end;

procedure TUnitScodeItem.Store;
begin
	inherited Store(S);
	S.WriteStr(Plural);
end;

procedure TUnitScodeItem.AddEditFields(P : PObjectEditBox);
var R : TRect;
begin
	inherited AddEditFields(P);
	P^.GrowTo(P^.Size.X, P^.Size.Y+1); {make room for extra field}
	P^.InsTitledField(9,4, 10, 1, 'Plural', New(PInputPStr, init(R,99)));
end;

function CreateUnitScodeItem(const NCode, NDesc : string) : PScodeItem; far;
begin CreateUnitScodeItem := New(PUnitScodeItem, init(NCode, NDesc)); end;

function ExpandUnitScode;
var Scode : PUnitSCodeItem;
begin
	if Code = '' then
		ExpandUnitSCode := ''
	else begin
		Scode := PUnitSCodeItem(GetScode(scGoodsUnits, Code));
		if Scode<>nil then
			if plural and (SCode^.Plural^<>'') then ExpandUnitScode := Scode^.Plural^
			else ExpandUnitScode := SCode^.DEscription^
		else
			ExpandUnitSCode := '?'+Code;
	end;
end;


{****************************************************************************
 ***                                                                      ***
 ***                THE Goods OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TGoods.Init;
begin
	inherited Init;
	SupplierID := -1;
	VATCode := ProgramSetup.Get(siDefaultVAT,'STD');
	{$IFDEF KBooks}
	IncAccCode := acIncome;
	{$ELSE}
	IncAccCode := '';
	{$ENDIF}
end;

procedure TGoods.CommonInit;
begin
	inherited CommonInit;
	Price.Init;
	SCodeCollection[scGoodsCategory]^.LogOn;
end;

destructor TGoods.Done;
begin
	SCodeCollection[scGoodsCategory]^.LogOff;
	inherited Done;{}
end;

{********************************************
 *** DISPLAY LINE                         ***
 ********************************************}
{Used for list views}
function TGoods.DisplayLine;
var S,SS,S1,S2,QP,Name : string;
		Scale : integer;  {used to scale down space avaialbel if window width <80}
		mtType : byte;
		I : byte;

begin
	if Maxlen<78 then Scale := 78-Maxlen else Scale := 0;

	S := Categories;
	{swap first two codes if gotby ix 2}
	if Gotbyix = 2 then begin
		S1 := SplitByWord(S); {split off first code}
		S2 := SplitByWord(S); {split off 2nd, S now contains rest}
		S := S2+' '+S1+' '+S; {put back together}
	end;

	{If not room, display only code, not fully expanded text}
	if Scale>15 then
		 S := delspace(S) {get rid of normal padded up to 3}
	else
		 S := ExpandSCode(scGoodsCategory, S);

	{--- Display by code/name ------------}
	if delspace(Code)<>'' then
		S := S+' '+Desc+' ('+Code+')'
	else
		S := S + ' '+Desc;

	{---- Technical aid ----}
	{$IFDEF fixit}
		{Add tekky detail}
		S  := S + #13+'  TEK: Dat'+N2Str(RecNo)
							+' CatIdx' +N2Str(CategoryIdx[1])+'/'+N2Str(CategoryIdx[2])+'/'+N2Str(CategoryIdx[3])
							+' CodeIdx'+N2Str(CodeIdx);
	{$ENDIF}

	S := Copy(S, 1,Maxlen);   {keep to single line display & chop off surplus}

	{Set}
	DisplayLine :=S;
end;


function TGoods.GetName;
var S : string;
begin
	case naType of
		naDisplay : S := delspaceR(Categories)+' '+Desc; {for input lines, etc}
	else
		S := ExpandSCode(scGoodsCategory, Categories)+' '+Desc;
	end;

	if Maxlen>0 then S := Copy(S,1,maxlen);
	GetName := S;
end;


{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
function TGoods.recsize;
begin recsize := 100; end;

function tGoods.srtype;
begin srtype := srGoods; end;

{------- LOAD MAIN DATA ----------}
constructor TGoods.Load;
var Ver : byte;

begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			Categories := S.ReadStr;
			Desc := S.REadStr;
			Code := S.ReadStr;

			S.Read(SupplierID, 4);

			Price.Load(S);
			VATCode := ProgramSetup.Get(siDefaultVAT,'STD');
			{$IFDEF kbooks}
			IncAccCode := acIncome;
			{$ELSE}
			IncAccCode := '';
			{$ENDIF}
		end;
		2 : begin
			{v4.3, added vat & nom cat codes}
			inherited Load(S);

			Categories := S.ReadStr;
			Desc := S.REadStr;
			Code := S.ReadStr;

			S.Read(SupplierID, 4);
			S.Read(VATCode, 4);
			S.REad(IncAccCode, 4);

			Price.Load(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TGoods.Load',mfError,hcInternalErrorMsg);
		fail;
	end; {case}
end; {proc}

{-------- STORE MAIN DATA ----------}
procedure TGoods.StoreFields;
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WRiteStr(@Categories);
	S.WriteStr(@Desc);
	S.WriteStr(@Code);
	S.Write(SupplierID,4);
	S.Write(VATCode, 4);
	S.Write(IncAccCode, 4);
	Price.Store(S);
end;

{============== POINTERS TO OTHER JIMMYS===================}
function TGoods.NumIDs;
begin NumIDs := 1; end;

function TGoods.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @SupplierID;
	else
		GetJimmyID := nil;
	end;
end;

{------ INDEXING -----}
function TGoods.NumixTypes : byte;
begin Numixtypes := 4; end;

procedure TGoods.GetIndex;
begin
	inherited getIndex(ixType, IdxRec, fiType);

	case ixType of
		1,2,3 : begin IdxRec := @CategoryIdx[ixtype];	fiType := fiCatProdIdx; end;
		4 		: begin	IDxRec := @CodeIdx;							fitype := fiCodeProdIdx; end;
	end;
end;

function TGoods.GetIndexKey;
var S : string;
		W1,W2,W3 : string[5];

		procedure SetSubStrings;
		begin
			S := Categories;
			W1 := SplitByWord(S)+' '; {split off first code}
			W2 := SplitByWord(S); if W2<>'' then W2 := W2+' ';{split off 2nd, S now contains rest}
			W3 := SplitByWord(S); if W3<>'' then W3 := W3+' ';{split off 3rd, S now contains rest}
			if S<>'' then S := S+' ';
		end;

begin
	GetIndexKey := '';

	if not Deleted then
		case ixType of
			1 : GetIndexKey := ucase(delspaceR(delspaceR(Categories)+' '+Desc));
			2 : begin
				{swap first two categories}
				SetSubStrings;
				if W2<>'' then GetIndexKey := ucase(delspaceR(W2+W1+W3+S + Desc));
			end;
			3 : begin
				{swap third cat into first}
				SetSubStrings;
				if W3<>'' then GetIndexKey := ucase(delspaceR(W3+W1+W2+S + Desc));
			end;
			4 : GetIndexKey := ucase(delspaceR(Code));
		end;

end;


{***************************************************************************
 ***                EDIT Goods                                         ***
 ***************************************************************************}
procedure TGoods.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		I,L : byte;
		S : string;
		VATLine, NomCatLine, PriceLine : PView;

begin
	R.Assign(0, 0, 55, 12); {Size of box}
	R.Move(0, (Desktop^.Size.Y div 3) - 6);  {top 1/3 of screen}
	EditBox := New(PJimmyEditBox, init(R, 'Goods Registration',Caller,@Self));

	with EditBox^ do begin
		Options := Options or ofCenterX;
		Insert(New(PSkipBytes, init(sizeof(TJimmy)+12+4))); {skip categoryidx, codeidx}
		{--- Set up box interior ---}
		{ X, Y, Boxlen,  FieldLen,     Title}

		InsTitledField(15, 1, 37, 1, 'C~a~tegories',  New(PInputSCLine, Init(R, 11, scGoodsCategory)));{}
		InsTitledBox(  15, 2, 20, 1, '~D~esc',20);
		InsTitledBox(  15, 3, 20, 1, 'Code', 20);

		InsTitledField(15, 5, 20, 1, '~S~plr', New(PInputDirectory, Init(R,30, fiCatDirIdx, lsDirectory, 'SUP')));

		PriceLine 	:= InsTitledField(15, 7,  9, 1, 'Price', New(PInputMoney, init(R)));

		VATLine 		:= InsTitledField(15, 9,  9, 1, '~V~AT Rate', New(PInputSCode, init(R, scVATRates)));
		{$IFDEF KBooks}
		NomCatLine 	:= InsTitledField(15,10,  9, 1, '~I~ncome a/c', New(PInputSCode, init(R, scAccounts)));
		{$ELSE}
		Insert(New(PSKipBytes, init(sizeof(TSCode))));
		NomCatLine := Current;
		{$ENDIF}

		SetDataOrder;
		MoveDataOrder(PriceLine, NomCatLine); {moves price line to after nomcatline}

		Insert(New(PJimmyOKButton, init(Size.X-11,Size.Y-5, @Self)));
		InsCancelButton(Size.X-11,Size.Y-3);

		EndInit;
	end;
end;


{****************************************************************
 ***                    SET CODES                             ***
 ****************************************************************}
procedure TGoods.SetFormCodes;
var S : string;
begin
	inherited SetFormCodes(formcodes);
	with FormCodes^ do begin
		SetStr('DESC',Desc);
		SetStr('CODE',Code);
		Insert(New(PSCodeFormCode, init('CTGY',Categories,scGoodsCategory)));

		{general description text}
		S := '';
		if delspaceR(Categories)<>'' then
			S := ExpandSCode(scGoodsCategory, Categories)+' ';
		if delspaceR(Desc)<>'' then
			S := S + Desc;
		SetStr('TEXT',S);
	end;
end;


procedure TGoods.GetPriceFor;
begin
	Money.SetTo(Price);
end;

procedure TGoods.GetCostFor;
begin
	Money.Clear;
end;


{*********************************************************
 ***                                                   ***
 ***          Goods SELECTOR FOR ORDER DESCENDANTS   ***
 ***                                                   ***
{*********************************************************}

constructor TGoodsOrderItem.Init;
begin
	inherited Init(Param);
	Quantity := '';
	GoodsID := -1;
end;

procedure TGoodsOrderItem.CommonInit;
begin
	inherited CommonInit;
	SCodeCollection[scGoodsUnits]^.LogOn;{}
	PriceEach.Init;
end;

destructor TGoodsOrderItem.Done;
begin
	SCodeCollection[scGoodsUnits]^.LogOff;{}
	inherited Done;
end;

procedure LastLineRSet(var S : string; AS : string; Maxlen : byte);
var SS : String;
		L : byte;
begin
	SS := '';
	for L := 1 to NumLines(S)-1 do SS := SS + GetLine(S,L) + #13;
	S := SS + SetLength(GetLine(S, NumLines(S)), Maxlen - length(AS)) + AS;
end;


{======= DISPLAY LINE ====================}
function TGoodsOrderItem.DisplayLine;
var S,SE,SA : string;

begin
	S := GetJimmyIDName(GoodsID, naFull,0);

	if (delspaceR(Quantity)<>'') then S := S + ' x'+Quantity+' '+units;

	LastLineRSet(S, inherited DisplayLine(ListForWho, lstype, Maxlen, View), maxlen);

	{$IFDEF Fixit}
	S := S + #13+'      TEK:'+N2Str(RecNo)+' For'+N2Str(ForOrder);
	{$ENDIF}

	DisplayLine := S;
end;

{takes goods (source[1]) and units (source[2]) with price band and
calcs the price (target1) and vat rate (target2)}
procedure LinkGoods(const Linker : PInputLinker; const CallingView : PView); far;
var Goods : PGoods;
		UnitCode,BandCode : TScode;
		Price : TMoney;
		Order : POrder;
		OrderItem : POrderItem;
		DirectoryItem : PDirectoryItem;
		VAT : TSCode;

begin
	Goods 		:= PGoods(PInputJimmy(Linker^.SourceView[1])^.GetJimmy);
	Linker^.SourceView[2]^.GetData(UnitCode);
	Price.Init;
	if Goods<>nil then begin
		{get price band...}
		OrderItem := POrderItem(PJimmyEditBox(CallingView^.Owner)^.Jimmy);
		Order := POrder(GetJimmy(OrderItem^.ForOrder));
		if Order<>nil then begin
			DirectoryItem := PDirectoryItem(GetJimmy(Order^.ForWho));

			if DirectoryItem<>nil then begin
				if DirectoryItem^.RecNo = Goods^.SupplierID then
					{assume sales order - ie supplier price}
					Goods^.GetCostFor(UnitCode, Price)
				else
					Goods^.GetPriceFor(UnitCode, DirectoryItem^.GetCategories, Price);
				dispose(DirectoryItem, done);
			end;
			dispose(Order, done);
		end;

		{set price}
		with PInputMoney(Linker^.TargetView[2])^ do begin
			SetData(Goods^.VATCode);
		end;

		with PInputMoney(Linker^.TargetView[1])^ do begin
			SetData(Price);
			DrawView;
			ForceLink;
		end;
	end;
end;

procedure LinkPriceQty(const Linker : PInputLinker; const CallingView : PView); far;
var UnitPrice,Price : TMoney;
		Qty : String[10];
		Q : real;

begin
	Linker^.SourceView[1]^.GetData(Qty);
	Linker^.SourceView[2]^.GetDAta(UnitPrice);

	Price.SetTo(UnitPrice);
	Q := S2Real(Qty);
	if Q = 0 then Q := Frac2Real(Qty);
	if Q<>0 then Price.MultiplyBy(Q);

	with PInputMoney(LInker^.TargetView[1])^ do begin
		SetData(price);
		DrawView;
		ForceLink; {do vat, etc}
	end;
end;



{================ EDIT BOX ============================}
procedure TGoodsOrderItem.MakeEditBox;
var Bounds, R : TRect;
		QtyPriceLinker,GoodsLinker : PInputLinker;
		GoodsLine : PView;

begin
	Bounds.Assign(0, 0, 45,17);
	CentreOnView(Bounds, Caller);
	EditBox := New(PJimmyEditBox, init(Bounds, 'Goods Item',Caller,@Self));
	New(QtyPriceLinker, 	init(@LinkPriceQty, EditBox));
	New(GoodsLinker, init(@LinkGoods, EditBox));

	{----Position box, in centre of calling view----}
	with EditBox^ do begin

		{$IFDEF fixit}
			Insert(New(PSkipBytes, init(sizeof(TJimmy))));
			InsTitledField( 9, 14, 6, 1, 'Order', 		New(PINputLint, init(R, 8)));
			InsTitledField(26, 14, 6, 1, 'Parent', 		New(PINputLint, init(R, 8)));
			InsTitledField( 9, 15, 6, 1, 'From', 			New(PINputLint, init(R, 8)));
			InsTitledField(26, 15, 6, 1, 'Next', 			New(PINputLint, init(R, 8)));
		{$ELSE}
			Insert(New(PSkipBytes, init(sizeof(TOrderItem)-sizeof(TPriceGroup)-sizeof(NomCat))));  {Skip detail fields & VMT}
		{$ENDIF}

		Insert(New(PInputPriceGroup, init(2,8, EditBox))); {for prices, vat, etc}
		QtyPriceLinker^.SetTargetView(PInputPriceGroup(Current)^.PriceLine,1);
		GoodsLinker^.SetTargetView(PInputPriceGroup(Current)^.VATSCodeLine, 2);

		R.XYLD(12, 15, 19, 1); Insert(New(PInputSCode, init(R, scAccounts))); AddLabel('~N~om Ctgy', Current);
{		Insert(New(PSkipBytes, init(sizeof(NomCat))));{}

		{-- Buttons --}
		{inserted here so after price group}
		if AllowChanges then
			Insert(New(PJimmyOKButton, 			Init(33,Size.Y-5, @Self)));
		Insert(New(PjimmyCancelButton, 	init(33,Size.Y-3, @Self)));

		GoodsLine :=
			InsTitledField(12,  1, 30, 1, 'Pr~o~duct', New(PInputIndexedJimmy, init(R, 30, fiCatProdIDx, lsGoodsServices, '')));
		GoodsLinker^.SetSourceView(Current, 1);
		with PInputList(Current)^ do ListOptions := ListOptions or loAutoList;

		InsTitledBox(12,  3, 10, 1, '~Q~uantity', 10);
		QtyPriceLinker^.SetSourceView(Current,1);

		R.XYLD(12, 4, 19, 1); Insert(New(PInputSCode, Init(R, scGoodsUnits))); AddLabel('~U~nits', Current);{}
		GoodsLinker^.SetSourceView(Current, 2);

		InsTitledField(19,  6, 10, 1, 'Price ~E~ach       ', New(PInputMoney, init(R)));
		QtyPriceLinker^.SetSourceView(Current,2);
		GoodsLinker^.SetTargetView(Current,1);

		EndInit;
		GoodsLine^.Focus;

	end;

end;

{************************************
 ***         DATABASE             ***
 ************************************}
function TGoodsOrderItem.RecSize;
begin RecSize := 100; end;

function TGoodsOrderItem.srType;
begin srType := srGoodsOrderItem; end;


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

	case Ver of
		2 : begin
			{v4.3}
			inherited Load(S);
			S.Read(GoodsID, 4);
			Quantity := S.ReadStr;
			S.Read(Units, 4);
			PriceEach.Load(S);
		end;
{		1 : begin
			{special for sbs - goodsid pointer didn't get updated in the
			update procedure so this is a botched reset to stop -5 errors}

{			inherited Load(S);
			S.Read(GoodsID, 4);
			GoodsID := -1;

			Quantity := S.ReadStr;
			S.Read(Units, 4);
			PriceEach.Load(S);
		end;{}
	else
		DBaseMessage(@S,'Version '+N2Str(Ver)+' not known'#13'TGoodsOrderItem.Load', mfError,hcInternalErrorMsg)
	end;

	Quantity := DelSpaceR(Quantity); {just for display/etc purposes}
end;


{========== STORE ===================}
procedure TGoodsOrderItem.StoreFields;
var
	ver : byte;

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

	inherited StoreFields(S);

	S.Write(GoodsID, 4);
	S.WriteStr(@Quantity);
	S.Write(Units, 4);
	PriceEach.Store(S);
end;

procedure TGoodsOrderItem.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID, SubHookToID, hkType, Key, InsertBias);
	Key := 1;
end;

{============== POINTERS TO OTHER JIMMYS===================}
function TGoodsOrderItem.NumIDs;
begin NumIDs := 5; end;

function TGoodsOrderItem.GetJImmyID;
begin
	case jiType of
		1..4 	: GetJimmyID := inherited GetJimmyID(jiType);
		5 		: GetJimmyID := @GoodsID;
	else
		GetJimmyID := nil;
	end;
end;


procedure TGoodsOrderItem.SetFormCodes;
var Goods : PGoods;
		SCode : PSCodeItem;
		Q,U,Text : string;

begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		Insert(New(PMoneyFOrmCode, init('PEACH', PriceEach)));
		SetStr('QTY', Quantity);

		Q := delspace(Quantity); if Q<>'' then Q := Q + ' ';
		U := ''; if delspace(Units)<>'' then U := Units; {ExpandUnitSCode(Units, S2Lint(Quantity)>1);{}
		SetStr('QTYUNIT', Q+U);

		Insert(New(PJimmyFormCode, init('GOODS', GoodsID)));

		SetStr('TEXT', '<GOODS.TEXT>');

		if U<>'' then U := U +' ';
		SetStr('UTEXT',U+Text); {make units part of text}
	end;
end;

function TGoodsOrderItem.FormRoot : string;
begin	FormRoot := 'GOODS'; end;





function NewGoods(P : pointer) : pointer; far;
begin NewGoods := New(PGoods, init); end;

function NewGoodsOrderItem(P : pointer) : pointer; far;
begin NewGoodsOrderItem := New(PGoodsOrderItem, init(P)); end;


{**********************************
 ***  LIST CREATION (TASK)      ***
 **********************************}
procedure StartForSaleList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Goods & Services',
													New(PIndexedJimmyListView, init(bounds, lsGoodsServices, fiCatProdIdx,'')))));
end;

procedure StartGoodsCodeList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJImmyListWindow, init(Bounds, 'Goods by Code',
													New(PIndexedJimmyListView, init(bounds, lsGoodsServices, fiCodeProdIdx,'')))));
end;

function NewGoodsCatIdxStream : PStream; far;
begin	NewGoodsCatIdxStream := New(PIndexedJimmyStream, init('FORSALE.IDX',40)); end;

function NewGoodsCodeIdxStream : PStream; far;
begin	NewGoodsCodeIdxStream := New(PIndexedJimmyStream, init('GOODSREF.IDX',30)); end;


{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
 const
	 {--- Required for Stream ----}
	 RGoods : TStreamRec = (
		 ObjType : srGoods;
		 VmtLink : Ofs(TypeOf(TGoods)^);
		 Load : @TGoods.Load;
		 Store : @TGoods.Store
	 );

const
	{--- Required for Stream ----}
	RGoodsOrderItem : TStreamRec = (
		ObjType : srGoodsOrderItem;
		VmtLink : Ofs(TypeOf(TGoodsOrderItem)^);
		Load : @TGoodsOrderItem.Load;
		Store : @TGoodsOrderItem.Store
	);

{unit initialisation procedure}
begin
	{Task registration}
	RegisterTask(DesktopTasks, cmStartForSaleList, @StartForSaleList);
	RegisterTask(DesktopTasks, cmStartGoodsCodeList, @StartGoodsCodeList);

	NewFileAdmin(fiCatProdIdx, 'Goods & Services Category Index',NewGoodsCatIdxStream);
	NewFileAdmin(fiCodeProdIdx, 'Goods Coded Index',NewGoodsCodeIdxStream);

	{Various sentence codes}
	New(SCodeCollection[scGoodsCategory], Init('GdsCatgy.SC', 'Goods Catagories', StdScodeCreator));
	New(SCodeCollection[scGoodsUnits], Init('GdsUnits.SC', 'Goods Units', CreateUnitSCodeItem));{}

	RegisterType(RGoods);
	RegisterType(RGoodsOrderItem);{}
	RegisterType(RUnitSCode);

	RegisterNewWithList(lsGoodsServices, '~G~oods', cmNewGoods);
	RegisterNewWithList(lsSalesItems, '~G~oods', cmNewGoodsOrderItem);
	RegisterNewWithList(lsInvoiceItems, '~G~oods', cmNewGoodsOrderItem);

	RegisterCreator(cmNewGoods, NewGoods);
	RegisterCreator(cmNewGoodsOrderItem, NewGoodsOrderItem);
end.


