{******************************************************
 ***OOP                                             ***
 ***                PAYMENTS                        ***
 ***                                        MCH 96  ***
 ******************************************************}
{Payment objects for use with invoices & bills received.  Separated from
ordproc unit as they need kinvoice.pas in order to load the paid amount
(when creating a new one it automatically assumes you're paying off the
lot)}
{$I compdirs}
unit payments;

interface

uses global, jimmys, tuiedit, views, dattime, forms, multcurr, files;

type
	{==== PAYMENT ITEM ===============}
	PPayment = ^TPayment;
	TPayment = object(TJimmy)
		ForOrderID : longint;
		Date : TDate;
		WhoPaidID : longint; {WhoPaidID paid}
		Paid : TMoney; {amount paid}
		Discounted : TMoney; {amount discounted}
		Ref : string[9];

		constructor Init(Param : PJimmyInitParam);
		procedure COmmonInit; virtual;

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

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

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);
		procedure OnStoreing(const DiskJImmy : PJimmy); virtual;    {extra storing method, done by storeself}

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

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

		{-- printing ---}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
	end;

implementation

uses
			{$IFDEF kinvoice} kinvoice, {$ENDIF} {for payments, setting auto-paid}
			{$IFDEF kbooks} 	kbooks, {$ENDIF}
			ordproc,
			kdirctry,
			inpdnt,
			help,
			tui, tuijimmy, tuimsgs,
			tasks,
			objects,
			minilib;


