{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          L I V E S T O C K                           ***
 ***                                                                      ***
 *** M Hill                                                      MAY 1995 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KLivestk;

INTERFACE

uses objects, scodes, dattime, files, views, global, tuilist, tasks,
			devices, forms,
			notes,
			jimmys, jimindxs, inpjimmy,
			tuiedit,
			indexes,
		 drivers, tui, setup, menus;


{************************************
 ***       Herd                   ***
 ************************************}
const
	THerdIdxSize = 50;
{	ixMaxHerd = 1;{}

	{livestock extras}
	hkBulls = 3; {needs to come after hkhistory which used to be 1 for livestock, so that pointers read ok}
{	hkHerdHistory = 1;{use global hkHistory = 2}

	DeadHerdID = -2;

	stDead = 'D';
	stStolen = 'STO';
	stSold = 'SOL';

type
	PHerd = ^THerd;
	THerd = object(TJimmy)

		Ptr2Idx : longint;
		HistoryHook : longint;
		Ptr2Bulls : longint;

		Name : string[10];
		Breeding : boolean;
		Desc : string[30];
		Handler : longint; {not really nec?}

		constructor Init;

		function GetName(naType : byte; Maxlen : integer) : string; virtual;

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

		function RecSize : word; virtual;
		function srType : word; virtual;
		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;


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

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

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{First Bull At}
		function FirstBullAt(Date : TDate) : longint;

	end;


{**************************************
 ***           Livestock               ***
 **************************************}

const
	TLivestockIdxSize = 50; {Size reserved for index record - surname + forname + odd ptrs}
{	ixMaxLiveStock = 4;{}
	NumBreedTypes = 4;

type
	PBreed = ^TBreed;
	TBreed = object(TObject)
		Code : array[1..NumBreedTypes] of TSCode;
		Prop : array[1..NumBreedTypes] of byte;

		constructor Init;
		procedure Store(var S : TDataStream);
		procedure Load(var S : TDataStream);
		function Unspecified : byte; {gets unspecified proportion}
		function NumTypes : byte; {gets number of codes specified/num lines}
		function TotalProp : byte;
		function GetLine(const C : TSCode) : byte;
		function GetProp(const C : TSCode) : byte;
		function Frac(B : byte) : string;
		function GetFrac(const C : TScode) : string;
		procedure Sort;

		Function BriefText : string;
	end;

type

	PLivestock = ^TLivestock;
	TLivestock = object(TJimmy)

{		AnimalType : TSCode;{}
		BrandNumber : string[5];
		Name : string[20];

		Sex : TSCode; {male, female, gelding}

		{origin details}
		DOB : TDate;
		Birthweight : word; {in kilograms}
		BoughtFrom : TSCode;

		SireID : longint; {pointer to father}
		DameID : longint; {pointer to mother}

		Breed : TBreed;

		HerdID : longint; {pointer to herd}

		Status : string[7]; {lactating, ill, etc}
		TrainedState : string[7]; {Riding, baggage, etc}

		CalfID : longint; {pointer to current calf}
		CalvingDate : TDate;

		NoteCodes : string[20];

		ArchiveIdx : longint;
		LiveNameIdx : longint; {alive stock only}
		LiveBrandIdx : longint;
		HerdNameIdx : longint; {separate, by-herd index - special 0 entry for deadstock}
		HerdBrandIdx : longint; {separate, by-herd index - special 0 entry for deadstock}
		FullNameIdx : longint; {all (dead/alive) stock}
		FullBrandIdx : longint;

		NotesHook : longint;
		HistoryHook : longint;

	 {-- Methods --}
	 constructor Init(Param : PJImmyInitParam);
	 procedure CommonInit; virtual;
	 destructor Done; virtual;

		function GetName(naType : byte; Maxlen : integer) : string; virtual;

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

		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;

		{--- Indexing ----}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;
		function GotByAlias(const fiType : byte) : boolean; virtual; {returns whether this is an alias (true)

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

		function HookingOn(const hkType,htType : byte; const HookingJimmy : PJimmy) : boolean; virtual;

		{editing/printing}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		function MakeCalf : PLiveStock;
		function InHerdAt(Date : TDate) : longint; {returns which herd it was in at given date}

		function IsCurrent : boolean; {is livestock/deadstock}
 end;

 const
	 {--- Required for Stream ----}
	 RLivestock : TStreamRec = (
		 ObjType : srLivestock;
		 VmtLink : Ofs(TypeOf(TLivestock)^);
		 Load : @TLivestock.Load;
		 Store : @TLivestock.Store
	 );

type

	PCrush = ^TCrush;
	TCrush = object(TJimmy)

		ForWho		: longint; {pointer to camel}
		Date      : TDate;
		Weight		: word;
		Status		: string[7]; {allow for two codes}
		Notes			: PFreeTextData;{}
		MedicalID : longint;

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

		{Display/edit/print}
		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;

		procedure LoadSupplements; virtual;

		{DataBase}
		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

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

		function GetKey : longint; {for convenience}
	end;



{*****************************************
 ***      Transfers                    ***
 *****************************************}
type
	PTransfer = ^TTransfer;
	TTransfer = object(TJimmy)
		Date : TDate;
		ForWho : longint;
		FromHerd : longint;
		ToHerd : longint;

	 {-- Methods --}
	 constructor Init(Param : PJImmyInitParam);

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{DataBase}
		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

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

type
	PWeaning = ^TWeaning;
	TWeaning = object(TJimmy)
		Date : TDate;
		DameID : longint;
		CalfID : longint;
		NewBrand : string[5];
		FromHerd : longint;
		ToHerd : longint;

	 {-- Methods --}
	 constructor Init(Param : PJimmyInitParam);

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{DataBase}
		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

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

	PService = ^TService;
	TService = object(TJimmy)
		Date : TDate;
		MaleID : longint;
		FemaleID : longint;

		{-- Methods --}
		constructor Init(Param : PJImmyInitParam);

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

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



	PLiveStockQNote = ^TLiveStockQNote;
	TLiveStockQNote = object(TJimmy)
		CamelID : longint;
		Date : TDate;
		What : TSCode;
		Quantity : word;
		Note : PFreeTExtData;

		{-- Methods --}
		constructor Init(Param : PJImmyInitParam);
		procedure CommonInit; virtual;
		destructor Done; virtual;

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		procedure LoadSupplements; virtual;

		function RecSize : word; virtual;
		function srType : word; virtual;

		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream);              virtual;

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

function Brand2Index(BrandNo : string) : string;


{**************************************
 ***      Livestock LIST VIEWS         ***
 **************************************}

type
	PLivestockListView   = ^TLivestockListView;          {Interior}
	TLivestockListView   = object(TIndexedJimmyListView)
		procedure HandleEvent(var Event : TEvent); virtual;
		function GetSearch4Index : string; virtual;  {converts search typed to search to search on}
	end;

	PInputLiveStock = ^TInputLiveStock;
	TInputLiveStock = object(TInputIndexedJimmy)
		Sex : TSCode; {sex restrictor}
		constructor Init(R : TRect; NFieldLen : byte; NSex : string);
		function SearchOn : string; virtual;
		function CreateList(Bounds : TRect) : PListWindow; virtual;
		function Valid(Command : word) : boolean; virtual;
	end;

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

uses 	minilib, tuimsgs, app, dialogs, printers,
			jimhooks,
			kamsetup,
			reports,
			lstrings,
			help,
			messtext,
			tuijimmy,
			kmedical, {medical stuff for animal history}
			kMNote, {for adding to camel notes}

{$IFDEF kdirctry} kdirctry, {$ENDIF}
			inpdnt;


function Brand2Index(BrandNo : string) : string;
var	P : byte;
begin
	BrandNo := delspace(BrandNo);

	{Locate numeric part (if any)}
	P := 0;
	repeat inc(P) until (P>length(BrandNo)) or (BrandNo[p]<#48) or (BrandNo[P]>#57);

	if P>1 then
		Brand2Index := PadSpaceL(Copy(BrandNo,1,P-1),5)+copy(BrandNo,P,255)
	else
		Brand2Index := BrandNo;
end;

{============= HERD/LIVESTOCK LINKER =================}
{can target it from a livestock entry and it
will pick up that livestock's herd}
type
	PLivestockHerdLinker = ^TLiveStockHerdLinker;
	TLivestockHerdLinker = object(TInputLinker)
		constructor Init(const LiveStockLine, HerdLine : PView; const EditBox : PEditBox);
		procedure CalculateLink(const CallingView : PView); virtual;
	end;

constructor TLivestockHerdLinker.Init;
begin
	inherited Init(nil, EditBox);
	SetSourceView(LiveStockLine, 1);
	SetTargetView(HerdLine, 1);
end;

procedure TLivestockHerdLinker.CalculateLink;
var	Animal : PLIveStock;
begin
	Animal := PLivestock(PInputJimmy(SourceView[1])^.GetJimmy);
	if Animal<>nil then with TargetView[1]^ do begin
		SetData(Animal^.HerdID); {set self to animal's current herd}
		DrawView;
	end;
end;



{****************************************************************************
 ***                                                                      ***
 ***                THE HERD OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor THerd.Init;
begin
	inherited Init;
	Ptr2Idx := -1;
	HistoryHook := -1;
	Ptr2Bulls := -1;
	Deleted := False;
	Name := '';
	Desc := '';
	Handler := -1;
	Breeding := False;
end;

function THerd.GetName(naType : byte; Maxlen : integer) : string;
begin
	GetName := Name;
end;

function THerd.DisplayLine;
begin
	DisplayLine := Name +': '+Desc;
end;

{========= DATABASE FUNCS ==========}
const
	{--- Required for Stream ----}
	RHerd : TStreamRec = (
		ObjType : srHerd;
		VmtLink : Ofs(TypeOf(THerd)^);
		Load : @THerd.Load;
		Store : @THerd.Store
	);

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

function THerd.srType;
begin srType := srHerd; end;

constructor THerd.Load;
var Ver : byte;
begin
	S.Read(Ver, 1);

	case Ver of
		4 : begin
			{moved ptrs to inherited load}
			inherited Load(S);
			Name := S.ReadStr;
			Desc := S.ReadStr;
			S.Read(Handler, 4);
			S.Read(Breeding, 1);
		end;
{		3 : begin
			CommonInit;

			S.Read(Lock, 1);
			S.Read(Deleted, 1);

			S.Read(Ptr2Idx, 4);
			S.Read(HistoryHook, 4);
			S.Read(Ptr2Bulls, 4);
			S.Read(Deleted, 1);
			Name := S.ReadStr;
			Desc := S.ReadStr;
			S.Read(Handler, 4);
			S.Read(Breeding, 1);
		end;
		2 : begin
			{added current hooked bull list and breeding marker}
{			CommonInit;

			S.Read(Lock, 1);
			S.Read(Ptr2Idx, 4);
			S.Read(HistoryHook, 4);
			S.Read(Ptr2Bulls, 4);
			S.Read(Deleted, 1);
			Name := S.ReadStr;
			Desc := S.ReadStr;
			S.Read(Handler, 4);
			S.Read(Breeding, 1);
		end;
		1 : begin
			COmmonInit;
			S.Read(Lock, 1);
			S.Read(Ptr2Idx, 4);
			S.Read(HistoryHook, 4);
			S.Read(Deleted, 1);
			Name := S.ReadStr;
			Desc := S.ReadStr;
			S.Read(Handler, 4);
			Ptr2Bulls := -1;
			Breeding := False;
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'Loading Herd',mfError);
		fail;
	end; {}
end; {proc}

procedure THerd.StoreFields;
var	Ver : byte;

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

	inherited StoreFields(S);

	S.WriteStr(@Name);
	S.WriteStr(@Desc);
	S.Write(Handler, 4);
	S.Write(Breeding, 1);
end;

{============= INDEXING/HOOKING ========================}
function THerd.NumixTypes;
begin Numixtypes := 1; end;

{Get items the letter is supposed to hook up to when storing}
procedure THerd.GetIndex;
begin
	inherited GetIndex(ixType, Idxrec, fiType);
	case ixType of
		1 : begin IdxRec := @Ptr2Idx; fiType := fiHerdIdx; end;
	end;
end;

function THerd.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		1 : GetIndexKey := ucase(delspaceR(Name));
	end;
end;


function THerd.NumhkTypes;
begin Numhktypes := 3; end;

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

	case hkType of
		hkHistory : begin HookRec := @HistoryHook; end;
		hkBulls 	: begin HookRec := @Ptr2Bulls; end;
	end;
end;



{******************************************
 ***           EDIT HERD                ***
 ******************************************}
type
	PListLiveStockButton = ^TListLiveStockButton;
	TListLiveStockButton = object(TJImmyStoreButton)
		procedure Press; virtual;
	end;

procedure TListLiveStockButton.Press;
var Bounds : TRect;
		List : PIndexedJImmyListWindow;

begin
	inherited Press; {store, etc}

	if OwnerValid<>1 then exit;

	Bounds.Assign(5,Desktop^.Size.Y div 4, 75, Desktop^.Size.Y -2);

	New(List, init(Bounds, 'Livestock of '+PHerd(DataItem)^.Name,
		New(PLiveStockListView, init(Bounds, lsLiveStock, fiHerdstockIdx,
					PakLint(PHerd(DataItem)^.RecNo)))));

	Desktop^.Insert(List);
end;

procedure THerd.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
begin
	R.Assign(0, 0, 50, 12); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, init(R, 'Herd Registration',Caller, @Self));

	EditBox^.Options := EditBox^.Options or ofCenterX;
	with EditBox^ do begin
		{--- Set up box interior ---}
{$IFDEF fixit}
		GrowTo(Size.X, Size.Y+3); {Add an extra line}

		Insert(New(PSkipBytes, init(Sizeof(TObject))));

		{data item stuff}
		R.XYLD(5, Size.Y-3, 6, 1); Insert(New(PInputLint, init(R,8))); AddLabel('Rec',Current);
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('Ter',Current);
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('Cou',Current);

		{jimmy stuff}
		R.XYLD(-5,Size.Y-2, 6, 1);
		R.Move(10,0);							 Insert(New(PInputBYte, init(R,3))); AddLabel('ix',Current);
		R.Move(10,0);							 Insert(New(PInputBoolean, init(R))); AddLabel('Del',Current);
		R.Move(10,0);							 Insert(New(PInputBoolean, init(R))); AddLabel('Tag',Current);
		Insert(New(PSkipBytes, init(sizeof(TTimer)))); {skip insert-ttime timer}

		{herd stuff}
		R.XYLD(5, Size.Y-1, 6, 1); Insert(New(PInputLint, init(R,8))); AddLabel('Nam', Current);
		R.Move(10,0);							 Insert(New(PInputLint, init(R,8))); AddLabel('His', Current);
		R.Move(10,0);							 Insert(New(PInputLint, init(R,8))); AddLabel('Bul', Current);

{$ELSE}
		Insert(New(PSkipBytes, init(sizeof(TJimmy)+4+4+4))); {skip name idx & history ptr & bulls ptr}
{$ENDIF}

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

		InsTitledField(10, 3,  1, 1, '~B~reeding', New(PInputBoolean, init(R)));

		InsTitledField(10, 4, 23, 1, '~D~esc', New(PInputELine, init(R, 30)));

{$IFDEF kdirctry}
		InsTitledField(10, 5, 23, 1, '~H~andler', New(PInputDirectory, init(R, 10, fiFullDirIdx, lsDirectory, '')));
{$ENDIF}

		R.XYLD(10, 7, 25, 3); Insert(New(PDlgHookView,	Init(R, lsHerdBulls, 0, hkBulls, @Self, PJimmyEditBox(EditBox) )));
		AddLabel('~B~ulls', Current);

{		R.XYLD(10,10, 25, 5); Insert(New(PDlgHookView,	Init(R, lsHerdHistory, 0, hkHistory, @Self, PJimmyEditBox(EditBox) )));
		AddLabel('~H~istory', Current);
		PHookViewer(Current)^.SetFocusKey(kbHistory);{}

		Insert(New(PListLiveStockButton, init(Size.X-13, Size.Y-9, '~L~ivestck', cmNone, bfNormal {or bfGetData{}, @Self)));

		Insert(New(PHookListButton, init(Size.X-13,Size.Y-7,'~H~istory',
																cmNone, bfNormal, @Self, hkHistory, lsHerdHistory)));{}

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

		EndInit;
	end;

end;


{*********** HERD FUNCTIONS ***************************}
{finds first bull in index, should be supplemented by a findnext}
function Therd.FirstBullAt(Date : TDate) : longint;
begin
	FileAdmin(fiHooks)^.LogOn;
	FirstBullAt := HookFile^.FindFirst(Ptr2Bulls, srLiveStock);
	FileAdmin(fiHooks)^.LogOff;
end;


procedure THerd.SetFormCodes;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		SetStr('NAME', Name);
	end;
end;


{*************************************************************
 ***                BREED                                  ***
 *************************************************************}
{A Breed consists of an array of codes/proportions, each code/proportion
giving the type of breed and the proportion that this breed is of that, eg:

	P - Pakistani		4	- 4/8ths (=1/2)
	S - Somali			2	- 2/8ths (=1/4)

	--> 1/4 (remainder) unspecified.

The object gives methods for storing and displaying}

const
	BreedFracs = 8; {done in 1/8ths}


constructor TBreed.Init;
var B : byte;
begin
	inherited Init;
	for B := 1 to NumBreedTypes do begin
		Code[B] := '';
		Prop[B] := 0;
	end;
end;

procedure TBreed.Store;
var B : byte;
begin
	for B := 1 to NumBreedTypes do begin
		S.WriteFixedStr(@Code[B], 3);
		S.Write(Prop[B], 1);
	end;
end;

procedure TBreed.Load;
var B : byte;
begin
	for B := 1 to NumBreedTypes do begin
		Code[B] := S.ReadFixedStr(3);
		S.Read(Prop[B], 1);
	end;
end;

function TBreed.Unspecified;
begin
	if TotalProp<BreedFracs then Unspecified := BreedFracs-TotalProp else Unspecified := 0;
end;

function TBreed.TotalProp : byte;
var B : byte;
		T : byte;
begin
	T := 0;
	for B :=1 to NumBreedTypes do T := T + Prop[B];
	TotalProp := T;
end;

function TBreed.NumTypes : byte;
var B : byte;
begin
	B := 1;
	while (B<=NumBreedTypes) and (delspaceR(Code[B])<>'') do inc(B);
	NumTypes := B-1;
end;

{locates array position by code}
function TBreed.GetLine(const C : TSCode) : byte;
var B : byte;
begin
	B := 1;
	while (B<=NumBreedTypes) and (delspaceR(C)<>delspaceR(Code[B])) do inc(B);
	if B<=NumBreedTypes then GetLine := B else GetLine := 0;
end;

function TBreed.GetProp(const C : TSCode) : byte;
var B : byte;
begin
	B := GetLine(C); if B=0 then GetProp := 0 else GetProp := Prop[B];
end;


function TBreed.Frac(B : byte) : string;
begin
	if (B>0) and (B<NumBreedTypes) then
		Frac := SimplifyFracStr(N2Str(Prop[B]) + '/' + N2Str(BreedFracs))
	else
		Frac := '';
end;

function TBreed.GetFrac(const C : TScode) : string;
begin
	GetFrac := SimplifyFracStr(N2Str(GetProp(C))+'/'+N2Str(BreedFracs));
end;


{--- sorts into largest first -----}
procedure TBreed.Sort;
var Breed : TBreed;
		PMax, APos : byte;
		B, C : byte;
begin
	Breed.Init;
	{target array}
	for B := 1 to 4 do begin
		PMax := 0; APos := 0;
		{find largest in self}
		for C := 1 to 4 do
			if Prop[C]>PMax then begin {biggest so far}
				PMax := Prop[C];
				APos := C;
			end;

		if APos<>0 then begin
			Breed.Code[B] := Code[APos];
			Breed.Prop[B] := prop[APos];
			Prop[APos] := 0; {so not found again}
		end;
	end;

	{copy to self}
	Self := Breed;

	Breed.Done;

end;


function TBreed.BriefText : string;
var S : String;
		B : byte;
begin
	if Unspecified=BreedFracs then
		{unknown breed}
		BriefText := ''
	else
		{pure breed}
		if Prop[1] = BreedFracs then
			BriefText := ExpandSCode(scBreed, Code[1])
		else begin
			S := '';
			for B := 1 to NumBreedTypes do
				if delspaceR(Code[B])<>'' then S := S + delspaceR(Code[B])+'x';

			if Unspecified>0 then
				S := S + '?'
			else
				S := Copy(S,1,length(S)-1);

			BriefText := S;
		end;
end;



{============ INPUT BREED ================}
type
	PInputBreed = ^TInputBreed;
	TInputBreed = object(TView)

		Breed : TBreed;
		SelectedLine : byte;

		constructor Init(Bounds : TRect);
		destructor Done; virtual;

		procedure Draw; virtual;
		procedure HandleEvent(var Event : TEvent); virtual;
		procedure SetData(var Rec); virtual;
		procedure GetData(var Rec); virtual;
		function datasize : word; virtual;
		function GetPalette : PPalette; virtual;
		function Valid(Command : word) : boolean; virtual;
		procedure SetState(AState : word; Enable : boolean); virtual;

	end;

constructor TInputBreed.Init;
begin
	inherited init(Bounds);
	Breed.Init;
	SelectedLine := 1;
	EventMask := $FFFF and not evMouseMove; {catch all except mouse *movements* - still pick up clicks}

	{switch on act on first click (ofSelectable & ofFirstClick) and switches off moving to top on click - interferes with tab}
	Options := (Options or ofSelectable or ofFirstClick)
							and not ofTopSelect;
end;


destructor TInputBreed.Done;
begin
	Breed.Done;
	inherited Done;
end;

{=== DRAW =====}
procedure TInputBreed.Draw;
var B : byte;
		Colour : byte;
		Line : string[80];

	procedure FormatLine(const BreedType : string; const Prop : byte);
	begin
		Line := SetLength(BreedType,15)
							+PadSpaceR(SimplifyFracStr(N2Str(Prop)+'/'+N2Str(BreedFracs)),4)
							+PadSpaceR(MakeBar(Prop*2),Size.X-19);
	end;

begin
	for B := 1 to Breed.NumTypes do begin
		if B=SelectedLine then
			if GetState(sfFocused) then
				Colour := 3
			else
				Colour := 4
		else
			Colour := 1;
		FormatLine(ExpandSCode(scBreed, Breed.Code[B]), Breed.Prop[B]);
		WriteStr(0,B-1,Line,Colour);
	end;

	{Blank rest}
	Line := space(Size.X);
	for B := Breed.NumTypes to 4 do WriteStr(0,B,Line,1);

	{add unspecified to end}
	if Breed.Unspecified>0 then begin
		FormatLine('Unspecified', Breed.Unspecified);
		WriteStr(0,Breed.NumTypes,Line, 1);
	end;
end;

function TInputBreed.GetPalette: PPalette;
const
	P: String[Length(CListViewer)] = CListViewer;
begin
	GetPalette := @P;
end;{}

{---- Handle event ------}
procedure TInputBreed.HandleEvent(var Event : TEvent);
var InputLine : PInputSCode;
		R : TRect;
		B : byte;
		Code : TScode;
begin
	if GetState(sfFocused) and (Event.What = evKeyDown) then begin
		case Event.KeyCode of
			kbUp : begin
				if (SelectedLine>1) then
					dec(SelectedLine)
				else
					if Breed.NumTypes>0 then SelectedLine := Breed.NumTypes;
				DrawView;
			end;
			kbDown : begin
				if SelectedLine >= Breed.NumTypes then
					SelectedLine := 1
				else
					inc(SelectedLine);
				DrawView;
			end;
			kbIns : if Breed.NumTypes<NumBreedTypes then begin
				{select new code}
				Owner^.Lock;
				R.Assign(Origin.X,Origin.Y,Origin.X+5,Origin.Y+1); {so that list view can locate}
				InputLine := New(PInputSCode, init(R, scBreed));
				Owner^.Insert(InputLine); {so that list view has somewhere to cling to}
				InputLine^.ExecuteList;
{				Owner^.Delete(InputLine); should happen in dispose below}
				InputLine^.GetData(Code);
				dispose(InputLine, done);

				{check if already there}
				if Breed.GetLine(Code)>0 then
					Breed.Code[Breed.GetLine(Code)] := Code
				else
					Breed.Code[Breed.NumTypes+1] := Code;

				Focus; {draw focus back to here}
				{auto proportions}
				if Breed.NumTypes=1 then Breed.Prop[1] := BreedFracs; {auto full on first one}
				if (Breed.NumTypes=2) and
						((Breed.Prop[1]+Breed.Unspecified)=BreedFracs) then begin {half and half}
					Breed.Prop[1] := BreedFracs div 2;
					Breed.Prop[2] := BreedFracs div 2;
				end;
				Owner^.Unlock;
				DrawView;
			end;
			kbShiftDel : begin
				{shuffle up}
				for B := SelectedLine+1 to Breed.NumTypes do begin
					Breed.Code[B-1] := Breed.Code[B];
					Breed.Prop[B-1] := Breed.Prop[B];
				end;
				Breed.Prop[Breed.NumTypes] := 0;
				Breed.Code[Breed.NumTypes] := '';
				if SelectedLine>Breed.NumTypes then SelectedLine := Breed.NumTypes;
				DrawView;
			end;
			kbLeft : if (SelectedLine<=Breed.NumTypes) and (Breed.Prop[SelectedLine]>1) then begin
				dec(Breed.Prop[SelectedLine]);
				DrawView;
			end;
			kbRight : if (SelectedLine<=Breed.NumTypes) and (Breed.Prop[SelectedLine]<BreedFracs) then begin
				inc(Breed.Prop[SelectedLine]);
				DrawView;
			end;
		end;
	end;

	inherited HandleEvent(Event);
end;

procedure TInputBreed.SetState;
begin
	inherited SetState(AState, Enable);
	if (AState = sfFocused) then
		Draw; {draw view so that highlighted line changes colour}
end;


function TInputBreed.Valid(Command : word) : boolean;
var V : boolean;
begin
	V := inherited Valid(Command);

	if V and DoValidFor(Command) then
		if Breed.TotalProp > BreedFracs then begin
			V := False;
			if Command<>cmForceLink then begin
				Focus; DrawView;
				InputWarning('Proportions come to too much');
			end;
		end;

	Valid := V;
end;

{----- SetData ------------}
procedure TInputBreed.SetData(var Rec);
begin
	Breed := TBreed(Rec);
end;

procedure TInputBreed.GetData(var Rec);
begin
	TBreed(Rec) := Breed;
end;

function TInputBreed.DataSize : word;
begin
	DataSize := sizeof(Tbreed);
end;


{****************************************************************************
 ***                                                                      ***
 ***                THE Livestock OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TLivestock.Init;
var Calf, Dame : PLiveStock;
begin
	inherited Init;

{	AnimalType := ''; {LivestockSetup.DefaultType;{}
	BrandNumber := '';
	Name :='';
	HerdID :=-1;
	SireID :=-1;
	DameID :=-1;
	CalfID :=-1;
	Sex := '';
	Status := '';

	{origin}
	DOB.Clear;
	CalvingDate.Clear;
	Birthweight := 0;
	BoughtFrom := '';


	if (Param<>nil) and (Param^.ListView<>nil) then begin
		if (Param^.ListView^.lstype=lsLiveStock) and (PIndexedJImmyListView(Param^.ListView)^.SubIndexString<>'') then begin
			{a livestock list - is it a herd sublist ---> auto herd}
			Move(PINdexedJImmyListView(Param^.ListView)^.SubIndexString[1], HerdID, 4); {set herd}
		end;

		if (Param^.ListView^.lsType = lsLiveStockHistory) then begin
			{in history --> a birth}
			DameID := PHookViewer(Param^.ListView)^.DummyParentJimmy^.RecNo;
			if DameID<>-1 then begin {safety}
				Dame := PLivestock(GetJimmy(DameID));
				Calf := Dame^.MakeCalf;
				dispose(Dame, done);

				Self := Calf^;
				if not DeadDataMode then DOB.SetToToday;

				dispose(Calf, done);
			end;
		end;

	end;

end;

procedure TLivestock.CommonInit;
begin
	inherited CommonInit;
	Breed.Init;
{	SCodeCollection[scAnimalType]^.LogOn;{}
	SCodeCollection[scSex]^.LogOn;
	SCodeCollection[scBreed]^.LogOn;
	SCodeCollection[scBoughtFrom]^.LogOn;
	SCodeCollection[scCrushState]^.LogOn;
	SCodeCollection[scTrainedState]^.LogOn;
	SCodeCollection[scLiveStockSearch]^.LogOn;
end;

destructor TLivestock.Done;
begin
{	SCodeCollection[scAnimalType]^.LogOff;{}
	Breed.Done;
	SCodeCollection[scSex]^.LogOff;
	SCodeCollection[scBreed]^.LogOff;
	SCodeCollection[scBoughtFrom]^.LogOff;
	SCodeCollection[scCrushState]^.LogOff;
	SCodeCollection[scTrainedState]^.LogOff;
	SCodeCollection[scLiveStockSearch]^.LogOff;
	inherited Done;{}
end;

{********************************************
 *** DISPLAY LINE                         ***
 ********************************************}
{Used for list views}
function TLivestock.DisplayLine;
var S : string;

begin
	S := '';

	if lstype = lsLiveStockHistory then
		S := DOB.Digit8+' BIRTH OF '+Name+' #'+BrandNumber+' '+delspaceR(Sex)
	else
		if lstype = lsLiveStockMore then
			S := 'OFFSPRING: '+Name +' #'+BrandNUmber+' '+delspaceR(Sex)
		else begin
			{main list}
			if (gotbyix = 1) or (gotbyix=3) then
				S := S+PadSpaceR(Name, 12)+PadSpaceL('#'+BrandNumber, 6)+delspaceR(Sex)
			else
				S := S+PadSpaceR(BrandNumber+Sex,6)+PadSpaceR(Name, 9);

			if Breed.BriefText<>'' then S := S + ' '+Breed.BriefText;
			if not DOB.Blank then S :=S + ' '+DOb.Text(daAge);
		end;

{$IFDEF fixit}
	S := S +#13+space(6)+'TEK:'+N2Str(RecNo)+' Idx N'+N2Str(FullNameIdx)+'/B'+N2Str(FullBrandIdx)
												+' Herd Idx N'+N2Str(HerdNameIdx)+'/B'+N2Str(HerdBrandIdx)
												+' Live Idx N'+N2Str(LiveNameIdx)+'/B'+N2Str(LiveBrandIdx)
												+' Arc'+N2Str(ArchiveIdx)
												+' Notes'+N2Str(NotesHook)
												+' Hist'+N2Str(HistoryHook);
{$ENDIF}

	{Set}
	DisplayLine :=S;
end;


function TLivestock.GetName;
var S : string;
begin
	if DelspaceR(Name)<>'' then S := Name+' #'+BrandNumber else S := BrandNumber;

	S := S + delspaceR(Sex);

	if naType<>naRef then begin
		if Breed.BriefText<>'' then S := S+', '+BReed.BriefText;

		if naType=naDisplay then if HerdID<>-1 then S := S +' ('+GetJimmyIDName(HerdID, naRef,0)+')';
	end;

	if Maxlen>0 then S := Copy(S,1,maxlen);
	GetName := S;
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}
function TLiveStock.RecSize;
begin RecSize := 250; end;

function TLiveStock.srType;
begin srType := srLiveStock; end;

{------- LOAD MAIN DATA ----------}
constructor TLivestock.Load;
var Ver : byte;
		I : longint;
		Herd : PHerd;

begin
	S.Read(Ver, 1);
{	RecNo := -1; {not set yet}
{	ArchiveIdx := -1;{}

	case Ver of
		10 : begin
			{extra fullstock & deadstock indexes created}
			inherited Load(S);

			S.Read(BrandNumber, sizeof(BrandNumber));
			S.Read(Name, sizeof(Name));
			S.Read(HerdID, 4);
			S.Read(CalfID, 4);
			S.Read(Status, sizeof(Status));
			S.Read(TrainedState, sizeof(TrainedState));
			S.Read(Sex,sizeof(Sex));

			{origin}
			DOB.Load(S);
			S.Read(BirthWeight, 2);

			S.Read(SireID, 4);
			S.Read(DameID,4);
			S.Read(BoughtFrom, sizeof(BoughtFrom));
			Breed.Load(S);
			CalvingDate.Load(S);

			S.Read(NoteCodes, sizeof(NoteCodes));
		end;
		9 : begin
			{indexes/hooks moved to inherited}
			CommonInit;
			S.REad(LockTerminal, 1);
			S.Read(Deleted, 1);

			S.Read(ArchiveIdx, 4);
			S.Read(LiveNameIdx, 4);
			S.Read(LiveBrandIdx,4);
			S.Read(HerdNameIdx, 4);
			S.Read(HerdBrandIdx,4);

			S.Read(NotesHook,4);
			S.Read(HistoryHook,4);

			FullNameIdx := -1;
			FullBrandIdx := -1;


			S.Read(BrandNumber, sizeof(BrandNumber));
			S.Read(Name, sizeof(Name));
			S.Read(HerdID, 4);
			S.Read(CalfID, 4);
			S.Read(Status, sizeof(Status));
			S.Read(TrainedState, sizeof(TrainedState));
			S.Read(Sex,sizeof(Sex));

			{origin}
			DOB.Load(S);
			S.Read(BirthWeight, 2);

			S.Read(SireID, 4);
			S.Read(DameID,4);
			S.Read(BoughtFrom, sizeof(BoughtFrom));
			Breed.Load(S);
			CalvingDate.Load(S);

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

			{new deadstock list}
			Herd := PHerd(GetJimmy(HerdID));
			if (Herd<>nil) then begin
				if (pos('DEAD',ucase(Herd^.Name))>0) then begin
					HerdID := DeadHerdID;
					Status := stDead;
				end;
				if (pos('STOLEN',ucase(Herd^.Name))>0) then begin
					HerdID := DeadHerdID;
					Status := stStolen;
				end;
				if (pos('SOLD',ucase(Herd^.Name))>0) then begin
					HerdID := DeadHerdID;
					Status := stSold;
				end;
				dispose(Herd, done);
			end;


			if not IsCurrent then HerdID := DeadHerdID;
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'Loading Livestock',mfError);
		fail;
	end; {}
end; {proc}

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

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

	inherited StoreFields(S);

	S.Write(BrandNumber, sizeof(BrandNumber));
	S.Write(Name, sizeof(Name));
	S.Write(HerdID, 4);
	S.Write(CalfID, 4);
	S.Write(Status, sizeof(Status));
	S.Write(TrainedState, sizeof(TrainedState));
	S.Write(Sex, sizeof(Sex));

	{origin}
	DOB.Store(S);
	S.Write(BirthWeight, 2);

	S.Write(SireID, 4);
	S.Write(DameID,4);
	S.Write(BoughtFrom, sizeof(BoughtFrom));

	Breed.Store(S);
	CalvingDate.Store(S);

	S.Write(NoteCodes, sizeof(NoteCodes));
end;


{============= INDEXING/HOOKING ========================}
function TLivestock.NumixTypes;
begin Numixtypes := 6; end;

{Get items the letter is supposed to hook up to when storing}
procedure TLivestock.GetIndex;
begin
	inherited GetIndex(ixType, Idxrec, fiType);

	case ixType of
		1 : begin IdxRec := @LiveNameIdx; 	fiType := fiLivestockIdx; end;
		2 : begin IdxRec := @LiveBrandIdx;	fiType := fiLivestockIdx; end;
		3 : begin IdxRec := @HerdNameIdx; 	fiType := fiHerdstockIdx; end;
		4 : begin IdxRec := @HerdBrandIdx; 	fiType := fiHerdstockIdx; end;
		5 : begin IdxRec := @FullNameIdx; 	fiType := fiFullstockIdx; end;{}
		6 : begin IdxRec := @FullBrandIdx; 	fiType := fiFullstockIdx; end;{}

		ixArchive : begin IdxRec := @ArchiveIdx; fiType := fiArchiveIdx; end;
	end;
end;

function TLivestock.GetIndexKey;

	function NameKey : string;
	begin NameKey := ucase(Name); end;

	function BrandKey : string;
	begin BrandKey := ucase(Brand2Index(BrandNumber))+DelspaceR(Sex); end;

begin
	GetIndexKey := '';

	case ixType of
		{livestock}
		1 : if IsCurrent then GetIndexKey := NameKey;
		2 : if IsCurrent then GetIndexKey := BrandKey;
		{herdstock}
		3 : if Name<>'' then
					if IsCurrent then GetIndexKey := PakLint(HerdID)+NameKey
											 else GetIndexKey := PakLint(DeadHerdID)+NameKey;
		4 : if IsCurrent then GetIndexKey := PakLint(HerdID)+BrandKey
										 else GetIndexKey := PakLint(DeadHerdID)+BrandKey;
		{fullstock}
		5	: GetIndexKey := NameKey;
		6	: GetIndexKey := BrandKey;
		ixArchive : GetIndexKey := BrandKey;
	end;
end;

function TLivestock.GotByAlias;
begin
	case fitype of
		fiLivestockIdx 	: GotByAlias := (GotByix = 1);
		fiHerdstockIdx 	: GotByAlias := (GotByix = 3);
		fiFullstockIdx 	: GotByAlias := (GotByix = 5);
	else
		GotByAlias := False;
	end;
end;

function TLivestock.NumhkTypes;
begin Numhktypes := 2; end;

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

	case hkType of
		hkMore 			: begin HookRec := @NotesHook; end;
		hkHistory 	: begin HookRec := @HistoryHook; end;
	end;
end;

function TLivestock.NumHookTo;
begin NumHooKTo := 4; end;

procedure TLivestock.GetHookTo;
var Herd : PHerd;
begin
	inherited GetHookTo(htType, HookToID, SubHookToID, hkType, Key);

	if DOB.Blank then
		Key := sortkeystart
	else
		Key := - DOB.Days;

	case htType of
		{mark offspring on more-about}
		1 : begin HookToID := @SireID; hkType := hkMore; end;
		2 : begin HookToID := @DameID; hkType := hkMore; end;
		{mark as a birth on dame's history}
		3 : begin HookToID := @DameID; hkType := hkHistory; end; {mark birth on history}
		{if a bull, and herd a breeding herd, mark on herd's bull list}
		4 : if (HerdID>-1) and (delspaceR(Sex)='M') and (pos('C',ucase(BrandNumber))=0) then begin
			Herd := PHerd(GetJimmy(HerdID));
			if (herd^.Breeding) then begin HookToID := @HerdID; hkType := hkBulls; end;
			dispose(Herd, done);
		end;
	end;
end;



{===== AUTO UPDATES BY OTHER JIMMYS BEING HOOKED ON ===================}
{Returns true if anything changed}
function TLiveStock.HookingOn;
var Service : PService;
		Crush : PCrush;
		LiveStock : PLivestock;
		S : String;
		I : integer;
		CDate : TDate;
		Control : word;
begin
	HookingOn := False;
	if hkType = hkHistory then
		case HookingJimmy^.srType of

			{CRUSH hooked on - if live data, don't bother if not latest}
			srCrush : if not DeadDataMode then{} begin

				{------- Latest Crush -------}
				Crush := PCrush(HookingJimmy); {shorthand}

				{---- Becoming Pregnant => Calving date ========}
				if (pos(' P ',' '+Status+' ')=0) and
					(pos(' P ',' '+Crush^.Status+' ')>0) and
						(CalvingDate.Blank) then begin
					{has become pregnant}

					Service := PService(HookFile^.GetFirst(HistoryHook, srService));
					while (Service<>nil) and (Service^.Date.Days>Crush^.Date.Days) do begin
						dispose(Service, done);
						Service := PService(HookFile^.GetNextJimmy); {find the one prev to crush}
					end;

					if Service<>nil then begin
						S := 'Last Service '+Service^.Date.Text(daAbbr)
									+' by '+GetJimmyIDName(Service^.MaleID, naDisplay, 0);

						if Service^.Date.Days<(Crush^.Date.Days-100) then begin
							S := S+#13#13+'Too long ago?';
							CDate.SetToDate(Crush^.Date);
						end else
							CDate.SetToDate(Service^.Date);

						dispose(Service, done);
					end else begin
						CDate.SetToDate(Crush^.Date);
						S := 'No previous service found';
					end;
					CDate.AddYear(true);
					CDate.Day := 0;
					Control := MessageBox('CRUSH',GetName(naFull,0)+' has become pregnant'#13#13
											+S+#13
											+'Setting Calving Date to '+CDate.Text(DaAbbr),
											mfOKButton+mfCancelButton+mfInformation + mfNotifyBleep);{}
					if Control=cmOK then CalvingDate.SetToDate(CDate);
				end; {become pregnant}

				if (pos(' P ',' '+Status+' ')<>0) and
					(pos(' P ',' '+Crush^.Status+' ')=0) then begin
					{is no longer pregnant - change of mind/abortion/etc}
					CalvingDate.Clear;
				end;

				Status := Crush^.Status;

				HookingOn := True; {changed}

			end; {latest srcrush}

			srTransfer : if not DeadDataMode then begin
				{----- Latest transfer -------}
				HerdID := PTransfer(HookingJimmy)^.ToHerd;
				HookingOn := True; {changed}
			end;

			srWeaning : begin
				{------ Latest/only?! Weaning -----}
				if PWeaning(HookingJimmy)^.CalfID = RecNo then begin
					{this is the calf it's hooking on to}
					BrandNumber := PWeaning(HookingJimmy)^.NewBrand;
					if not DeadDataMode then HerdID := PWeaning(HookingJimmy)^.ToHerd;
					HookingOn := True;
				end;
				if (PWeaning(HookingJimmy)^.DameID = RecNo) and
						(PWeaning(HookingJimmy)^.CalfID = CalfID) then begin
					{this is the dame it's hooking on to, with calf at foot}
					CalfID := -1;
					HookingOn := True;
				end;
			end;

			{BIRTH}
			{does rather assume that the calf will have a "c" in the brand number.
			This helps also to prevent problems when livestock are re-hooked after
			weaning, when otherwise this routine is called.  Also will only do if
			prev marked pregnant, (so as to avoid deaddata problems...?)}
			srLivestock : if (PLivestock(HookingJimmy)^.DameID = RecNo)
				and (pos('c',PLivestock(HookingJimmy)^.BrandNumber)>0)
				and (CalfID=-1) then begin
				I := pos(' P ',' '+Status+' ');
				if ((I>0) or DeadDataMode) then begin
					if (I>0) and not DeadDataMode then Status := Copy(Status, 1, I-1)+Copy(Status,I+1, 255); {remove pregnant marker}
					CalvingDate.Clear;
					CalfID := HookingJimmy^.RecNo;
					HookingOn := True; {changed}
				end;
			end;

		end; {case}

end;


function TLiveStock.InHerdAt(Date : TDate) : longint;
begin
	InHerdAt := HerdID; {for now}
end;


{is it currently live & present?}
function TLiveStock.IsCurrent : boolean;
begin
	IsCurrent := 		(pos(' '+stDead  +' ',' '+Status+' ')=0)
							and (pos(' '+stStolen+' ',' '+Status+' ')=0)
							and (pos(' '+stSold  +' ',' '+Status+' ')=0);
end;

{***************************************************************************
 ***                                                                     ***
 ***              EDIT Livestock                                         ***
 ***                                                                     ***
 ***************************************************************************}
{--- Breed line link ----}
const
	svSireLine = 1;
	svDameLine = 2;
	svDOBLine = 3; {alos does check for existing calf in dead data mode}
	{target lines are breed lines}
	tvBreedView = 1;

procedure LinkBreed(const Linker :PInputLinker; const CallingView : PView); far;
var Sire, Dame,Sibling : PLiveStock;
		Breed : TBreed;
		DOB : TDate;
		B,C : byte;
		{for shorthand access to source/target array}
		SireLine : PInputJimmy;
		DameLine : PInputJimmy;
		BreedView : PInputBreed;
		DOBLine : PINputDate;

begin
	{set input lines - easier access to source/target arrays}
	SireLine := PInputJImmy(Linker^.SourceView[svSireLine]);
	DameLine := PInputJimmy(Linker^.SourceView[svDameLine]);
	BreedView := PInputBreed(Linker^.TargetView[tvBreedView]);

	{get parents}
	Sire := PLiveStock(SireLine^.GetJimmy);
	Dame := PLiveStock(DameLine^.GetJimmy);

	if (Sire=nil) and (Dame=nil) then exit; {nothing there - just leave}

	{clear calculation array}
	Breed.Init;

	{calculate mixed parentage}
	if Sire<>nil then
		Breed := Sire^.Breed; {set to sire's as a start}

	{add dame to sire's}
	{run through all Breed array comparing with dame}
	{uses flag Done to mark when inserted so that it doesn't keep inserting
		into blank ones - can't clear Dame as it is *not* a local jimmy}
	if Dame<>nil then
		for B := 1 to Dame^.Breed.NumTypes do begin
			C := Breed.GetLine(Dame^.Breed.Code[B]);
			if C=0 then C := Breed.NumTypes+1; {add to end}
			if C<=NumBreedTypes then begin
				Breed.Code[c] := Dame^.Breed.Code[B];
				Breed.Prop[c] := Breed.Prop[C] + Dame^.Breed.Prop[B];
			end;
		end;

	{now divide all by two to take average}
	for C := 1 to NumBreedTypes do
		Breed.Prop[C] := Breed.Prop[C] div 2;

	Breed.Sort; {sorts into order}

	BreedView^.SetData(Breed);
	BreedView^.Drawview;

	Breed.Done;

	if DeadDataMode and (Dame<>nil) then begin
		{do check for existing sibling with same dob...}
		DOBLine := PInputDate(Linker^.SourceView[svDOBLine]);
		DOBLine^.GetData(DOB);
		if not DOB.Blank and ((CallingView = PView(DameLine)) or (CallingView = PView(DOBLine))) then begin
			FileAdmin(fiHooks)^.LogOn;
			Sibling := PLivestock(HookFile^.GetFirst(Dame^.NotesHook, srLivestock));
			while Sibling<>nil do begin
				if Sibling^.DOB.Days = DOB.Days then
					ProgramWarning('Sibling '+Sibling^.GetName(naFull,0)+' already entered with this DOB');
				dispose(Sibling, done);
				Sibling := PLivestock(HookFile^.GetNextJimmy);
			end;
			FileAdmin(FiHooks)^.LogOff;
		end;
	end;
end;{}


procedure LinkSexCalf(const Linker :PInputLinker; const CallingView : PView); far;
var SexCode : TSCode;
begin
	PInputSCode(Linker^.SourceView[1])^.GetData(SexCode);
	if delspaceR(SexCode)='F' then begin
		Linker^.TargetView[1]^.SetState(sfDisabled, False); {calf id line}
		Linker^.TargetView[2]^.SetState(sfDisabled, False); {calving date line}
	end else begin
		Linker^.TargetView[1]^.SetState(sfDisabled, True);
		Linker^.TargetView[2]^.SetState(sfDisabled, True);
	end;

	Linker^.TargetView[1]^.DrawView;
	Linker^.TargetView[2]^.DrawView;
end;


type
	{expecting entry of just one calf, with auto new on kbUp instead of list,
	with calf details all set, etc.  Still derive from TINputindexedjimmy so
	that "superlist" available in the future}
	PInputCalf = ^TInputCalf;
	TINputCalf = object(TInputLiveStock)
		procedure HandleEvent(Var Event : TEvent); virtual;
		procedure Draw; virtual;
	end;

procedure TInputCalf.HandleEvent(var Event : TEvent);
var Calf : PLiveStock;
		Dame : PLiveStock;
begin
	if Event.What = evKeyDown then begin

		if (Event.KeyCode = kbIns) or ((Event.KeyCode = kbChange) and (GetJimmy=nil)) then begin
			{new calf}
			Dame := PLiveStock(PJimmyEditBox(Owner)^.Jimmy); {shorthand}
			if Dame^.RecNo = -1 then begin
				PJimmyEditBox(Owner)^.GetData(Dame^);
				Dame^.StoreSelf; {so recno set for back pointer below}
			end;

			Calf := Dame^.MakeCalf;

			if Calf<>nil then Calf^.Edit(Owner, @Self); {owner as calling view, self as acceptor}

			ClearEvent(Event);
			DrawView;
		end;
	end;


	inherited HandleEvent(Event);
end;

procedure TInputCalf.Draw;
begin
	inherited Draw;
end;


type
	PCrushButton = ^TCrushButton;
	TCrushBUtton = object(THooklistButton)
		procedure Press; virtual;
	end;

procedure TCrushButton.Press;
var Event : TEvent;
begin
	inherited Press;

	Event.What := evCommand;
	Event.Command := cmNewCrush;
	Event.InfoPtr := nil;

	QueueEvent(Event);
end;


{var
	LastBoxLoc : TPoint;{}

procedure TLivestock.MakeEditBox(var EditBox : PEditBox; Caller : PView);
var R : TRect;
		I,L : byte;
		S : string;
		BreedLinker : PInputLinker;
		SexCalfLinker : PInputLinker;
		HerdLine, DOBLine : PView;

begin
	R.Assign(0, 0, 70, 22); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, init(R, 'Livestock Registration',Caller, @Self));

	New(BreedLinker, init(@LinkBreed, EditBox));{}
	New(SexCalfLinker, init(@LinkSexCalf, EditBox));
	SexCalfLinker^.ForceInitLink := True;

	with EditBox^ do begin
		{--- Set up box interior ---}
		Insert(New(PSkipBytes, init(sizeof(TJimmy))));

{		InsTitledField(15, 2, 17, 1, 'Animal ~T~ype', New(PInputSCode, init(R, scAnimalType)));{}
		InsTitledField(12, 1,  5, 1, '~B~rand No.', New(PINputELine, init(R, 5)));
		PInputELine(Current)^.MustInput := True;
		InsTitledField(12, 2, 17, 1, '~N~ame', New(PINputELine, init(R, 20)));
		InsTitledField(40, 1, 17, 1, 'Se~x~',  New(PInputSCode, init(R, scSex)));
		SexCalfLinker^.SetSourceView(Current, 1);

		DOBLine := InsTitledField(12, 4, 10, 1, '~D~OB', New(PInputDate, init(R)));
		BreedLinker^.SetSourceView(Current, svDOBLine);
		{insert age indicitor - cannot do normal insert then do current as it is not selectable}
		R.Assign(25,4,31,6);
		PINputDate(DOBLIne)^.AgeIndicator := New(PAgeIndicator, init(R,' '));
		Insert(PInputDate(DOBLine)^.AgeIndicator);
		InsTitledField(12, 5,  5, 1, 'Birth ~W~t', New(PInputWord, init(R, 5)));
{		PInputWord(CUrrent)^.DecPlaces := 1;{}

		InsTitledField(40, 4, 17, 1, 'Ori~g~in', New(PInputSCode, init(R, scBoughtFrom)));

		InsTitledField(12,7, 17, 1, 'S~i~re', New(PInputLiveStock, init(R, 20, 'M')));
		BreedLinker^.SetSourceView(Current, svSireLine);{}
		InsTitledField(12,8, 17, 1, 'Dame', New(PInputLiveStock, init(R, 20, 'F')));
		BreedLinker^.SetSourceView(Current, svDameLine);{}

		InsTitledField(40, 7, 25, 4, '~B~reed', New(PInputBreed, init(R)));
		BreedLinker^.SetTargetView(Current, tvBreedView);

		InsTitledField(12, 11, 17, 1, 'H~e~rd', New(PInputIndexedJimmy, init(R, 20, fiHerdIdx, lsHerd, '')));
		InsTitledField(12, 12, 17, 1, '~S~tate', New(PINputSCLine, init(R, 7, scCrushState)));
		InsTitledField(12, 13, 17, 1, '~T~rained', New(PINputSCLine, init(R, 7, scTrainedState)));

		InsTitledField(40, 12, 20, 1, 'C~a~lf', New(PInputCalf, init(R, 20, '')));
		SexCalfLinker^.SetTargetView(Current, 1);
		if delspace(Sex)<>'F' then Current^.SetState(sfDisabled, True);
		InsTitledField(40, 13, 12, 1, 'Cal~v~ing', New(PInputDate, init(R)));
		SexCalfLinker^.SetTargetView(Current, 2);
		if delspace(Sex)<>'F' then Current^.SetState(sfDisabled, True);

		InsTitledField(12, 15, 40, 1, 'N~o~te', New(PinputSCLine, init(R, 20, scLiveStockSearch)));

		{-- add more-about view ---}
		InsTitledField(11, 17,  44, 4, '~M~ore',
							New(PDlgHookView,	Init(R, lsLivestockMore, 0, hkMore, @Self, PJimmyEditBox(EditBox) )));
		PHookViewer(Current)^.SetFocusKey(kbMore);

		{-- add buttons --}
		Insert(New(PCrushButton, init(55,Size.Y-9,'C~r~ush',
																	cmNone, bfNormal, @Self, hkHistory, lsLivestockHistory)));

		Insert(New(PHookListButton, init(55,Size.Y-7,'~H~istory',
																	cmHistory, bfNormal, @Self, hkHistory, lsLivestockHistory)));
		PHookListButton(Current)^.kbType := kbHistory;

		Insert(New(PJimmyOKButton, init(55,Size.Y-5, @Self)));
		Insert(New(PJimmyCancelButton, init(55,Size.Y-3, @Self)));

{$IFDEF FIXIT}
		InsTitledField(4 ,Size.Y-2,5,1, 'A',New(PINputLint, init(R,9)));
		InsTitledField(14,Size.Y-2,5,1, 'LN',New(PINputLint, init(R,9)));
		InsTitledField(24,Size.Y-2,5,1, 'LB',New(PINputLint, init(R,9)));
		InsTitledField(34,Size.Y-2,5,1, 'HN',New(PINputLint, init(R,9)));
		InsTitledField(44,Size.Y-2,5,1, 'HB',New(PINputLint, init(R,9)));
		InsTitledField(54,Size.Y-2,5,1, 'FN',New(PINputLint, init(R,9)));
		InsTitledField(64,Size.Y-2,5,1, 'FB',New(PINputLint, init(R,9)));

		InsTitledField(4 ,Size.Y-1,5,1, 'NH',New(PINputLint, init(R,9)));
		InsTitledField(14,Size.Y-1,5,1, 'HH',New(PINputLint, init(R,9)));
{$ENDIF}

		EndInit;
	end;

end;


{****************************************************************
 ***                    SET CODES                             ***
 ****************************************************************}
procedure TLivestock.SetFormCodes;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		SetStr('BRAND',BrandNumber);
		SetStr('NAME', Name);
		SetStr('SEX', Sex);
		Insert(New(PJimmyFormCode, init('HERD',HerdID)));
		Insert(New(PJimmyFormCode, init('SIRE',SireID)));
		Insert(New(PJimmyFormCode, init('DAME',DameID)));
		Insert(New(PJimmyFormCode, init('CALF',CalfID)));
		SetDate('DOB',DOB);
		SetStr('WAB', N2Str(BirthWeight));
		SetStr('BREED',Breed.BriefText);
		SetStr('ORIGIN', ExpandSCode(scBoughtFrom, BoughtFrom));
		SetStr('CTGY', NoteCodes);
		SetStr('STAT', Status);
		FileAdmin(fiHooks)^.LogOn;
		Insert(New(PJimmyFormCode, init('LASTCRUSH', HookfIle^.FindFirst(HistoryHook, srCrush))));
		FileAdmin(fiHooks)^.LogOff;
	end;


end;



{*******************************
 ***     CREATE CALF         ***
 *******************************}
function TLiveStock.MakeCalf : PLiveStock;
var Calf : PLiveStock;
		Service : PService;
begin
	New(Calf, init(nil));

	Calf^.BrandNumber := BrandNumber+'c';
	Calf^.DameID := RecNo;
	Calf^.HerdID := HerdID;
	if not DeadDataMode then Calf^.DOB.SetToToday;

	{locate sire if poss - look for previous service}
	FileAdmin(fiHooks)^.LogOn;
	Service := PService(HookFile^.GetFirst(HistoryHook, srService));
	FileAdmin(fiHooks)^.LogOff;

	if Service <> nil then begin
{		if (Service^.Date.Days > (Calf^.DOB.Days - 90))  and
				(Service^.Date.Days < (Calf^.DOB.Days + 90)) then{}
			Calf^.SireID := Service^.MaleID;
		Dispose(Service, done);
	end;

	MakeCalf := Calf;
end;

{*************************************************************************
 ***                                                                   ***
 ***                 LIVESTOCK VIEWS                                   ***
 ***                                                                   ***
 *************************************************************************}
{**************************************
 ***      INPUT LIVESTOCK           ***
 **************************************}
constructor TInputLiveStock.Init;
begin
	inherited Init(R,NFieldLen,fiLivestockidx, lsLiveStock, '');
	Sex := delspace(NSex);
end;

function TInputLivestock.CreateList;
begin
	CreateList := New(PListWindow, init(
		Bounds, GetMessage(msListTitles, lsType),
		New(PLivestockListView, init(
			Bounds, lsType, fiType, SubIndexString
		))
	));
end;

function TInputLiveStock.SearchOn : string;
begin
	{need to right set the number}
	if S2Num(Data^)>0 then
		if ucase(Right(Data^,1))=Sex then
			SearchOn := SubIndexString + ucase(Brand2Index(Data^))
		else
			SearchOn := SubIndexString + ucase(Brand2Index(Data^)) + Sex
	else
		SearchOn := SubINdexString + ucase(Data^);
end;


function TInputLiveStock.Valid;
var V : boolean;
begin
	V := inherited Valid(Command);

	if V and (Command<>cmValid) and (Command<>cmClose) and (Command<>CmCancel) then begin
		if (Sex<>'') and (GetJimmy<>nil) and (delspace(PLivestock(GetJimmy)^.Sex)<>Sex) then begin
			if Command<>cmForceLink then
				InputWarning('Wrong Sex!'#13'Should be '+ExpandSCode(scSex, Sex));
			V := False;
		end;
	end;

	Valid := V;
end;

{***********************************
 ***        MERGE LIVESTOCK      ***
 ***********************************}
procedure MergeLivestockItems;
var
	R : Trect;
	EditBox : PEditBox;
	Command : word;
	DelJimmy, MergeJimmy : PJimmy;
	DelLine, Mergeline : PView;

begin
	{========= INPUT WHICH TWO =========================}
	R.Assign(0,0, 30, 8);
	New(EditBox, init(R, 'Livestock Merge',nil));
	with EditBox^ do begin

		Options := Options or ofCenterx or OfCenterY;

		DelLine := InsTitledField(11,2,16,1,'Delete', New(PInputLivestock, init(R, 20, '')));
		PInputELine(DelLine)^.MustINput := True;
		MergeLine := InsTitledField(11,3,16,1,'Merge to', New(PinputLivestock, init(R, 20, '')));
		PInputELine(MergeLine)^.MustINput := true;

		InsOKButton( 8,  5, nil);
		InsCancelButton(18, 5);

		EndInit;
	end;

	Command := Desktop^.ExecView(EditBox);

	{remember that deljimmy, mergejimmy will point to the jimmys of the input
		lines, so will be disposed of when the editbox is disposed of}

	if Command = cmOK then begin
		DelJimmy := PInputJimmy(DelLine)^.GetJimmy;
		MergeJimmy := PInputJimmy(MergeLine)^.GetJImmy;

		MergeJimmys(DelJimmy, MergeJimmy);
	end;

	dispose(EditBox, done);

end;


{***************************************************
 ***             Livestock LIST                    ***
 ***************************************************}

procedure TLiveStockListView.HandleEvent;
var Event2 : TEvent;
begin
	if (Event.What = evCommand) and DrawnFocused then begin

		case Event.Command of
			cmMerge : begin
				MergeLivestockItems;
				Redraw; FindOKItemNo(Focused);
				ClearEvent(Event);
				ClearSearch;
			end; {Maintenance option}

			{Attached information - edit & press button automatically}
			cmHistory, cmMoreAbout, cmNewCrush: begin
				{Stack up which button will be pressed}
				Event2.What := evKeyDown;
				Event2.InfoPtr := nil;
				case Event.Command of
					cmHistory : Event2.KeyCode := kbHistory;
					cmMoreAbout : Event2.KeyCode := kbMore;
					cmNewCrush : Event2.KeyCode := kbAltR;   {press crush button}
				end;
				QueueEvent(Event2);

{				if Event.Command = cmNewCrush then QueueEvent(Event); {queue up cmnewcrush}

				{and ask to edit now}
				Event.What := evCommand;
				Event.Command := cmEdit;
			end;
		end;
	end;

	inherited HandleEvent(Event);
end;


function TLivestockListView.GetSearch4Index : string;
begin
	if S2Num(Search)>0 then
		GetSearch4Index := SubIndexString + Brand2Index(ucase(Search))
	else
		GetSearch4Index := SubIndexString + ucase(Search);
end;




{****************************************************************
 ***                                                          ***
 ***                CRUSH DETAILS                             ***
 ***                                                          ***
 ****************************************************************}

{--- Inititalise - set ptrs to SC ---}
constructor TCrush.Init;
var Animal : PLiveStock;
		EditView : PView;
		Crush : PCrush;
begin
	inherited Init;
	ForWho := -1;
	if DeadDataMode then Date.Clear else Date.SetToToday;
	Status := ''; {set to current camel?}
	Weight := 0;
	MedicalID := -1;

	if (Param<>nil) and (Param^.ForWho<>-1) then begin
		ForWho := Param^.ForWho;
		Animal := PLivestock(FindJimmy(ForWho,EditView)); {get from file & update from view if existing}

		{--- Automatic weight & state ----}
		if Animal <>nil then begin
			Weight := Animal^.BirthWeight; {in case it cannot find any prev crushes}
			Status := Animal^.Status;

			{nowlook for previous crush entry}
			FileAdmin(fiHooks)^.LogOn;
			Crush := PCrush(Hookfile^.GetFirst(Animal^.GetFirstHookPtr(hkHistory), srCrush));
			if (Crush<>nil) and (Crush^.Date.Days=Today.Days) then
				ProgramWarning('Crush already entered for today');
				{but carry on anyway}

			if DeadDataMode then begin
				{-- Dead data mode - get previous state & weight ---}
				while (Crush<>nil) and (Crush^.Date.Days>Today.Days) do begin
					dispose(Crush, done);
					if Crush^.Weight<>0 then Weight := Crush^.Weight; {this way we get the nearest if there isn't a previous}
					Status := Crush^.Status;
					Crush := PCrush(HookFile^.GetNextJImmy);
				end;

				if Crush<>nil then Status := Crush^.Status
			end else begin
				{-- live data - get latest non-zero crush wt}
				while (Crush<>nil) and (Crush^.Weight=0) do begin
					dispose(Crush, done);
					Crush := PCrush(HookFile^.GetnExtJimmy);
				end;
			end;

			{now have correct crush}
			if Crush<>nil then begin
				Weight := Crush^.Weight;
				dispose(Crush, done);
			end;

			FileAdmin(fiHooks)^.LogOff;

			if EditView=nil then dispose(Animal, done); {was gotten from file}
		end;
	end;

end;

procedure TCrush.CommonInit;
begin
	inherited CommonInit;
	New(Notes, init);{}
	SCodeCollection[scCrushState]^.LogOn;
end;

destructor TCrush.Done;
begin
	SCodeCollection[scCrushState]^.LogOff;
	Dispose(Notes, done);{}
	inherited Done;
end;


 {==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TCrush.DisplayLine;
var S : string;

begin
	{First line}
	S := Date.Digit8+' '+PadSpaceR(Status,8)+PadSpaceL(N2Str(Weight),3)+'kg';

	{weight graph bar}
	if lsType<>0 then S :=S+' '+MakeBar(Weight div 20);

	{add notes if exist}
	if Notes^.First<>-1 then begin
		if not Notes^.Loaded then Notes^.LoadText;
		S := S + #13+space(9)+LSGetLine(Notes^.Text,1);
	end;

	DisplayLine := S;
end;

function TCrush.GetName;
begin
	GetName := Date.Digit8 + ' '+Status+' '+N2Str(Weight)+'kg';
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}
{creates an uneditable recent history list when the "for" is typed in, for
back checking}
type
	PInputCrushLiveStock = ^TInputCrushLiveStock;
	TInputCrushLiveStock = object(TInputLiveStock)
		HistoryList : PListWindow;

		constructor Init(var Bounds : TRect; NFieldLen : integer);
		destructor Done; virtual;
{		function SetID : boolean; virtual; {displays list when changed}
		procedure DOHistoryList;
	end;

constructor TInputCrushLivestock.Init;
begin
	inherited Init(Bounds, NFieldLen, '');
	HistoryList := nil;
end;

destructor TInputCrushLiveStock.Done;
begin
	if HistoryList<>nil then dispose(HistoryList, done);
	inherited Done;
end;

{produce list when ID is set}
{function TInputCrushLiveStock.SetID;
var OldID : longint;

begin
	OldID := ID;

	SetID := inherited SetID;

	{Display History list}
{	if (OldID<>ID) then DoHistoryList;
end;{}

procedure TInputCrushLiveStock.DoHistoryList;
var Bounds : TRect;
begin
	if HistoryList <> nil then dispose(HistoryList, done);

	if (ID=-1) or (GetJimmyView(ID,lsLiveStockHistory)<>nil) then begin
		{no id entered or view already present}
		HistoryList := nil;
	end else begin

		{Set bounds for window}
		Bounds.Assign(0,0,54,11);
		SeparateDRFromView(Bounds, Owner);

		{Execute list}
		HistoryList := New(PListWindow,	Init(bounds,
																			GetMessage(msListTitles, lsLiveStockHistory)+' '+GetJimmy^.GetName(naReport,0),
																			New(PHookViewer, init(
																				Bounds, lsLiveStockHistory, 0, hkHistory, GetJimmy
																			))));
		HistoryList^.List^.ViewOnly := True;
		HistoryList^.Options := HistoryList^.Options and not (ofSelectable);

		Desktop^.Insert(HistoryList); {places behind all other views}

		HistoryList^.List^.DrawCompletely;

{		Owner^.MakeFirst; {move to front} {at initial link, owner is not yet inserted}
	end;

end;

{====== MEDICAL BUTTON ========}
type
	PMedicalButton = ^TMedicalButton;
	TMedicalButton = object(TAccessJimmyButton)
		procedure SetParam(var Param : TJimmyInitParam); virtual;
		procedure SetJimmyFields; virtual;
	end;


procedure TMedicalButton.SetParam;
begin
	with Param do begin
		ListVIew := nil;
		ForWho 		:= -1;
		FocusedParentID := PCrush(PJimmyEditBox(Owner)^.Jimmy)^.ForWho;
		FocusedID := PJimmyEditBox(Owner)^.Jimmy^.RecNo;
	end;
end;

procedure TMedicalButton.SetJimmyFields;
begin
	PMedical(Jimmy)^.Date := PCrush(PJimmyEditBox(Owner)^.Jimmy)^.Date;
end;

{===== ENTER CRUSH FOR CALF ============}
type
	PCalfCrushButton = ^TCalfCrushButton;
	TCalfCrushButton = object(TOurButton)
		constructor Init(const X,Y : byte; const NDataItem : PJimmy);
		procedure Press; virtual;
	end;

constructor TCalfCrushButton.Init;
begin
	inherited init(X,Y, 'C~a~lf', cmNone, bfNormal, NDataItem);
end;

procedure TCalfCrushButton.Press;
var Crush, Crush2 : PCrush;
		ForWho : longint;
		Hook : PHook;
		CalfDame : PLiveStock;
		InitParam: TJImmyInitParam;

begin
	if (DataItem<>nil) and not GetState(sfDisabled) then begin
		DrawState(True);
		Crush := nil;
		{get dame or calf for new crush}
		if Title^='C~a~lf' then begin
			{calf button}
			ForWho := PLiveStock(DataItem)^.CalfID;


			if DeadDataMode then begin
				{look for calf birth previous to date}
				New(Crush2, init(Nil)); Owner^.GetData(Crush2^); {to get key}
				FileAdmin(fiHooks)^.LogOn;
				Hook := HookFile^.GetFirstHook(PLivestock(DataItem)^.HistoryHook, srLivestock);
				while (Hook<>nil) and (Hook^.GetKey<Crush2^.GetKey) do begin
					dispose(Hook, done);
					Hook := HookFile^.GetHookFrom(True);
				end;
				if Hook<>nil then begin
					ForWho := Hook^.JimmyID;
					dispose(Hook, done);
				end;
				FileAdmin(fiHooks)^.LogOff;
				dispose(Crush2, done);
			end; {}


		end else
			ForWho := PLiveStock(DataItem)^.DameID;

		if ForWho<>-1 then begin

			if PLIveStock(DataItem)^.RecNo>-1 then begin

				{editing old crush - try and find corresponding old crush}
				CalfDame := PLiveStock(GetJimmy(ForWho));
				New(Crush2, init(nil)); Owner^.GetData(Crush2^); {to get key}

				FileAdmin(FiHooks)^.LogOn;
				Crush := PCrush(HookFile^.GetFirst(CalfDame^.HistoryHook, srCrush));
				while (Crush<>nil) and (Crush^.GetKey<Crush2^.GetKey) do begin
					dispose(Crush, done);
					Crush := PCrush(HookFile^.GetNextJimmy);
				end;
				FileAdmin(fiHooks)^.LogOff;
				if (Crush<>nil) and (Crush^.GetKey<>Crush2^.GetKey) then begin
					Dispose(Crush, done);
					Crush := nil;
				end;
				Dispose(Crush2, done);
				dispose(CalfDame, done);
			end;


			if (Crush =nil) then begin
				{editing new crush (or no match found), so create new for calf/dame}
				InitParam.ForWho := ForWho;
				InitParam.ListView := nil;
				New(Crush, init(@InitParam));

				{get date}
				New(Crush2, init(nil));
				Owner^.GetData(Crush2^); {set date, etc}
				Crush^.Date.SetToDate(Crush2^.Date);
				dispose(Crush2, done);
			end;
		end;

		if Crush<>nil then Crush^.Edit(Owner, nil);
		DrawState(False);
	end;
end;

procedure LinkToCalfButton(const Linker :PInputLinker; const CallingView : PView); far;
var Dame : PLivestock;
		Button : PCalfCrushButton;
begin
	{Check history display}
	if CallingView = Linker^.SourceView[1] then
		PInputCrushLiveStock(CallingView)^.DoHistoryList;

	Button := PCalfCrushButton(Linker^.TargetView[1]);

	{allow calf button/dame button}
	Dame := PLiveStock(PInputJimmy(Linker^.SourceView[1])^.GetJimmy);
	Button^.DataItem := Dame;

	if DeadDataMode then begin
		{assume calf button...}
	end else begin

		{now actually, the button may be a calf *or* dame button, depending on
		whether we're dealing with the dame or the calf...}
		if (Dame=nil) or ((Dame^.CalfID=-1) and (Dame^.DOB.Age>=2)) then begin
			Button^.Options := Button^.Options and not ofSelectable; {so doesn't refocus when hiding}
			Button^.SetState(sfDisabled, True);
			Button^.Hide;
		end else begin
			if Dame^.CalfID>-1 then
				{it *is* the dame - no need to dispos/new as strings are of same length}
				Button^.Title^ := 'C~a~lf'
			else
				Button^.Title^ := 'D~a~me';
			Button^.Options := Button^.Options or ofSelectable; {so can focus}
			Button^.SetState(sfDisabled, False);
			Button^.Show;
		end;
	end;
	Button^.DrawView;
end;



procedure TCrush.MakeEditBox;
var	R: TRect;
		WeightLine, ForLine, StateLine, DateLine : PView;
		CalfButtonLinker : PInputLinker;

begin
	if not Notes^.Loaded then Notes^.LoadText;{}

	R.Assign(0, 0, 42, 12);
	SeparateULFromView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Crush Details',Caller, @Self));

{	if Forwho = -1 then {if inserting as new in desktop rather than part of
											a history, leave space for the "recent history" box}
{		EditBox^.MoveTo(EditBox^.Origin.X-10, EditBox^.Origin.Y-4);{}

	New(CalfButtonLinker, init(@LinkToCalfButton, EditBox));
	CalfButtonLinker^.ForceInitLink := True;

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

		ForLine := InsTitledField(9, 1,25, 1, 'For', New(PInputCrushLiveStock, init(R, 25)));
		PInputELine(Current)^.MustInput := True;
		CalfBUttonLinker^.SetSourceView(Current, 1);
{$IFNDEF Fixit}
		if ForWho<>-1 then
			CUrrent^.SetState(sfDisabled, True);{}
{$ENDIF}

		DateLine := InsTitledField(9, 2,10, 1, '~D~ate', New(PinputDate, Init(R)));
		PInputELine(DateLine)^.MustInputToClose := True;

		WeightLine := InsTitledField(9, 3, 6, 1, 'Weight', New(PinputWord, Init(R,6)));
		StateLine := InsTitledField(9, 4,30, 1, 'State', New(PinputSCLine, Init(R,7,scCrushState)));

		InsTitledField(9, 5,30, 3, '~N~otes', New(PInputFreeText, Init(R, 250, 0, nil)));{}

		Insert(New(PCalfCrushButton, init(1, 9, nil)));
		CalfButtonLinker^.SetTargetView(Current,1);

		Insert(New(PMedicalBUtton, init(11, 9, '~M~edical', srMedical, @Self)));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(21, 9, @Self)));
		Insert(New(PjimmyCancelButton, init(31,9, @Self)));

		{the refocus lines below may move from the ForWho line which as
		a required entry line will return an error as there is no data
		entered.  SO move back another stage first so endinit doesn't focus
		on it in the first place}
		SelectNext(True); {move back to the OK button}
		EndInit;

		if ForWho=-1 then
			ForLine^.Focus
		else
			if DeadDataMode then DateLine^.Focus else WeightLine^.Focus;
	end;

end;


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

const
	{--- Required for Stream ----}
	RCrush : TStreamRec = (
		ObjType : srCrush;
		VmtLink : Ofs(TypeOf(TCrush)^);
		Load : @TCrush.Load;
		Store : @TCrush.Store
	);

function TCrush.RecSize : word;
begin RecSize:= 40; end;

function TCrush.srType : word;
begin srType := srCrush; end;

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

begin
	S.Read(Ver, 1);

	case Ver of
		4 : begin
			{changed status read method}
			inherited Load(S);

			S.Read(ForWho, 4);
			Date.Load(S);
			Status := S.ReadStr;
			S.Read(Weight, 2);
			Notes^.Load(S);
			S.Read(MedicalID, 4);
		end;
		3 : begin
			{added inherited load}
			inherited Load(S);

			S.Read(ForWho, 4);
			Date.Load(S);
			S.Read(Status, sizeof(Status));
			S.Read(Weight, 2);
			Notes^.Load(S);
			S.Read(MedicalID, 4);
		end;
{		2 : begin
			CommonInit;

			{added medical link}
{			S.Read(Lock,1);
			S.Read(ForWho, 4);
			Date.Load(S);
			S.Read(Status, sizeof(Status));
			S.Read(Weight, 2);
			Notes^.Load(S);
			S.Read(MedicalID, 4);
		end;
		1 : begin
			CommonInit;

			S.Read(Lock,1);
			S.Read(ForWho, 4);
			Date.Load(S);
			S.Read(Status, sizeof(Status));
			S.Read(Weight, 2);
			Notes^.Load(S);
			MedicalID := -1;
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'Crush.Load',mfError);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);

	S.Write(ForWho, 4);
	Date.Store(S);
	S.WriteStr(@Status);
	S.Write(Weight, 2);

	Notes^.store(S);{}

	S.Write(MedicalID, 4);
end;


{=============== HOOKING =====================}
function TCrush.NumHookTo;
begin NumHooKTo := 1; end;

procedure TCrush.GetHookTo;
var Herd : PHerd;
begin
	inherited GetHookTo(htType, HookToID, SubHookToID, hkType, Key);

	Key := GetKey;

	case htType of
		1 : begin HookToID := @ForWho; hkType := hkHistory; end;
	end;
end;

function TCrush.GetKey;
begin
	if Date.Blank then
		GetKey := sortkeystart
	else
		GetKey := - Date.Days;
end;


procedure TCrush.LoadSUpplements;
begin
	if Not NOtes^.Loaded then Notes^.LoadText;
end;

{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TCrush.SetFormCodes;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		SetStr('TYPE', 'CRUSH');
		SetDate('DT', Date);
		Insert(New(PJimmyFormCode, init('CAMEL',ForWho)));
		Insert(New(PJimmyFormCode, init('MEDICAL',MedicalID)));
		SetStr('WT', N2Str(Weight));
		SetStr('STATE', Status);
	end;
end;



{****************************************************************
 ***                                                          ***
 ***                TRANSFER                                  ***
 ***                                                          ***
 ****************************************************************}

constructor TTransfer.Init;
var Animal : PLiveStock;
begin
	inherited Init;
	ForWho := -1;
	FromHerd := -1;
	ToHerd := -1;
	if DeadDataMode then DAte.Clear else Date.SetToToday;

	if (Param<>nil) and (Param^.ListView<>nil) then begin
		if Param^.ListView^.lsType = lsHerd then FromHerd := Param^.ForWho;
		if Param^.ListView^.lsType = lsLivestockHistory then begin
			ForWho := Param^.ForWho;
			Animal := PLiveStock(GetJimmy(ForWho));
			if Animal<>nil then begin
				FromHerd := Animal^.HerdID;
				dispose(Animal, done);
			end;
		end;
	end;
end;

{==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TTransfer.DisplayLine;
var S : string;

begin
	{First line}
	S := Date.Digit8+' Transfer: ';

	case lsType of
		lsLiveStockHistory : S := S+'from '+GetJimmyIDName(FromHerd, naDisplay, 0)
															 +' to ' +GetJimmyIDName(ToHerd, naDisplay, 0);

		lsHerdHistory : begin
			S := S+GetJimmyIDName(ForWho, naReport, 0);
			if ListForWho <> ToHerd then S := S +' to '+GetJimmyIDName(ToHerd, naDisplay, 0);
			if ListForWho <> FromHerd then S := S+' from '+GetJimmyIDName(FromHerd, naDisplay, 0);
		end;
	else
		{printer}
		S := S+GetJimmyIDName(ForWho, naReport, 0){}
					+' from '+GetJimmyIDName(FromHerd, naDisplay, 0)
					+' to '+GetJimmyIDName(ToHerd, naDisplay, 0);
	end;

	DisplayLine := S;  {chop off last indent, etc}
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}
{auto update from herd when entering camel}

procedure TTransfer.MakeEditBox;
var	R: TRect;
		LHLinker : PLIvestockHerdLinker;
		AnimalLine, TOHerdLine : PInputIndexedJimmy;

begin
	R.Assign(0, 0, 30, 10);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Animal Transfer',Caller, @Self));

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

		InsTitledField(8, 2,10, 1, '~D~ate', New(PinputDate, Init(R)));
		PInputELine(Current)^.MustInputToClose := True;
		InsTitledField(8, 3,18, 1, 'Animal', New(PInputLiveStock, init(R, 25, '')));
		AnimalLine := PInputIndexedJimmy(Current);
		AnimalLine^.MustInput := True;

		InsTitledField(8, 4,18, 1, '~F~rom', New(PInputIndexedJimmy, init(R, 20, fiHerdIdx, lsHerd, '')));
		PInputELine(Current)^.MustInput := True;

		New(LHLinker, init(AnimalLine, Current, EditBox));

		InsTitledField(8, 5,18, 1, '~T~o', New(PInputIndexedJImmy, init(R, 20, fiHerdIdx, lsHerd, '')));
		ToHerdLine := PInputIndexedJimmy(Current);
		ToHerdLine^.MustInput := True;

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init( 1, 7, @Self)));
		Insert(New(PjimmyCancelButton, init(11,7, @Self)));

		EndInit;

		if (ForWho<>-1) and not DeadDataMode then ToHerdLine^.Focus;
	end;
end;



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

const
	{--- Required for Stream ----}
	RTransfer : TStreamRec = (
		ObjType : srTransfer;
		VmtLink : Ofs(TypeOf(TTransfer)^);
		Load : @TTransfer.Load;
		Store : @TTransfer.Store
	);

function TTransfer.RecSize : word;
begin RecSize:= 40; end;

function TTransfer.srType : word;
begin srType := srTransfer; end;

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

begin
	S.Read(Ver, 1);

	case Ver of
		2 : begin
			inherited Load(S);
			Date.Load(S);
			S.Read(ForWho, 4);
			S.Read(FromHerd, 4);
			S.Read(ToHerd, 4);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'Transfer.Load',mfError);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);

	Date.Store(S);
	S.Write(ForWho, 4);
	S.Write(FromHerd, 4);
	S.Write(ToHerd, 4);
end;

{=============== HOOKING =====================}
function TTransfer.NumHookTo;
begin NumHooKTo := 3; end;

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

	if Date.Blank then
		Key := sortkeystart
	else
		Key := - Date.Days;

	case htType of
		1 : begin HookToID := @ForWho; 		hkType := hkHistory; end;
		2 : begin HookToID := @FromHerd; 	hkType := hkHistory; end;
		3 : begin HookToID := @ToHerd; 		hkType := hkHistory; end;
	end;
end;



{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TTransfer.SetFormCodes;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		SetDate('DT', Date);
	end;
end;



{****************************************************************
 ***                                                          ***
 ***                Weaning DETAILS                             ***
 ***                                                          ***
 ****************************************************************}

{--- Inititalise - set ptrs to SC ---}
constructor TWeaning.Init;
var Jimmy : PJimmy;
		IdxRec, Holerec : longint;
begin
	inherited Init;
	if DeadDataMode then Date.Clear else Date.SetToToday;
	CalfID := -1;
	DameID := -1;
	FromHerd := -1;

	{now need to work out - is this being entered in the dames' history or
	the calf}
	if (Param<>nil) then begin
		if (Param^.ListView<>nil) then begin
			if Param^.ListView^.lstype = lsLiveStockHistory then
				{check - if dame it will have a calf}
				Jimmy := GetJimmy(Param^.ForWho);
				if PLiveStock(Jimmy)^.CalfID<>-1 then begin
					DameID := JImmy^.RecNo;
					CalfID := PLiveStock(Jimmy)^.CalfID;
				end else begin
					CalfID := Jimmy^.RecNo;
					DameID := PLiveStock(Jimmy)^.DameID;
				end;
				dispose(Jimmy, done);
		end;
	end;

	{set new herd to weaning herd}
	FIleAdmin(fiHerdIdx)^.LogOn;
	IndexStream(fiHerdIdx)^.FindFirst('WEAN', IdxRec, Holerec, ToHerd);
	FIleAdmin(fiHerdIdx)^.LogOff;


end;

 {==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TWeaning.DisplayLine;
var S : string;

begin
	{First line}
	S := Date.Digit8+' ';

	if lstype = lsHerdHistory then begin
		S := S+' Calf Weaned '+GetJimmyIDName(CalfID,naReport,0);
		if ListForWho = FromHerd then
			S := S+' to '+GetJimmyIDName(ToHerd, naDisplay,0)
		else
			S := S+' from '+GetJimmyIDName(FromHerd, naDisplay,0);
	end else begin
		if ListForWho=DameID then
			S := S+ 'CALF WEANED '+GetJimmyIDName(CalfID,naReport,0)
		else
			if ListForWho=CalfID then
				S := S + 'WEANED';

		S := S + ' from '+GetJimmyIDName(FromHerd,naDisplay,0)
						+' to '+GetJImmyIDName(ToHerd, naDisplay, 0);
	end;

	DisplayLine := S;  {chop off last indent, etc}
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}
const
	svDame = 1;
	svCalf = 2;
	tvHerd = 1;

procedure LinkDameCalf(const Linker :PInputLinker; const CallingView : PView); far;
var Livestock : PLiveStock;
begin
	if CallingView = Linker^.SourceView[svDame] then begin
		{dame line changed, set calf line}
		LiveStock := PLiveStock(PInputJimmy(Linker^.SourceView[svDame])^.GetJimmy);
		if LiveStock<>nil then{} begin
			Linker^.SourceView[svCalf]^.SetData(LiveStock^.CalfID);
			Linker^.TargetView[tvHerd]^.SetData(LiveStock^.HerdID);
			CallingView^.Owner^.DrawView;
		end;
	end else begin
		{calf line changed, so set dame line}
		LiveStock := PLiveStock(PInputJimmy(Linker^.SourceView[svCalf])^.GetJimmy);
		if LiveStock<>nil then begin
			Linker^.SourceView[svDame]^.SetData(LiveStock^.DameID);
			Linker^.TargetView[tvHerd]^.SetData(LiveStock^.HerdID);
			CallingView^.Owner^.DrawView;
		end;
	end;
end;

procedure TWeaning.MakeEditBox;
var	R: TRect;
		NewNoLine, DateLine : PVIew;
		DameCalfLinker : PINputLinker;

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

	New(DameCalfLinker, init(@LinkDameCalf, EditBox));
{	DameCalfLinker^.ForceInitLink := True;{}

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

		DateLine:= InsTitledField(11, 2,10, 1, '~D~ate', New(PinputDate, Init(R)));
		PInputELine(Current)^.MustInputToClose := True;

		InsTitledField(11, 3,18, 1, 'Dame', New(PInputLivestock, init(R, 25, 'F')));
		PInputELine(Current)^.MustInput := True;
		DameCalfLInker^.SetSourceView(Current,svDame);
		InsTitledField(11, 4,18, 1, 'Calf', New(PInputLivestock, init(R, 25, '')));
		PInputELine(Current)^.MustInput := True;
		DameCalfLInker^.SetSourceView(Current,svCalf);

		InsTitledField(11, 5,18, 1, 'New #', New(PinputELine, init(R,5)));
		NewNoLine := CUrrent;
		PInputELine(Current)^.MustInput := True;

		InsTitledField(11, 7,18, 1, 'From Herd', New(PInputIndexedJimmy, Init(R,20, fiHerdIdx, lsHerd, '')));
		DameCalfLinker^.SetTargetView(Current, tvHerd);
		InsTitledField(11, 8, 18, 1, 'To Herd', New(PInputIndexedJimmy, Init(R,20, fiHerdIdx, lsHerd, '')));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init( 1, 11, @Self)));
		Insert(New(PJimmyCancelButton, init(11,11, @Self)));

		EndInit;
	end;

	if DeadDataMode then DateLine^.Focus else NewNoLine^.Focus;
end;


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

const
	{--- Required for Stream ----}
	RWeaning : TStreamRec = (
		ObjType : srWeaning;
		VmtLink : Ofs(TypeOf(TWeaning)^);
		Load : @TWeaning.Load;
		Store : @TWeaning.Store
	);

function TWeaning.RecSize : word;
begin RecSize:= 40; end;

function TWeaning.srType : word;
begin srType := srWeaning; end;

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

begin
	S.Read(Ver, 1);

	case Ver of
		3 : begin
			{added inherited}
			inherited Load(S);
			Date.Load(S);
			S.Read(DameID, 4);
			S.Read(CalfID, 4);
			S.Read(NewBrand, sizeof(NewBrand));
			S.Read(FromHerd, 4);
			S.Read(ToHerd, 4);
		end;
{		2 : begin
			{added to/from herd - ie transfer}
{			S.Read(Lock,1);
			Date.Load(S);
			S.Read(DameID, 4);
			S.Read(CalfID, 4);
			S.Read(NewBrand, sizeof(NewBrand));
			S.Read(FromHerd, 4);
			S.Read(ToHerd, 4);
		end;
		1 : begin
			S.Read(Lock,1);
			Date.Load(S);
			S.Read(DameID, 4);
			S.Read(CalfID, 4);
			S.Read(NewBrand, sizeof(NewBrand));
			S.Read(ToHerd, 4);
			FromHerd :=-1;
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'Weaning.Load',mfError);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);
	Date.Store(S);
	S.Write(DameID, 4);
	S.Write(CalfID, 4);
	S.Write(NewBrand, sizeof(NewBrand));
	S.Write(FromHerd, 4);
	S.Write(ToHerd, 4);
end;

{=============== HOOKING =====================}
function TWeaning.NumHookTo;
begin NumHooKTo := 4; end;

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

	if Date.Blank then
		Key := sortkeystart
	else
		Key := - Date.Days;

	case htType of
		1 : begin HookToID := @DameID; hkType := hkHistory; end;
		2 : begin HookToID := @CalfID; hkType := hkHistory; end;
		3 : begin HookToID := @ToHerd; hkType := hkHistory; end;
		4 : begin HookToID := @FromHerd; hkType := hkHistory; end;
	end;
end;




{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TWeaning.SetFormCodes;
begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin
		SetDate('DT', Date);
	end;
end;



{****************************************************************
 ***                                                          ***
 ***                SERVICING                                 ***
 ***                                                          ***
 ****************************************************************}

{--- Inititalise - set ptrs to SC ---}
constructor TService.Init;
var Animal : PLiveStock;
begin
	inherited Init;
	MaleID := -1;
	FemaleID := -1;
	Date.Clear;

	if (Param<>nil) then begin
		{pick up whether in bull's or female's history}
		Animal := PLiveStock(GetJImmy(Param^.ForWho));
		if Animal<>nil then begin
			if delspaceR(Animal^.Sex)='F' then FemaleID := Animal^.RecNo else MaleID := Animal^.RecNo;
			dispose(Animal, done);
		end;
	end;
end;

{==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TService.DisplayLine;
var S : string;

begin
	{First line}
	S := Date.Digit8+' SERVICED ';

	if ListForWho<>FemaleID then
		S := S + GetJimmyIDName(FemaleID, naReport, 0);

	if ListForWho<>MaleID then
		S := S + 'by '+GetJimmyIDName(MaleID, naReport, 0);

	DisplayLine := S;  {chop off last indent, etc}
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}

{Linker gets herd female is in and finds which bull is there at the date}
const
	svDate = 1;
	svFemale = 2;
	tvMale = 1;

procedure LinkFemaleMale(const Linker :PInputLinker; const CallingView : PView); far;
var Date : TDate;
		Herd : PHerd;
		HerdID,MaleID : longint;
begin
	Linker^.SourceView[svDate]^.GetData(Date);
	if PInputJimmy(Linker^.SourceView[svFemale])^.GetJimmy<>nil then begin
		HerdID := PLivestock(PInputJimmy(Linker^.SourceView[svFemale])^.GetJimmy)^.HerdID;

		if HerdID<>-1 then begin
			Herd := PHerd(GetJimmy(HerdID));
			if Herd<>nil then begin
				MaleID := Herd^.FirstBullAt(Date);
				if MaleID<>-1 then Linker^.TargetView[tvMale]^.SetData(MaleID);
				dispose(Herd, done);
			end;
		end;
	end;
end;



procedure TService.MakeEditBox;
var	R: TRect;
		MaleLine, FemaleLine : PView;
		FemaleMaleLinker : PInputLinker;

begin
	R.Assign(0, 0, 30, 9);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Animal Service',Caller, @Self));

	New(FemaleMaleLinker, init(@LinkFemaleMale, EditBox));

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

		InsTitledField(8, 2,10, 1, '~D~ate', New(PinputDate, Init(R)));
		PInputELine(Current)^.MustInputToClose := True;
		FemaleMaleLinker^.SetSourceView(Current, svDate);

		MaleLine := InsTitledField(8, 3,18, 1, '~M~ale', New(PInputLivestock, init(R, 25, 'M')));
		PInputELine(Current)^.MustInput := True;
		FemaleMaleLinker^.SetTargetView(Current, tvMale);

		FemaleLine := InsTitledField(8, 4,18, 1, '~F~emale', New(PInputLivestock, init(R, 25, 'F')));
		PInputELine(Current)^.MustInput := True;
		FemaleMaleLinker^.SetSourceView(Current, svFemale);

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init( 1, 6, @Self)));
		Insert(New(PJimmyCancelButton, init(11,6, @Self)));

		EndInit;

		{focus on date}
{		if MaleID=-1 then MaleLine^.Focus else FemaleLine^.Focus;{}
	end;
end;


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

const
	{--- Required for Stream ----}
	RService : TStreamRec = (
		ObjType : srService;
		VmtLink : Ofs(TypeOf(TService)^);
		Load : @TService.Load;
		Store : @TService.Store
	);

function TService.RecSize : word;
begin RecSize:= 40; end;

function TService.srType : word;
begin srType := srService; end;

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

begin
	S.Read(Ver, 1);

	case Ver of
		2 : begin
			inherited Load(S);
			Date.Load(S);
			S.Read(MaleID, 4);
			S.Read(FemaleID, 4);
		end;
{		1 : begin
			S.Read(Lock,1);
			Date.Load(S);
			S.Read(MaleID, 4);
			S.Read(FemaleID, 4);
		end;{}
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'Service.Load',mfError);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);
	Date.Store(S);
	S.Write(MaleID, 4);
	S.Write(FemaleID, 4);
end;

{=============== HOOKING =====================}
function TService.NumHookTo;
begin NumHooKTo := 2; end;

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

	if Date.Blank then
		Key := sortkeystart
	else
		Key := - Date.Days;

	case htType of
		1 : begin HookToID := @MaleID; 	hkType := hkHistory; end;
		2 : begin HookToID := @FemaleID; hkType := hkHistory; end;
	end;
end;



{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TService.SetFormCodes;
begin
	inherited SetFormCodes(Formcodes);

	with FormCodes^ do begin
		SetDate('DT', Date);
	end;
end;



{****************************************************************
 ***                                                          ***
 ***                LIVESTOCK QUICK NOTE                      ***
 ***                                                          ***
 ****************************************************************}

{--- Inititalise - set ptrs to SC ---}
constructor TLiveStockQNote.Init;
begin
	inherited Init;
	CamelID := -1;
	Quantity := 0;
	if DeadDataMode then Date.Clear else Date.SetTotoday;

	if (Param<>nil) then
		CamelID := Param^.ForWho;
end;

procedure TLivestockQnote.CommonInit;
begin
	inherited CommonInit;
	New(Note, init);
	SCodeCollection[scQNoteWhat]^.LogOn;
end;

destructor TLivestockQNote.Done;
begin
	SCodeCollection[scQNoteWhat]^.Logoff;
	dispose(Note, done);
	inherited Done;
end;

{==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TLiveStockQNote.DisplayLine;
var S : string;

begin
	S := Date.Text(daDigit8)+' '+ExpandSCode(scQNoteWhat, What);
	If Quantity<>0 then S:=S+' '+N2Str(Quantity);

	if Note^.First<>-1 then begin
		if not Note^.Loaded then Note^.LoadText;
		if delspaceR(What)<>'' then S := S + #13+Space(9); {new line}
		S := S + LSGetLine(Note^.Text,1);
	end;

	DisplayLine := S;
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}
procedure TLiveStockQNote.MakeEditBox;
var	R: TRect;
		CamelLine, DateLine : PView;

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

	with EditBox^ do begin
		Insert(new(PSkipBytes, init(sizeof(TJimmy))));{}

		CamelLine := InsTitledField(11, 1, 25, 1, 'Camel', New(PInputLiveStock, init(R, 25, '')));
		DateLine := InsTitledField(11, 2, 10, 1, '~D~ate', New(PInputDate, init(R)));
		PInputELine(Current)^.MustInputToClose := True;

		InsTitledField(11, 3, 15, 1, 'What', New(PInputScode, init(R, scQNoteWhat)));
		InsTitledField(30, 3,  6, 1, 'Qty', New(PInputWord, init(R, 6)));

		InsTitledField(11, 5, 25, 3, '~N~otes', New(PInputFreeText, Init(R, 250, 0, nil)));{}

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

		SelectNext(True); {so focussing below works}

		EndInit;

		if CamelID<>-1 then DateLine^.Focus else CamelLine^.Focus;
	end;
end;


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

const
	{--- Required for Stream ----}
	RLiveStockQNote : TStreamRec = (
		ObjType : srLiveStockQNote;
		VmtLink : Ofs(TypeOf(TLiveStockQNote)^);
		Load : @TLiveStockQNote.Load;
		Store : @TLiveStockQNote.Store
	);

function TLiveStockQNote.RecSize : word;
begin RecSize:= 40; end;

function TLiveStockQNote.srType : word;
begin srType := srLiveStockQNote; end;

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

begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			inherited Load(S);
			Date.Load(S);
			S.Read(CamelID, 4);
			What := S.ReadStr;
			S.Read(Quantity, 2);
			Note^.Load(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TLiveStockQNote.Load',mfError);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);

	Date.Store(S);
	S.Write(CamelID, 4);
	S.WriteStr(@What);
	S.Write(Quantity, 2);
	Note^.Store(S);
end;

{=============== HOOKING =====================}
function TLiveStockQNote.NumHookTo;
begin NumHooKTo := 1; end;

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

	if Date.Blank then
		Key := sortkeystart
	else
		Key := - Date.Days;

	case htType of
		1 : begin HookToID := @CamelID; hkType := hkHistory; end;
	end;
end;


procedure TLivestockQnote.LoadSupplements;
begin
	if not Note^.Loaded then Note^.LoadText;
end;

{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure TLiveStockQNote.SetFormCodes;
begin
	inherited SetFOrmCodes(FormCodes);

	with FOrmCodes^ do begin
		Insert(New(PJimmyFormCode, init('CAMEL',CamelID)));
		SetDate('DT', Date);
		SetStr('TYPE', ExpandSCOde(scQNoteWhat, What));
		SetStr('QTY', N2Str(Quantity));
	end;
end;



{*****************************************
 ***         CREATORS                  ***
 *****************************************}


function CreateTransfer(P : pointer) : pointer; far;
begin	CreateTransfer := New(PTransfer, Init(P)); end;

function CreateService(P : pointer) : pointer; far;
begin	CreateService := New(PService, Init(P)); end;

function CreateWeaning(P : pointer) : pointer; far;
begin	CreateWeaning := New(PWeaning, Init(P)); end;

function CreateCrush(P : pointer) : pointer; far;
begin	CreateCrush := New(PCrush, Init(P)); end;

function CreateLiveStockQNote(P : pointer) : pointer; far;
begin CreateLiveStockQNote := New(PLiveStockQNote, init(P)); end;

function CreateHerd(P : pointer) : pointer; far;
begin	CreateHerd := New(PHerd, Init); end;

function CreateLivestock(P : pointer) : pointer; far;
begin CreateLivestock := New(PLivestock, init(PJImmyInitParam(P))); end;


{**********************************
 ***  LIST CREATION (TASK)      ***
 **********************************}
procedure NewLivestockList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Livestocks',
		New(PLivestockListView, init(Bounds, lsLivestock, fiLivestockIdx, '')))));
end;

procedure NewFullStockList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Full Livestock',
		New(PLivestockListView, init(Bounds, lsLivestock, fiFullStockIdx, '')))));
end;

procedure NewDeadStockList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Dead Livestock',
		New(PLiveStockListView, init(Bounds, lsLiveStock, fiHerdstockIdx,
					PakLint(DeadHerdID))))));
end;

procedure NewHerdList; far;
var Bounds : TRect;
begin
	Bounds.Assign(0,0,40,15); {small list}
	Bounds.Move(20,Desktop^.Size.Y div 5);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Herds',
		New(PIndexedJimmyListView, init(Bounds, lsHerd, fiHerdIdx, '')))));
end;

function NewLivestockIdxStream : PStream; far;
begin	NewLivestockIdxStream := New(PIndexedJImmyStream, init('LIVESTK.IDX',TLivestockIdxSize)); end;

function NewHerdstockIdxStream : PStream; far;
begin	NewHerdStockIdxStream := New(PIndexedJImmyStream, init('HERDSTK.IDX',TLivestockIdxSize)); end;

function NewFullstockIdxStream : PStream; far;
begin	NewFullStockIdxStream := New(PIndexedJImmyStream, init('FULLSTK.IDX',TLivestockIdxSize)); end;

function NewHerdIdxStream : PStream; far;
begin	NewHerdIdxStream := New(PIndexedJImmyStream, init('HERDS.IDX',THerdIdxSize)); end;


{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
{$IFDEF fixit} writeln('Livestock...'); {$ENDIF}

	{Create file admins}
	NewFileAdmin(fiLivestockIdx, 'Livestock Index',NewLivestockIdxStream);
	NewFileAdmin(fiHerdstockIdx, 'Herd Livestock Index',NewHerdstockIdxStream);
	NewFileAdmin(fiFullstockIdx, 'Full Livestock Index',NewFullstockIdxStream);
	NewFileAdmin(fiHerdIdx, 'Herd Index',NewHerdIdxStream);

	{Various sentence codes}
{	New(SCodeCollection[scAnimalType], Init('LSTYPE.SC', 'Animal Types', StdScodeCreator));{}
	New(SCodeCollection[scSex], Init('LSSEX.SC', 'Animal sex', StdSCodeCreator));
	New(SCodeCollection[scBreed], Init('LSBREED.SC', 'Animal Breeds', StdSCodeCreator));
	New(SCodeCollection[scBoughtFrom], init('LSBOUGHT.SC', 'Bought From', StdSCodeCreator));
	New(SCodeCollection[scCrushState], init('LSCRSTAT.SC', 'Crush Status', StdSCodeCreator));
	New(SCodeCollection[scTrainedState], init('LSTRAIN.SC', 'Trained State', StdSCodeCreator));
	New(SCodeCollection[scLivestockSearch], init('LSNOTES.SC', 'Livestock Note Codes', StdSCodeCreator));
	New(SCodeCollection[scQnoteWhat], init('LSQNWOT.SC', 'Livestock DataItem codes', StdSCodeCreator));

	{register jimmys}
	RegisterJimmy(RLivestock, CreateLivestock, 	lsLivestock, 	'~A~nimal');
	RegisterJimmy(RHerd,			CreateHerd,				lsHerd,				'~H~erd');
	RegisterJimmy(RCrush,			CreateCrush,			0, ''); {special new reg below}
	RegisterJimmy(RService,		CreateService,		lsLivestockHistory, '~S~ervice');
	RegisterJimmy(RTransfer,  CreateTransfer,		lsLivestockHistory, '~T~ransfer');
	RegisterJimmy(RWeaning,		CreateWeaning,		lsLivestockHistory, '~W~eaning');
	RegisterJimmy(RLivestockQnote, CreateLivestockQNote, lsLivestockHistory, 'Q~uickNote');

	{register objects with lists}
	RegisterNewWithList(lsLiveStockMore, '~C~alf', cmNewLivestock);

	RegisterNewWithList(lsHerdHistory, '~T~ransfer', cmNewTransfer);

	RegisterWithList(lsLivestockHistory, '~N~ew', NewItem('C~r~ush', '', kbAltR, cmNewCrush, hcNocontext, nil),nil);
	RegisterNewWithList(lsLivestockHistory, '~B~irth', cmNewLiveStock);

	RegisterNewWithList(lsHerdBulls, '~T~ransfer', cmNewTransfer);

	RegisterNewWithList(lsDesktop, '~Q~uickNote', cmNewLiveStockQNote);
	RegisterNewWithList(lsDesktop, 'Transfer', cmNewTransfer);

	RegisterWithList(lsDesktop, '~N~ew', NewItem('C~r~ush', '', kbAltR, cmNewCrush, hcNocontext, nil),nil);

	{Extra options for livestock list}
	RegisterWithList(lsLIvestock, '~S~how', NewItem('~N~otes', 'Alt-M',  kbAltM, cmMoreAbout, hcNoContext, nil),nil);
	RegisterWithList(lsLivestock, '~S~how', NewItem('~H~istory', 'Alt-H',  kbAltH, cmHistory,   hcNoContext, nil),nil);
	RegisterWithList(lsLivestock, '~S~how', NewItem('History - New C~r~ush', 'Alt-R', kbAltR, cmNewCrush, hcNoContext, nil),nil);

{$IFDEF kmaint}
	RegisterWithList(lsLivestock, '~E~dit',  NewItem('~M~erge',    '',      kbNone,   cmMerge, hcNoContext, nil),nil);
{$ENDIF}


	{Desktop List registration}
	RegisterTask(DesktopTasks, cmNewLivestockList, @NewLivestockList);
	RegisterTask(DesktopTasks, cmNewDeadstockList, @NewDeadstockList);
	RegisterTask(DesktopTasks, cmNewFullstockList, @NewFullstockList);
	RegisterTask(DesktopTasks, cmNewHerdList, @NewHerdList);

end.


