{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                          MEMBERSHIP MODULE                           ***
 ***                                                                      ***
 *** M Hill                                                      Nov 1992 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}
{Provides an attachment object for attaching via a member button to TPerson
and TCompany. {}

unit KMEMSHIP;

INTERFACE

uses global, objects, jimmys, scodes, dattime,
			files,
			forms,
			tuiedit, views;

const
	TMemNumIndexSize = 30;
	TMembersIndexSize = 80; {leave room for branch/region/category & name}

	ixMemNum 	= 1; {purely for admin - looking up by mem no}
	ixMemName = 2; {members by name}
	ixMemClub = 3; {members by club/name}
	ixMemCat  = 4; {members by club/category/name}


type
	PMemberShip = ^TMemberShip;
	TMemberShip = object(TJimmy)

		MemNumIdx 		: longint; {list/access by membership number}
		MembersIdx 		: longint;				{list of members by name - subset of full list}
		MembersByClubIdx 	: longint; {list by region/branch & name}
		MembersByCatIdx 	: longint; 	{members by category by region/branch}

		ForWho : longint; 		{pointer to person/coy}

		Region : TSCode;
		Branch : TScode;

		{Membership details}
		MemNum		: string[20]; 					{Membership number}
		Category 	: string[10];					{membership type}

		DOJoining : TDate; 							{Date of joining}
		DOExpiry	:	TDate;								{Date of membership expiry}

		DOB				: TDate;

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

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

		function Blank : boolean; virtual; {returns true if empty}

		function OneHookEntryOnly : boolean; virtual;

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

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

		{Other Jimmy ID ptrs - 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}

		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint;
												var hkType : byte; var Key : longint; var InsertBias : boolean); virtual;

		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;

		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;
		procedure AddFields(const Group : PGroup; const EditBox : PEditBox); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

 end;

 const
	 {--- Required for Stream ----}
	 RMemberShip : TStreamRec = (
		 ObjType : srMemberShip;
		 VmtLink : Ofs(TypeOf(TMemberShip)^);
		 Load : @TMemberShip.Load;
		 Store : @TMemberShip.Store
	 );



IMPLEMENTATION

uses
			reports,
			kdirrpts,
			kdirctry,
			drivers,
			jimhooks,
			multcurr,
			dialogs,
			help,
			tui,
			tasks,
			kamsetup,
			tuimsgs,
			jimindxs,
			app,
			inpdnt, tuijimmy,
			minilib;

{****************************************************************************
 ***                                                                      ***
 ***                THE Member OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}
{in constructor it ought to check and see if there are any other membership
types - if so it ought to fail...}
constructor TMembership.Init;
begin
	inherited init;

	MemNumIdx := -1;
	MembersByClubIdx := -1;

	ForWho := -1;

	if Param<>nil then begin
		if PAram^.ForWho<>-1 then begin
			ForWho := Param^.ForWho;
		end;
	end;

	DOB.Clear;
	DOJoining.Clear;
	DOExpiry.Clear;
end;


procedure TMembership.CommonInit;
begin
	inherited CommonInit;
	ScodeCollection[scMembershipCategory]^.LogOn;
	ScodeCollection[scMembershipRegion]^.LogOn;
	ScodeCollection[scMembershipBranch]^.LogOn;
end;

destructor TMembership.Done;
begin
	ScodeCollection[scMembershipCategory]^.LogOff;
	ScodeCollection[scMembershipRegion]^.LogOff;
	ScodeCollection[scMembershipBranch]^.LogOff;
	inherited Done;
end;

{Only allowed to have one entry in a hook chain}
function TMembership.OneHookEntryOnly;
begin OneHookEntryOnly := True; end;

function TMembership.Blank;
begin
	Blank := (delspaceR(Region)='') and (delspaceR(Branch)='') and
						(delspaceR(MemNum)='') and (delspaceR(Category)='') and
						DOExpiry.Blank;
end;

