{**************************************************************
 ***                                                        ***
 ***                 BOOKS REPORTS                          ***
 ***                                                        ***
 **************************************************************}
{$I compflgs}

unit KBksRpts;

INTERFACE

IMPLEMENTATION

uses kbooks, devices, scodes, global, printers, multcurr,
			objects,
			minilib,
			inpdnt, dattime,
			tuiedit,
			forms,
			files,
			app, views,
			help,
			tasks,
			tuimsgs, reports;

{***********************************************
 ***              TOOLS                      ***
 ***********************************************}

{========= TOTAL UP OPENING/CLOSING BALANCES OF CATEGORY CODES =============}

{Clear balances}
procedure ClearBalances;
var I : word;
begin
	{Clear opening/closing balances}
	for I := 0 to SCodeCollection[scAccounts]^.Count-1 do begin
		PAccCatSCodeItem(SCodeCollection[scAccounts]^.At(I))^.OpeningBalance.Clear;
		PAccCatSCodeItem(SCodeCollection[scAccounts]^.At(I))^.ClosingBalance.Clear;
	end;
end;

const
	ocAdd = $00;
	ocSubtract = $01;
	ocOpen = $02;
	ocClose = $04;

{Add/subtract to opening/closing balances of complete heirarchy}
procedure AddToHeirarchy(Acc : TSCode; Amount : TMoney; oc : word);
var SCode,Scode2 : PAccCatScodeItem;
begin
	Scode := PAccCatSCodeItem(GetSCode(scAccounts, delspaceR(Acc)));
	while Scode<>nil do begin

		if (oc and ocOpen)>0 then
			{opening balances}
			if (oc and ocSubtract)>0 	then SCode^.OpeningBalance.Subtract(Amount)
																else SCode^.OPeningBalance.Add(Amount)
		else
			{closing balances}
			if (oc and ocSubtract)>0 	then SCode^.ClosingBalance.Subtract(Amount)
																else SCode^.ClosingBalance.Add(Amount);

		Scode2 := GetParentSCode(Scode);
		dispose(Scode, done); Scode2 := Scode;
	end;
end;

procedure AddTransactionToHeirarchy(Transaction : PTransaction; ForDateRange : TDateRange);
begin
	with Transaction^ do begin
		{add up opening/closing balances if before selection date}
		if not ForDateRange.Start.Blank and (Date.Days<ForDateRange.Start.Days) then begin
			AddToHeirarchy(ToAcc, 	Amount, ocAdd				+ocOpen + ocClose);  {Add to opening & closing total}
			AddToHeirarchy(FromAcc, Amount, ocSubtract 	+ocOpen + ocClose);  {subtract}
		end;

		{add closing balances if within selection date}
		if ForDateRange.inRange(Date) then begin
			AddToHeirarchy(ToAcc, 	Amount, ocAdd 			+ ocClose);  {once for to account}
			AddToHeirarchy(FromAcc, Amount, ocSubtract 	+ ocClose);  {once for from account}
		end;
	end;
end;


procedure TotalBalances;
var Rec : longint;
		Transaction : PTransaction;
		DateRange : TDateRange;
begin
	ThinkingOn('Totalling balances');

	FileAdmin(fiTransactions)^.LogOn;

	ClearBalances;
	DateRange.Start.SetTotoday;
	DateRange.Finish.Clear;

	for Rec := 0 to Stream(fiTransactions)^.NoRecs -1 do begin
		Transaction := PTransaction(Stream(fiTransactions)^.GetAt(Rec));

		AddTransactionToHeirarchy(Transaction, Daterange);

		dispose(Transaction, done);
	end;

	FileAdmin(FiTransactions)^.LogOff;

	ThinkingOff;
end;




{***********************************************
 ***                                         ***
 ***              END OF YEAR                ***
 ***                                         ***
 ***********************************************}
procedure EndOfYear; far;
var Control : word;
		MEssageBox : PMessageBox;
begin
	{ARE YOU SURE?!!}
	New(MessageBox, init('END OF YEAR',
												'!YOU ARE ABOUT TO DELETE ALL TRANSACTIONS & BALANCES!'+#13#10+
												'Check you have made a backup and printed a full report',
												mfWarning + mfPayAttentionBleep + mfOKCancel,
											hcEndOfYear));

	MessageBox^.SelectNext(False); {make cancel the default}

	Control := Desktop^.ExecView(MessageBox);
	if Control = cmCancel then exit;

	{Clear file completely}
	ThinkingOn('Clearing');
	FileAdmin(fiTransactions)^.LogOn;
	Stream(fiTransactions)^.Seek(0);
	Stream(fiTransactions)^.Truncate;
	FileAdmin(fiTransactions)^.LogOff;
	ThinkingOff;

	PauseMessage('Accounts','Nominal Ledger Cleared',hcEndOfYear);
