{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          C O M P A N Y                               ***
 ***                                                                      ***
 *** M Hill                                                      Dec 1993 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KCompany;

INTERFACE

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

{**************************************
 ***           Company               ***
 **************************************}
type
	PCompany = ^TCompany;
	TCompany = object(TDirectoryItem)
		CompanyName : string[40];
		Alias : string[15];

		DeptFor : longint;
		RefID		: longint;

		AddressPID : Plongint; {IPAddress;{}

		CategoryCodes  : string[20];        {Category 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;

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

		{indexing}
		function GetIndexKey(const ixType : byte) : string; virtual;

		{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 company contact list -----}
		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 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,
			tuijimmy,
			tasks,
			printers, {for printing report}
			kperson, {used for the contacts}
			inptel, drivers, {for input}
			jimhooks, {for more-about view}
			lstrings,
			kdirsetu,
			help,
			kamsetup,
			{$IFDEF Update} upv4objs, {$ENDIF}
			minilib;

{****************************************************************************
 ***                                                                      ***
 ***                THE Company OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}

constructor TCompany.Init;
var DirItem : PJimmy;
begin
	inherited Init;
	DeptFor := -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}
			DeptFor := Param^.ForWho;
			{and what about auto-address?}
			DirItem := GetJimmy(DeptFor);
			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 TCompany.CommonInit;
begin
	CategoryCodes := ''; {so that getindex works ok when clearing pointers}
	CompanyName := ''; Alias := '';
	inherited CommonInit;
	AddressPID := @AddressID;{}
	SCodeCollection[scDirectoryCategory]^.LogOn;
	New(Comment, init);
end;


destructor TCompany.Done;
begin
	dispose(Comment, done);
	SCodeCollection[scDirectoryCategory]^.LogOff;
	inherited done;
end;

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

begin
	DisplayLine := '';

	{-- chain view display -------}
	if gotbyix = 0 then begin {got from a chain view - eg company contacts list}
		if delspaceR(Alias)<>'' then 	DisplayLine := CompanyName+' ('+Alias+')'
		else													DisplayLine := CompanyName;
		exit;
	end;

	{--- index view display ---------}

	{company name}
	if Gotbyix = 2 then 		S := Alias + '  ('+CompanyName+')'+SkipTab {got by alias}
	else if delspaceR(Alias)<>'' then  S := CompanyName + '  ('+Alias+')'+SkipTab
		else									S := CompanyName + SkipTab;

	case View of

		{---"BLANK"---}
		dvNone : begin end; {just name, as above}

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

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

			{add parent coy}
			if DeptFor<>-1 then
				SS := GetJimmyIDName(DeptFor, naDisplay,0)
			else begin
				{Add town}
				if GetAddress<>nil then	SS := Address^.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 DeptFor<>-1 then
				S := S+GetJimmyIDName(DeptFor, naDisplay,0)
			else begin
				{Add postcode}
				if GetAddress<>nil then S := S+Address^.Postcode;{}
			end;
		end;

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

			{add parent coy}
			if DeptFor<>-1 then
				S := S +Tab+GetJimmyIDName(DeptFor, 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 DeptFor<>-1 then S := S +Tab+GetJimmyIDName(DeptFor, naDisplay,0) else S := S+Tab;

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

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

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

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

			S := S + Tab+CategoryCodes;	{CategoryCodes}

		end;

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


	else {case view of}

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

	end;

	DisplayLine := S + inherited DisplayLine(ListForWho, lstype, Maxlen, 0);
	ClearAddress;
end;


{************************************************
 *** NAME FORMATS                             ***
 ************************************************}
{See KPerson for various formats}

function TCompany.GetName(naType : byte; Maxlen : integer) : string;
var S : string;
begin
	S := '';
	if (naType = naDisplay) and (maxLen>0) and (Maxlen<=15) then natype := naRef; {not much room - switch to alias}
	case naType of
		naRef : begin
			S := FirstWord(Alias);
			if S = '' then begin
				S := FirstWord(CompanyName);
				if ucase(S)='THE' then S := WordNo(CompanyName,2);
			end;
		end; {first word of alias/coy name}
		naDear : S := ProgramSetup.Get(siImpersonalDear,'Sirs');
	else
		S := CompanyName;
	end;

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

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

end;


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

function TCompany.GetContactFOr;
begin GetContactFor := DeptFor; end;

procedure TCompany.SetFormCodes;
var S,S1 : string;
		I : integer;
		Contact : PDirectoryItem;

begin
	inherited SetFormCodes(FormCodes);

	with FormCodes^ do begin

		{-- Contacts --}
{		S := '';
		FileAdmin(fiHooks)^.LogOn;
		Contact := PDirectoryItem(HookFile^.GetFirst(Ptr2More, srPerson));
		while Contact<>nil do begin
			S := S + Contact^.GetName(naReport,0)+', '+PPerson(Contact)^.JobTitle;
			if Contact^.GetTelNum(1)<>'' then S := S + ' ('+Contact^.GetTelNum(1)+')';
			S := S + CRLF;
			dispose(Contact, done);
			Contact := PDirectoryItem(HookFile^.GetNextJimmy);
		end;
		FileAdmin(fiHooks)^.LogOff;
		SetStr('CONTACTS',S);{}

		Insert(New(PJimmyFormCode, init('COY', DeptFor)));
		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);
	end;
end;


{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
function TCompany.RecSize;
begin RecSize := inherited RecSize + 250; end;

function TCOmpany.srType;
begin srType := srCompany; end;

const
	 {--- Required for Stream ----}
	 RCompany : TStreamRec = (
		 ObjType : srCompany;
		 VmtLink : Ofs(TypeOf(TCompany)^);
		 Load : @TCompany.Load;
		 Store : @TCompany.Store
	 );

{------- LOAD MAIN DATA ----------}
constructor TCompany.Load(var S : TDataStream);
var Ver : byte;

begin
	S.Read(Ver, 1);
	case Ver of
		4: begin
			{Dec 96 - moved tel nos to address, added comment field}
			inherited Load(S);

			S.Read(DeptFor, 4);

			CompanyName  := S.ReadStr;
			Alias := S.ReadStr;{}

			CategoryCodes := S.ReadStr;

			Comment^.Load(S);

			RefID := -1;
		end;
		5: begin
			{temporary reintroduction of ref}
			inherited Load(S);

			S.Read(DeptFor, 4);

			CompanyName  := S.ReadStr;
			Alias := S.ReadStr;{}

			CategoryCodes := S.ReadStr;

			Comment^.Load(S);

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

{	AddressIP := AddressID;{}
end; {proc}

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

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

	inherited StoreFields(S);

	S.Write(DeptFor, 4);

	S.WriteStr(@Companyname);
	S.WriteStr(@Alias);{}

	S.WriteStr(@CategoryCodes);

	Comment^.Store(S);

	S.Write(RefID, 4);
end;

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

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

{******************************
 *** INDEX OBJECT INTERFACE ***
 ******************************}
{indexing}
function TCompany.GetIndexKey;
begin
	GetIndexKey := ''; {set up key}
	case ixType of
		1,ixArchive :	GetIndexKey := ucase(delspaceR(CompanyName));  {Sort by Company name}
		2 					: GetIndexKey := ucase(delspaceR(Alias));
		{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 -----}
{Cascades hooking so that any jimmy stored in this person's history
automatically gets stored on the companie's history too}
function TCompany.HookingOn;
begin
	HookingOn := False; {no need to save}
	if (DeptFor<>-1) and (HookingJimmy^.srType<>srLetter) then
		case hkType of
			hkHistory,hkAccounts : HookToID(HookingJimmy, DeptFor, -1, htType);
		end;
end;

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

{Hooks onto company items}
function TCompany.NumHookTo;
begin NumHookTo := 1; end;

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

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


{***************************************************************************
 ***                EDIT Company                                          ***
 ***************************************************************************}
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 TCompany.MakeEditBox;
var R : Trect;
		I : byte;
		CoyAddressLink : PInputLinker;
		S : string;
		NameLine : PView;
		TabbedGroup : PGroupOfTabbed;
		MoreView, ContactView, BillView : PView;


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

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

	with EditBox^ do begin
		inherited MakeEditBox(EditBox,Caller); {for tekky mode etc}

		HelpCtx := hcCompanyEditBox;

		NameLine := InsTitledBox(  11, 1,  19, 1, '~N~ame',40); {Sizeof(SurName)-1); {}
		PInputELine(CUrrent)^.MustInput := True;
		InsTitledBox(  11, 2,  15, 1, 'Alias',15); {Sizeof(SurName)-1); {}

		InsTitledField(41, 1,  20, 1, 'Dpt ~F~or', new(PInputDirectory, Init(R, 20, fiFullDirIdx, lsDirectory, '')));
		InsTitledField(41, 2,  20, 1, 'Ref', new(PInputDirectory, Init(R, 20, fiFullDirIdx, lsDirectory, '')));

		CoyAddressLink^.SetSourceView(Current, svCtForLine);

		{Address}
		Insert(New(PInputAddress, init(2,4, @Self, True)));

		CoyAddressLink^.SetTargetView(Current, tvAddress);
		CoyAddressLink^.ForceInitLink := True; {to set altaddressowner to coy}

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


		{-- Bottom tabbed view ----}
		R.XYLD(1,13, 57, 7);

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

		with TabbedGroup^ do begin

			R.XYLD(10,1, 42, 5);{}


			{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}
			AddTabbedView(New(PAttachedJimmyInput, init(R, srMembership, hkMore, 1, PJimmyEditBox(EditBox))),
										whLeft, 4, '~M~em/ship');
			{$ENDIF}
		end;{}



		{Contacts/depts}
{		Insert(New(PHookListButton, init( 6,Size.Y-4,'C~o~ntacts',
																cmNone, bfNormal, @Self, hkContacts, lsContacts)));

		{Other/More About}
{		Insert(New(PHookListButton, init(18,Size.Y-4,'~N~otes',
																cmNone, bfNormal, @Self, hkMore, lsMoreAbout)));

		{Bills/accounts}
{		Insert(New(PHookListButton, init(30,Size.Y-4,'B~i~lls',
																cmNone, bfNormal, @Self, hkAccounts, lsAccounts)));

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

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

	NameLine^.Focus;

end;

{*****************************************************************
 ***                      PRINT                                ***
 *****************************************************************}
procedure TCompany.PrintLabel;
begin
	Device^.writeln(GetName(naAddress,0));
	inherited PrintLabel(Device,LabelAs);
end;

procedure TCompany.PrintFull;
var I : integer;
		S : string;

begin
	{============ STANDARD REPORT PRINT - Company & MORE DETAILS =============}
			ThinkingOn('Printing');
			with Device^ do begin
				FormCodes^.SetPrefix('P');
				SetFormCodes(FormCodes);
				StartPrint('','');

				{------Print basic Company DataItems-------}
				writeln(UCASE(GetName(naReport,0)));
				writeln('');

				GetAddress;
				{Address & tel nos}
				for I := 1 to 9 do begin
					if Address<>nil then S := Address^.GetFormattedLine(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;

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

				inherited PrintFull(Device, PrintAs); {Prints more about list & does endprint}
			end; {with}
			ThinkingOff;

end;


function NewCompany(P : pointer) : pointer; far;
begin NewCompany := New(PCompany, init(PJImmyinitParam(P))); end;


{******************************************
 ***         UNIT INITIALISATION        ***
 ******************************************}
{unit initialisation procedure}
begin
	RegisterType(RCompany);{}

	RegisterCreator(cmNewCompany, NewCompany);

	RegisterNewWithList(lsDirectory, '~C~ompany', cmNewCompany);

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