{********************************************
 *** DISPLAY LINE                         ***
 ********************************************}
{Used for list views}
function TMembership.DisplayLine;
var S : string;
begin
	if DOExpiry.Blank then
		S := 'Life'
	else
		if DOExpiry.Days >=Today.Days then
			S := DOExpiry.Digit8
		else
			if DOExpiry.Days - S2Num(ProgramSetup.Get(siMemDueLeeway,'')) >= Today.Days then
				S := 'DUE '+DOExpiry.Digit8
			else
				S := 'EXPIRED'+DOExpiry.Digit8;

	case GotByix of
		{hook view}
		0 : S :=  'Membership: '+MemNum + ' ' +ExpandSCode(scMembershipCategory,Category) + ' '+DOExpiry.Digit8+' '+S;
		{membership number view}
		ixMemNum : S := MemNum + ' '+GetJimmyIDName(ForWho, naDisplay, 0)+S;

		{members by club/name or club/type/name}
		ixMemName, ixMemClub, ixMemCat :
			S := GetJimmyIDName(ForWho, naDisplay, 0)+Tab+MemNum+Tab+S+Tab+Category;
	end;

	DisplayLine := S;
end;


function TMembership.GetName(naType : byte; Maxlen : integer) : string;
begin
	GetName := MemNum + ' '+ExpandSCode(scMembershipCategory,Category);
end;


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

	with FormCodes^ do begin
		Insert(New(PJimmyFormCode, init('FOR', ForWho)));

		SetStr('NUM', MemNum);

		Insert(New(PScodeFormCode, init('TYPE', Category, scMembershipCategory)));

		Insert(New(PScodeFormCode, init('REGION', Region, scMembershipRegion)));
		Insert(New(PScodeFormCode, init('BRANCH', Branch, scMembershipBranch)));

		SetDate('DOE', DOExpiry); {expiry...}
		SetDate('DOR', DOExpiry); {...renewal}
		SetDate('DOJ', DOJoining);
		SetDate('DOB', DOB);
	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 TMembership.srType;
begin srType := srMembership; end;

function TMembership.RecSize;
begin RecSize := 150; end;

{------- LOAD MAIN DATA ----------}
constructor TMembership.Load;
var Ver : byte;
		L : longint;
begin
	S.Read(Ver, 1); {stored in object}
	case Ver of

		1 : begin
			{not used after 18/12/96}
			inherited Load(S);

			S.Read(ForWho, 4);
			S.Read(L, 4);

			MemNum := S.ReadStr;
			Category := S.ReadStr;

			Branch := S.REadFixedStr(3);
			Region := S.ReadFixedStr(3);

			DOJoining.Load(S);
			DOExpiry.Load(S);
			DOB.Clear;
		end;

		2 : begin
			{tidied up}
			CommonInit;
			S.Read(LockTerminal, 1);
			S.Read(Deleted, 1);
			S.Read(MemNumIdx, 4);
			S.Read(MembersByClubIdx, 4);
			MembersIdx := -1;
			MembersByCatIdx := -1;

			S.Read(ForWho, 4);

			MemNum := S.ReadStr;
			Category := S.ReadStr;

			Branch := S.REadFixedStr(3);
			Region := S.ReadFixedStr(3);

			DOJoining.Load(S);
			DOExpiry.Load(S);
			DOB.Load(S);
		end;
		3 : begin
			{added indexes for names}
			inherited Load(S);

			S.Read(ForWho, 4);

			MemNum := S.ReadStr;
			Category := S.ReadStr;

			Branch := S.REadFixedStr(3);
			Region := S.ReadFixedStr(3);

			DOJoining.Load(S);
			DOExpiry.Load(S);
			DOB.Load(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'TMembership.Load',mfError,hcInternalErrorMsg);
		fail;{}
	end; {case}
end; {proc}

{-------- STORE MAIN DATA ----------}
procedure TMembership.StoreFields;
var Ver : byte;
begin
	{SEE ALSO STORE POINTER}
	Ver := 3; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.Write(ForWho, 4);

	S.WriteStr(@MemNum);
	S.WriteStr(@Category);

	S.WriteFixedStr(@Branch, 3);
	S.WriteFixedStr(@Region, 3);

	DOJoining.Store(S);
	DOExpiry.Store(S);
	DOB.Store(S);
end;



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

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


{**********************************************************
 ***                 HOOKING TO                         ***
 **********************************************************}

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

