{*********************************************************************
 ***                                                               ***
 ***                                                               ***
 ***                   RONGAI WORKSHOPS (VEHICLES/ETC)             ***
 ***                                                               ***
 ***                                                               ***
{*********************************************************************}
{provides vehicles, etc suitable for Rongai workshops, Nakuru, Kenya}
{$I compflgs}
unit KRongai;

INTERFACE

uses views, files, multcurr, dattime, scodes,
		forms, devices,
		dialogs,
		jimprint,
		ordproc, tuiedit, global, jimmys;

const
	VehicleIndexSize = 20;
	ShipIndexSize = 30;
	ContainerIndexSize = 30;

type
	PTractor = ^TTractor;
	TTractor = object(TJimmy)
		Ptr2Idx : longint;
		Ptr2History : longint;

		RegNum : string[10];
		Make : TSCOde;
		Model : TSCode;
		Driver : longint; {usual driver}

		YearMan : word;
		YearImp : word;
		Status : TSCode;
		CurrentDelivery : longint; {points to current delivery note}

		constructor Init(Param : PJimmyInitParam);
		procedure COmmonInit; virtual;
		destructor Done; virtual;

		{--- Viewing -----}
		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 -{}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Printing ---}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
		procedure PrintSummary(const Device : PDeviceStream; const PrintAs : word); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual;

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

		{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;

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint;
												var hkType : byte; var Key : longint; var InsertBias : boolean); virtual;
	end;

	PTrailer = ^TTrailer;
	TTrailer = object(TJimmy)
		Ptr2Idx : longint;
		Ptr2History : longint;

		RegNum : string[10];
		Make : TSCOde;
		Model : string[10];
		YearMan : word;
		YearImp : word;
		Status : TSCode;
		CurrentDelivery : longint;

		constructor Init(Param : PJimmyInitParam);
		procedure COmmonInit; virtual;
		destructor Done; virtual;

		{--- Viewing -----}
		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 -{}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); 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);

		{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;

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;
	end;

	PShip = ^TShip;
	TShip = object(TJimmy)
		Ptr2Idx : longint;
		Ptr2DiaryIdx : longint;

		Name : string[30];
		Coy : longint;

		Opening : TDate;
		CLosing : TDate;
		Arrival : TDate;

		constructor Init(Param : PJimmyInitParam);

		{--- Viewing -----}
		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 -{}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual;

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

		{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;
	end;


	PContainer = ^TContainer;
	TContainer = object(TJimmy)
		Ptr2Idx : longint;
		Ptr2AtRongaiIdx : longint;

		Number : string[15];
		Size : string[5];
		Wt : word; {weight in kg}
		Coy : longint;

		LastAt : longint;

		constructor Init(Param : PJimmyInitParam);

		{--- Viewing -----}
		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 -{}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual;

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

		{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;
	end;



IMPLEMENTATION

uses
			objects,
			tasks,
			inpjimmy,
			idindex,
			kdirctry,
			tui,
			printers,
			menus,
			kdiary,
			tuimsgs,
			tuiboxes,
			jimindxs,
			inpdnt,
			tuijimmy,
			app,
			minilib;


{*********************************************************************
 ***                                                               ***
 ***                     TRACTORS & TRAILORS                       ***
 ***                                                               ***
{*********************************************************************}

constructor TTractor.INit;
begin
	inherited Init;
	Ptr2Idx := -1;
	Ptr2History := -1;
	Driver := -1;

	CurrentDelivery :=-1;
end;

procedure TTractor.CommonInit;
begin
	inherited CommonInit;

	SCodeCollection[scVehicleModel]^.LogOn;
	SCodeCollection[scVehicleStatus]^.LogOn;
	SCodeCollection[scVehicleMake]^.LogOn;
end;

destructor TTractor.Done;
begin
	SCodeCollection[scVehicleModel]^.LogOff;
	SCodeCollection[scVehicleStatus]^.LogOff;
	SCodeCollection[scVehicleMake]^.LogOff;
	inherited Done;
end;

function TTractor.DisplayLine;
var S : string;
begin
	S := Setlength(RegNum,10)+SetLength(ExpandScode(scVehicleModel, Model),10)
			+Status;

	if lsType=lsMoreAbout then
		S := 'USUAL TRUCK: '+S
	else
		S := S+' '+SetLength(GetJimmyIDName(Driver, naDisplay,15),16)
					+GetJimmyIDName(CurrentDelivery, naDisplay, 0);

{	if GetLock<>0 then S := SetLength(S, Maxlen-1)+char(GetLock);{}

	DisplayLine := S;
end;

function TTractor.GetName;
begin
	if naType = naRef then
		GetName := RegNum
	else
		if delspaceR(Model)<>'' then
			GetName := RegNum+' ('+ExpandSCode(scVehicleModel, Model)+')'
		else
			GetName := RegNum;
end;

{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TTractor.MakeEditBox;
var	R: TRect;

begin
	R.Assign(0, 0, 40, 16);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Vehicle',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+8)));


		InsTitledField(10,  1,10, 1, '~R~eg',  New(PInputELine, init(R, 10)));
		PInputELine(Current)^.UpperCase := True;
		PInputELine(Current)^.MustInput := True;

		InsTitledField(10,  3,25, 1, '~M~ake', New(PInputSCode, Init(R, scVehicleMake)));
		InsTitledField(10,  4,25, 1, 'M~o~del',  New(PInputScode, init(R, scVehicleModel)));

		InsTitledField(10,  5,25, 1, 'Dr~i~ver', New(PInputDirectory, init(R, 25, fiCatDirIdx, lsDirectory, 'DRI')));

		InsTitledField(10,  7, 4, 1, 'YO Man', New(PInputWord, init(R,4)));
		InsTitledField(10,  8, 4, 1, 'YO Imp', New(PInputWord, init(R,4)));

		InsTitledField(10, 10,25, 1, '~S~tatus', New(PInputSCode, init(R, scVehicleStatus)));
		InsTitledField(10, 11,20, 1, 'Deliv', New(PinputJimmy, init(R, 20, 0)));
		Current^.SetState(sfDisabled, True);

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(15,13, @Self)));
		Insert(New(PjimmyCancelButton, init(25,13, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RTractor : TStreamRec = (
		ObjType : srTractor;
		VmtLink : Ofs(TypeOf(TTractor)^);
		Load : @TTractor.Load;
		Store : @TTractor.Store
	);

function TTractor.RecSize;
begin RecSize := 100; end;

function TTractor.srType;
begin srType := srTractor; end;


constructor TTractor.Load(var S : TDataStream);
var	Ver : byte;

begin
	S.Read(Ver, 1);

	case Ver of
		3 : begin
			{added usual driver}
			inherited Load(S);

			RegNum := S.ReadStr;
			S.Read(Make, 4);
			S.Read(Model, 4);
			S.Read(YearMan, 2);
			S.REad(YearImp, 2);
			S.Read(Status, 4);
			S.Read(CurrentDelivery, 4);
			S.Read(Driver, 4);
		end;
{		2 : begin
			inherited Load(S);

			RegNum := S.ReadStr;
			S.Read(Make, 4);
			S.Read(Model, 4);
			S.Read(YearMan, 2);
			S.REad(YearImp, 2);
			S.Read(Status, 4);
			S.Read(CurrentDelivery, 4);
			Driver := -1;
		end;
		1 : begin
			inherited Load(S);

			RegNum := S.ReadStr;
			S.Read(Model, 4);
			S.Read(Make, 4);
			S.REadStr; {used to be model}
{			S.Read(YearMan, 2);
			S.REad(YearImp, 2);
			S.Read(Status, 4);
			S.Read(CurrentDelivery, 4);
			Driver := -1;
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TTractor.Load',mfError,hcNoContext);
		fail;
	end;
end;

procedure TTractor.StoreFields(var S : TDataStream);
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WriteStr(@RegNum);
	S.Write(make, 4);
	S.Write(Model, 4);
	S.Write(YearMan, 2);
	S.Write(YearImp, 2);
	S.Write(Status, 4);
	S.Write(CurrentDelivery, 4);
	S.Write(Driver, 4);
end;

{****************************************************
 ***               POINTERS TO OTHER JIMMYS       ***
 ****************************************************}
function TTractor.NumIDs;
begin
	NumIDs := 2;
end;

function TTractor.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @Driver;
		2 : GetJimmyID := @CurrentDelivery;
	else
		GetJimmyID := nil;
	end;
end;

{**************************************
 ***       DATABASE                 ***
 **************************************}
function TTractor.NumixTypes;
begin NumixTypes := 1; end;

function TTractor.NumhkTypes;
begin NumhkTypes := 2; end; {incl hkhistory}

function TTractor.NumHookTo;
begin NumHookTo := 1; end;

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

	case ixType of
		1 : begin IdxRec := @Ptr2Idx; 	fiType := fiVehicleIdx; end;
	end;
end;

function TTractor.GetIndexKey;
begin
	case ixType of
		1 : GetIndexKey := ucase(RegNum);
	else
		GetIndexKey := '';
	end;
end;


procedure TTractor.GetHookOn;
begin
	inherited GetHookOn(hkType, HookRec);

	case hkType of
		hkHistory : HookRec := @Ptr2History;
	end;
end;

procedure TTractor.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key, InsertBias);

	case htType of
		1 : begin HookToID := @Driver; hkType := hkMore; end;
	end;
end;

{************************************************************
 ***              PRINTING                                ***
 ************************************************************}
procedure TTractor.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	with FormCodes^ do begin
		SetStr('REG', RegNum);
		SetStr('MAKE', ExpandScode(scVehicleMake, Make));
		SetStr('MODEL', ExpandScode(scVehicleModel, Model));
		SetStr('YOMAN', N2Str(YearMan));
		SetStr('YOIMP', N2Str(YearImp));
		SetStr('STATUS', ExpandScode(scVehicleStatus, Status));
		Insert(New(PJimmyFormCode, init('CDELIV', CurrentDelivery)));
		Insert(New(PJImmyFormCode, init('UDRIVER', Driver))); {usual driver}
	end;
end;


{will only be used (?) in Driver's more-about list}
procedure TTractor.PrintSummary;
begin
	Device^.writeln(DisplayLine(Driver, lsMoreAbout, 0,0));
end;

{*********************************************************************
 ***                                                               ***
 ***                     TRAILORS                                  ***
 ***                                                               ***
{*********************************************************************}

constructor TTrailer.INit;
begin
	inherited Init;
	Ptr2Idx := -1;
	Ptr2History := -1;

	CurrentDelivery :=-1;
end;

procedure TTrailer.CommonInit;
begin
	inherited CommonInit;

	SCodeCollection[scVehicleStatus]^.LogOn;
	SCodeCollection[scVehicleMake]^.LogOn;
end;

destructor TTrailer.Done;
begin
	SCodeCollection[scVehicleStatus]^.LogOff;
	SCodeCollection[scVehicleMake]^.LogOff;
	inherited Done;
end;

function TTrailer.DisplayLine;
var S : string;
begin
	S := Setlength(RegNum,10)+SetLength(Model,10)+Status+' '+GetJimmyIDName(CurrentDelivery,naDisplay,0);
{	if GetLock<>0 then S := SetLength(S, Maxlen-1)+char(GetLock);{}
	DisplayLine := S;
end;

function TTrailer.GetName;
begin
	if delspaceR(Model)<>'' then
		GetName := RegNum+' ('+Model+')'
	else
		GetName := RegNum;
end;


{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TTrailer.MakeEditBox;
var	R: TRect;

begin
	R.Assign(0, 0, 43, 14);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Trailer',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+8)));

		InsTitledField(9,  1,10, 1, '~R~eg',  New(PInputELine, init(R, 10)));
		PInputELine(Current)^.UpperCase := True;
		PInputELine(Current)^.MustInput := True;

		InsTitledField(9,  2,20, 1, '~M~ake', New(PInputSCode, Init(R, scVehicleModel)));

		InsTitledField(9,  3,10, 1, 'M~o~del',  New(PInputELine, init(R, 10)));

		InsTitledField(9,  5, 4, 1, 'YO Man', New(PInputWord, init(R,4)));
		InsTitledField(9,  6, 4, 1, 'YO Imp', New(PInputWord, init(R,4)));

		InsTitledField(9,  8,20, 1, '~S~tatus', New(PInputSCode, init(R, scVehicleStatus)));
		InsTitledField(9,  9,20, 1, 'Deliv', New(PinputJimmy, init(R, 20, 0)));
		Current^.SetState(sfDisabled, True);

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(20,Size.Y-3, @Self)));
		Insert(New(PjimmyCancelButton, init(31,Size.Y-3, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RTrailer : TStreamRec = (
		ObjType : srTrailer;
		VmtLink : Ofs(TypeOf(TTrailer)^);
		Load : @TTrailer.Load;
		Store : @TTrailer.Store
	);

function TTrailer.RecSize;
begin RecSize := 100; end;

function TTrailer.srType;
begin srType := srTrailer; end;


constructor TTrailer.Load(var S : TDataStream);
var	Ver : byte;

begin
	S.Read(Ver, 1);

	case Ver of
		2 : begin
			{got rid of tractor, changed model/type}
			inherited Load(S);

			RegNum := S.ReadStr;
			S.Read(Make, 4);
			Model := S.REadStr;
			S.Read(YearMan, 2);
			S.REad(YearImp, 2);
			S.Read(Status, 4);
			S.Read(CurrentDelivery, 4);
		end;
{		1 : begin
			inherited Load(S);

			RegNum := S.ReadStr;
			S.Read(Make, 4); {used to be type}
{			S.Read(Make, 4);
			Model := S.REadStr;
			S.Read(YearMan, 2);
			S.REad(YearImp, 2);
			S.Read(Status, 4);
			S.Read(CurrentDelivery, 4);
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TTrailer.Load',mfError,hcNoContext);
		fail;
	end;
end;

procedure TTrailer.StoreFields(var S : TDataStream);
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WriteStr(@RegNum);
	S.Write(make, 4);
	S.WriteStr(@Model);
	S.Write(YearMan, 2);
	S.Write(YearImp, 2);
	S.Write(Status, 4);
	S.Write(CurrentDelivery, 4);
end;

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

function TTrailer.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @CurrentDelivery;
	else
		GetJimmyID := nil;
	end;
end;
{**************************************
 ***       DATABASE                 ***
 **************************************}
function TTrailer.NumixTypes;
begin NumixTypes := 1; end;

function TTrailer.NumhkTypes;
begin NumhkTypes := 2; end; {incl hkhistory}

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

	case ixType of
		1 : begin IdxRec := @Ptr2Idx; fiType := fiVehicleIdx; end;
	end;
end;

function TTrailer.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		1 : GetIndexKey := ucase(RegNum);
	end;
end;

procedure TTrailer.GetHookOn;
begin
	inherited GetHookOn(hkType, Hookrec);

	case hkType of
		hkHistory : HookRec := @Ptr2History;
	end;
end;


{************************************************************
 ***              PRINTING                                ***
 ************************************************************}
procedure TTrailer.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	with FormCodes^ do begin
		SetStr('REG', RegNum);
		SetStr('MAKE', ExpandScode(scVehicleMake, Make));
		SetStr('MODEL', Model);
		SetStr('YOMAN', N2Str(YearMan));
		SetStr('YOIMP', N2Str(YearImp));
		SetStr('STATUS', ExpandScode(scVehicleStatus, Status));
		Insert(New(PJimmyFormCode, init('CDELIV', CurrentDelivery)));
	end;
end;

{*********************************************************************
 ***                                                               ***
 ***                     SHIPS                                     ***
 ***                                                               ***
{*********************************************************************}

constructor TShip.INit;
begin
	inherited Init;
	Ptr2Idx := -1;
	Ptr2DiaryIdx := -1;
	Coy := -1;

	Opening.Clear;
	CLosing.Clear;
	Arrival.Clear;
end;


function TShip.DisplayLine;
var S : string;
begin
	if lsType = lsDiary then
		S := {Closing.Digit8+' '+{}Name+' closing'
	else
		S := SetLength(Name,20)	+' '+Opening.Digit8
																			+' -> '+Closing.Digit8
																			+' ('+Arrival.Digit8
																			+') '+GetJimmyIDNAme(Coy, naDisplay, 0);
{	if GetLock<>0 then S := SetLength(S, Maxlen-1)+char(GetLock);{}

	DisplayLine := S;
end;

function TShip.GetName;
begin
	GetName := Name+' ->'+Closing.Digit8;
end;

{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TShip.MakeEditBox;
var	R: TRect;

begin
	R.Assign(0, 0, 43, 11);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Ship',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+8)));

		InsTitledField(10,  1,30, 1, '~N~ame',  New(PInputELine, init(R, 30)));
		PInputELine(Current)^.MustInputToClose := True;

		InsTitledField(10,  2,20, 1, 'Co~y~', New(PInputDirectory, init(R, 20, fiFullDirIdx, lsDIrectory, '')));

		InsTitledField(10,  4,10, 1, '~O~pening', New(PinputDate, init(R)));
		InsTitledField(10,  5,10, 1, 'C~l~osing', New(PinputDate, init(R)));
		InsTitledField(10,  6,10, 1, '~A~rrival', New(PinputDate, init(R)));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(20,Size.Y-3, @Self)));
		Insert(New(PjimmyCancelButton, init(31,Size.Y-3, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RShip : TStreamRec = (
		ObjType : srShip;
		VmtLink : Ofs(TypeOf(TShip)^);
		Load : @TShip.Load;
		Store : @TShip.Store
	);

function TShip.RecSize;
begin RecSize := 100; end;

function TShip.srType;
begin srType := srShip; end;


constructor TShip.Load(var S : TDataStream);
var	Ver : byte;

begin
	S.Read(Ver, 1);

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

			Name := S.ReadStr;
			S.Read(Coy, 4);
			Opening.Load(S);
			CLosing.Load(S);
			Arrival.Load(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TShip.Load',mfError, hcNoContext);
		fail;
	end;
end;

procedure TShip.StoreFields(var S : TDataStream);
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WriteStr(@Name);
	S.Write(Coy, 4);
	Opening.Store(S);
	CLosing.Store(S);
	Arrival.Store(s);
end;

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

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

{**************************************
 ***       DATABASE                 ***
 **************************************}
function TShip.NumixTypes;
begin NumixTypes := 2; end;

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

	case ixType of
		1 : begin IdxRec := @Ptr2Idx; 			fiType := fiShipIdx; end;
		2 : begin IdxRec := @Ptr2DiaryIdx; 	fitype := fiDIaryIdx; end;
	end;
end;

function TShip.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		1 : GetIndexKey := ucase(Name);
		2 : if not CLosing.Blank then GetIndexKey := Closing.AsKey;
	end;
end;


{*********************************************************************
 ***                                                               ***
 ***                     CONTAINERS                                ***
 ***                                                               ***
{*********************************************************************}

constructor TContainer.INit;
begin
	inherited Init;
	Ptr2Idx := -1;
	Ptr2AtRongaiIdx := -1;
	Coy := -1;
	LastAt := -1;
end;


function TContainer.DisplayLine;
var S: string;
begin
	S := GetJimmyIDName(LastAt, naRef, 0); if S<>'' then S := ' @'+S;
	S := SetLength(Number,16)+SetLength(Size,6)+SetLength(N2Str(Wt)+'kg',7)+GetJimmyIDName(Coy, naRef, 0)+S;

{	if GetLock<>0 then S := SetLength(S, Maxlen-1)+char(GetLock);{done in jimindxs}

	DisplayLine := S;
end;

function TContainer.GetName;
begin
	GetName := Number;
end;

{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TContainer.MakeEditBox;
var	R: TRect;

begin
	R.Assign(0, 0, 43, 11);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Container',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+8)));

		InsTitledField(10,  1,15, 1, '~N~umber',  New(PInputELine, init(R, 15)));
		PInputELine(Current)^.MustInputToClose := True;
		InsTitledField(10,  2, 5, 1, '~S~ize',    New(PInputELine, init(R, 5)));
		InsTitledField(10,  3, 6, 1, 'Tare ~W~t',	New(PInputWord, init(R, 6)));

		InsTitledField(10,  4,20, 1, 'Compan~y~', New(PInputDirectory, init(R, 20, fiCatDirIdx, lsDIrectory, 'SHI')));
		InsTitledField(10,  5,20, 1, '~A~t', New(PInputDirectory, init(R, 20, fiFullDirIdx, lsDIrectory, '')));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(20,Size.Y-3, @Self)));
		Insert(New(PjimmyCancelButton, init(31,Size.Y-3, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RContainer : TStreamRec = (
		ObjType : srContainer;
		VmtLink : Ofs(TypeOf(TContainer)^);
		Load : @TContainer.Load;
		Store : @TContainer.Store
	);

function TContainer.RecSize;
begin RecSize := 50; end;

function TContainer.srType;
begin srType := srContainer; end;


constructor TContainer.Load(var S : TDataStream);
var	Ver : byte;

begin
	S.Read(Ver, 1);

	case Ver of
		2 : begin
			{added Tare Wt}
			inherited Load(S);

			Number := S.ReadStr;
			Size := S.ReadStr;
			S.Read(Wt, 2);
			S.Read(Coy, 4);
			S.REad(LastAt, 4);
		end;
		1 : begin
			inherited Load(S);

			Number := S.ReadStr;
			Size := S.ReadStr;
			S.Read(Coy, 4);
			S.REad(LastAt, 4);
			Wt := 0;
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TContainer.Load',mfError, hcNoContext);
		fail;
	end;
end;

procedure TContainer.StoreFields(var S : TDataStream);
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WriteStr(@Number);
	S.WriteStr(@Size);
	S.Write(Wt, 2);
	S.Write(Coy, 4);
	S.Write(LastAt, 4);
end;

{****************************************************
 ***               POINTERS TO OTHER JIMMYS       ***
 ****************************************************}
function TContainer.NumIDs;
begin
	NumIDs := 2;
end;

function TContainer.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @Coy;
		2 : GetJimmyID := @LastAt;
	else
		GetJimmyID := nil;
	end;
end;
{**************************************
 ***       DATABASE                 ***
 **************************************}
function TContainer.NumixTypes;
begin NumixTypes := 2; end;

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

	case ixType of
		1 : begin IdxRec := @Ptr2Idx; 	fiType := fiContainerIdx; end;
		2 : begin IdxRec := @Ptr2AtRongaiIdx; fitype := fiRongaiContainerIdx; end;
	end;
end;

function TContainer.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		1 : GetIndexKey := ucase(Number);
		2 : if LastAt=UserCoyID then GetIndexKey := ucase(Number); {at rongai list}
	end;
end;

procedure TContainer.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	with FormCodes^ do begin
		SetStr('NUM', Number);
		SetStr('SIZE', Size);
		SetStr('WT', N2Str(Wt));
		Insert(New(PJimmyFormCode, init('COY', Coy)));
		Insert(New(PJImmyFormCode, init('LASTAT', LastAt)));
	end;
end;


{*********************************************************************
 ***                                                               ***
 ***                     REGISTRATION, ETC                         ***
 ***                                                               ***
{*********************************************************************}
function NewVehicleIndex : PStream; far;
begin NewVehicleIndex := New(PIndexedJimmyStream, init('VEHICLES.IDX',VehicleIndexSize)); end;

function NewShipIndex : PStream; far;
begin NewShipIndex := New(PIndexedJimmyStream, init('SHIPS.IDX',ShipIndexSize)); end;

function NewContainerIndex : PStream; far;
begin NewContainerIndex := New(PIndexedJimmyStream, init('CONTAINR.IDX',ContainerIndexSize)); end;

function NewRongaiContainerIndex : PStream; far;
begin NewRongaiContainerIndex := New(PIndexedJimmyStream, init('RONGCONT.IDX',ContainerIndexSize)); end;



function CreateTractor(P : pointer) : pointer; far;
begin CreateTractor := New(PTractor, init(P)); end;

function CreateTrailer(P : pointer) : pointer; far;
begin CreateTrailer := New(PTrailer, init(P)); end;

function CreateShip(P : pointer) : pointer; far;
begin CreateShip := New(PShip, init(P)); end;

function CreateContainer(P : pointer) : pointer; far;
begin CreateContainer := New(PContainer, init(P)); end;{}



procedure StartVehicleList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Vehicle List',
				New(PIndexedJimmyListView, init(Bounds, lsVehicles, fiVehicleIdx, '')))));
end;

procedure StartShipList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Ship List',
				New(PIndexedJimmyListView, init(Bounds, lsShips, fiShipIdx, '')))));
end;

procedure StartRongaiContainerList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Containers at Rongai',
				New(PIndexedJimmyListView, init(Bounds, lsContainers, fiRongaiContainerIdx, '')))));
end;

procedure StartContainerList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'All Containers',
				New(PIndexedJimmyListView, init(Bounds, lsContainers, fiContainerIdx, '')))));
end;


begin
	RegisterScodeType(scVehicleModel, 'TRACTORS.SC', 'Vehicle Models', StdSCodeCreator);
	RegisterSCodeType(scVehicleStatus, 'VEHSTAT.SC', 'Vehicle Status', StdSCodeCreator);
	RegisterSCodeType(scVehicleMake, 'VEHMAKE.SC', 'Vehicle Makes', StdScodeCreator);
	RegisterSCodeType(scGoods, 'GOODS.SC', 'Goods', CostedScodeCreator);

	{Streams}
	NewFileAdmin(fiVehicleIdx, 'Vehicle Index',NewVehicleIndex);
	NewFileAdmin(fiShipIdx, 'Ship Index', NewShipIndex);
	NewFileAdmin(fiContainerIdx, 'Container Index', NewContainerIndex);
	NewFileAdmin(fiRongaiContainerIdx, 'Containers at Rongai Index', NewRongaiContainerIndex);

	{lists}
	RegisterTask(DesktopTasks, cmStartVehicleList, @StartVehicleList);
	RegisterTask(DesktopTasks, cmStartShipList, @StartShipList);
	RegisterTask(DesktopTasks, cmStartRongaiContainerList, @StartRongaiContainerList);
	RegisterTask(DesktopTasks, cmStartContainerList, @StartContainerList);

	{Register jimmys}
	RegisterJimmy(RTractor, CreateTractor, lsVehicles, '~T~ractor');
	RegisterJimmy(RTrailer, CreateTrailer, lsVehicles, 'T~r~ailer');
	RegisterJimmy(RShip,		CreateShip,			lsShips, 		'S~h~ip');
	RegisterJimmy(RContainer,CreateContainer, lsContainers, '~C~ontainer');{}

end.
