{*****************************************************************
 ***                      DEVICE STREAM                        ***
 *****************************************************************}
{provides a root stream for dos devices, handling forms, etc, that
should be descendable for modems, faxes, printers, etc}
{$I compflgs}
{$I compdirs} {for kusers for auto user check}
{$I-}  {In this unit, all errors should be self-detected}
unit devices;

INTERFACE

uses objects, global,
		files,{for reading filters}
		lstrings,
		{$IFDEF Windows}
			winmsgs,
		{$ELSE}
			tuiedit, views, tuimsgs,
		{$ENDIF}
		inpfname,
		tasks, {creator func}
		forms; {decoding codes, etc}

const
	{-- Standard codes --}
{	FF : char = #12;
	CR : char = #13;
	LF : char = #10;
	ESC : char = #27; see global}

	{---- st extensions ----}
	{see global

	{stTimeOut = 5;{should be errorinfo set}

	MaxLabelLines = 19;

	PaperExt = 'PFM';
	LabelPaperExt = 'LFM';

	{--- foxxx types ----}
	foASCII = $01; {normally set to True, non-ascii forms have
														to be treated differently to ascii ones.  eg
														DecodeLine normally expects the line string passed
														to correspond to a line on the form (therefor it can
														work out automatic indents, etc) but wordprocessors (eg
														WP51) have to be done by block, so indents must *not* be done!}
	foEndParaMarker = $02; {if true, adds an endparachar just before any CRLF}

type
	{====== DEVICE FILTER, FOR BOLD CODES, ETC =======}
	PDeviceFilter = ^TDeviceFilter;
	TDeviceFilter = object(TObject)
		Name    : string[30];
		InitSeq : string[50];
		FormFeed : char;
		PagePause : boolean; {pause on page breaks to allow change of paper}

		constructor Init(NName : string);
		function Edit : word; virtual;
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream);
		procedure SetFormCodes(const FOrmCodes : PFormCodeCollection); virtual;
	end;

{====== FORMS/PAPER TYPES ========}
type
	PPaper = ^TPaper;
	TPaper = object(TObject)
		LoadCodes : string[40]; {Codes to load this form}
		TopMargin : byte;
		LeftMargin : byte;
		Length : byte;       {Not including top margin}
		Width  : byte;       {Not including left margin}
		constructor Init;
		constructor Load(var S : TDataSTream);
		procedure  Store(var S : TDataStream); virtual;
		function Edit : word; virtual;
	end;

	PLabelPaper = ^TLabelPaper;
	TLabelPaper = Object(TPaper)
		{inherited Top/left margin are offset to first label}
		{Length and width become label length & width}
		LabelTopMargin : byte; {on each label}
		labelLeftMargin : byte;
		Rows : byte;    {#rows of labels on page}
		Columns : byte; {#cols of labels on page}
		RowGap : byte;  {#lines between rows}
		ColumnGap : byte; {#chars between cols}
		constructor Init;
		constructor Load(var S : TDataSTream);
		procedure  Store(var S : TDataStream); virtual;
		function Edit : word; virtual;
	end;


	{============ DEVICE =======================}
	PDeviceStream = ^TDeviceStream;
	TDeviceStream = object(TStream) {TStream provices status, etc}

		Name : string[30];						{user name, eg HP Laserjet, etc}

		{ready for dos files}
		DosFileName : FNameStr;
		DosFile : Text;                            {Output device}

		IsOpen : boolean;											{Flag to mark whether open}
		IsInitialised : boolean;
		Active : boolean; {marks whether done StartPrint and not yet EndPrint}
		Permanant : boolean; {marker whether to allow dispose - eg Printer, do not}

		Filter : PDeviceFilter;
		Paper : PPaper;

		{XPos,{}YPos : word;                   {current cursor pos from top of page}
		Page : word;												{current page number}
		TopMarginDone : boolean;
		PageCheck : boolean;								{check for end of page}
		JustMode : byte; 									{justification mode - see juxxx minilib}
		AutoSend : boolean;								{to automatically "send" (print/fax/etc) after endprint}
		AutoInit		: boolean; 						{whether to automatically do printer init}

		{for form processing}
		WriteBuffer : TLongString;			{contains codes processed so far.  See flush}
		FormCodes : PFormCodeCollection; {see forms unit}
		FormFound : boolean; 								{Access from other objects to see if form was found & processed}
		HeaderName1 : FNameStr;   {Current general (eg REPORT) header & footer file names}
		HeaderName2 : FNameStr;   {Current specific (eg WARRANTY, JOBNUM) header & footer file names}
		LastPage : boolean;									{marker used for endprint so endpage knows to use lastpage form}
		SkipBlankLines : boolean;						{for form processing....}

		{type of processing}
		FormOptions : byte; {see foxxx above}

{use <FAXTONUM> and <FAXTONAME>		FaxToNumber : string[30]; {See jimmys.pas unit, doesn't have to be a fax device...}


		{--- Stream Admin methods ---}
		constructor Init(NName : string; NDosFileName : FNameStr);
		procedure CommonInit; virtual;
		destructor Done;  virtual;
		procedure AppendOpen; virtual;
		procedure Open;   virtual;
		procedure Close;  virtual;

		procedure UpdateStatus; virtual; {checks for errors and updates status & errorinfo}
		function StatusText : string; virtual; {works out message from status & errorinfo}
		procedure CheckStatus(Msg : TMessageStr);  virtual;

		{-- paper layouts ---}
		procedure SetPaper(NPaper : PPaper);
		procedure SetPaperTo(const FullFileName : string);
		procedure SetNulPaper; virtual;

		{--- filters --------}
		procedure SetFilter(NFilter : PDeviceFilter);
		procedure SetFilterTo(const FullFileName : string);
		procedure SetNulFilter; virtual; {for descendants to override - called if NFilter above line is nil}

		{---- Print methods ------}
		procedure Initialise; virtual;          {sends initialisation codes}
		procedure StartPrint(NHeaderName1,NHeaderName2 : FNameStr); virtual;
										{tries 1 first, Start report - page no set to 0, initial codes}
		procedure EndPrint; virtual; {End ordinary print}
		procedure Send; virtual; {wp - prints, fax - faxes, etc}

		{---- Page functions -----}
		procedure FeedPage; virtual;  {Form Feed}
		procedure StartPage; virtual;
		procedure EndPage;  virtual; {Footers, etc}
		procedure NewPage; {End Page, add one to page no, start next page, etc}
		procedure CheckForNewPage(const Delta : integer);  {Allow for checking with mod to page length}
		function 	ReadyforEndOfPage(const Delta : integer) : boolean;

		{---- form methods -----}
		procedure ClearCodes;
		procedure SetDefaultCodes; virtual;
		procedure DoFormCode(Code, SubCode, Param : string);
		procedure LoadCodes(const S : String);
		procedure WriteCodedStr(S : String);
		procedure WriteFlushed(var LString : TLongString);
		procedure WriteCodedBlock(var LString : TLongString; const S : string);
		procedure Printform(FormName : FNameStr) ; virtual;

		{----- writing to stream -----}
		procedure DeviceWrite(const S : string); virtual; {override by descendants}
		procedure WriteStr(S : string); {Writes a string using devicewrite}
		procedure Writeln(S : string); {Writes a line (string +CR +LF)}
		procedure WriteLStr(LString : TLongString); {writes a long string}

		{---- reading from stream -----}
		function ReadCh : char; virtual;
		function ReadLn : string; virtual;
		procedure Flush; virtual;

		{---- editability ------}
		function Edit : word; virtual;
		procedure AddEditFields(EditBox : PEditBox); virtual;
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream);
	end;


	{for codes that affect the device itself}
	PFormCodeDevice = ^TFormCodeDevice;
	TFOrmCodeDevice = object(TFormCode)
		Device : PDEviceStream;
		constructor Init(NCode : string; NDevice : PDEviceStream);
		function Replace(const SubCode, Param : TFCodeStr; const Collection : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;

	{a bit like TFuncFormCode (see forms.pas) but flushes first, then calls
	replace direct from device print - see device^.writeflush}
	TFlushFunc = procedure(const Device : PDeviceStream; const Code, SubCode,Param : TFCodeStr; const Info : PObject);

	PFlushFormCode = ^TFlushFormCode;
	TFlushFormCode = object(TFormCode)
		Info : PObject; {is disposed of in done}
		Func : TFlushFunc;
		constructor Init(NCode : string; NFunc : TFlushFunc; NInfo : PObject);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																											var LString : TLongString) : boolean; virtual;

		procedure DoFunc(const Device : PDeviceStream; const SubCode, Param : TFCodeStr); virtual;
	end;


const
	{Standard nul/screen filter}
	NulFilter : TDeviceFilter = (Name : 'NUL Filter'; InitSeq : '';
																FormFeed : #12;
																PagePause : False
																);
	NulPaper : TPaper = (LoadCodes : ''; TopMargin : 0; LeftMargin : 0; Length : 0; Width : 0);
	A4StdPaper : TPaper = (LoadCodes : ''; TopMargin : 0; LeftMargin : 2; Length : 60; Width : 80);
	A4StdLabels : TLabelPaper = (LoadCodes : ''; TopMargin : 1; LeftMargin : 0; Length : 9; Width : 40;
										 LabelTopMargin : 0; LabelLeftMargin : 5; Rows : 7; Columns : 2; RowGap : 0; ColumnGap : 0);

function GetFilter(FileName : FNameStr) : PDeviceFilter;
function GetPaper(FileName : Fnamestr) : PPaper;{}
function GetDevice(FileName : Fnamestr) : PDeviceStream;{}

function EditPaper(var FullFileName : FNameStr; const Ext : string) : word;
function EditDevice(var FullFileName : FNameStr; const Ext : string; Creator : TCreatorFunc) : word;

procedure SetDevice(var Device : PDeviceStream;
										const BoxTitle, Ext,SetupCommand : string;
										const EditProc : TFileEditorProc);


IMPLEMENTATION

uses  dosutils, {for checking for form files}
			messtext,
			kamsetup, stddlg, {for setdevice}
			tuiboxes,
			help,
			minilib,
			app;

{********************************************
 ***           FORM CODES                 ***
 ********************************************}

{Device Stream form code object}
constructor TFormCodeDevice.Init;
begin
	inherited Init(NCode);
	Device := NDevice;
end;

function TFormCodeDevice.Replace;
begin
	Device^.DoFormCode(Code^,SubCode,Param);
	LSClear(LString);
	Replace := True;
end;


constructor TFlushFormCode.Init;
begin
	inherited Init(NCode);
	Func := NFunc;
	Info := NInfo;
end;

destructor TFlushFormCode.Done;
begin
	if Info<>nil then dispose(Info, done);
	inherited Done;
end;

function TFlushFormCode.Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean;
begin
	LSInsertStr(LString, 'FLUSH ', 1);
{	LSClear(LString);
	if ReplaceStr <> nil then LSAppendStr(LString, ReplaceStr^);{}
end;


procedure TFlushFormCode.DoFunc(const Device : PDeviceStream; const SubCode, Param : TFCodeStr);
begin
	Func(Device, Code^, SubCode, Param, Info);
end;


{**************************************************************************
 ***                                                                    ***
 ***                           DEVICE STREAM                            ***
 ***                                                                    ***
 **************************************************************************}

{=== INITIALISE STREAM ============}
constructor TDeviceStream.Init;
var I : integer;
begin
	inherited Init;
	DosFIleName := NDosFileName;
	Name := NName;

	CommonInit;
end;

procedure TDEviceStream.CommonInit;
begin
	IsOpen := False;
	IsInitialised := False;
	Status := stOK; {so far....!}

	{XPos := 0;{} YPos := 0; Page := 0;
	PageCheck := True;
	Active := False;

	LSNew(WriteBuffer);
	FormOptions := foASCII;
	SkipBlankLines := False;
	LastPage := False;
	FormFound := True;
	HeaderName1 := '';
	HeaderName2 := '';
	New(FormCodes, init);

	SetNulFilter;
	SetNulPaper;

	SetDefaultCodes;

	JustMode := juLeft;
	AutoSend := True;
	AutoInit := True;

	Permanant := False;

	TopMarginDone := False; {used to mark whether topmargin done, so first
	call to write for any page does the topmargin.  Can't really do at real
	start of page because then any <PAPER> or <TM> type of codes in a header
	form are completely wasted.  Now if they are on the first line, they
	will be acted on correctly, *before* anything is printed}

end;


destructor TDeviceStream.Done;
begin
	if Permanant then begin
		ProgramWarning('Trying to dispose of '+Name+#13#10'Which is Permanant',hcInternalErrorMsg);
		exit;
	end;

	LSDispose(WriteBuffer);
	if IsOpen then CLose;
	dispose(Filter, Done);
	dispose(Paper, DOne);
	if FormCodes<>nil then dispose(FormCodes, done);
	inherited Done;
end;

procedure TDeviceStream.Open;
begin
	Reset;
	Assign(DosFile, DosFileName);        {Open device path}
	Rewrite(DosFile);                   {And prepare to output}
	TDeviceStream.CheckStatus('Could not open '+DosFileName); {just do devicestream check,
																which checks for ioresult problems, not bios stuff, etc}
	if Status<>stOK then
		Status := stOpenError
	else
		IsOpen := True;

	IsInitialised := False; {wrong place to do it for devices like printers
		that remain on, but handy jic}
end;

procedure TDeviceStream.AppendOpen;
begin
	Reset;
	Assign(DosFile, DosFileName);        {Open device path}
	Append(DosFile);                   {And prepare to output}
	if IOResult=2 then Rewrite(DosFile); {if no file}

	TDeviceStream.CheckStatus('Could not append open');

	if Status<>stOK then
		Status := stOpenError
	else
		IsOpen := True;

	IsInitialised := False; {see above}
end;

procedure TDeviceStream.Close;
begin
	Flush;
	IsOpen := False;
{	IsInitialised := False; {wrong place to do it - eg, if printer stays switched on physically}
	System.Close(DosFile);

	ErrorInfo := IOResult;
	if ErrorInfo<>0 then begin
		ProgramWarning('Error Closing '+DosFileName+#13#10+IOError(ErrorInfo),hcIOErrorMsg);
		Status := stCloseError;
	end;
end;


{=== CHECK STATUS ==================}
procedure TDeviceStream.UpdateStatus;
begin
	ErrorInfo := IOResult;
	if ErrorInfo<>0 then Status := stError else Status := stOK;
end;

function TDeviceStream.StatusText;
var S : string;
begin
	S := '';
	case Status of
		stError				: S := 'Error'#13;
		stInitError   : S := 'Initialising Error'#13;
		stOpenError 	: S := 'Open Error'#13;
		stReadError 	: S := 'Read Error'#13;
		stWriteError 	: S := 'Write Error'#13;
		stAbandoned 	: S := 'User Abandoned'#13;
		stFormOpenError : S := 'Could not Open Form'#13;{couldn't open form}
		stFormReadError : S := 'Error Reading Form'#13;
	end;
	StatusText := S+IOError(ErrorInfo);
end;

procedure TDeviceStream.CheckStatus;
begin
	UpdateStatus;
	if Status<>stOK then
		 ProgramWarning('Device "'+Name+'" Error '+#13
											+Msg+#13
											+StatusText,
										hcDeviceErrorMsg);
end;

{====== FLUSH BUFFER =============}
{not used at the moment methinks}
procedure TDeviceStream.Flush;
begin
	if LSLen(WriteBuffer)>0 then WriteLStr(WriteBuffer);
	LSClear(WriteBuffer);
end;

{=== SET PAPER ====================}
procedure TDeviceStream.SetPaper;
begin
	dispose(Paper, done);
	if NPaper = nil then
		SetNulPaper
	else
		Paper := NPaper;

	{if the stream is running then do loadcodes,
	to switch tray, etc.  o/w leave, as the initialise routine will do it}
	if IsOpen and IsInitialised and (Paper^.LoadCodes<>'') then
		LoadCodes(Paper^.LoadCodes); {copes with ESC.. and <8LPI><12CPI>}
end;

procedure TDeviceStream.SetPaperTo(const FullFileName : string);
var P : PPaper;
begin
	if GetJustFileName(FullFIleName)<>'' then
		P := PPaper(GetObjFromFile(FullFileName))
	else
		P := nil;

	if (GetExt(FullFileName)=LabelPaperExt) and (P=nil) then
		P := New(PLabelPaper, init);

	SetPaper(P);
end;


{=== SET FILTER ====================}
procedure TDeviceStream.SetFilter;
begin
	dispose(Filter, done);
	if NFilter=nil then
		SetNulFilter
	else
		Filter := NFilter;

	if FormCodes<>nil then Filter^.SetFormCodes(FormCodes);
end;

procedure TDeviceStream.SetNulFilter;
begin
	Filter := New(PDevicefilter, init('Nul')); Filter^ := NulFilter;
end;

procedure TDeviceStream.SetNulPaper;
begin
	Paper := New(PPaper, init); Paper^ := NulPaper;
end;

procedure TDeviceStream.SetFilterTo(const FullFileName : string);
begin
	if (delspace(FullFileName)<>'') and (FullFileName[1]<>'.') then
		SetFilter(PDeviceFilter(GetObjFromFile(FullFileName)));
end;


{*********************************************************
 ***              PRINT HANDLING                       ***
 *********************************************************}
{=== Start general prints =====}
procedure TDeviceStream.StartPrint(NHeaderName1, NHeaderName2 : FNameStr);
begin
	LastPage := False; {not last page yet}
	Page := 1; YPos := 0; {XPos := 0;{}
	PageCheck := True;
	Active := True;

	if IsOpen and (Status<>stOPenError) then Reset; {starting another print, so try again}

	if not IsOpen then Open;
	if not IsInitialised and AutoInit then Initialise;

	HeaderName1 := NHeaderName1;
	HeaderName2 := NHeaderName2;

	StartPage;
end;

procedure TDeviceStream.EndPrint;
begin
	LastPage := True; {mark as lastpage so endpage knows what footer to put in}
	if Status = stOk then EndPage;  {End of page footers}
	if (Status = stOK) and (PageCheck) then FeedPage; {feed page}
	Active := False;
{	Dispose(FormCodes, done); {see above startprint}
{	FormCodes := nil;{}
	if AutoSend then Send;
	ClearCodes;
end;

procedure TDeviceStream.Send;
begin end;

{=== INITIALISE ====================}
procedure TDeviceStream.Initialise ;
begin
	if Filter^.InitSeq<>'' then	LoadCodes(Filter^.InitSeq);
	if Paper^.LoadCodes<>'' then LoadCodes(Paper^.LoadCodes);
	if Status = stOk then IsInitialised := True;
end;

{*********************************************************
 ***              PAGE HANDLING                        ***
 *********************************************************}

{====== START PAGE ========================}
{At top of form, do headers, etc}
procedure TDeviceStream.StartPage ;
begin
	if Status<>stOK then exit;

	if Filter^.PagePause then
		PauseMessage('Printer','About to start new page'#13#10'Align paper, etc', hcPausePage);

	TopMarginDone := False;

	FormCodes^.SetStr('PN', N2Str(Page)); {set page number code}

	{=== HEADER 1 ================}
	if pos('.',HeaderName1)>0 then
		{extension specified, so use it}
		PrintForm(HeaderName1)
	else
		{On page one, we'll print form .HD1 if it exists (HDR o/w)}
		if Page = 1 then begin
			PrintForm(HeaderName1+'.HD1');
			if not FormFound then PrintForm(HeaderName1+'.HDR');
		end else
			PrintForm(HeaderName1+'.HDR');     {eg REPORT.HDR, LETTER.HDR, etc}

	{=== HEADER 2 ================}
	{If it doesn't exist, then try secondary form}
	if (Status = stOK) and (not FormFound or (HeaderName1='')) then begin
		if pos('.',HeaderName2)>0 then
			{extension specified, so use it}
			PrintForm(HeaderName2)
		else
			if Page = 1 then begin
				PrintForm(HeaderName2+'.HD1');
				if not FormFound then PrintForm(HeaderName2+'.HDR');
			end else
				PrintForm(HeaderName2+'.HDR');     {eg REPORT.HDR, LETTER.HDR, etc}
	end;
end;

{============= END PAGE ======================}
{At bottom of page, print footers, etc, but do not feed}
procedure TDeviceStream.EndPage ;
var TempLength : word;
		TempPC : boolean;
begin
	if Status <> stOK then exit; {if not outputting, don't start printing}

 {Temporarily switch off page end checking, so that footers can be printed}
	TempPC := PageCheck;
	PageCheck := False;

	{On last page, we'll print form .FTL if it exists (FTR o/w)}
	if LastPage then begin
		PrintForm(HeaderName1+'.FTL');
		if not FormFound then PrintForm(HeaderName1+'.FTR');
	end else
		PrintForm(HeaderName1+'.FTR');

	{Similarly with secondary header}
	if (Status = stOk) and (not FormFound or (HeaderName1='')) then begin
		if LastPage then begin
			PrintForm(HeaderName2+'.FTL');
			if not FormFound then PrintForm(HeaderName2+'.FTR');
		end else
			PrintForm(HeaderName2+'.FTR');
	end;

	PageCheck := TempPC;
end;

{============= FEED NEXT SHEET ==================}
procedure TDeviceStream.FeedPage ;
begin
	if Status=stOK then begin  {Form feed, reset variables}

		if Filter^.FormFeed<>#0 then begin
			CheckStatus('Feeding Page');
			if Status = stOK then begin
				DeviceWrite(Filter^.FormFeed + CR); { add only CR to start in col 1, and use DeviceWrite to avoid left margn spaces}
				CheckStatus('Feeding Page');
			end;
		end else begin
			{no form feed character - new lines to end of page}
			PageCheck := False;
			while YPos<Paper^.Length do Writeln('');
			PageCheck := True;
		end;

		{XPOs := 0;{} YPos := 0;
		inc(Page);
	end;
end;

{Use check for new page between form prints if wished - so that invoice items,
search records, etc appear complete on each page}
{Parameter Delta used so, for eg, advance checks can be made for a new page
appearing in the next 4 lines - do CheckForNewPage(+4)}
procedure TDeviceStream.CheckforNewPage(const Delta : integer);
begin
	if ReadyForEndOFPage(Delta) then NewPage;
end;

function TDeviceStream.ReadyforEndOfPage(const Delta : integer) : boolean;
begin
	ReadyForEndOfPAge := False;
	if PageCheck and (Status=stOK) then
		if typeof(Paper^)<>typeof(TLabelPaper) then
			{label paper gets a new page when number of labels done, not at a line number}
			if ((YPos+Delta)>Paper^.Length) and (Paper^.Length<>0) then
				ReadyForEndOfPAge := True;
end;


{========== NEW PAGE ===================}
{Finish current page, feed new sheet, start next page}
procedure TDeviceStream.NewPage ;
begin
	EndPage;      {First finish off current page}
	FeedPage;     {Feed new page}
	StartPage;    {Then start next one}
end;

{*********************************************************
 ***                 FORMS                             ***
 *********************************************************}
procedure TDeviceStream.ClearCodes;
begin
	if FormCodes<>nil then begin
		FormCodes^.Clear;
		SetDefaultCodes;
	end;
end;

procedure TDeviceStream.SetDefaultCodes;
begin
	Filter^.SetFormCodes(FormCodes);
	with FormCodes^ do begin
		SetStr('RTITLE', 'REPORT');
		SetStr('RPTDESC', ''); {in case not set before printing}
		SetStr('LISTHDR', '');

		{when these codes are encountered, the DoFormCOde method is called}
		Insert(New(PFormCodeDevice, init('TM', @Self)));
		Insert(New(PFormCodeDevice, init('LW', @Self)));
		Insert(New(PFormCodeDevice, init('PL', @Self)));
		Insert(New(PFormCodeDevice, init('LM', @Self)));
		Insert(New(PFormCodeDevice, init('SBL', @Self)));
		Insert(New(PFormCodeDevice, init('PBL', @Self)));
		Insert(New(PFormCodeDevice, init('PBT', @Self)));
		Insert(New(PFormCodeDevice, init('PAPER', @Self)));
		Insert(New(PFormCodeDevice, init('FORM', @Self)));
		Insert(New(PFormCodeDevice, init('AL', @Self)));
		Insert(New(PFormCodeDevice, init('AP', @Self)));
		Insert(New(PFormCodeDevice, init('FF', @Self)));

		{justification types}
		Insert(New(PFormCodeDevice, init('JF', @Self)));
		Insert(New(PFormCodeDevice, init('JL', @Self)));
		Insert(New(PFormCodeDevice, init('JR', @Self)));
		Insert(New(PFormCodeDevice, init('JC', @Self)));


		{standard user...}
		{$IFDEF Kusers}
		{WIBN, but it suddenly drags in users 'n' stuff to a simple device
		object....}
{		if CurrentUser<>nil then
			Insert(New(PJimmyFormCode, init('USER', CUrrentUser^.RecNo)));{}
		{$ENDIF}
	end;
end;

procedure TDeviceStream.DoFormCode;
var I : integer;
		SavePageCheck : boolean;
begin
	{strip numbers off code and add to parameter}
{	while Pos('01234567890+-',Code[length(Code)])>='0' do begin
	end;{at this stage it's already gone through the checker - will only trap
	full codes....}

	if Param[1]='/' then Param := Copy(Param, 2, length(Param)); {chop off initial slash}

	{Formatting commands}
	if Code = 'TM' then Paper^.TopMargin := S2Num(Param);
	if Code = 'LW' then Paper^.Width := S2Num(Param);
	if Code = 'PL' then Paper^.Length := S2Num(Param);
	if Code = 'SBL' then SkipBlankLines := True;
	if Code = 'PBL' then SkipBlankLines := False;

	if Code = 'JL' then JustMode := juLeft;
	if Code = 'JR' then JustMode := juRight;
	if Code = 'JC' then JustMode := juCentre;
	if Code = 'JF' then JustMode := juFull;

	{Left margin - allow for relative changes}
	if (Code = 'LM') then begin
		I := S2Num(Param);
		if ((Param[1] = '+') or (Param[1]='-')) then
			inc(Paper^.LeftMargin,I) {not range checked - so it won't crash if user does summink stupid with the margins}
		else
			Paper^.LeftMargin := I;
	end;

	{Test page break}
	if Code = 'PBT' then CheckForNewPage(S2Num(Param));

	{New paper}
	if (Code = 'PAPER') and (Param<>'') then begin
{		if Param[1]='/' then Param := Copy(Param,2,length(param));{}
		if pos('.',Param)=0 then Param := '.'+PaperExt;
		SetPaperTo(PrintersPath+Param);
	end;

	{include another form - useful for including other headers, etc...}
	if (Code = 'FORM') and (Param<>'') then begin
{		if (Param[1]='/') then Param := Copy(Param,2,length(param));{}
		PrintForm(Param);
	end;

	{Form feed}
	if Code = 'FF' then FeedPage;

	{Advance to line}
	if ((FormOptions and foASCII)>0) and (Code = 'AL') then begin
		SavePageCheck := PageCheck;
		PageCheck := False;
		for I := YPos to S2Num(Param) do writeln('');
		PageCheck := SavePageCheck;
	end;

	{advance to position}
{	if ASCIIForms and (Code = 'AP') then begin
		LSClear(Replace);
		if XPos+CodeXPos<S2Num(Param) then String2LS(space(S2Num(Param)-XPos-CodeXPos), Replace);
		Code := '';
	end;

{}
end;

{============ PRINT FORM =================================}

{ASSUMES Normal ASCII type of form, which it deals with line by line.
Descendants will have to deal with peculiar stuff (like WP forms)}
{Doing it line by line means that margins, etc set in the origingal form
will work where expected.  Note that codes that are replaced with multiple lines
with eg margin changes within it, will end up having the margins, etc changed
before the line is printed, ie while being processed....}
procedure TDeviceStream.PrintForm(FormName : FNameStr);
var
	FormFile : text;
	Line : string;

begin
	if not IsOpen then begin
		programWarning('Device not Open at PrintForm'#13#10'Opening',hcInternalErrorMsg);
		Open;
	end;

	if (Status<>stOK) or (FOrmName[1]='.') then exit; {status bad or no name given}

	if Pos('\',FormName)=0 then FormName := FormsPath+FormName;  {If no path specified, go for main data path}

	ErrorInfo := IOResult; {Clear IOResult}
	Assign(FormFile, FormName);
	System.Reset(FormFile);
	ErrorInfo := IOResult;

	if ErrorInfo<>0 then begin

		{Form not readable}
		FormFound := False;
		if (ErrorInfo<>2) and (ErrorInfo<>3) then begin {File Not Found/Path not found = form not written}
			ProgramError('Could not do Form '+FormName+#13#10+IOError(ErrorInfo), hcIOErrorMsg);
			Status := stFormOpenError;
		end;

	end else begin
		{Form was found, so print it}
		FormFound := True;

		Line := '';

		while (not eof(FormFile)) and (Status = stOK) and (Pos('<END>',Line)=0) do begin
			System.Readln(FormFile, Line);

			{Check for error reading}
			ErrorInfo := IOResult;
			if (ErrorInfo<>0) and (ErrorInfo<>100) then begin {No problem, or Read passed end of file}
				ProgramWarning('Could not read form '+FormName+#13#10+IOError(ErrorInfo),hcIOErrorMsg);
				Status := stFormReadError;
			end;

			{Decode}
			WriteCodedStr(Line+CRLF); {decode Line}
		end;

		System.Close(FormFile);

	end;
end;


{a slight variation on the standard decoding, assumes codes from filter
or paper loadcodes, ie either escape codes or <> codes to other codes.  eg
an envelope loadcode might want the biggest font <CPI10><L+> and set
portrait mode <PORTRAIT>, or it might be a set of ESC codes, ie ESC nnn...:
or it might be a !R! from ye olde kyocera, or 18 for an epson...}
procedure TDeviceStream.LoadCodes(const S : String);
begin
	if S<>'' then
		{use devicewrite to bypass formatting --> top margins, etc}
		if S[1]='<' then
			DeviceWrite(FormCodes^.QDecodeStr(S))
		else
			DeviceWrite(DecodeESC(S));
end;

{assumes dealing with ascii forms/input, and so no codes across line
boundaries, and dealing with a whole number of lines at a time}
procedure TDeviceStream.WriteCodedStr(S : String);
var LString : TLongString;
		L : integer;
begin
	if Status<>stOK then exit;

	LSNew(LString);
	String2LS(S, LString);
	FormCodes^.DecodeLString(LString,(FormOptions and foASCII)>0);
	if LSPos('<FLUSH ', LString)<>LSNotFound then WriteFlushed(LString);
	WriteLStr(LString);
	LSDispose(LString);
end;


{in order to deal with codes that might lie across string boundaries (eg when
reading data from a textdata stream) we need to keep, say, 50 chars back from
being written that will be stuck on the beginning of the next chunk and
decoded.  This procedure uses LString as the running print string, with
S as the new string to be printed - LString will usually be returned with
the last 50 chars (or whatever) that is being kept back}
procedure TDeviceStream.WriteCodedBlock(var LString : TLongString; const S : string);
var LS : TLongString;
begin
	if Status<>stOK then exit;

	LSAppendStr(LString, S);
	FormCodes^.DecodeLString(Lstring,(FormOptions and foASCII)>0);
	if LSPos('<FLUSH ',Lstring)<>LSNotFound then WriteFlushed(LString);
	if LSLen(LString)>50 then begin
		LSNew(LS);
		LSCopy(LS, LString, 0, LSLen(LString)-50); {copy from lstring to ls, not incl last 50 chars}
		LSDelete(LString,0,LSLen(LString)-50);
		WriteLStr(LS);
		LSDispose(LS);
	end else begin
		WriteLStr(LString);
		LSClear(LString);
	end;
end;

{--- WRITE FLUSHED ----}
{The idea behind the <FLUSH xxxxx> codes is that all the codes up to that
point are decoded *and written*.  This means that the special form decoder
(derivitive of TFlushFormCode) can write direct to the device rather than
having to insert the replacement into a lstring. This means that we can
use a code for hook chains for example, where the code is, eg, <NOTES>,
is replaced by <FLUSH NOTES>, all the form is decoded *and written* up to
the first bracket, and the form code decoder then does a printform for
each item in the notes list, then returns to here...}
procedure TDeviceStream.WriteFlushed(var LString : TLongString);
var LS : TLongString;
		W1,W2 : word;
		Code,SubCode, Param : TFCodeStr;
		FormCode : PFormCode;

begin
	LSNew(LS);
	W1 := LSPos('<FLUSH ',Lstring);
	W2 := LSPosFrom('>',LString, W1);

	while (W1<>LSNotFound) and (W2<>LSNotFound) do begin
		{write up to code}
		if W1>0 then begin
			LSCopy(LS, LString, 0, W1); 	{copy up to beginning of code}
			WriteLStr(LS);                {write pre-code}
		end;

		{extract code}
		Code := LSGetString(LString, W1+7, W2-W1-7);

		FormCodes^.SplitCode(Code, Code, Param);

		FormCode := FormCodes^.DottedGetFormCode(Code, SubCode);

		if FormCode=nil then begin
			{This may be caused by, eg, COY.NOTES, which will be replaced by
			the right replacement}
			ProgramWarning('Could not handle Flush Code'#13#10
											+LSGetString(LString, W1, W2-W1+1)+' devices unit', hcFormCodeErrorMsg);
		end else begin
			{*assume* special code...}
			PFlushFormCode(FormCode)^.DoFunc(@Self, SubCode, Param);
		end;

		LSDelete(LString, 0, W2+1);   	{and remove from lstring}

		W1 := LSPos('<FLUSH ',Lstring);
		W2 := LSPosFrom('>',LString, W1);
	end;

	LSDispose(LS);
end;



{**************************************************************************
 ***                           WRITING                                  ***
 **************************************************************************}
{override for different devices}
procedure TDeviceStream.DeviceWrite(const S : string);
begin
	if Status<>stOK then exit;

	System.Write(DosFile, S);

	{this unit has $I- throughout, so check it's OK}
	ErrorInfo := IOresult;
	if ErrorInfo<>0 then begin
		ProgramWarning('Could not write to device '+Name+#13#10
											+IOError(ErrorInfo)+#13#10
											+DosFileName,
										hcDeviceErrorMsg);
		Status := stWriteError;
	end;
end;


{=== WRITE STRING ==============================}
procedure TDeviceStream.writeStr;
var I : integer;
		P : byte;
		Line : string;
begin
	{--- Safety checks -----}
	if not IsOpen then begin
		ProgramError('DEVICE '+Name+' NOT OPEN AT WRITESTR', hcInternalErrorMsg);
		exit;
	end;

	if Status<>stOK then exit;

	{check *before* writing for those devices that can pre-empt errors, eg printers}
	CheckStatus('Writing '+delspace(copy(S,1,10))+'...');
	if Status<>stOK then exit;

	{--- Check for top margin -----}
	{don't want to do the topmargin until we
	actually start printing something, so this is set to false on startpage
	and done as soon as it gets here...}
	if not TopMarginDone then begin
		TopMarginDone := True; {so we don't loop}
		if Paper^.TopMargin>0 then
			{write blank lines, Write() func will add left margin}
			for I := YPos+1 to Paper^.TopMargin do DeviceWrite(CRLF); {don't do Writeln as SkipBlankLines would skip it}

		S := space(Paper^.Leftmargin)+S; {add left margin to first line of page -
																										left margin bit below will do for all future CR's, }
	end;

	{--- Add endpara markers ----}
{	if (FormOptions and foEndParaMarker)>0 then begin
		I := 1;
		while Pos(#13,Copy(S,I,length(S)))>0 do begin
			I := I+Pos(#13,Copy(S,I,length(S)));  {Move marker along}
{			S := Copy(S,1,I-2)+EndParaChar+Copy(S,I-1,length(S)); {Insert marker}
{			inc(I); {skip past newly inserted marker}
{		end;
	end;{}

	if (FormOptions and foASCII)>0 then begin
		{--- ASCII line processing -----}
		{for multi-line strings... do one line at a time to check for new pages,
		blank lines, and eop markers}
		{NB - assume a cr precedes all lf's - o/w we may have a problem with split crlf's when printing blocks}
		{NB - if no .hdr is defined for a form, this can cause real problems
		with newpages/top margins/etc in the checkfornewpage here...}
		I := 1;
		P := pos(#10,S);
		while P>0 do begin
			inc(YPos); {work out new ypos from LF's}
			Line := Copy(S,1,P); {last two chars are #13#10}
			S := copy(S,P+1,256);

			{check for endpara marker}
			if ((FormOptions and foEndParaMarker)>0) and (pos(#13,Line)>0) then
				Line := Copy(Line, 1, pos(#13,Line)-1)+EndParaChar+Copy(Line,pos(#13,Line),256);

			{check for blank line}
			if not SkipBlankLines or ((delspaceL(Line)<>#13#10) and (delspaceL(Line)<>EndParaChar+#13#10)) then
				DeviceWrite(Line+space(Paper^.LeftMargin));

			{check for new page}
			CHeckForNewPage(0);
			P := pos(#10,S);
		end;
{		XPos := length(S);{}
		if length(S)>0 then DeviceWrite(S); {write remainder}
	end else
		{----- NON ASCII ---------------}
		{Just write it out}
		DeviceWrite(S);

	{check status after writing for errors in devicewrite}
	CheckStatus('Writing '+copy(S,1,10)+'...');
end;

{=== WRITE LINE ==================}
procedure TDeviceStream.Writeln;
begin
	writeStr(S+CRLF); {this should do checks for blank lines, etc}
end;

{===== WRITE LONGSTRING ===========}
procedure TDeviceStream.WriteLStr(LString : TLongString);
var L : word;
begin
	if (Status<>stOK) or (LSLen(LString)=0) then exit;

	{print block by block - don't worry about xpos/ypos and it may be more
	than 256 chars between crlf (eg wp5.1) so do by 200 char block}
	while LSLen(LString)>200 do begin
		writeStr(LSGetString(LString,0,200));
		LSDelete(LString, 0, 200);
	end;
	{write remainder}
	writeStr(LS2String(LString));
end;

{**************************************************************************
 ***                           READING                                  ***
 **************************************************************************}
function TDeviceStream.ReadCh : char;
begin ReadCh := #0; end;

function TDeviceStream.Readln : string;
begin Readln := ''; end;


{**************************************************************************
 ***                           EDITABILITY                              ***
 **************************************************************************}
function TDeviceStream.Edit : word;
var EditBox : PEditbox;
		R : TRect;

begin
	if IsOpen then begin
		ProgramWarning(Name+' in use, let it finish first',hcEditDeviceInUseMsg);
		exit;
	end;

	R.Assign(0,0,36,11);
	New(EditBox, init(R,Name, nil));

	with EditBox^ do begin
		Options := Options or ofCentered;

		Insert(New(PSkipBytes, init(sizeof(TStream))));

		InsTitledField(12,  1,20, 1, 'Name', New(PinputELine, Init(R, 30)));
		AddEditFields(EditBox);

		InsOKButton(    14,Size.Y-3, @Self);
		InsCancelButton(25,Size.Y-3);

		EndInit;

		SetData(Self);
	end;

	Edit := Desktop^.ExecView(EditBox);

	dispose(Editbox, done);
end;

procedure TDeviceStream.AddEditFields(EditBox : PEditBox);
begin end;

constructor TDeviceStream.Load(var S : TDataStream);
var Ver : byte;
begin
	CommonInit;
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			Name := S.REadStr;
			DosFileName := S.REadStr;
		end;
	end;
end;

procedure TDeviceStream.Store(var S : TDataStream);
var Ver : byte;
begin
	Ver := 1; S.Write(Ver, 1);
	S.WriteStr(@Name);
	S.WriteStr(@DosFileName);
end;

{**************************************************************************
 ***                                                                    ***
 ***                           FILTERS                                  ***
 ***                                                                    ***
 **************************************************************************}
constructor TDeviceFilter.Init(NName : string);
begin
	inherited Init;
	Name := NName;
	InitSeq := '';
	FormFeed := #12;
	PagePause := False;
end;

constructor TDeviceFilter.Load;
var Ver : byte;
begin
	S.Read(Ver,1);
	case Ver of
		1 : begin
			Name := S.ReadStr;
			InitSeq := S.ReadStr;
			S.Read(FormFeed, 1);
			S.Read(PagePause, 1);
		end;
	else
		ProgramError('Ver '+N2Str(ver)+' not understood'#13'TDeviceFilter.Load', hcInternalErrorMsg);
	end;
end;

procedure TDeviceFilter.Store;
var Ver : byte;
begin
	Ver := 1;
	S.Write(Ver, 1);
	S.WriteStr(@Name);
	S.WriteStr(@InitSeq);
	S.Write(FormFeed,1);
	S.Write(pagePause,1);
end;

{leave to descendants}
function TDeviceFilter.Edit;
begin
end;

procedure TDeviceFilter.SetFormCodes(const FormCodes : PFormCodeCollection);
begin
	with FormCodes^ do begin
		SetStr('INIT',InitSeq);
		SetStr('$', '');
	end;
end;

{*************************************
 ***        PAPER                  ***
 *************************************}
constructor TPaper.Init;
begin
	inherited Init;
	Self := A4StdPaper;
end;

function TPaper.Edit;
var EditBox : TObjectEditBox;
		R : TRect;

begin
	 R.Assign(0,0,35,12);
	 with EditBox do begin
		 Init(R, 'PAPER DEFINITION',nil);

		 Options := Options or ofCenterX or ofCenterY;
		 HelpCtx := hcEditPaper;

		 {--- Set up box interior ---}
		 { X, Y, Boxlen,  depth, FieldLen,     Title}
		 InsTitledBox(  15, 2,  17, 1, 'Load Codes', 40);
		 InsTitledField(15, 4,   4, 1, 'Top Margin',  New(PInputByte, init(R, 4)));
		 InsTitledField(15, 5,   4, 1, 'Left',        New(PInputByte, init(R, 4)));
		 InsTitledField(15, 6,   4, 1, 'Length',      NEw(PInputByte, init(R, 4)));
		 InsTitledField(15, 7,   4, 1, 'Width',       NEw(PInputByte, init(R, 4)));

		 {-- Buttons --}
		 InsOKButton(     7, 9, @Self);
		 InsCancelButton(18, 9);

		 EndInit;

		 SetData(Self);
	 end;

	 Edit := Desktop^.ExecView(@EditBox);

	 EditBox.Done;  {Disposes of all those internal bits}
end;

constructor TPaper.Load;
var Ver : byte;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			LoadCodes := S.ReadStr;
			S.Read(TopMargin,1);
			S.Read(LeftMargin,1);
			S.Read(Length,    1);
			S.Read(Width,     1);
		end;
	end;
end;

procedure TPaper.Store;
var Ver : byte;
begin
	Ver := 1;	S.Write(Ver,1);
	S.WriteStr(@LoadCodes);
	S.Write(TopMargin,1);
	S.Write(LeftMargin,1);
	S.Write(Length,    1);
	S.Write(Width,     1);
end;

{*************************************
 ***        LABEL PAPER            ***
 *************************************}
constructor TLabelPaper.Init;
begin
	inherited Init;
	Self := A4StdLabels;
end;

function TLabelPaper.Edit;
var EditBox : TObjectEditBox;
		R : TRect;
		Control : word;

begin
	 R.Assign(0,0,40,19);
	 with EditBox do begin
		 Init(R, 'LABEL PAPER DEFINITION',nil);

		 Options := Options or ofCenterX or ofCenterY;
		 HelpCtx := hcEditLabels;

		 {--- Set up box interior ---}
		 { X, Y, Boxlen,  depth, FieldLen,     Title}
		 InsTitledBox(  18, 2,  17, 1, 'Load Codes', 40);
		 InsTitledField(18, 4,   4, 1, 'Lines to first',  New(PInputByte, init(R, 4)));
		 InsTitledField(18, 5,   4, 1, 'Cols to first',        New(PInputByte, init(R, 4)));
		 InsTitledField(18, 6,   4, 1, 'Label Length',      NEw(PInputByte, init(R, 4)));
		 InsTitledField(18, 7,   4, 1, 'Label Width',       NEw(PInputByte, init(R, 4)));
		 InsTitledField(18, 9,   4, 1, 'Top Margin',  NEw(PInputByte, init(R, 4)));
		 InsTitledField(18,10,   4, 1, 'Left',        NEw(PInputByte, init(R, 4)));
		 InsTitledField(18,11,   4, 1, 'Rows Labels', New(PInputByte, init(R, 4)));
		 InsTitledField(18,12,   4, 1, 'Columns',     NEw(PInputByte, init(R, 4)));
		 InsTitledField(18,13,   4, 1, 'Gap between Rows', New(PInputByte, init(R, 4)));
		 InsTitledField(18,14,   4, 1, 'Gap between Cols', New(PInputByte, init(R, 4)));

		 {-- Buttons --}
		 InsOKButton(    14,16, @Self);
		 InsCancelButton(25,16);

		 EndInit;

		 SetData(Self);
	 end;

	 repeat

		 Control := Desktop^.ExecView(@EditBox);

		 if Control <> cmCancel then begin
			 if (Length>MaxLabelLines) then begin
				 InputWarning('Label length too large'#13#10
											+'Must be '+N2Str(MaxLabelLines)+' or less',
											hcEditLabels);
				 Control := cmInvalid;
			 end;
		 end;

	 until Control <>cmInvalid;

	 EditBox.Done;  {Disposes of all those internal bits}

	 Edit := Control;
end;

constructor TLabelPaper.Load;
var Ver : byte;
begin
	S.Read(Ver, 1);
	inherited Load(S);
	S.Read(LabelTopMargin, 1); {on each label}
	S.Read(LabelLeftMargin,1);
	S.Read(Rows, 1);
	S.Read(Columns, 1);
	S.Read(RowGap, 1);
	S.Read(ColumnGap, 1);
end;

procedure TLabelPaper.Store;
var Ver : byte;
begin
	Ver := 1;	S.Write(Ver,1);     {Version 1}
	inherited Store(S);
	S.Write(LabelTopMargin, 1); {on each label}
	S.Write(LabelLeftMargin,1);
	S.Write(Rows, 1);
	S.Write(Columns, 1);
	S.Write(RowGap, 1);
	S.Write(ColumnGap, 1);
end;



{********************************************
 ***           GET FILTERS & DRIVERS      ***
 ********************************************}

function GetFilter(FileName : FNameStr) : PDeviceFilter;
begin
	if (FileName='') or (FileName[1] = '.') then begin GetFilter := nil; exit; end;
	if pos('\',FileName)=0 then FileName := PrintersPath + FileName;

	GetFilter := PDeviceFilter(GetObjFromFile(FileName));
end;

function GetPaper(FileName : Fnamestr) : PPaper;{}
begin
	if (FileName='') or (FileName[1] = '.') then begin Getpaper := nil; exit; end;
	if pos('\',FileName)=0 then FileName := PrintersPath + FileName;

	GetPaper := PPaper(GetObjFromFile(FIleName));
end;

function GetDevice(FileName : Fnamestr) : PDeviceStream;{}
begin
	if (FileName='') or (FileName[1] = '.') then begin GetDevice := nil; exit; end;
	if pos('\',FileName)=0 then FileName := PrintersPath + FileName;

	GetDevice := PDEviceStream(GetObjFromFile(FIleName));
end;


{*********************************************
 ***       INputFName compatible editors   ***
 *********************************************}
{These procedures are suitable as editors for
the InpFname inputline, when selecting paper, etc
for printers, or label types for printing labels, etc}

{===== PAPER DEFINITION =============}
function EditPaper(var FullFileName : FNameStr; const Ext : string) : word;
var	Control : word;
		Paper : PPaper;
		Name : string;

begin
	EditPaper := cmCancel;

	{Open file, retrieve details, warn if new, edit and save}
	Name := GetFileName(FullFileName);

	if (Name = '') or (Name[1] = '.') then
		{no name given - new}
		if GetExt(FullFileName)=PaperExt then
			New(Paper, init) {new paper}
		else
			Paper := new(PLabelPaper, init) {new labels paper}
	else begin
		Paper := GetPaper(FullFileName);

		if Paper = nil then begin
			ProgramWarning('Could not find Paper '+Name, hcFileNotFoundMsg);
			exit;
		end;
	end;

	Control := Paper^.Edit;  {Edit}

	if (Control = cmOK) and ((Name = '') or (Name[1]='.')) then
		Control := SaveAsBox(FullFileName,GetExt(FullFileName));

	if COntrol = cmOK then PutObjToFile(FullFileName, Paper);

	dispose(Paper, done);

	EditPaper := Control;
end;

{=== EDIT DEVICE ===================}
function EditDevice(var FullFileName : FNameStr; const Ext : string; Creator : TCreatorFunc) : word;
var	Control : word;
		Device : PDeviceStream;
		Name : string;

begin
	EditDevice := cmCancel;

	{Open file, retrieve details, warn if new, edit and save}
	Name := GetFileName(FullFileName);

	if (Name = '') or (Name[1] = '.') then begin
		Device := PDeviceStream(Creator(nil));
		if Device = nil then begin
			ProgramWarning('Could not create Device to edit', hcInternalErrorMsg);
			exit;
		end;
	end else begin
		Device := GetDevice(Name);

		if Device = nil then begin
			ProgramWarning('Could not find Device File '+Name, hcFileNotFoundMsg);
			exit;
		end;
	end;

	Control := Device^.Edit;  {Edit}

	{get name if new}
	if (Control = cmOK) and ((Name = '') or (Name[1]='.')) then
		Control := SaveAsBox(FullFileName, Ext);

	if COntrol = cmOK then
		{store}
		PutObjToFile(FullFileName, Device);

	dispose(Device, done);

	EditDevice := Control;
end;

{********************************************
 ***         EDIT DEVICES, ETC            ***
 ********************************************}
{New method uses the standard dialogs file box - see stddlg.pas
the only disadvantage over the old inputbox (commented out below)
is that you can't select *no* device... Could add another button for
that}

procedure SetDevice(var Device : PDeviceStream;
										const BoxTitle, Ext,SetupCommand : string;
										const EditProc : TFileEditorProc);

var FileName,FullFileName : FNameStr;
		WorkDevice : PDeviceStream;
		Control : word;
		fdType : word;

begin
	FileName := ProgramSetup.Get(SetupCommand,'');
	fdType := fdPickOnly+fdAcceptButton;
	if @EditProc<>nil then fdType := fdType or fdEditButton+fdNewBUtton;

	repeat
		Control := FileSelectBox(BoxTitle, 'Name', FileName, Ext,PrintersPath, fdType, hcSetDevice);

		case Control of
			cmNew : begin
				FullFIleName := PrintersPath; if pos(' ',Ext)=0 then FullFileName := FullFileName+'.'+Ext;
				EditProc(FullFileName, Ext);
			end;
			cmAccept : begin
				FullFileName := PrintersPath+FileName;
				WorkDevice := GetDevice(FullFileName);
				if WorkDevice<>nil then begin
					if device<>nil then dispose(Device, done);
					Device := WorkDevice;
					ProgramSetup.Put(SetupCommand, GetJustFileName(FileName));{chop off extension}
					ProgramSetup.Store;
				end else
					ProgramWarning('Could not load Driver'#13+FullFileName, hcFileNotFoundMsg);
			end;
			cmEdit : begin
				FullFileName := PrintersPath+FileName;
				EditProc(FullFileName, Ext);
			end;
		end;
	until (Control=cmAccept) or (Control = cmCancel);
end;

{************************************
 ***        INITIALISATION        ***
 ************************************}
const
	{--- Required for Stream ----}
	RPaper : TStreamRec = (
		ObjType : srPaper;
		VmtLink : Ofs(TypeOf(TPaper)^);
		Load : @TPaper.Load;
		Store : @TPaper.Store
	);

	RLabelPaper : TStreamRec = (
		ObjType : srLabelPaper;
		VmtLink : Ofs(TypeOf(TLabelPaper)^);
		Load : @TLabelPaper.Load;
		Store : @TLabelPaper.Store
	); {}


begin
	RegisterType(RPaper);
	RegisterType(RLabelPaper);
{	RegisterType(RDeviceFilter);{Descendants may need stored, not this one}
end.
