{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                      QUICK NOTE FOR HISTORY                          ***
 ***                                                                      ***
 *** M Hill                                                      Dec 1992 ***
 ****************************************************************************}
{$I compdirs}  {Compiler directives}

unit KQNote;

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

{**************************************************************
 ***                                                        ***
 ***               DEFINE EVENT OBJECT                      ***
 ***                                                        ***
 **************************************************************}
{const
 THistoryNoteSize = 40;{}

type

	PHistoryNote = ^THistoryNote;
	THistoryNote = object(TJimmy)

		ForWho 		: longint;
		ByWho 		: longint;
		Date      : TDate;
		Time      : string[6];
		Code      : TScode;
		Notes			: PFreeTextData;{}

		Outcome   : TSCode;

		ParentITemID : longint; {for subhooking on lists}

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

		{Display/edit/print}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

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

		function RecSize : word; virtual;
		function srType : word; 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}
		{-- 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;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
		procedure PrintSummary(const Device : PDevicestream; const PrintAs : word); virtual;

	end;

function CreateHistoryNote(P : pointer) : pointer;


IMPLEMENTATION

uses 	inpdnt, kdirctry,
			tuimsgs,
			tasks,
			app,
			tuilist,  tuijimmy,
			indexes,
			jimhooks,
			lstrings,
{$IFDEF klivestk} inpjimmy, {$ENDIF} {For inputting herd/livestk}
{$IFDEF kusers}   kusers,  {$ENDIF} {for by}
			help,
			jimindxs,
			multcurr, {event codes are costedscodes}
			minilib;

{--- Inititalise - set ptrs to SC ---}
constructor THistoryNote.Init;
begin
	inherited Init;
	ForWho := -1;
	ByWho := -1;
	ParentItemID := -1;

	if Param <> nil then begin
		ForWho := Param^.Forwho;
		PArentItemID := Param^.FocusedParentID;
	end;

{$IFDEF kusers}	if CurrentUser<>nil then ByWho := CUrrentUser^.RecNo; {$ENDIF}

	Date.SetToToday;
	Time := '';
end;

procedure THistoryNote.CommonInit;
begin
	inherited CommonInit;
	New(Notes, init);{}
	SCodeCollection[scEvents]^.LogOn;
	SCodeCollection[scOutcomes]^.LogOn;
end;

destructor THistoryNote.Done;
begin
	SCodeCollection[scEvents]^.LogOff;
	SCodeCollection[scOutcomes]^.LogOff;
	Dispose(Notes, done);{}
	inherited Done;
end;


 {==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function THistoryNote.DisplayLine;
const Indent = 9;
var S,SS,SSS : string;
	 I : integer;
	 B : boolean;

begin
	{First line}
	S := SetLength(Date.Digit8,Indent);
	SS := ucase(ExpandScode(scEVents, Code));	if SS<>'' then SS := SS +': '; {CR+space(Indent);}

	{Codes}
	SS := SS + ExpandScode(scOutcomes, Outcome);
	if SS<>'' then S := S+ SS+CR+space(Indent);

	{Notes}
	if not Notes^.Loaded then Notes^.LoadText;
	if MaxLen-Indent<=1 then
		LSReWidth(Notes^.Text, 0)
	else
		LSReWidth(Notes^.Text, Maxlen-Indent-1);	 {rewidth to fit maxlen}
	for I := 1 to LSNumLines(Notes^.Text) do S := S+LSGetLine(Notes^.Text, I)+CRLF+Space(Indent);

	if pos(CR,S)>0 then begin {more than one line, so remove last indent & CR}
		while S[length(S)]<>CR do S := Copy(S,1,length(S)-1); {remove indent}
		S := Copy(S,1,length(S)-1); {remove last CR}
	end;

	DisplayLine := S;  {chop off last indent, etc}
end;


{*****************************************
 ***        SCREEN INPUT BOX           ***
 *****************************************}

procedure THistoryNote.MakeEditBox;
var	R: TRect;
		ForLine, ByLine, DateLine, OutLine, TypeLine : PView;

begin
	if not Notes^.Loaded then Notes^.LoadText;{}

	R.Assign(0, 0, 45, 18);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Quick Note',Caller, @Self));

	inherited MakeEditBox(EditBox, Caller);

	with EditBox^ do begin
		InsTitledField(9,  1,25, 1, '~F~or',  New(PInputDirectory, init(R, 30,  fiFullDirIdx, lsDirectory,'')));
		ForLine := Current;
		PInputELine(ForLine)^.MustInputToClose := True;

		InsTitledField(9,  2,25, 1, '~B~y',  New(PInputDirectory, init(R, 30,  fiCatDirIdx, lsDirectory, 'STA')));
		ByLine := Current;
		InsTitledField(9,  4,10, 1, '~D~ate', New(PinputDate, Init(R)));
		InsTitledField(28, 4, 6, 1, 'Time', New(PinputELine, Init(R,6)));

		InsTitledField(9,  6,33, 1, 'T~y~pe',New(PinputSCode, Init(R, scEvents))); TypeLine := Current;{}
		InsTitledField(9,  7,33, 5, '~N~otes', New(PInputFreeText, Init(R, 1000, 32, nil)));{}
		Insert(PINputFreeText(Current)^.VSCrollBar);

		InsTitledField(9, 13,33, 1, 'O~u~tcome', New(PinputSCode, Init(R, scOutcomes))); OutLine := Current;

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(20,15, @Self)));
		Insert(New(PjimmyCancelButton, init(31,15, @Self)));

		EndInit;

		if ForWho=-1 then
			ForLine^.Focus
		else
			if ByWho=-1 then
				ByLine^.Focus
			else
				if Code='' then
					TypeLine^.Focus {focus on type line}
				else
					OutLine^.Focus; {focus on outcome - rest typed OK}
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RHistoryNote : TStreamRec = (
		ObjType : srHistoryNote;
		VmtLink : Ofs(TypeOf(THistoryNote)^);
		Load : @THistoryNote.Load;
		Store : @THistoryNote.Store
	);