end;


{***********************************************
 ***                                         ***
 ***              END OF PERIOD              ***
 ***                                         ***
 ***********************************************}
procedure EndOfPeriod; far;
var Control : word;
		MEssageBox : PMessageBox;
begin
	{ARE YOU SURE?!!}
	New(MessageBox, init('END OF PERIOD',
												'!YOU ARE ABOUT TO DELETE ALL TRANSACTIONS!'+#13#10+
												'Check you have made a backup and printed a full report',
												mfWarning + mfPayAttentionBleep + mfOKCancel,
											hcEndOfPeriod));

	MessageBox^.SelectNext(False); {make cancel the default}

	Control := Desktop^.ExecView(MessageBox);
	if Control = cmCancel then exit;

	{Clear file completely, but setting up new opening balances}
{	ThinkingOn('Clearing');
	FileAdmin(fiTransactions)^.LogOn;
	PDataStream(FileAdmin(fiTransactions]^.FilePtr)^.Seek(0);
	PDataStream(FileAdmin(fiTransactions]^.FilePtr)^.Truncate;
	FileAdmin(fiTransactions)^.LogOff;
	ThinkingOff;

	PauseMessage('Nominal Ledger Cleared','');{}
	PauseMessage('Accounts','Nothing done - not written yet',hcEndOfPeriod);{}

end;

{****************************************************************************
 ***                                                                      ***
 ***                            NOMINAL REPORT                            ***
 ***                                                                      ***
 ****************************************************************************}
{Based on reports object}
type
	PNominalReport = ^TNominalReport;
	TNominalReport = object(TReport)

		Search : record
			AcType : string[3];
			CostCentre : string[3];
			DateRange : TDateRange;
			Ref : string[5];
		end;

		ToMode : boolean;

		constructor Init;
		destructor Done; virtual;
		function EnterCriteria(eaType : word) : word; virtual;
		procedure OutputAll;			virtual;
		procedure SearchAll(Command : word);							 virtual;

		function GetItem(ItemNum : longint) : PObject;  virtual;
		function MatchItem(Item : PObject) : boolean;      virtual;
		procedure OutputItem(item : PObject; ItemNo : longint); virtual;
		function GetItemKey(Item : PObject) : string; virtual;

		function IsSortKey : boolean; virtual; {is there a sort key entered}

		procedure SetHeaderCodes(FormCodes : PFormCodeCollection); virtual;

	end;


{============ INITIALISE ====================}
constructor TNominalReport.Init;
begin
	inherited Init('Nominal Report', 'Searching', 'Sorting', 'Printing', 'Nominal Report');

	with Search do begin
		DateRange.Start.Clear;
		DateRange.Finish.Clear;
	end;
	SCodeCollection[scAccounts]^.LogOn;
end;

destructor TNominalReport.Done;
begin
	SCodeCollection[scAccounts]^.LogOn;
	inherited Done;
end;


{============== SEARCH =======================}
procedure TNominalReport.SearchAll;
begin
	FileAdmin(fiTransactions)^.LogOn;
	StartRec := 0; EndRec := Stream(fiTransactions)^.NoRecs-1;

	ClearBalances;

	{does search twice - once in from mode, and once in to mode, to pick up
		both sides of the transaction}
	ToMode := False; inherited SearchAll(Command);
	ToMode := True; inherited SearchAll(Command);

	FileAdmin(FiTransactions)^.LogOff;
end;


{============== OUTPUT =======================}
procedure TNominalReport.OutputAll;
begin
	ToMode := False;
	inherited outputAll; {for now}

end;


{============= ENTER CRITERIA ===================}
function TNominalReport.EnterCriteria(eaType : word) : word;
var
	EditBox : PEditBox;
	Control : word;
	R : TRect;

begin
	EnterCriteria := cmCancel;

	case eaType of
		eaAdmin : EnterCriteria := inherited EnterCriteria(eaAdmin);

		eaSearch : begin
			R.Assign(0,0,38,9);
			New(EditBox, init(R, Title,nil));

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

				InsTitledField(10,2,22,1, 'Account', New(PInputSCode, init(R, scAccounts)));
				InsTitledField(10,3,22,1, 'Cost Ctr', New(PInputSCode, init(R, scCostCentres)));

				Insert(New(PSkipBytes, init(sizeof(Tobject)))); {for TDateRange}
				InsTitledField(10,4,10,1, 'From', 		New(PInputDate, init(R)));
				InsTitledField(25,4,10,1, '-', 				New(PInputDate, init(R)));
				InsTitledField(10,5, 5,1, 'Ref',      New(PInputELine, init(R,5)));

				InsOKButton(15, 6, @Search);
				InsCancelButton(25, 6);

				EndInit;
			end;

			EnterCriteria := Desktop^.ExecView(EditBox);

			dispose(EditBox, done);
		end;

		eaOutput : begin
			EnterCriteria := cmOK;
		end;

	end;
end;

{=============== ITEM METHODS ==================}
function TNominalReport.GetItem(ItemNum : longint) : PObject;
begin
	GetItem := Stream(fiTransactions)^.GetAt(ItemNum);
end;

{also totals up opening/closing balances}
function TNominalReport.MatchItem(Item : PObject) : boolean;

begin
	{adds up opening/closing balances}
	AddTransactionToHeirarchy(PTransaction(Item), Search.DateRange);

	with PTransaction(Item)^ do begin
		{now test for matching}
		MatchItem := (
			{check date range}
			Search.DateRange.inRange(Date)

			{check cost centering}
			and ((Search.CostCentre='') or ((pos(Search.CostCentre, CostCentres)>0) and (CostCentres<>'')))

			{reference}
			and ((Search.Ref='') or (pos(ucase(Search.Ref), ucase(Ref))>0))

			{account number - check mode}
			and ((Search.acType='')
						or (not ToMode and IsCodeInHeirarchy(FromAcc, Search.acType))
						or (ToMode and IsCodeinHeirarchy(ToAcc, Search.acType)))
		);
	end;
end;

procedure TNominalReport.OutputItem;
begin
	if ToMode then
		PTransaction(Item)^.Print(prOneLine+prToAcc, Printer)
	else
		PTransaction(Item)^.Print(prOneLine, Printer)
end;

function TNominalReport.GetItemKey(Item : PObject) : string;
var S : string;
begin
	with PTransaction(Item)^ do begin
		if ToMOde then S := ToAcc else S := FromAcc;

		GetItemKey := MakeHeirarchyLine(S)+ '  '+Date.AsKey+' '+Ref;
	end;
end;


function TNominalReport.IsSortKey : boolean;
begin IsSortKey := True; end;


procedure TNominalReport.SetHeaderCodes;
begin
	inherited SetHeaderCodes(FormCodes);

	FormCodes^.SetStr('RPTDESC', 'For Period: '+Search.DateRange.Text(daAbbr));
	FormCodes^.SetStr('LISTHDR', '   Date      Desc                               Amount a/c Pmt Ref');
end;




{*********************************************
 ***       TASKS                           ***
 *********************************************}
procedure NominalReport; far;
var Report : PNominalReport;
begin
	New(Report, init);
	Report^.DoSearch;
	dispose(Report, done);
end;

procedure TrialBalance; far;
var I : word;
		Scode : PAccCatScodeItem;
begin
	SCodeCollection[scAccounts]^.LogOn;
	TotalBalances;

	{and print... in heirarchical order...}
	Printer^.StartPrint('TRLBAL','');
	for I := 0 to SCodeCollection[scAccounts]^.Count-1 do begin
		Scode := PAccCatSCodeItem(SCodeCollection[scAccounts]^.At(I));
		Printer^.Writeln(Scode^.Code+'  '+Scode^.Description^+'  '
											+ 'Opening '+Scode^.OpeningBalance.TExt(mtFull)
											+ 'Closing '+Scode^.ClosingBalance.Text(mtFull));
	end;
	Printer^.EndPrint;

	SCodeCollection[scAccounts]^.LogOff;
end;



begin
	RegisterTask(DesktopTasks, cmNominalReport,  @NominalReport);
	RegisterTask(DesktopTasks, cmTrialBalance,  @TrialBalance);

	{===== END OF YEAR, EDIT SETUP =====}
	RegisterTask(DesktopTasks, cmEndOfYear,  	@EndOfYear);
	RegisterTask(DesktopTasks, cmEndOfPeriod, @EndOfPeriod);
end.