{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          P E R S O N  L I S T S / E T C              ***
 ***                                                                      ***
 *** M Hill                                                      Jan 1992 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KPerson;

INTERFACE

uses 	kdirctry, jimmys,
{$IFDEF WINDOWS}
	wui,	{windows}
{$ELSE}
	tui,views,dialogs, {text}
{$ENDIF}
			scodes,
			objects,
			address,
			devices,forms,{}
			tuiedit, notes,
			global,{}
			dattime,
			files; {for index items}

{**************************************
 ***           PERSON               ***
 **************************************}


type
	PPerson = ^TPerson;
	TPerson = object(TDirectoryItem)
		Surname : string[30];
		ForName : string[25];
		Title   : string[10];
		DearName: string[15];

		ContactFor : longint;
		JobTitle : string[30];
		Dept     : string[30];
		RefID 	 : longint; {pointer to referrer}

		AddressPID : Plongint; {indirect pointer to AddressID - set to AddressID in
															TDirectoryItem, this is used for the InputAddress
															in makeeditbox}

		Tel  : PString; {personal tel no/ext}

		CategoryCodes  : string[20];        {CategoryCodes codes}
		Comment : PFreeTextData;

	 {-- Methods --}
	 constructor Init(Param : PJimmyInitParam);
	 procedure CommonInit; virtual;
	 destructor Done; 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 GetIndexKey(const ixType : byte) : string; virtual;

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

		{hooking}
		function HookingOn(const hkType, htType : byte; const HookingJimmy : PJimmy) : boolean; virtual;
		function UnHooking(const hkType, htType : byte; const HookingJimmy : PJimmy) : boolean; virtual;

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

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

		function GetName(naType : byte; Maxlen : integer) : string; virtual;
		function GetTelNum(L : integer) : string; virtual;
		function GetCategories : string; virtual;
		function GetContactFor : longint; virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		procedure PrintLabel(const Device : PDeviceStream; LabelAs : word); virtual;
		procedure PrintFull(const Device : PDeviceStream; const PrintAs : word); virtual;
 end;


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

uses 	tuimsgs,
			tasks, {For registering creator}
			printers, {for printing report}
			inptel, drivers, {for input}
			{$IFDEF krongai} krongord,{} {$ENDIF} {for displaying driver's whereabouts}
			{$IFDEF Update} upv4objs, {$ENDIF}
			kdirsetu,
			help,
			inpjimmy,
			lstrings,
			jimhooks,
			tuijimmy,
			minilib;

{****************************************************************************
 ***                                                                      ***
 ***                THE PERSON OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TPerson.Init;
var DirItem : PJimmy;
begin
	inherited Init;
	ContactFor := -1;
	RefID := -1;
	if (Param<>nil) and (Param^.ListView<>nil) then begin
		if (Param^.ListView^.lsType=lsContacts) then begin
			{in contact list - ie being entered as a contact for a coy}
			ContactFor := Param^.ForWho;
			{and what about auto-address?}
			DirItem := GetJimmy(ContactFor);
			AddressID := PDirectoryItem(DirItem)^.AddressID;
			dispose(DirItem, done);
		end;
		if (Param^.ListView^.lsType=lsDirectory) then begin
			{set category to list's category}
			CategoryCodes := PDirectoryListView(Param^.ListView)^.SubIndexString;
		end;
	end;
end;

procedure TPerson.CommonInit;
begin
	CategoryCodes := ''; {so that getindex works ok when clearing pointers}
	SurName := ''; ForName := ''; DearName := '';

	inherited CommonInit;

	AddressPID := @AddressID; {indirect ptr for InputAddress}

	SCodeCollection[scDirectoryCategory]^.LogOn;

	New(Comment, init);

	Tel := nil;
end;

destructor Tperson.Done;
begin
	SCodeCollection[scDirectoryCategory]^.LogOff;
	dispose(Comment, done);
	if Tel<>nil then disposeStr(Tel);
	inherited Done;
end;


{Cascades hooking so that any jimmy stored in this person's history
automatically gets stored on the companie's history too}
function TPerson.HookingOn;
begin
	HookingOn := False; {no need to save}
	if (ContactFor<>-1) and (HookingJimmy^.srType<>srLetter) then {no company, or letter auto-hooks anyway}
		case hkType of
			hkHistory,hkAccounts : HookToID(HookingJimmy, ContactFor, -1, htType);
		end;
end;

function TPerson.UnHooking;
begin
	UnHooking := False; {no need to save}
	if (COntactFor<>-1) and (HookingJimmy^.srType<>srLetter) then
		case hkType of
			hkHistory, hkAccounts : UnHookFromID(HookingJimmy, ContactFor, htType);
		end;
end;

{********************************************
 *** DISPLAY LINE                         ***
 ********************************************}
{Used for list views}
function TPerson.DisplayLine;
var	S,SS : string;
		N1, N2 : string;
		Delivery,ForWho : PJimmy;

begin
	DisplayLine := '';

	if gotbyix = 0 then begin {got from a chain view - eg company contacts list}
		S := Surname+', '+ForName;
		if JobTitle<>'' then S := S +' ('+JobTitle+')';
		SS := '';
		if (Tel<>nil) and (delspace(Tel^)<>'') then
			SS := Tel^
		else begin
			ForWho := GetJimmy(ListForWho);
			if PDirectoryItem(ForWho)^.AddressID<>AddressID then SS := delspaceR(GetTelNum(1));
			dispose(ForWho, done);
		end;
		if SS<>'' then S := S + RightSet+SS;
		DisplayLine := S;
		ClearAddress;
		exit;
	end;

	{------NAME--------}
	if GotByIx = 2 then S := DearName+Tab+Surname
	else								S := Surname +Tab+Forname;

	case View of
		{---"BLANK" - just names---}
		dvNone : if GotbyIx = 2 then S := S+Tab+ForName else S :=S+Tab+DearName;

		{---FOR TELADDR VIEW----}
		dvTelAddr : begin

			S := S + Tab+GetTelNum(1);			{Add telephone no}
			SS := '';

			{add parent coy}
			if ContactFor<>-1 then
				SS := GetJimmyIDName(ContactFor, naDisplay,0)
			else begin
				{Add town}
				if GetAddress<>nil then
					if GetAddress^.adType=ademail then
						SS := GetAddress^.GetFormattedLine(1)
					else
						SS := GetAddress^.Town;
			end;
			if Maxlen<50 then SS := Copy(FirstWord(SS),1,11);
			S := S + RightSet+ SS;
		end;

		{--- telephone postcode ---}
		dvTelPostc : begin

			S := S + Tab+GetTelNum(1);	{Add telephone no}

			{add parent coy}
			if ContactFor<>-1 then
				S := S +Tab+GetJimmyIDName(ContactFor, naDisplay,0)
			else begin
				{Add postcode}
				if GetAddress<>nil then S := S+ Tab+GetAddress^.Postcode;{}
			end;
		end;

		{---FOR ADDR VIEW----}
		{Tends to be used for selection views}
		dvAddr : begin

			{add parent coy}
			if ContactFor<>-1 then
				S := S +Tab+GetJimmyIDName(ContactFor, naDisplay,0)
			else begin
				{Add postcode & town}
				if GetAddress<>nil then
					if GetAddress^.adType=ademail then
						S := S + Tab + GetAddress^.GetFormattedLine(1)
					else
						if Maxlen<=40 then
							S := S + RightSet+ GetAddress^.Town
						else
							S := S +Tab+GetAddress^.Town+Tab+GetAddress^.Postcode;
			end;
		end;

		{---FOR SEARCH/COMMENT VIEW----}
		dvSerCOmm : begin
			{add parent coy}
			if ContactFor<>-1 then S := S +Tab+GetJimmyIDName(ContactFor, naDisplay,0) else S := S+ Tab;

			{categories}
			S := S + Tab+ExpandSCode(scDirectoryCategory, CategoryCodes);

		end;

		{---FOR CRAMMED VIEW-----------}
		dvCrammed : begin
			S := S + Tab+GetTelNum(1);{Add telephone no}

			{add parent coy}
			if ContactFor<>-1 then S := S +Tab+GetJimmyIDName(ContactFor, naDisplay,0) else S := S+Tab;

			{Add first part of postcode}
			if GetAddress<>nil then S := S + Tab+FirstWord(GetAddress^.PostCode) else S := S+Tab;{}

			S := S + Tab+CategoryCodes; {Category - just codes}
		end;

		dvTelOnly : begin
			S := S + RightSet+GetTelNum(1);
		end;

	else

		S := '?View type='+N2Str(View);
	end;

	{$IFDEF kRongai}
		{get current delivery item, and display}
		if pos('DRI',CategoryCodes)>0 then begin {driver}
			if Ptr2More>-1 then begin
				FileAdmin(fiHooks)^.LogOn;
				Delivery := HookFile^.GetFirst(Ptr2More, srRongaiDelivery);
				if Delivery<>nil then begin
					S := S + Tab + PRongaiDelivery(Delivery)^.Date.Digit8
									+' '+GetJimmyIDName(PRongaiDelivery(Delivery)^.TakeTo, naRef, 0)
									+' To '+GetJimmyIDName(PRongaiDelivery(Delivery)^.TakeFrom, naRef, 0);
					dispose(Delivery, done);
				end;
				FileAdmin(fiHooks)^.LogOff;
			end;
		end;{}
	{$ENDIF}

	{Set}
	DisplayLine :=S + inherited DisplayLine(ListForWho, lsType, 0,0);

{	ClearAddress; why?}
end;


function Tperson.GetName(naType : byte; Maxlen : integer) : string;
var S : string;
begin
	if ((Maxlen>0) and (Maxlen<=15)) and (naType = naDisplay) and (DearName<>'') then
		S := DearName {for small inputlines}
	else
		S := minilib.GetName(Surname, ForName, Title, DearName, naType, Maxlen); {use minilib calc}

	if naType = naDisplay then
		if ContactFor<>-1 then S := S + ' ('+GetJImmyIDName(ContactFor, naRef, 0)+')';

	GetNAme := S;
end;


function TPerson.GetTelNum;
begin
	{look at personal first, then usual (address) one}
	if Tel=nil then L := L +1;
	if L <= 1 then GetTelNum := Tel^ else GetTelNum := inherited GetTelNum(L-1);
end;


function TPerson.GetCategories;
begin GetCategories := CategoryCodes; end;

function TPerson.GetCOntactFor;
begin GetContactFor := ContactFor; end;


{***************************************************
 *** SET FORM CODES                              ***
 ***************************************************}


procedure TPerson.SetFormCodes;
var	I : integer;
		S : string;
		Coy : PDirectoryItem;

begin
	inherited SetFormCodes(FormCodes);
{	exit;{}

	with FormCodes^ do begin
		{Various sorts of names}
		SetStr('NS', Surname);
		SetStr('NF', Forname);
		SetStr('NT', Title);

		SetStr('SUR', Surname);
		SetStr('FOR', Forname);
		SetStr('TITLE', Title);

		Insert(New(PFreeTextFormCode, init('CMNT', Comment^)));

		{used by forms /?! to check if comment/category line - or can be used on own as new line...}
		if (LSLen(Comment^.Text)=0) and (delspace(GetCategories)='') then SetStr('ISCC','') else SetStr('ISCC',CRLF);

		SetStr('JOB', JobTitle);
		SetStr('DPT', Dept);


		S := '<'+Prefix+'NAME>'+CRLF;
		if delspaceR(JobTitle)<>'' 	then S := S + '<'+Prefix+'JOB>'+CRLF;
		if delspaceR(Dept)<>''      then S := S + '<'+Prefix+'DPT>'+CRLF;
		if ContactFor<>-1 					then S := S + '<'+Prefix+'COY.NAME>'+CRLF;
		SetStr('FULLADD', S + '<'+Prefix+'ADD>');

		{--- Contact For ----}
		Insert(New(PJimmyFormCode, init('COY', ContactFor)));

		{--- set personal telephone ----}
		if Tel<>nil then SetStr('PERTEL', Tel^) else SetStr('PERTEL','');

		{if no fax/tel for this person, check company and use that}
		if (QDecode('TEL')='') or (QDecode('FAX')='') then begin

			Coy := PDirectoryItem(GetJimmy(ContactFor));
			if Coy<>nil then begin

				{telephones}
				if QDecode('TEL')='' then begin
					S := '';
					for I := 1 to 4 do S := S+ Coy^.GetTelNum(I)+CRLF;
					while Right(S,2)=CRLF do S := Copy(S,1,length(S)-2); {chop off *last* blank ones but leave any inbetween blank ones in,
																												in case user is using position for something}
					SetStr('TEL',S);
				end;

				{Fax}
				if QDecode('FAX')='' then
					SetStr('FAX',Coy^.GetFaxNum);

				dispose(Coy, done);
			end;
		end;

		{--- Set faxing details ---}
		{Therefore acts as a default for any objects to do with it}
		S := Prefix; SetPrefix('');
		SetStr('FAXTO.NAME','<'+S+'NAME>');
		SetStr('FAXTO.NUM', '<'+S+'FAX>');
		SetStr('FAXTO.CNTRY', '<'+S+'ADD.CNTRY>');
		SetPrefix(S);
	end;
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 TPerson.RecSize;
begin RecSize := inherited RecSize + 300; end;

const
	 {--- Required for Stream ----}
	 RPerson : TStreamRec = (
		 ObjType : srPerson;
		 VmtLink : Ofs(TypeOf(TPerson)^);
		 Load : @TPerson.Load;
		 Store : @TPerson.Store
	 );


function TPerson.srType;
begin srType := srPerson; end;

{------- LOAD MAIN DATA ----------}
constructor TPerson.Load;
var	Ver :byte;
		Fax : string;

begin
	S.Read(Ver, 1); {stored in object}
	case Ver of
		6 : begin
			{moved tels to address, inv to & ref to attachments}
			inherited Load(S);

			{Surname/Forename also stored in index}
			Surname  := S.ReadStr;
			ForName  := S.ReadStr;
			Title    := S.ReadStr;
			DearName := S.ReadStr;

			JobTitle := S.ReadStr;
			Dept := S.ReadStr;
			S.Read(ContactFor, 4);

			Tel := NewStr(S.ReadStr);
			Fax := S.ReadStr;

			CategoryCodes := S.ReadStr;
			Comment^.Load(S);

			RefID := -1;
		end;
		7 : begin
			{added ref back in temporarily}
			inherited Load(S);

			{Surname/Forename also stored in index}
			Surname  := S.ReadStr;
			ForName  := S.ReadStr;
			Title    := S.ReadStr;
			DearName := S.ReadStr;

			JobTitle := S.ReadStr;
			Dept := S.ReadStr;
			S.Read(ContactFor, 4);

			Tel := NewStr(S.ReadStr);
			Fax := S.ReadStr;

			CategoryCodes := S.ReadStr;
			Comment^.Load(S);

			S.Read(RefID, 4);
		end;
	else
		{$IFDEF Update}
			if not TPersonLoad(@Self, Ver, S) then fail;
		{$ELSE}
			DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'TPerson.Load',mfError,hcInternalErrorMsg);
			fail;{}
		{$ENDIF}
	end; {case}
end; {proc}

{-------- STORE MAIN DATA ----------}
procedure TPerson.StoreFields;
var I : integer;
		Ver : byte;
		Fax : string;

begin
	{SEE ALSO STORE POINTER}
	Ver := 7; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.WriteStr(@Surname);
	S.WriteStr(@ForName);
	S.WriteStr(@Title);
	S.WriteStr(@DearName);

	S.WriteStr(@JobTitle);
	S.WriteStr(@Dept);
	S.Write(ContactFor, 4);

	S.WriteStr(Tel);
	Fax := ''; S.WriteStr(@FAx);

	S.WriteStr(@CategoryCodes);
	Comment^.Store(S);

	S.Write(RefID, 4);
end;

{============== POINTERS TO OTHER JIMMYS===================}
function TPerson.NumIDs;
begin NumIDs := 3; end;

function TPerson.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := inherited GetJimmyID(1);
		2 : GetJImmyID := @ContactFor;
		3 : GetJimmyID := @RefID;
	else
		GetJimmyID := nil;
	end;
end;

{----- Indexing -------}
function TPerson.GetIndexKey;
begin
	GetIndexKey := '';

	case ixType of
		1,ixArchive :	GetIndexKey := ucase(delspaceR(PadSpaceR(SurName, 30) + ForName));  {Sort by person name}
		2 					: GetIndexKey := ucase(delspaceR(DearName));
		{category subindexes}
		3,4,5,6,7		: if WordNo(CategoryCodes, ixType-2)<>'' then
										GetIndexKey := SetLength(WordNo(CategoryCodes, ixType-2),3)
													+GetIndexKey(1);
	end;
end;


{--- Hooking -----}
function TPerson.NumHookTo;
begin NumHookTo := 1; end;

{Hooks onto company contact list}
procedure TPerson.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID, SubHookToID, hkType, Key, InsertBias);

	case htType of
		1 : begin
			HookToID := @ContactFor;
			hkType := hkContacts;
		end; {hook on to contact list of coy}
	end;
end;


{***************************************************************************
 ***                EDIT PERSON                                          ***
 ***************************************************************************}
const
	svCtForLine = 1;
	tvAddress = 1;

procedure LinkCoyAddress(const Linker : PInputLinker; const CallingView : PView);  far;
var	AddID : Plongint;
{		AddPID : PLongint;{}
		CoyLine : PInputDirectory;
		AddGroup : PInputAddress;

begin
	CoyLine := PInputDirectory(Linker^.SourceView[svCtForLine]);
	AddGroup := PInputAddress(Linker^.TargetView[tvAddress]);

	{do only if name matches id (text not changed), there is a jimmy entered,
	and it's been chnaged from initial setting (ie not when box first displayed and
	ForceInitLink done)}
	if (not CoyLine^.TextChanged) and (CoyLine^.GetJimmy<>nil) and CoyLine^.OrigChanged then  begin
		AddID := @PDirectoryItem(CoyLine^.GetJimmy)^.AddressID;
{		AddPID := @AddID;{}
		AddGroup^.SetData(AddID);
		AddGroup^.Redraw;
	end;

	{set addgroup altaddressowner to company - whatever, ie blank if coy line blank}
	AddGroup^.AltAddressOwner := CoyLine^.GetJimmy;
end;



procedure TPerson.MakeEditBox;
var R : TRect;
		CoyAddressLink : PInputLinker;
		SurLine : PView;
		List : PView;
		TabbedGroup : PGroupOfTabbed;
		MoreView, ContactView, BillView : PView;

begin
	{Create box}
	R.Assign(0, 0, 66, 23); {Size of box}
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Person Registration',Caller, @Self));

	New(CoyAddressLink, init(@LinkCoyAddress, EditBox));

	if not Comment^.Loaded then Comment^.LoadText;

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

		HelpCtx := hcPersonEditBox;

		SurLine := InsTitledBox(  11, 1,  20, 1, 'S~u~rname',30); {Sizeof(SurName)-1); {}
		PInputELine(Current)^.MustInput := True; {Force entry}
		InsTitledBox(  11, 2,  20, 1, 'Forname', 25); {Sizeof(ForName)-1); {}
		InsTitledBox(  11, 3,  10, 1, 'Title',   10); {Sizeof(Title)-1   ); {}
		InsTitledBox(  11, 4,  15, 1, 'Dear',    15); {Sizeof(DearName)-1); {}

		InsTitledField(41, 1,  20, 1, 'Ct/~F~or', new(PInputDirectory, Init(R, 30, fiFullDirIdx, lsDirectory, '')));

		CoyAddressLink^.SetSourceView(Current, svCtForLine);

		InsTitledBox(  41, 2,  20, 1, '~J~ob',     30);
		InsTitledBox(  41, 3,  20, 1, 'Dept',  30);
		InsTitledField(41, 4,  20, 1, 'Ref', new(PInputDirectory, Init(R, 30, fiFullDirIdx, lsDirectory, '')));


		{Address}
		Insert(New(PInputAddress, init(2,6, @Self, True)));
		CoyAddressLink^.SetTargetView(Current, tvAddress);
		CoyAddressLink^.ForceInitLink := True; {to set altaddressowner to coy}

		{Telephone Numbers}
		InsTitledField(41,11,  20, 1, '~T~el',   New(PInputTelNum, init(R, 25)));
{		InsTitledField(43,12,  21, 1, '~F~ax',   New(PInputTelNum, init(R, 25)));{}

		InsTitledField(11,13,  50, 1, 'Cat~g~y',  New(PInputSCLine, Init(R, 20, scDirectoryCategory)));
		InsTitledField(11,14,  50, 1, 'Comment',  New(PInputString, Init(R)));


		{-- Bottom tabbed view ----}
		R.XYLD(1,15, 60, 7);

		TabbedGroup := New(PGroupOfTabbed, init(R));
		Insert(TabbedGroup);

		with TabbedGroup^ do begin

			R.XYLD(10,1, 42, 5);{-1 so scroll bar is *inside* frame}

			{more about list}
			AddTabbedView(New(PDlgHookView,	Init(R, lsMoreAbout, 0, hkMore, @Self, PJimmyEditBox(EditBox))),
										whLeft, 0, '~M~ore');
			MoreView := Current;
			with PHookViewer(Current)^.VScrollBar^ do Options := Options or ofTopSelect;
			Insert(PHookViewer(Current)^.VScrollBar);

			{Contacts list}
			AddTabbedView(New(PDlgHookView,	Init(R, lsContacts, 0, hkContacts, @Self, PJimmyEditBox(EditBox))),
										whLeft, 2, 'C~o~ntacts');
			ContactView := Current;
			with PHookViewer(Current)^.VScrollBar^ do Options := Options or ofTopSelect;
			Insert(PHookViewer(Current)^.VScrollBar);

			if IsMenuforlsType(lsAccounts) then begin
				{accounts list}
				AddTabbedView(New(PDlgHookView,	Init(R, lsAccounts, 0, hkAccounts, @Self, PJimmyEditBox(EditBox))),
											whLeft, 4, '~B~ills');
				BillView := Current;
				with PHookViewer(Current)^.VScrollBar^ do Options := Options or ofTopSelect;
				Insert(PHookViewer(Current)^.VScrollBar);
				PHookViewer(Current)^.ColHeader := InvoiceCOlHeader; {see global}
			end else
				BillView := nil;

			case DirectorySetup.DefTopList of
				dtMore 		: MoreView^.Focus;
				dtContacts: ContactView^.Focus;
				dtBills   : if BillView<>nil then BillView^.Focus;
			end;

			{$IFDEF kmemship}
			R.B.X := R.B.X + 1; {+1 cos no scroll bar}
			AddTabbedView(New(PAttachedJimmyInput, init(R, srMembership, hkMore, 1, PJimmyEditBox(EditBox))),
										whLeft, 4, 'Mem/~s~hip');
			{$ENDIF}
		end;{}

		{History}
		if IsMenuForlsType(lsHistory) then
			Insert(New(PHookListButton, init(Size.X-12,16,'~H~istory',
																cmNone, bfNormal, @Self, hkHistory, lsHistory)));{}


		{OK/Cancel}
		Insert(New(PJimmyOKButton, 			init(Size.X-12,18, @Self)));
		Insert(New(PJimmyCancelButton, 	init(Size.X-12,20, @Self)));
	end;

	SurLine^.Focus;
end;

{*****************************************************************
 ***                      PRINT                                ***
 *****************************************************************}
procedure TPerson.PrintLabel;
begin
	Device^.writeln(Getname(naAddress,0));
	if delspaceR(JobTitle)<>'' then Device^.writeln(JobTitle);
	if delspaceR(Dept)<>'' then Device^.writeln(Dept);
	if ContactFor<>-1 then DEvice^.writeln(GetJimmyIDName(ContactFor, naAddress,0));
	inherited PrintLabel(Device, LabelAs);
end;


procedure TPerson.PrintFull;
var I : integer;
		S : string;
begin
	ThinkingOn('Printing');
	Device^.FormCodes^.SetPrefix('');
	SetFormCodes(Device^.FormCodes);
	Device^.StartPrint('DIRECTRY','');

	{------Print basic person DataItems-------}
	if not Device^.FormFound then with Device^ do begin
		writeln(UCASE(GetName(naReport,0)));
		writeln('');

		{Address & tel nos}
		GetAddress; {load address, if there is one}
		for I := 1 to 9 do begin
			if Address<>nil then S := Address^.GetAddressLine(I) else S := '';
			case I of
				1..5 	: S := PadSpaceR(S, 40)+GetTelNum(I);
				7     : S := PadSpaceR(S, 40)+GetFaxNum;
			end;
			if S<>'' then writeln(S);
		end;
		ClearAddress;

		{Category area and comment line}
		writeln('');
		writeln(ExpandSCode(scDirectoryCategory, CategoryCodes));
	end;

	inherited PrintFull(Device, PrintAs); {more about list, etc & endprint}

	ThinkingOff;
end;


function NewPerson(P : pointer) : pointer; far;
begin NewPerson := New(PPerson, init(PJImmyInitParam(P))); end;

{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
	RegisterType(RPerson);{}

	RegisterCreator(cmNewPerson, NewPerson);

	RegisterNewWithList(lsDirectory, '~P~erson Contact', cmNewPerson);

	{This ends up registering on all more-about lists (ie persons, members, etc), but never mind}
	RegisterNewWithList(lsContacts, '~C~ontact', cmNewPerson);
end.