function ThistoryNote.RecSize;
begin RecSize := 50; end;

function THistoryNote.srType;
begin srType := srHistoryNote; end;


constructor THistoryNote.Load(var S : TDataStream);
var	Ver : byte;

begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			CommonInit;
			S.Read(ForWho, 4);
			S.Read(ByWho, 4);
			Date.Load(S);
			Time := S.ReadStr;
			S.Read(Code, sizeof(Code));
			Notes^.Load(S);{}
			S.Read(Outcome, sizeof(Outcome));{}
			ParentItemID := -1;
		end;
		2 : begin
			{v4.1 - added lock}
			inherited Load(S); {common init, lock, deleted marker}

			S.Read(ForWho, 4);
			S.Read(ByWho, 4);
			Date.Load(S);
			Time := S.ReadStr;
			S.Read(Code, sizeof(Code));
			Notes^.Load(S);{}
			S.Read(Outcome, sizeof(Outcome));{}
			ParentItemID := -1;
		end;
		3 : begin
			{added lock ptr2itemparent}
			inherited Load(S); {common init, lock, deleted marker}

			S.Read(ForWho, 4);
			S.Read(ByWho, 4);
			Date.Load(S);
			Time := S.ReadStr;
			S.Read(Code, sizeof(Code));
			Notes^.Load(S);{}
			S.Read(Outcome, sizeof(Outcome));{}
			S.Read(ParentItemID,4);
		end;
		4 : begin
			{set fixedstr reads/writes to save space - some overflowing}
			inherited Load(S); {common init, lock, deleted marker}

			S.Read(ForWho, 4);
			S.Read(ByWho, 4);
			Date.Load(S);
			Time := S.ReadStr;
			Code := S.ReadFixedStr(3);
			Notes^.Load(S);{}
			OutCome := S.ReadFixedStr(3);{}
			S.Read(ParentItemID,4);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'HistoryNote.Load',mfError,hcInternalErrorMsg);
		fail;
	end;
end;

procedure THistoryNote.StoreFields(var S : TDataStream);
var	Ver : byte;

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

	inherited StoreFields(S);

	S.Write(ForWho, 4);
	S.Write(ByWho, 4);
	Date.Store(S);
	S.WriteStr(@Time);
	S.WriteFixedStr(@Code, 3);
	Notes^.store(S);{}
	S.WriteFixedStr(@Outcome, 3);{}

	S.Write(ParentItemID, 4);

