{************************************************************************
 ***                                                                  ***
 *** New Fabbo Singing Dancing OOP                                    ***
 ***                            STOCK CONTROL OBJECTS                 ***
 ***                                                                  ***
 *** M Hill                                                     Apr 97***
 ***********************************************************************}
{For making Purchase orders}

{$I compdirs}  {Compiler directives}
unit kStock;

INTERFACE

uses
			jimmys,
			tuiedit,
			objects,
			global,
			jimprint,
			views,
			forms, devices,
			files,
			dialogs,
			ordproc;

{*****************************
 ***  Packing Slip         ***
 *****************************}
type
	PPackingSlip = ^TPackingSlip;
	TPackingSlip = object(TOrder)

		constructor Init(Param : PJimmyInitParam);


		{--- Editing ----}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -
																																					eg selection lines, window headers, etc}
		{--- Printing ----}
		procedure PrintFull(const Device : PDeviceStream; const PrintAs : word); virtual;
		procedure GetDefaultPrintType(var PrintType : TJimmyPrintType; var PrintAs : PSItem; var PrintAsLink : pointer); 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}
		function PtrOffset : byte; virtual; {extra ver no}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		procedure OnPrinting(const PrintType : TJimmyPrintType); virtual;
		procedure Send; virtual; {printed/sent/whatever}

		procedure PrintLabel(const Device : PDeviceStream; LabelAs : word); virtual;
	end;


IMPLEMENTATION

uses tui, tuimsgs,
			idindex,
			inpdnt,
			dattime,
			notes,
			help,
			kinvsetu, {for checking overdue level}
			kdirctry, address,
			tasks,
			tuijimmy,
			jimhooks,
			minilib;


{***********************************************************************
 ***                                                                 ***
 ***                      PackSlip                                ***
 ***                                                                 ***
 ***********************************************************************}
constructor TPackingSlip.Init(Param : PJimmyInitParam);
begin
	inherited init(param);
	Date.Clear;  {sent date is set at first print}
end;

{==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TPackingSlip.DisplayLine;
var S : string;
begin
	S := Date.Digit8+' PACKING SLIP';

	DisplayLine := S;
end;


function TPackingSlip.GetName;
begin
	GetName := 'PAK #'+N2Str(Ref)+' '+GetJimmyIDName(ForWho,naRef,0)+' '+Date.Text(daDigit8);
end;


{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}

procedure TPackingSlip.MakeEditBox;
var	R: TRect;
		ForLine, RefLine, ByLine, PmntView, ItemView : PView;

begin
	R.Assign(0, 0, 70, 19);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Packing Slip',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(sizeof(TJimmy))));
		Insert(New(PSkipBytes, init(4+sizeof(TDate)))); {skip forop & lastprint}

		R.Assign(0,0,0,0); Insert(New(PStateField, init(RecNo)));
		Current^.SetState(sfDisabled, True);

		{price group}
		Insert(New(PSkipBytes, init(sizeof(TTotallerGroup))));

		{ref, etc}
		InsTitledField(7,  1, 5, 1, 'Ref', New(PInputRefNum, init(R,5, srPurchaseOrder)));
		Insert(New(PSkipBytes, init(4))); {oldref}
		InsTitledField(28, 1,10, 1, 'Send ~D~ate', New(PinputDate, Init(R)));

		ForLine := InsTitledField( 7,  3,30,1, '~T~o',  New(PInputDirectory, init(R, 30,  fiFullDirIdx, lsDirectory,'')));
		PInputELine(ForLine)^.MustInput := True;

		R.XYLD(50,3,10,1); Insert(New(PInputPStr, init(R, 10)));	AddLabel('Cust Ref', Current);

		ByLine  := InsTitledField( 7, 4,30,1, '~B~y',  New(PInputDirectory, init(R, 30,  fiFullDirIdx, lsDirectory,'')));

		ItemView := InsTitledField(7, 6,60,7, '~G~oods',
																New(PDlgHookView,	Init(R, lsSalesItems, 0, hkOrderItems, @Self, PJimmyEditBox(EditBox))));
		Insert(PHookViewer(ItemView)^.VScrollBar);

		InsTitledField(7, 14, 35, 4, 'N~o~tes', New(PInputFreeText, Init(R,200,20,nil)));

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

		EndInit;
	end;

	if ForWho=-1 then
		ForLine^.FOcus
	else
		ItemView^.Focus; {hmmm, this makes it automatically save...}
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}
function TPackingSlip.RecSize;
begin RecSize := 100; end;

function TPackingSlip.srType;
begin srType := srPackingSlip; end;

function TPackingSlip.PtrOffset;
begin PtrOffset := inherited PtrOffset + 1; end; {extra ver in load}

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

begin
	S.Read(Ver, 1);

	case Ver of
		1 : begin
			{v4.3a all in TOrder}
			inherited Load(S); {common init, lock, delete marker}
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TPackingSlip.Load',mfError,hcInternalErrorMsg);
		fail;
	end;
end;

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

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

	inherited StoreFields(S);
end;


{*****************************************
 ***  PRINTING                         ***
 *****************************************}
const
	PackingSlipPrintType : TJimmyPrintType =
		(Editor : edInternal;
		 Target : ptPrint;
		 DeviceName : '';
		 PrintAs : 0;
		 FormName : 'PAKSLIP';
		 NumCopies : 1;
		 PlusLabel : False);

procedure TPackingSlip.GetDefaultPrintType
										(var PrintType : TJimmyPrintType; var PrintAs : PSItem; var PrintAsLink : pointer);
begin
	PrintAs := 	nil;
	PrintType := PackingSlipPrintType;
	PrintAsLink := nil;
end;


procedure TPackingSlip.PrintFull;
begin	PrintForm(Device, 'PAKSLIP'); end;

procedure TPackingSlip.PrintLabel;
begin
	inherited PrintLabel(Device, apDelivery);
end;



procedure TPackingSlip.OnPrinting;
begin
	if State and osSent = 0 then Send;
	inherited OnPrinting(printType);
end;

procedure TPAckingSlip.Send;
begin
	inherited Send; {set osSent state}
	Date.SetToToday; {send date}
end;

{*****************************************
 ***  INITIALISATION/REGISTRATION      ***
 *****************************************}
const
	{--- Required for Stream ----}
	RPackingSlip : TStreamRec = (
		ObjType : srPackingSlip;
		VmtLink : Ofs(TypeOf(TPackingSlip)^);
		Load : @TPackingSlip.Load;
		Store : @TPackingSlip.Store
	);


function CreatePackingSlip(P : pointer) : pointer; far;
begin	CreatePackingSlip := New(PPackingSlip, init(P)); end;


begin
{$IFDEF fixit} writeln('KPakSlip...'); {$ENDIF}
	RegisterJimmy(RPackingSlip, CreatePackingSlip, lsHistory, '~P~acking Slip');

	{Register with desktop}
	RegisterNewWithList(lsDesktop, '~P~acking Slip', cmNewPackingSlip);{}
end.
