{*************************************************************************
 ***                      Simple Money OBJECT                          ***
 *************************************************************************}
{$I compflgs}
unit SMoney;

INTERFACE

uses tuiedit, objects;    {for streaming}

const
	{SimpleMoney text constants}
	mtPounds      = $01;
	mtPoundsPence = $02;
	mtSymbol		  = $10;  {Add symbol}
	mtBlankZero	  = $20;  {Blanks if zero}

type
	{======= SimpleMoney OBJECT ================}
	PSimpleMoney = ^TSimpleMoney;
	TSimpleMoney = object
																			 {Needs to be a record for input GetData, etc}
		Value : longint;

		{constructor Init(NAmount : longint); only required for objects with virtual methods}
		constructor Init;

		procedure Clear;
		function Blank : boolean;
		function inPence : longint;
		function inPounds : real;

		procedure SetToPence(NAmount : longint);
		procedure SetTo(Pounds : double);  {it's only double for kppms really, JIC strange values}
		procedure Add(SimpleMoney : TSimpleMoney);
		procedure Subtract(SimpleMoney : TSimpleMoney);

		function Pence : integer;  {Just pence}
		{-- Strings ---}
		function Text(mtType : byte) : string;
		function PoundsPenceStr : string;       {Pounds & pence}

		{--- File Storing ---}
		procedure Store(var S : TStream);
		procedure Load(var S : TStream);

	end;

	{====== INPUT MONEY FIELD ============}
{	PInputSimpleMoney = ^TInputSimpleMoney;
	TInputSimpleMoney = object(TInputNum)
		function Valid(Command : word) : boolean; virtual;
		procedure Draw; virtual;
		procedure GetData(var Rec); virtual;
		procedure SetData(var Rec); virtual;
		function DataSize : word; virtual;
	end;{}



IMPLEMENTATION

uses tuimsgs, help, global, views, minilib;

{*************************************
 ***         SimpleMoney OBJECT          ***
 *************************************}

	constructor TSimpleMoney.Init;
	begin Value := 0; end;


	procedure TSimpleMoney.Clear;
	begin Value := 0; end;

	function TSimpleMoney.Blank;
	begin if Value = 0 then Blank := True else Blank := False; end;

	{--- Setting & Getting data ----}
	procedure TSimpleMoney.SetToPence;
	begin
		Value := NAmount;
	end;


	procedure TSimpleMoney.SetTo;
	begin
		if InLongintRange(Pounds*100) then
			Value := round(Pounds * 100)
		else
			Value := 0;
	end;

	procedure TSimpleMoney.Add;
	begin
		Value := Value + SimpleMoney.Value;
{		if InLongintRange(Pounds*100) then
			Value := Value + round(Pounds * 100)
		else
			Value := 0;{Old add; parameter = pounds}
	end;

	procedure TSimpleMoney.Subtract;
	begin
		Value := Value - SimpleMoney.Value;
{		if InLongintRange(Pounds*100) then
			Value := Value + round(Pounds * 100)
		else
			Value := 0;{Old add; parameter = pounds}
	end;

	function TSimpleMoney.inPence : longint;
  begin
    inPence := Value;
	end;

	function TSimpleMoney.inPounds : real;
	begin
    inPounds := Value/100;
	end;


	function TSimpleMoney.Pence : integer;
  begin
    Pence := Value mod 100;
	end;

	{---- Various output formats ----------}

	function TSimpleMoney.Text;
	var S,Pe,Po : string[20];
			V : longint;
	begin
		V := Value; if V<0 then V:=-V;					{Get rid of sign}

		Pe := '00'+N2Str(V mod 100); Pe := Copy(Pe,length(Pe)-1,2);     {Pennies}
		Po := N2Str(V div 100);     						{Pounds}

		case (mtType and $0F) of
			mtPounds 			: S := Po;			    {pounds only}
			mtPoundsPence : S := Po+'.'+Pe;  {Pounds and definitely pence}
		else
			begin
				{default - pounds, add pence if present, if 0 leave blank}
				S := Po; if Pe<>'00' then S := S + '.' +Pe;
				if S = '0' then S := '';
			end;
		end;

		if ((mtType and mtSymbol)>0) and (S<>'') then S := PoundSign + S;

		if Value<0 then S := '-'+S;  {Add sign after currency symbol}

		if (Value = 0) and ((mtType and mtBlankZero)>0) then S := '';

		Text := S;
	end;


	function TSimpleMoney.PoundsPenceStr : string;
	begin	PoundsPenceStr := Text(mtPoundsPence);	end;


	{--- File storing ----}
	procedure TSimpleMoney.Store;
	begin
    S.Write(Value, sizeof(Value));
  end;

	procedure TSimpleMoney.Load;
  begin
    S.Read(Value, sizeof(Value));
	end;

	{*********************************
	 ***       INPUT MONEY FIELD   ***
	 *********************************}

{	function TInputSimpleMoney.Valid;
	var L : longint;
			V : boolean;
			R : Real;
			B : byte;
			CMoney : TSimpleMoney;

	begin
		V := inherited Valid(COmmand);

		if V and (Command <> cmCancel) then begin
			{Test to see if Get Data will be safe}
{			R := S2Real(Data^) * 100;
			if not inlongintRange(R) then begin
				InputWarning('Value too large', hcIWRangeMsg);
				V := False;
			end else begin
				GetData(CMoney);
				B := length(Delspace(Data^));
				if ValErr>0 then begin
						InputWarning('Money Error'#13#10
												+Space(ValErr-1)+#25+space(B-ValErr)+#13#10
												+delspace(Data^)+#13#10
												+Space(ValErr-1)+#24+space(B-ValErr), hcIWValueMsg);
					 V := False;
				end else
					if length(CMoney.Text(mtPoundsPence))>Maxlen then begin
						InputWarning('Value too large to fit', hcIWRangeMsg);
						V := False;
					end else
						{reformat - right justify}
{						SetData(CMoney);
			end;

		end;

		Valid := V;

	end;

	procedure TInputSimpleMoney.GetData(var Rec);
	var R : real;  {For reading into}
{	begin
		R := S2Real(Data^) * 100;         {Pounds to pennies}
{		longint(Rec) := round(R);
	end;

	procedure TInputSimpleMoney.SetData(var Rec);
	var CMoney : TSimpleMoney;  {To get conversion routine}
{			S : string;
	begin
		CMoney.SetToPence(longint(Rec));
		S := CMoney.Text(mtPoundsPence); {right set}
{		if (length(S)<=(Size.X-2)) and (Maxlen>=Size.X-2) then {safety check for maxlen - should be larger}
{			Data^ := PadSpaceL(S, Size.X-2) {if it will fit in display, then do so}
{		else
			Data^ := copy(S,1,Maxlen); {otherwise just set, with safety length check}
{	end;

	function TInputSimpleMoney.DataSize : word;
	begin DataSize := Sizeof(TSimpleMoney); end;

	procedure TInputSimpleMoney.Draw;
	begin
		inherited Draw;
		writechar(0,0, #156, 4,1);   {Draws luminous green œ}
{	end;{}

end.
