{****************************************************************************
 ***                                                                      ***
 *** New Fabbo Singing Dancing OOP                                        ***
 ***                            PACKING SLIPS                             ***
 ***                                                                      ***
 *** M Hill                                                    April 1994 ***
 ****************************************************************************}
{For placing PackingSlips with suppliers.  Based on invoices - sales PackingSlips - for
 nodes, etc}

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

INTERFACE

uses 	jimmys,
			objects,
			tuiedit, views,
			output,
			global,
			tui, menus, tasks,
			notes,
			nodes,
      kinvoice, kinvnode,
			dattime, inpdnt;

{*****************************
 ***  PackingSlip              ***
 *****************************}
const
 TPackingSlipSize = 100;

type
 PPackingSlip = ^TPackingSlip;
 TPackingSlip = object(TOrder)

		Ref				: string[5];

		ToWho    : longint;

		ItemTree : TNodeTree;

		Comment   : PNoteData;            {Text on PackingSlip}

    SentDate	: TDate;

	 {-- Methods --}
	 constructor Init(Params : pointer);
	 procedure   CommonInit; virtual;    {Extra initialisation, shared between init & load}
	 destructor Done; virtual;

	 {Display}
	 function DisplayLine(Maxlen : integer; View : word) : string; virtual;

	 {DataBase}
	 constructor Load(var S : TStream);
	 procedure   Store(var S : TSTream);              virtual;
		function    GetKey : word;                        virtual;

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

		procedure SetFormCodes(Output : PoutputStream; Prefix : String); virtual;
		function Print(prType : word; Output : Poutputstream) : word; virtual;

    procedure Send;

 end;

function CreatePackingSlip(P : pointer) : pointer; far;


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

var PackingSlipNewMenu : PMenu;


IMPLEMENTATION

uses  files,
			minilib,
			errors, messages,
			kamapp, app,
			jimhooks,
			setup,
			dialogs,
      idindex,  {id refs etc}
      kproduct,
			khistory, {for adding to new menu}
			inpdir, kdirctry;



{***********************************************************************
 ***                                                                 ***
 ***                      PackingSlip                                      ***
 ***                                                                 ***
 ***********************************************************************}
function CreatePackingSlip; begin CreatePackingSlip := New(PPackingSlip, Init(P)); end;

{--- Initialise - set ptrs to SC ---}
constructor TPackingSlip.Init;
begin
	inherited Init;

	if Params <> nil then ToWho := Plongint(Params)^ else ToWho :=-1;

  SentDate.Clear;

	Ref := '*NEW*';
end;

procedure TPackingSlip.CommonInit;  {Init shared betweeen load and init above}
begin
	inherited CommonInit;
	New(Comment, init);
	FileAdmin(fiInvoiceNodes)^.LogOn;
	ItemTree.Init(fiInvoiceNodes);
end;


destructor TPackingSlip.Done;
begin
	ItemTree.Done;

	FileAdmin(fiInvoiceNodes)^.LogOff;
	Dispose(Comment, done);
	inherited Done;
end;


{==== CREATE DISPLAY-LINE-FORMAT STRING ============}
function TPackingSlip.DisplayLine;
var S : string;

begin
 	S := SentDate.Digit8;
	S := S+' Packing Slip '+Ref;
	DisplayLine := S;
end;


{**************************************************************************
 ***                                                                    ***
 ***                  PackingSlip EDIT BOX                                    ***
 ***                                                                    ***
 **************************************************************************}
{========= DO EDIT =======================}
procedure TPackingSlip.MakeEditBox;
var
	R: TRect;
	InputNote : PInputNote;
	ViewOnly : boolean;
	S : string;
	ItemList : PDirNodeViewer; {need the dir pointer - owner of the owning jimmy}
	ScrollBar : PSCrollBar;
  ToWhoLine : PInputDirectory;