constructor TPayment.Init;
var Order : POrder;
begin
	inherited Init;
	Date.SetToToday;
	WhoPaidID := -1;
	if Param<>nil then begin
		if Param^.ListView^.lsType = lsPayments then begin
			ForOrderID := Param^.ForWho;

			if ForOrderID<>-1 then begin
				Order := POrder(GetJimmy(ForOrderID));
				WhoPaidID := Order^.ForWho;
				case Order^.srType of
					{$IFDEF kQInv} not valid any more{srQuickInvoice : Paid.SetTo(PINvoice(Order)^.Due);}{$ENDIF}
					{$IFDEF KInvoice}
						srInvoice : begin
							Paid.SetTo(PInvoice(Order)^.Due);
							if PInvoice(Order)^.CashDiscountable then
								Discounted.SetTo(PInvoice(Order)^.TotallerGroup.CashDisc);
						end;
					{$ENDIF}
					0 : begin end; {dummy for compiler}
				else
					{put sr's that payments are valid for in above case statement}
					ProgramError('Trying to create payment for non-order?'#13#10
												+'JimmyID='+N2Str(ForOrderID)+' srtype='+N2Str(Order^.srType),hcNoContext);
				end;
				dispose(Order, done);
			end;
		end else begin
			ForOrderID := -1;
			WhoPaidID := Param^.ForWho;
		end;
	end;
end;

procedure TPayment.CommonInit;
begin
	inherited CommonInit;
	Paid.Init;
	Discounted.Init;
end;


{======= DISPLAY LINE ====================}
function TPayment.DisplayLine;
var S,SS: string;

begin
	{First line}
	S := Date.Digit8+' ';
	if Ref<>'' then S := S + Ref+' ';
	S := S +GetJimmyIDName(WhoPaidID, naRef,0);

	{add total}
	S := S+RightSet+' '+Paid.Text(mtValue);

	{$IFDEF Fixit}
	S := S + #13+'TEK:'+N2Str(RecNo)+' For'+N2Str(ForOrderID);
	{$ENDIF}

	DisplayLine := S;
end;


{================ EDIT BOX ============================}
{sets discount to 0 if paid amount is less than due}
procedure LinkDiscount(const Linker : PINputLinker; const CallingView : PView); far;
var Paid, Disc : Tmoney;
		Order : Porder;
begin
	Paid.Init; Disc.Init;
	Order := POrder(GetJimmy(PPayment(PJimmyEditBox(CallingView^.Owner)^.Jimmy)^.ForOrderID));
	if Order<>nil then begin
		if (Order^.srtype=srInvoice) and Order^.CashDiscountable then begin
			Linker^.SourceView[1]^.GetData(Paid);
			if Paid.Value<PInvoice(Order)^.Due.Value then
				Disc.Clear
			else
				Disc.SetTo(PInvoice(Order)^.TotallerGroup.CashDisc);
			Linker^.TargetView[1]^.SetData(Disc);
			Linker^.TargetView[1]^.DrawView;
		end;
		dispose(Order, done);
	end;

end;

procedure TPayment.MakeEditBox;
var Bounds, R : TRect;
		ForWhoLine, RefLine, PaidLine : PView;
		DiscountLinker : PInputLinker;

begin
	Bounds.Assign(0, 0, 35,9);
	CentreOnView(Bounds, Caller);
	EditBox := New(PJimmyEditBox, init(Bounds, 'Payment',Caller,@Self));
	New(DiscountLinker, init(@LinkDiscount, Editbox));

	{----Position box, in centre of calling view----}
	with EditBox^ do begin
		Insert(New(PSkipBytes, init(sizeof(TJimmy))));
		Insert(New(PSkipBytes, init(4)));  {Skip for order}

		InsTitledField(11,  1, 10, 1, '~D~ate ', New(PInputDate, Init(R)));
		ForWhoLine 	:= InsTitledField(11,  2, 21, 1, '~F~rom', New(PInputDirectory, init(R, 30, fiFullDirIdx, lsDirectory, '')));
		PaidLine 		:= InsTitledField(11,  3,  9, 1, '~P~aid', New(PInputMoney, init(R)));
		DiscountLinker^.SetSourceView(Current, 1);
									 InsTitledField(11,  4,  9, 1, '~D~iscount', New(PInputMOney, init(R)));
									 DiscountLinker^.SetTargetView(Current, 1);
{									 Current^.SetState(sfDisabled, True);{}
		RefLine 		:= InsTitledBox(  11,  5,  9, 1, '~R~ef', 	9);

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

		EndInit;
		if WhoPaidID=-1 then ForWhoLine^.Focus else PaidLine^.Focus;

	end;

end;

{************************************
 ***         DATABASE             ***
 ************************************}
const
	{--- Required for Stream ----}
	RPayment : TStreamRec = (
		ObjType : srPayment;
		VmtLink : Ofs(TypeOf(TPayment)^);
		Load : @TPayment.Load;
		Store : @TPayment.Store
	);

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

function TPayment.srType;
begin srType := srPayment; end;


{========== LOAD ===================}
constructor TPayment.Load;
var Ver : byte;
		PriceGroup : TPriceGroup;
begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			{was a torderitem descendant}
			S.Read(LockTerminal, 1);
			S.Read(Deleted, 1);
			S.Read(ForOrderID, 4);
			S.Seek(S.GetPos+10);
			PriceGroup.Load(S);

			Date.Load(S);
			S.Read(WhoPaidID, 4);
			Ref := S.ReadStr;
			Paid.Load(S);
		end;
		2 : begin
			{now a jimmy descendant}
			inherited Load(S);
			S.Read(ForOrderID, 4);
			Date.Load(S);
			S.Read(WhoPaidID, 4);
			Ref := S.ReadStr;
			Paid.Load(S);
		end;
		3 : begin
			{v4.3, added discounted}
			inherited Load(S);
			S.Read(ForOrderID, 4);
			Date.Load(S);
			S.Read(WhoPaidID, 4);
			Ref := S.ReadStr;
			Paid.Load(S);
			Discounted.Load(S);
		end;
	else
		DBaseMessage(@S,'Version '+N2Str(Ver)+' not known'#13'Tpayment.load', mfError,hcInternalErrorMsg);
		fail;
	end;
end;

{========== STORE ===================}
procedure TPayment.StoreFields;
var	ver : byte;

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

	inherited StoreFields(S);

	S.Write(ForOrderID, 4);
	Date.Store(S);
	S.Write(WhoPaidID, 4);
	S.WriteStr(@Ref);
	Paid.Store(S);
	Discounted.Store(S);
end;

{============== BOOKKEEPING ===============================}
procedure TPayment.OnStoreing;
var N : string;
begin
	{$IFDEF kbooks}
	if RecNo=-1 then begin
		N := GetJimmyIDName(WhoPaidID, naReport, 30);{}
		InsertTransaction(Date, acDebtors, acIncome, 		N, Paid, 'PMT'+Ref);{}
		InsertTransaction(Date, acDebtors, acDiscounts, N, Discounted, 'PMT'+Ref);{}
	end else begin
		{$IFNDEF update}
		ProgramWarning('No automatic update to books made'#13#10'Please do manually',hcNoContext);
		{$ENDIF}
	end;
	{$ENDIF}
end;

{============== POINTERS TO OTHER JIMMYS===================}
function TPayment.NumIDs;
begin NumIDs := 2; end;

function TPayment.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @ForOrderID;
		2 : GetJImmyID := @WhoPaidID;
	else
		GetJimmyID := nil;
	end;
end;

{-- Hooking to others -----}
function TPayment.NumHookTo;
begin NumHookTo := 3; end;

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure TPayment.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key, InsertBias);
	case httype of
		1 : begin
			HookToID := @ForOrderID;
			hkType := hkPayments;
		end;
		2 : if ForOrderID = -1 then begin {if not already part of an order}
			HookToID := @WhoPaidID;
			hkType := hkAccounts;
		end;
		3 : if ForOrderID = -1 then begin {if not already part of an order}
			HookToID := @WhoPaidID;
			hkType := hkHistory;
		end;
	end;
	if Date.Blank then	Key := SortKeyStart {Make sure appears at beginning}
	else Key := -Date.Days;  							{Reverse Sort on date}
end;

procedure TPayment.SetFormCodes;
begin
	inherited SetFormCodes(formCodes);

	with FormCodes^ do begin
		SetDate('DATE', Date);
		Insert(new(PMoneyFormCode, init('PAID', Paid)));
		Insert(new(PMoneyFormCode, init('DISC', Discounted)));
		SetStr('REF', Ref);
		Insert(New(PJimmyFormCode, init('ORDER', ForOrderID)));
		Insert(New(PJimmyFormCode, init('WHO', WhoPaidID)));
	end;
end;

{**************************************
 ***       INITIALISER              ***
 **************************************}

function CreatePayment(P : pointer) : pointer; far;
begin	CreatePayment := New(PPayment, init(P)); end;


begin
	RegisterType(RPayment);

	RegisterNewWithList(lsPayments, '~P~ayment', cmNewPayment);

	RegisterCreator(cmNewPayment, CreatePayment);
end.
