{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                      S T R O M S H O L M  G O O D S                  ***
 ***                                                                      ***
 *** M Hill                                                      Nov 1993 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KStroms;

INTERFACE

uses objects, scodes, dattime, files, views,
		 forms,
		 multcurr, kforsale, tuiedit;

{**************************************
 ***           StromsGoods               ***
 **************************************}

type
	PStromsGoods = ^TStromsGoods;
	TStromsGoods = object(TGoods)

		Units 			: array[0..3] of TSCode;

		QuotedCost 	: array[0..3] of TMoney;

		PriceBand 	: array[1..3] of record
			Band 	: TSCode;
			Price : array[0..3] of TMoney;
		end;

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

		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -}

		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual;
		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;
		function PtrOffset : byte; virtual;{}

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

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		procedure GetPriceFor(const UnitCode : TSCode; const BandCode : string; var Money : TMoney); virtual;
		procedure GetCostFor(const UnitCode : TScode; var Money : TMoney); virtual;
{		function GetArrayPosOfUnit(UnitCode : string) : integer;
		function GetArrayPosofBand(BandCode : string) : integer;{}
 end;



IMPLEMENTATION

uses 	minilib,
			global,
			help,
			inpdnt,
			tui,
			tuimsgs,
			tuijimmy,
			jimmys,
			kdirctry;


{****************************************************************************
 ***                                                                      ***
 ***                THE StromsGoods OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TStromsGoods.Init;
begin
	inherited Init;
end;

procedure TStromsGoods.CommonInit;
var I,L : longint;
begin
	inherited CommonInit;
	SCodeCollection[scGoodsUnits]^.LogOn;

	for I := 0 to 3 do begin
		QuotedCost[I].Init;
		for L := 1 to 3 do PriceBand[L].Price[I].Init;
	end;
end;

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

{********************************************
 *** DISPLAY LINE                         ***
 ********************************************}
{Used for list views}
function TStromsGoods.DisplayLine;
var S,SS,S1,S2 : string;
		I : byte;

begin
	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 Maxlen<60 then
		 S := delspace(S) {get rid of normal padded up to 3}
	else
		 S := ExpandSCode(scGoodsCategory, S);

	{--- Display by code/name ------------}
{	if (View and pvByCode)>0 then begin{}
		S := Code+S+' '+Desc;
{	end else begin
		if delspace(Code)<>'' then
			S := S+' '+Desc+' ('+Code+')'
		else
			S := S + ' '+Desc;
	end;
	View := View and $FF;

	{add prices}
	S := Setlength(S, maxlen div 2)+' ';
	for I := 0 to 3 do
		if (delspace(Units[I])<>'') or (not PriceBand[1].Price[I].Blank) then begin
			S := S + ' ';
			if Delspace(Units[I])<>'' then S := S + delspace(Units[i])+'=';
			S := S + PriceBand[1].Price[I].text(mtFull);
		end;
	S := S + GetJimmyIDName(SupplierID, naRef, 0); {add supplier name}

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


function TStromsGoods.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;


{used by other objects to find out which column of the matrix
a particular unit is for.  Returns -1 if not found}
{function TStromsGoods.GetArrayPosOfUnit;
var I : byte;
begin
	GetArrayPosOfUnit := -1;
	for I := 0 to 3 do
		if delspace(unitCode)=delspace(Units[I]) then GetArrayPosOfUnit := I;
end;

{used by other objects to find out which row of the matrix
a particular band is for.  Returns first band if not found}
{function TStromsGoods.GetArrayPosOfBand;
var I : byte;
begin
	GetArrayPosOfBand := 1;
	for I := 3 downto 1 do
		if delspace(BandCode)=delspace(PriceBand[I].Band) then GetArrayPosOfBand := I;
end;{}
procedure TStromsGoods.GetPriceFor;
var Un, Ba, I : integer;
begin
	Un := -1;
	for I := 0 to 3 do if delspaceR(UnitCode)=delspace(Units[I]) then Un := I;

	Money.Clear;
	if Un>-1 then
		for Ba := 1 to 3 do
			{sets to first band that is equal to bandcode parameter, or the first blank line}
			if ((BandCode<>'') and (Pos(' '+delspace(PriceBand[Ba].Band)+' ', ' '+BandCode+' ')>0)) or
				(Money.Blank and (delspace(PriceBand[Ba].Band) = '')) then
					Money.SetTo(PriceBand[Ba].Price[Un]);
end;

procedure TStromsGoods.GetCostFor(const UnitCode : TScode; var Money : TMoney);
var Un,I : integer;
begin
	Un := -1;
	for I := 0 to 3 do if delspaceR(UnitCode)=delspace(Units[I]) then Un := I;

	Money.Clear;
	if Un>-1 then Money.SetTo(QuotedCost[Un]);
end;

{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
function TStromsGoods.RecSize;
begin RecSize := 250; end;

function TStromsGoods.srType;
begin srType := srStromsGoods; end;

function TStromsGoods.PtrOffset;
begin PtrOffset := inherited PtrOffset +1; end; {inherited is TGoods, this adds another ver}

{------- LOAD MAIN DATA ----------}
constructor TStromsGoods.Load;
var Ver : byte;
		I,L : longint;

begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			{20/5/97, new Stromsholm special object, v4.3}
			inherited Load(S);

			for I := 0 to 3 do S.Read(Units[I], sizeof(TSCode));
			for I := 0 to 3 do QuotedCost[I].Load(S);

			for L := 1 to 3 do begin
				S.Read(PriceBand[L].Band, sizeof(TSCode));
				for I := 0 to 3 do PriceBand[L].Price[I].Load(S);
			end;
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'TStromsGoods.Load',mfError,hcInternalErrorMsg);
		fail;
	end; {case}
end; {proc}

{-------- STORE MAIN DATA ----------}
procedure TStromsGoods.StoreFields;
var	L,I : byte;
		Ver : byte;

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

	inherited StoreFields(S);

	for I := 0 to 3 do S.Write(Units[I], sizeof(TSCode));
	for I := 0 to 3 do QuotedCost[I].Store(S);

	for L := 1 to 3 do begin
		S.Write(PriceBand[L].Band, sizeof(TSCode));
		for I := 0 to 3 do PriceBand[L].Price[I].Store(S);
	end;
end;


{***************************************************************************
 ***                EDIT PRODUCT                                         ***
 ***************************************************************************}
{========== MARGIN ================}
{Automatic from banding code line - directory search code}
{Takes directory search code (source 1) and sets margin line target 2}
procedure LinkBandMargin(const Linker : PInputLinker; const CallingView : PView); far;
var SCode : PSCodeItem;
		C : TSCode;
begin
	with Linker^ do begin
		SourceView[1]^.GetData(C);
		SCode:= GetSCode(PInputSCLine(SourceView[1])^.scType, C);
		with TargetView[1]^ do begin
			SetData(PDirCatScodeItem(SCode)^.Margin);
			DrawView;
		end;
	end;
end;

{Takes margin (source 1) and purchase cost (source 2), and calcs selling price
source(3), or if it wias the selling price that was changed, calcs from that (3)
and purchase cost (2), the margin (1)}
procedure LinkMarginPrice(const Linker : PInputLinker; const CallingView : PView); far;
var Margin : Single;
		PurCost : TMoney;
		SalePrice : TMoney;
begin
	PurCost.Init; SalePrice.Init;
	with Linker^ do begin
		if (CallingView = SourceView[1]) or (CallingView = SourceView[2]) then begin
			SourceView[1]^.GetData(Margin);
			SourceView[2]^.GetData(PurCost);

			SalePrice.SetTo(PurCost);
			SalePrice.MultiplyBy(Margin);
			SalePrice.Add(PurCost);

			SourceView[3]^.SetData(SalePrice);
			SourceView[3]^.DrawView;
		end else begin
			SourceView[2]^.GetData(PurCost);
			SourceView[3]^.GetData(SalePrice);

			Margin := PurCost.Value * 100 / SalePrice.Value;

			SourceView[1]^.SetData(Margin);
			SourceView[1]^.DrawView;
		end;
	end;
end;


procedure TStromsGoods.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		Un,Ba : byte; {Unit, Band counters}
		S : string;
		VATLine, SupLine, NomCatLine : PView;

begin
	R.Assign(0, 0, 60, 17); {Size of box}
	EditBox := New(PJimmyEditBox, init(R, 'Product Registration',Caller, @Self));

	with EditBox^ do begin
		Options := Options or ofCentered;

		{--- Set up box interior ---}
		Insert(New(PSkipBytes, init(sizeof(TJimmy)+4*3+4))); {skip ptrs}

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

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

		Insert(New(PSkipBytes, init(sizeof(TMoney))));

		{Units}
		R.XYLD(15,7,10,1); Insert(New(PInputSCode, Init(R, scGoodsUnits))); AddLabel('~U~nits', Current);
		for Un := 1 to 3 do begin
			R.Move(11,0);
			Insert(New(PInputSCode, Init(R, scGoodsUnits)));
		end;

		{Supplier's price - Quoted cost}
		R.XYLD(15,8,10,1); Insert(New(PInputMOney, init(R))); AddLabel('Cos~t~', Current);
		for Un := 1 to 3 do begin
			R.Move(11,0);
			Insert(New(PInputMoney, init(R)));
		end;

		{Price bands}
		for Ba := 1 to 3 do begin
			R.XYLD( 8,9+Ba,5,1); Insert(New(PInputScode, init(R, scDirectoryCategory)));
			if Ba = 1 then AddLabel('~B~and', Current);

{			Insert(New(PSkipBytes, init(2))); {skip margin}

			R.XYLD(15,9+Ba,10,1);
			for Un := 0 to 3 do begin
				Insert(New(PInputMoney, init(R)));
				R.Move(11,0);
			end;
		end;

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

		SetDataOrder;
		MoveDataOrder(VATLine, SupLine);
		MoveDataOrder(NomCatLine, VATLine);

		Insert(New(PJimmyOKButton, init(35,Size.Y-3, @Self)));
		InsCancelButton(45,Size.Y-3);

		EndInit;
	end;
end;


{****************************************************************
 ***                    SET CODES                             ***
 ****************************************************************}
procedure TStromsGoods.SetFormCodes;
var U : byte;
		SS : string;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin

		{--- units ---}
		SS := '';
		for U := 0 to 3 do
			SS := SS + ExpandSCode(scGoodsUnits, Units[U]) +CRLF;

		SetStr('UNITS', SS);
	end;
end;


function NewStromsGoods(P : pointer) : pointer; far;
begin NewStromsGoods := New(PStromsGoods, init); end;

 const
	 {--- Required for Stream ----}
	 RStromsGoods : TStreamRec = (
		 ObjType : srStromsGoods;
		 VmtLink : Ofs(TypeOf(TStromsGoods)^);
		 Load : @TStromsGoods.Load;
		 Store : @TStromsGoods.Store
	 );

{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
	{Task registration}
	RegisterJimmy(RStromsGoods, NewStromsGoods, lsGoodsServices, '~P~roduct');
end.