begin
	if not Comment^.Loaded then Comment^.LoadText;
  if not ItemTree.Loaded then ItemTree.LoadTree;

	ViewOnly := False;

	R.Assign(0, 0, 65,19);
	EditBox := New(PEditBox, init(R, 'Packing Slip',Caller));

	inherited MakeEditBox(EditBox, Caller);

	{Add input fields}
	with EditBox^ do begin

		InsTitledField(   7,  1, 5, 1, '~R~ef', New(PINputRefNum, init(R, 5, srPackingSlip)));

		InsTitledField( 7,  2, 38, 1,'~T~o', New(PInputDirectory, init(R, 38, fiFullDirIdx)));
    ToWhoLine := PInputDirectory(Current);

		{---- Item List ---}
		R.Assign(1,  4, Size.X-2, 13);
		New(ItemList, init(R, 0, PackingSlipNewMenu, ToWhoLine));
		InsLabel(11,  R.A.Y-1, 'Item ~L~ist', ItemList);
		Insert(ItemList^.VSCrollBar);   	{Scroll bar}
		ItemList^.ViewOnly := ViewOnly;
		Insert(ItemList);{}
		PInputDirectory(ToWhoLine)^.SetTargetLink(ItemList);

		{--- Comment box ---}
		R.Assign(7, 14, 38, 17);
		New(InputNote, Init(R, 200, 0, nil, EditBox));
		Insert(InputNote);
		InsLabel(7, 14, '~N~otes', InputNote);
		{Really want to have something better than not-selectable, because you may not see all
		the Comment at one time on-screen, and some sort of scrolling should be allowed}
		if ViewOnly then Current^.Options := Current^.Options and not ofSelectable;
		Current^.GrowMode := 0;

		InsTitledField(50, 14, 10, 1, 'Sent', New(PInputDate, init(R))); Current^.SetState(sfDisabled, True);

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(39,16, @Self)));
		InsCancelButton(49, 16);
{		Insert(New(PJimmyPrintButton, init(54, 19, @Self)));{}

  	EndInit;

    if (Ref <>'') and (ToWho<>-1) then ItemList^.Focus; {move focus straight to list}
	end;

end;


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

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

begin
	CommonInit;

	{--- Load fields -----}
	S.Read(Ver, 1);

	case ver of
		1 : begin
			S.Read(Ref, sizeof(Ref));
			S.Read(ToWho, 4);

			ItemTree.Load(S);

	    SentDate.Load(S);

			Comment^.Load(S);
	end;
	else
		DBaseError(nil,'Unrecognised PackingSlip Version '+B2Str(Ver),'');
	end;

end;



procedure TPackingSlip.Store(var S : TStream);
var
	StartPos : longint;
	ver : byte;

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

	S.Write(Ref, sizeof(Ref));
	S.Write(ToWho, 4);

	ItemTree.Store(S);

	SentDate.Store(S);

	Comment^.Store(S);

	TopUpRecord(S, TPackingSlipSize, StartPos);
end;

function TPackingSlip.GetKey;
begin
	if SentDate.Blank then
		GetKey := 0                 {Make sure appears at beginning}
	else
		GetKey := 65535-SentDate.Days;  {Reverse Sort on PackingSlip date}
end;

procedure TPackingSlip.StoreSelf;
begin
	StoreJimmy(@Self);
 	HookJimmyToID(@Self, ToWho, hkHistory, srPackingSlip);
end;


{*************************************************
 ***  SET CODES (FOR PRINT)                    ***
 *************************************************}
{=========== SET CODES ==========}
procedure TPackingSlip.SetFormCodes;
begin
	Output^.ClearCodes;

	Output^.SetCode('RTITLE','Packing Slip');

	Output^.SetCodedFunc('ITEMS',PrintInvoiceTree, @ItemTree);
{  SetInvoiceItemsCode(ItemTree, Output);{}

	Output^.SetCode('DT', SentDate.Digit10);        {PackingSlip date, not today}
	Output^.SetCode('REF', Ref+' ');

	{Comment block}
	if not Comment^.Loaded then Comment^.LoadText;
	Output^.SetCode('NOTES',Comment^.Extract(1,256));  {maximum amount extractable}

	{DirectoryItem stuff}
  SetJimmyIDFormCodes(ToWho, Output, 'TO');
  Output^.SetCode('TOADDDT', SentDate.Digit10); {Change address date; see CodedFuncDoAddress in kdirctry}
end;


{**************************************
 ***         PRINT PackingSlip           ***
 **************************************}
function TPackingSlip.Print;
var RootItem : PNodeItem;
		ItemNo  : longint;
		ItemprType : word;
		FormFile : text;
		COntrol : word;
		S :string;
		DirectoryItem : PDirectoryItem;
		EditBox : PEditBox;
		R : TREct;
		NumLabels : byte;

{========== PRINT PROC =======}
begin
	Print := cmCancel;

	if (prType and pmPrintAs)=prLabel then begin

		{----Print label ----}
    NumLabels := 1;

    if (prType and prDefer)>0 then begin

      {--- Deferred - ask for quantity -------}
			R.Assign(0,0,30,7);
			New(EditBox, init(R, 'Packing Slip Labels',nil));
			EditBox^.Options := EditBox^.Options or ofCentered;
			EditBox^.InsTitledField(16,2,3,1, 'No. Labels', New(PInputByte, init(R, 3)));
			EditBox^.InsOKButton(7,4, @NumLabels);
			EditBox^.InsCancelButton(18, 4);

			EditBox^.SetData(NumLabels);
			EditBox^.EndInit;

			Control := Desktop^.ExecView(EditBox);

			dispose(EditBox, done);

			if Control = cmCancel then exit;

    end;

  	FileAdmin(fiJimmys)^.LogOn;
		DirectoryItem := PDirectoryItem(JimmyStream^.GetAt(ToWho));
  	FileAdmin(fiJimmys)^.LogOff;

		if (prType and pmDefer)>0 then
			DirectoryItem^.DeferLabel(Today, adDelivery, NumLabels)
		else
			DirectoryItem^.DoLabelNow(Today, adDelivery, NumLabels);

		dispose(DirectoryItem, done);

		{For stromsholm, who do packing slips then print labels but not the packing slip}
		if SentDate.Blank then begin
			SentDate.SetToToday;
			Print := cmStore;
		end;

		exit;
	end;

	ThinkingOn('Printing');
	if (prType and pmScope) <> prFullPage then begin
		{--- Print summary for history print}
		Output^.Writeln(SentDate.Digit8+' Packing Slip '+Ref);
	end else begin
		{--- Print a packing slip -----}
		if not Comment^.Loaded then Comment^.LoadText;
    if not ItemTree.Loaded then ItemTree.LoadTree;

		{---- Print header ----}
		{Set up codes}
		SetFormCodes(Output,'');
		control := Output^.StartPrint('','PackingSlip');

		{Standard Form}
		if not Output^.FormFound then DBAseWarning('No Packing Slip form','Create PAKSLIP.HDR etc in Maintenance');

		{printing items now done in form}

		{PackingSlip Footer}
		SetFormCodes(Output,''); {overwrite any VTOT's etc that PackingSlip items have set}
		Control := Output^.EndPrint;

		{--- "Send" ----}
		{If print went OK, and date is blank, then send it}
		if (Control = cmOK) and (SentDate.Blank or TekkyMode) then Send;
  end;

	Print := cmStore;            {So chlist will save on return}
	ThinkingOff;
end;

	{Stock control on a tree}
	procedure DoNode(Node : PNodeItem); far;
  var Product : PProduct;
  		I : longint;
  begin
		if typeof(Node^)=typeof(TProductInvNode) then begin
			Product := PProduct(JimmyStream^.GetAt(PProductInvNode(Node)^.ProductID));

      I := Product^.GetArrayPosOfUnit(PProductInvNode(Node)^.Units);

      if I>-1 then begin
      	Product^.NumInstock[I] := Product^.Numinstock[I] - S2Lint(PProductInvNode(Node)^.Quantity);
        {allow for the fact that sales orders may not be being used}
        if Product^.Sold[I]>0 then Product^.Sold[I] := Product^.Sold[I] - S2Lint(PProductInvNode(Node)^.Quantity);

      	JimmyStream^.PutAt(PProductInvNode(Node)^.ProductID, Product);
      end;

			dispose(Product, done);
		end;
  end;

procedure TPackingSlip.Send;
begin
	SentDate.SetTotoday;

  {run through items doing stock control bit}
  if not ItemTree.Loaded then ItemTree.LoadTree;
  FileAdmin(fiJimmys)^.LogOn;
  ItemTree.ForEach(DoNode);
  FileAdmin(fiJimmys)^.LogOff;{}
end;


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

begin
{	New(FileAdmin(fiInvoiceNodes], init('PackingSlip Node Stream',NewPackingSlipNodeStream));{}

{$IFDEF kstock}
	{Register existence in history list  - used by chain viewers}
	RegisterHistoryItem('~P~acking Slip',cmNewPackingSlip, CreatePackingSlip);
	RegisterType(RPackingSlip);

	{Register Product PackingSlip item}
	AddItemEnd(PackingSlipNewMenu, NewItem('~P~roduct Item', '', kbNone, cmNewProductInvNode, hcNoContext,	nil));
{	RegisterCreator(cmNewProductInvNode, CreateProductInvNode);
	RegisterType(RProductInvNode); {already registered in kinvnode unit}
{$ENDIF}

	{Register one-off PackingSlips with desktop}
{	AppMenuBar^.Add2Menu('~N~ew',
		NewItem('~P~acking Slip', '', kbNone, cmNewPackingSlip, hcNoContext,
	nil));
	RegisterTask(DesktopTasks, cmNewPackingSlip, InsertPackingSlip);
{}
end.