procedure TMembership.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key, InsertBias);
	case htType of
		1 : begin HookToID := @ForWho; hkType := hkMore; end;
{		2 : begin HookToID := @JointWho; hkType := hkMore; end;{}
	end;
end;


{**********************************************************
 ***                    INDEXING                        ***
 **********************************************************}
function TMembership.NumixTypes;
begin NumixTypes := 4; end;

procedure TMembership.GetIndex;
begin
	inherited GetIndex(ixType, IdxRec, fiType);
	case ixType of
		ixMemNum 	: begin IdxRec := @MemNumIdx; fiType := fiMemNumIdx; end;
		ixMemName : begin IdxRec := @MembersIdx; fiType := fiMembersIdx; end;
		ixMemClub : begin IdxRec := @MembersByClubIdx; fiType := fiMembersByClubIdx; end;
		ixMemCat 	: begin IdxRec := @MembersByCatIdx; 	fiType := fiMembersByCatIdx; end;
	end;
end;

function TMembership.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		ixMemNum 	: if delspaceR(MemNum)<>'' then GetIndexKey := MemNum;
{		ixMemClub : if delspaceR(Branch+Region)<>'' then GetIndexKey :=
			PadSpaceR(Branch,3)+PadSpaceR(Region,3){+GetJimmyIDName(name of forwho AND jointwho?}
	end;
end;


{***************************************************************************
 ***                EDIT MEMBER                                          ***
 ***************************************************************************}
type
	PExpiryMarker = ^TExpiryMarker;
	TExpiryMarker = object(TStaticText)
		procedure HandleEvent(var Event : TEvent); virtual;
	end;

	procedure TExpiryMarker.HandleEvent;
	var Date : TDate;
	begin
		if (Event.What = evCommand) and (Event.Command = cmUpdateFromLink) then begin
			PView(Event.InfoPtr)^.GetData(Date);
			disposeStr(Text);
			if Date.Blank then
				Text := NewStr('Life')
			else
				if Date.Days >= Today.Days then
					Text := NewStr('Current')
				else
					if Date.Days - S2Num(ProgramSetup.Get(siMemDueLeeway,'')) >= Today.Days then
						Text := NewStr('DUE')
					else
						Text := NewStr('EXPIRED');

			DrawView;
		end;

		inherited HandleEvent(Event);
	end;



procedure TMembership.MakeEditBox;
var R : TRect;
		ExpirYLinker : PInputLinker;
		ExpiryMarker : PExpiryMarker;

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

	New(ExpiryLinker, init(nil, EditBox));
	ExpiryLinker^.ForceINitLink := True;{}

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(sizeof(TJimmy)+4+4))); {skip inherited & index pointers}

		InsTitledField(9, 1,  20, 1, '~F~or', New(PInputDirectory, Init(R, 30, fiFullDirIdx, lsDirectory, '')));

		InsTitledField(9, 3,  20, 1, '~R~egion',  New(PinputSCode, Init(R, scMembershipRegion)));
		InsTitledField(9, 4,  20, 1, '~B~ranch',  New(PinputSCode, Init(R, scMembershipBranch)));

		InsTitledBox(  42, 3,  20, 1, 'Mem ~N~o', 20);
		InsTitledField(42, 4,  20, 1, 'Cate~g~ory',  New(PinputSCLine, Init(R,10, scMembershipCategory)));

		InsTitledField(9, 6,  10, 1, '~J~oined', New(PinputDate, init(R)));
		R.XYLD(23, 6,5,1); PInputDate(Current)^.AgeIndicator := New(PAgeIndicator, init(R, ' ')); {add age indicator}
		Insert(PInputDate(Current)^.AgeIndicator);

		InsTitledField(9, 7,  10, 1, 'E~x~pires', New(PinputDate, init(R)));
		ExpiryLinker^.SetSourceView(Current, 1);

		R.XYLD(23, 7,8,1); New(ExpiryMarker, init(R, ' '));
		Insert(ExpiryMarker);
		ExpiryLinker^.SetTargetView(ExpiryMarker, 1); {current not set by above}

		InsTitledField(42, 6,  10, 1, '~D~OB', New(PinputDate, init(R)));
		R.XYLD(56, 6,5,1); PInputDate(Current)^.AgeIndicator := New(PAgeIndicator, init(R, ' ')); {add age indicator}
		Insert(PInputDate(Current)^.AgeIndicator);

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

		EndInit;
	end;

end;

procedure TMembership.AddFields;
var R : TRect;
		ExpirYLinker : PInputLinker;
		ExpiryMarker : PExpiryMarker;

begin
	New(ExpiryLinker, init(nil, EditBox));
	ExpiryLinker^.ForceINitLink := True;{}

	with Group^ do begin
		Insert(New(PSkipBytes, init(sizeof(TJimmy)+4+4+4+4))); {skip inherited & index pointers}
		Insert(New(PSkipBytes, init(4))); {skip for who}

		R.XYLD(8,0,12,1); Insert(New(PinputSCode, Init(R, scMembershipRegion))); AddLabel('~R~egion', Current);
		R.XYLD(8,1,12,1); Insert(New(PinputSCode, Init(R, scMembershipBranch))); AddLabel('~B~ranch', Current);

		R.XYLD(29,0,14,1); Insert(New(PInputELine, init(R, 20))); AddLabel('Mem ~N~o', Current);
		R.XYLD(29,1,14,1); Insert(New(PInputScLine, init(R, 10, scMembershipCategory))); AddLabel('T~y~pe', Current);

		R.XYLD( 8,3,12,1); Insert(New(PInputDate, init(R))); AddLabel('Jo~i~ned', Current);
		R.XYLD(21,3, 3,1); PInputDate(Current)^.AgeIndicator := New(PAgeIndicator, init(R, ' ')); {add age indicator}
		Insert(PInputDate(Current)^.AgeIndicator);

		R.XYLD( 8,4,12,1); Insert(New(PInputDate, init(R))); AddLabel('~E~xpires', Current);
		ExpiryLinker^.SetSourceView(Current, 1);

		R.XYLD(21,4,8,1); New(ExpiryMarker, init(R, ' '));
		Insert(ExpiryMarker);
		ExpiryLinker^.SetTargetView(ExpiryMarker, 1); {current not set by above}

		R.XYLD(29,3,12,1); Insert(New(PInputDate, init(R))); AddLabel('~D~OB', Current);
		R.XYLD(29,4, 3,1); PInputDate(Current)^.AgeIndicator := New(PAgeIndicator, init(R, ' ')); {add age indicator}
		Insert(PInputDate(Current)^.AgeIndicator);

		SelectNext(False);
	end;

end;




function NewMemberShip(P : pointer) : pointer; far;
begin NewMemberShip := New(PMembership, init(P)); end;


{**************************************************************************
 **                        OVERDUE MEMBERS REPORT                       ***
 **************************************************************************}
type
	POverdueMemberSearch = ^TOverdueMemberSearch;
	TOverdueMemberSearch = object(TDirectoryReport)

		SearchCriteria : record
								Date    : TDate;{}
								CatCode   : TSCode;
						 end;

		procedure CommonInit; virtual;
		destructor Done; virtual;
		function EnterCriteria(eaType : word) : word; virtual;
		function MatchItem(Item : PObject) : boolean;      virtual;
		procedure SetHeaderCodes(FormCodes : PFormCodeCollection); virtual;
	end;

procedure TOverdueMemberSearch.CommonInit;
begin
	inherited CommonInit;
	FileAdmin(fiHooks)^.LogOn;
	AskForOutput := False;
end;

destructor TOverdueMemberSearch.Done;
begin
	FileAdmin(fiHooks)^.LogOff;
	inherited Done;
end;


function TOverdueMemberSearch.EnterCriteria;
var EditBox : PeditBox;
		R : TRect;
		Control : word;

begin
	EnterCriteria := cmOK;

	case eaType of
		eaSearch : begin
			R.Assign(0,0,40,9);
			New(EditBox, init(R, 'OVERDUE MEMBERS', nil));

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

				InsTitledField(15,2,10,1, 'For ~D~ate', New(PInputDate, init(R)));
				InsTitledField(15,4,20,1, '~C~ategory', New(PInputScode, init(R, scDirectoryCategory)));

				Insert(New(POurBUtton, init(15,6, 'O~K~', cmPrint, bfDefault+bfGetData+bfClose, @SearchCriteria)));
				InsCancelButton(25,6);

				EndInit;
			end;

			Control := Desktop^.ExecView(EditBox);

			dispose(EditBox, Done);

			if Control <> cmCancel then with SearchCriteria do begin
				CatCode := Delspace(CatCode);
			end;

			EnterCriteria := Control;
		end;
	else
		EnterCriteria := inherited EnterCriteria(eaType);
	end;
end;

procedure TOverdueMemberSearch.SetHeaderCodes(FormCodes : PFormCodeCollection);
var S : string;
begin
	inherited SetHeaderCodes(FormCodes);

	with SearchCriteria do begin
		if Date.Blank then S := '' else S := 'Overdue on '+Date.Text(daAbbr)+' ';
		if CatCode<>'' then S := S + ExpandSCode(scDirectoryCategory, CatCode) + ' ';
	end;

	FormCodes^.SetStr('RPTDESC', S);
{	FormCodes^.Insert(New(PSCodeFormCode, init('SEARCH', SearchCriteria.CatCode, scDirectoryCategory)));{}
end;

function TOverdueMemberSearch.MatchItem;
var	M : boolean;
		Membership : PMembership;
begin
	M := True;

	Membership := PMembership(HookFile^.GetFirst(PDirectoryItem(Item)^.Ptr2More, srMembership));

	if (Membership <> nil) then begin

		{check category code}
		if ((SearchCriteria.CatCode<>'') and
				(Pos(' '+SearchCriteria.CatCode+' ', ' '+PDirectoryItem(Item)^.GetCategories+' ')=0)) then
				 M := False;

		{check expiry date}
		if M and not SearchCriteria.Date.Blank and (SearchCriteria.Date.Days<=MemberShip^.DOExpiry.Days) then M := False; {current}

		dispose(Membership, done);
	end;

	MatchItem := M;
end;

procedure OverdueMembers; far;
var Search : TOverdueMemberSearch;
begin
	Search.Init('OVERDUE MEMBERS SEARCH','',fiFullDirIdx,-1,-1,nil,nil);
	Search.DoSearch;
	Search.Done;
end;

function NewMemNumIndex : PStream; far;
begin NewMemNumIndex := New(PIndexedJimmyStream, init('MEMNUM.IDX',TMemNumIndexSize)); end;

function NewMembersIndex : PStream; far;
begin NewMembersIndex := New(PIndexedJimmyStream, init('MEMBERS.IDX',TMembersIndexSize)); end;

function NewMembersByClubIndex : PStream; far;
begin NewMembersByClubIndex := New(PIndexedJimmyStream, init('MEMCLUB.IDX',TMembersIndexSize)); end;

function NewMembersByCatIndex : PStream; far;
begin NewMembersByCatIndex := New(PIndexedJimmyStream, init('MEMCAT.IDX',TMembersIndexSize)); end;

{==== DIRECTORY LIST ================}
procedure StartMemNumList; far;
begin

end;

procedure StartMemList; far;
var Bounds : TRect;
{		List : PMembershipListView;{}
begin
	Desktop^.GetExtent(Bounds);

{	New(List, Init(Bounds, lsMembers, fiMembersIdx,''));

	Kameleon^.InsertWindow(New(PIndexedJimmyListWindow, init(Bounds, Title, List)));

	NewDirectoryItemList := PListView(Desktop^.Current);{}
end;


{************************************
 ***         INITIALISATION       ***
 ************************************}
begin
	{Register Various sentence codes}
	New(ScodeCollection[scMembershipCategory], Init('MEMSHIP.SC', 'Membership Categories', CostedScodeCreator));{}
	New(ScodeCollection[scMembershipRegion], Init('MEMREG.SC', 	'Membership Regions', StdScodeCreator));{}
	New(ScodeCollection[scMembershipBranch], Init('MEMBRAN.SC', 'Membership Branch', 	StdScodeCreator));{}

	RegisterType(RMembership); {Register for streams}

	RegisterCreator(cmNewMembership, NewMembership);

	RegisterNewWithList(lsMoreAbout,  '~M~embership',cmNewMembership);

	RegisterTask(DesktopTasks, cmOverdueMembers, @OverdueMembers);

	RegisterTask(DesktopTasks, cmStartMemNumList, @StartMemNumList);
	RegisterTask(DesktopTasks, cmStartMemList, @StartMemList);

	NewFileAdmin(fiMemNumIdx, 'Membership Number Index',NewMemNumIndex);
	NewFileAdmin(fiMembersIdx, 'Members Index',NewMembersIndex);
	NewFileAdmin(fiMembersByClubIdx, 'Members By Club Index',NewMembersByClubIndex);
	NewFileAdmin(fiMembersByCatIdx, 'Members By Category Index',NewMembersByCatIndex);

end.