end;

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

function THistoryNote.GetJImmyID;
begin
	case jiType of
		1 : GetJImmyID := @ForWho;
		2 : GetJimmyID := @ParentITemID;
		3 : GetJimmyID := @ByWho;
	else
		GetJimmyID := nil;
	end;
end;

{-- Hooking to others -----}
function THistoryNote.NumHookTo;
begin NumHookTo := 1; end;

{for returning which jimmys ID's this jimmys should be hooked *to*}
procedure THistoryNote.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key, InsertBias);
	case httype of
		1 : begin
			HookToID := @ForWho;
			SubHookToID := @ParentItemID;
			hkType := hkHistory;
			if Date.Blank then	Key := SortKeyStart {Make sure appears at beginning}
			else Key := -Date.Days;  							{Reverse Sort on date}
			InsertBias := biStart;
		end;
	end;
end;

{********************************************
 ***             SET FORM CODES           ***
 ********************************************}
procedure THistoryNote.SetFormCodes;
var S : string;
begin
	inherited SetFormCodes(FormCodes); {loads supplements}
	if not Notes^.Loaded then Notes^.LoadText;

	with FormCodes^ do begin
		SetDate('DT', Date);
		{Changed date - see if date has changed from prev, if not.. hmmm.
		if GetCode('CDT') =                                              }
		{Text suitable for invoices}
		S := ExpandSCode(scEvents, Code) + #13#10 + LS2String(Notes^.Text);
		SetStr('TEXT', S);

		Insert(New(PFreeTextFormCode, init('NOTES', Notes^)));
	end;
end;


{********************************************
 ***             PRINT                    ***
 ********************************************}
procedure THistoryNote.PrintSummary;
var S : string;
		I : integer;

begin
	{======= PRINT SUMMARY ================}
	{Check to see if *likely* to run over page, and do a new page if nec (so
	trying to keep in discrete lumps}
	Device^.CheckForNewPage(1 + LSNumLines(Notes^.Text)+2);{}

	{First line}
	Device^.WriteStr(Date.Digit8+' ');

	if delspace(Code)<>'' then begin
		Device^.Writeln(ucase(ExpandScode(scEVents,Code)));
		Device^.WriteStr(space(11));
	end;

	{Notes}
	if not Notes^.Loaded then Notes^.LoadText;
	LSReWidth(Notes^.Text, Device^.Paper^.Width-13-Device^.Paper^.LeftMargin);
	for I := 1 to LSNumLines(Notes^.Text) do
		Device^.WriteStr(LSGetLine(Notes^.Text,I)+CRLF+Space(11));{}

	if delspaceR(Outcome)<>'' then
		Device^.Writeln(ExpandScode(scOutcomes, Outcome))
	else
		Device^.WriteStr(#13); {beginning of line w/o lf}
end;

function CreateHistoryNote;
begin	CreateHistoryNote := New(PHistoryNote, Init(PJimmyInitParam(P))); end;

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

begin
	{Register existence in sr list  - used by chain viewers}
	RegisterType(RHistoryNote);
	RegisterCreator(cmNewHistoryNote, CreateHistoryNote);

	RegisterSCodeType(scEvents,  'EVENTS.SC',  'Event Types', CostedSCodeCreator);
	RegisterSCodeType(scOutcomes,'Outcome.SC', 'Outcome Codes', StdScodeCreator);

{$IFDEF kqnote}
	RegisterNewWithList(lsHistory,  '~Q~uick Note',cmNewHistoryNote);

	{Register with desktop}
	RegisterNewWithList(lsDesktop, '~Q~uick Note', cmNewHistoryNote);
{	RegisterTask(DesktopTasks, cmNewHistoryNote, @CreateEditJimmy);{autodone}
{$ENDIF}

{$IFDEF klivestk}
	RegisterNewWithList(lsHerdHistory, '~Q~uick Note', cmNewHistoryNote);
{$ENDIF}
end.

