{********************************************************************
 ***                                                              ***
 ***                     FORMS PROCESSING                         ***
 ***                                                              ***
 ********************************************************************}
{this module handles the codes that can be inserted into forms, lines,
etc.  A valid code is a string of a few letters, which is tied to an object.
This object (based on TFormCode) will replace that code with another string,
either directly (as with TStringFormCode) or by calling a function (TFuncFormCode).
}
{$I compflgs}
unit forms;

INTERFACE

uses  lstrings,
			dattime,
			measures,{}
			objects;

type
	TFCodeStr = string[80]; {not going to need a code longer than 80 chars....?}
													{remember formatting, eg {<ASD> <ZXC> etc}
	PFormCodeCollection = ^TFormCodeCollection;

	{parent item of different kinds of codes}
	PFormCode = ^TFormCode;
	TFormCode = object(TObject)
		Code : Pstring;
		constructor Init(NCode : string);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;

	{simple code to be replaced with string}
	PStringFormCode = ^TStringFormCode;
	TStringFormCode = object(TFormCode)
		ReplaceStr : Pstring;
		constructor Init(NCOde, NReplaceStr : string);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;

	{code to be replaced with date}
	PDateFormCode = ^TDateFormCode;
	TDateFormCode = object(TFormCode)
		Date : TDate;
		constructor Init(NCOde : string; NDate : TDate);
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																													var LString : TLongString) : boolean; virtual;
	end;

	{associate a code with a function}
	{The function will expect an information pointer, defined at the time the
	FuncFormCode is defined.  As this will be disposed of when the FuncFormCode
	is disposed, it is descended from TObject (so we have a .done method)}

	{For FormCodedfunc; codes that call a function of this format:}
	{returns true if decoded/dealt with}
	TFormFunc = function(const Code, SubCode,Param : TFCodeStr; const Info : PObject;
							const FormCodes : PFormCodeCollection; var LString : TLongString) : boolean;

	PFuncFormCode = ^TFuncFormCode;
	TFuncFormCode = object(TFormCode)
		Func : TFormFunc;
		Info : PObject;
		constructor Init(NCode : string; NFunc : TFormFunc; NInfo : PObject);
		destructor Done; virtual;
		function Replace(const SubCode, Param : TFCodeStr; const FormCodes : PFormCodeCollection;
																											var LString : TLongString) : boolean; virtual;
	end;


	{General form code processing - add codes then request various decoding}
	TFormCodeCollection = object(TSortedCollection)
		Prefix : string; {used for setting codes}
		constructor Init;
		destructor Done; virtual;
		procedure Clear;
		function Compare(Key1, Key2: Pointer): Integer; virtual;
		procedure SetPrefix(const S : string);
		procedure Insert(Item : POINTER); virtual;
		procedure SetStr(const NCode : TFCodeStr;const NReplace : string);
		procedure SetFunc(const NCode : TFCodeStr; NFunc : TFormFunc; NInfo : PObject);
		procedure SetDate(const NCode : TFCodeStr; NDate : TDate);
		function GetFormCode(const Code : TFCodeStr) : PFormCode;
		function DottedGetFormCode(var Code,SubCode : TFCodeStr) : PFormCode;
		function QDecode(const Code : TFCodeStr) : string;
		function QDecodeStr(Str : string) : string;
		procedure SplitCode(OrigCode : TFCodeStr; var Code, Param : TFCodeStr);
		function Decode(Code,Param : TFCodeStr; var LString : TLongString) : boolean;
		procedure DecodeAndFormat(Code : TFCodeStr; var Replace : TLongString);
		procedure DeCodeLString(var LString : TLongString; const ASCIIForm : boolean);
	end;


{function BlankCodedFunc(const PreCode, Code,Param : string; const Info : PCodeInfo; var LString : TLongString) : boolean;{}

{supplementay processing methods}
function DecodeESC(Codes : string) : string;
procedure GetBracketPair(const LString : TLongString; const StartPos : word; var BPos1, BPos2 : word);

procedure WordWrapAndJustify(var Replace : TLongstring; const Width,Justify : word);

{parameter handling}
procedure RemoveParam(var Param : TFCodeStr; const SubParam : string);
function GetParam(const Param,SubParam : string) : string;
function IsParam(const Param, SubParam : string) : boolean;


IMPLEMENTATION

uses scodes, files,{} tuiedit, global, {for user definable codes}
			help,
			tuimsgs,
			minilib;

{*************************************************************
 ***                  PARAMETER HANDLING                   ***
 *************************************************************}

procedure RemoveParam(var Param : TFCodeStr; const SubParam : string);
begin
	if pos(SubParam, Param)>0 then System.Delete(Param, pos(SubParam, Param), length(SubParam)); {remove from parameter}
end;

{gets complete parameter given first few letters}
function GetParam(const Param,SubParam : string) : string;
var S : string;
begin
	if pos(SubParam,Param)>0 then begin
		S := Copy(Param, Pos(SubParam,Param)+1, length(Param)); {take off first stroke so it doesn't interfere with line below}
		if pos('/',S)>0 then S := Copy(S,1,pos('/',S)-1); {if any following parameters, ignore}
		GetParam := '/'+S;  {put stroke back on}
	end else
		GetParam := '';
end;

{returns whether parameter there}
function IsParam(const Param, SubParam : string) : boolean;
begin
	{really ought to check that subparam is complete parameter - for example,
		at the moment it will return true if searching for /U and there is
		a /UGLLE}
	if pos(SubParam, Param)>0 then IsParam := True else IsParam := False;
end;


{************************************************************
 ***                   DECODING METHODS                   ***
 ************************************************************}

function DecodeESC(Codes : string) : string;
{Converts code line Codes of format 23,42,H, etc to #23#42#72 in Print}
var	Print : string;
		Code : string;
begin
	Print := '';

	while Codes<>'' do begin

		{--- split off code -----}
		{split off complete bit specified by single quotes}
{		if (Codes[1]=#39) and (Pos(copy(COdes,2,255),#39)>0) then {both start and closing quotes}
		Code := SplitBy(Codes, ', '); {splits first word by comma or space to code and removes from codes}

		{--- translate to #27, char or string -----}
		if Code = 'ESC' then
			Code := #27
		else
			if (S2Num(Code)>0) and (S2Num(Code)<256) then
				Code := chr(S2Num(Code))
			else
				if Code='0' then Code := chr(0); {so that ESC W,0 works the same as ESC W,1}

		Print := Print+Code;
	end;

	DecodeESC := Print;
end;


procedure GetBracketPair(const LString : TLongString; const StartPos : word; var BPos1, BPos2 : word);
begin
	BPos1 := StartPos;

	while (BPos1<=LSLen(LString))
		and (Pos(LSGetChar(LString, BPos1), '<[{')=0) do
			inc(BPos1);

	if BPos1>LSLen(LSTring) then
		BPos1 := 65535
	else
		{Find second bracket of same type}
		BPos2 := LSPosFrom(char(ord(LSGetChar(LString, BPos1))+2), LString, BPos1); {2nd bracket 2 chars on from 1st in ascii table}

	if (BPos1<>65535) and (BPos2<>65535) then
		{check for <a<asdf>, etc}
		while LSPosFrom(LSGetChar(LString, BPos1), LString, BPos1+1)<BPos2 do
			BPos1 := LSPosFrom(LSGetChar(LString, BPos1), LString, BPos1+1);

	if (BPos1<>65535) and (BPos2=65535) then
		{no second bracket of same type}
		GetBracketPair(LString, BPos1+1, BPos1, BPos2);

end;

{***************************************
 ***     FORMATTING BY BRACKET TYPE  ***
 ***************************************}

{======== SQUARE BRACKETS =================}
{Replacement string is positioned by setting its length to the width of
the original bracket size.  If the code was positioned in the middle, the
replacement text is centralised, if on the right it is right set, if on
the left it is left set}

{-------- Word-wrapped formatting -------------}
{curley brackets - does a word wrap rather than chopping surplus}
{Uses LSReWidth method, but expects in format of only hard returns (ie
long lines and CRLF's for new paragraphs). Thus freetext codes need to
convert to this first}
procedure WordWrapAndJustify(var Replace : TLongstring; const Width,Justify : word);
var CRPos : word;
begin
	{Run through and add EndParaChars to before CRLF's}
	CRPos := LSPos(#13, Replace);
	while CRPos<>65535 do begin
		if LSGetChar(Replace, CRPos-1)<>EndParaChar then begin
			LSInsertChar(Replace, EndParaChar, CRPos);
			inc(CRPos);
		end;
		CRPos := LSPosFrom(#13,Replace, CRPos+1);
	end;

	{wrap}
	LSReWidth(Replace, Width);

	{now remove end-of-paras}
	CRPos := LSPos(EndParaChar, Replace);
	while CRPos<>65535 do begin
		LSDeleteChar(Replace, CRPos);
		CRPos := LSPosFrom(EndParaChar, Replace, CRPos);
	end;

	{and justify as above}
	LSJustify(Replace, Width, Justify);
end;


{***********************************************************
 ***     SUPPLEMENTARY USER FORM CODES                   ***
 ***********************************************************}
{A short-code list is available for the user to enter codes that
they may want to insert into letters, etc as standard.  eg, <YS> to be
replaced with Yours sincerely, CRCRCR, etc etc (though <YOURS> already
exists for letters in this case!)  Stromsholm use these for their
invoices}

{========= SPECIAL USER-FORM-CODES ====================================}
{Have an extra 250 char replacement string}
type
	PUserFormScode = ^TUserFormScode;
	TUserFormScode = object(TScodeItem)
		Replace : Pstring;
		constructor Init(const NCode, NDesc : string);
		destructor Done; virtual;
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream); virtual;
		procedure AddEditFields(P : PObjectEditBox);  virtual;
	end;


const
 RUserFormScode : TStreamRec = (
	 ObjType : srUserFormScode;
	 VmtLink : Ofs(TypeOf(TUserFormScode)^);
	 Load : @TUserFormScode.Load;
	 Store : @TUserFormScode.Store
 );

constructor TUserFormScode.Init;
begin inherited Init(NCode, NDesc); Replace := nil; end;

destructor TUserFormSCode.Done;
begin
	if Replace<>nil then disposeStr(Replace);
	inherited Done;
end;

constructor TUserFormScode.Load;
begin inherited Load(S);            Replace := NewStr(S.ReadStr);   end; {use tstream}

procedure TUserFormScode.Store;
begin inherited Store(S);        		S.WriteStr(Replace);	end;

procedure TUserFormScode.AddEditFields(P : PObjectEditBox);
var R : TRect;
begin
	inherited AddEditFields(P);
	P^.GrowTo(P^.Size.X, P^.Size.Y+1); {make room for below}
	P^.InsTitledField(9,4, P^.Size.X-12, 1, 'Replace', New(PInputPStr, init(R,250)));
end;

function CreateUserFormScode(const NCode, NDesc : string) : PScodeItem; far;
begin
	CreateUserFormScode := New(PUserFormScode, init(NCode, NDesc));
end;



{************************************************************
 ***                   CODED ITEMS                        ***
 ************************************************************}
{======== PARENT ==============}
constructor TFormCode.Init;
begin
	inherited Init;
	if NCode = '' then NCode := ' '; {o/wise newstr assigns nil. Shouldn't happen anyway}
	Code := NewStr(NCode);
end;

destructor TFormCode.Done;
begin
	DisposeStr(Code);
	inherited Done;
end;

function TFormCode.Replace;
begin
	Replace := False; {not replaced}
	LSClear(LString); LSappendStr(Lstring, 'No Replace Defined');
end;

{========= CODES/STRINGS ===========}
constructor TStringFormCode.Init;
begin
	inherited Init(NCode);
	ReplaceStr := NewStr(NReplaceStr);
end;

destructor TStringFormCode.Done;
begin
	DisposeStr(ReplaceStr);
	inherited Done;
end;

function TStringFormCode.Replace;
begin
	Replace := True;
	LSClear(LString);
	if ReplaceStr <> nil then LSAppendStr(LString, ReplaceStr^);
end;

{========= CODES/DATES ===========}
constructor TDateFormCode.Init;
begin
	inherited Init(NCode);
	Date.SetToDate(NDAte);
end;

function TDateFormCode.Replace;
var WorkDate : TDate;
		A : Byte;
begin
	Replace := True;

	WorkDate.SetToDate(Date);
	{add days - expects 2 digits}
	if Pos('/+', Param)>0 then
		WorkDate.AddDays(S2Num(Copy(Param,pos('/+',Param)+2,2)));

	if subCode='AGE' then begin
		if Pos('/T', Param)>0 then
			String2Ls(WorkDate.Text(daAge), LString) {age text - ie months if young, yrs if old}
		else
			if Pos('/M',Param)>0 then
				String2LS(N2Str(WorkDate.AgeMonths), LString) {age in months}
			else
				String2LS(N2Str(WorkDate.Age), LString); {normal age in years}
		exit; {done}
	end;

	if (SubCode='AGE.MONTHS') then begin
		String2Ls(N2Str(WorkDate.AgeMonths), LString); {for reports}
		exit;
	end;

	if (SubCode='AGE.DAYS') then begin
		String2Ls(N2Str(WorkDate.AgeDays), LString); {for reports}
		exit;
	end;


	String2LS(WorkDate.Digit10, LString);  {default}
	if Pos('/F', Param)>0	then String2LS(WorkDate.Text(daFull),LString);  {Full text date}
	if Pos('/A', Param)>0 then String2LS(WorkDate.Text(daAbbr),LString);
	if Pos('/E', Param)>0 then String2LS(WorkDate.Text(daExpand),LString); {expanded month}
	if Pos('/8', Param)>0 then String2LS(WorkDate.Digit8			,LString);        {8 Digit format}
{	if Pos('/10',Param)>0 then String2LS(WorkDate.Digit10			,LString);			 {10 Digit format}


end;



{=========== CODES/FUNCS ===========}
constructor TFuncFormCode.Init;
begin
	inherited Init(NCode);
	Func := NFunc;
	Info := NInfo;
end;

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

{The function may want to know exactly which code it was that called it.
This can mean, for example, that directory addresses can be specified as
going to here with a parameter to specify whether a delivery address, invoice
address, etc.  Also the collection must be specified in case any changes, etc
need done}
function TFuncFormCode.Replace;
begin Replace := Func(Code^, SubCode, Param, Info, FormCodes, LString); end;




{************************************************************
 ***                                                      ***
 ***                   CODE  COLLECTION                   ***
 ***                                                      ***
 ************************************************************}

constructor TFormCodeCollection.Init;
begin
	inherited Init(10, 5);
	SCodeCollection[scUserFormcodes]^.LogOn;
	Clear;
end;

destructor TFormCodeCollection.Done;
begin
	SCodeCollection[scUserFormcodes]^.LogOff;
	inherited Done;
end;

procedure TFormCodeCollection.Clear;
begin
	FreeAll;
	Prefix := '';
	{default codes}
	SetDate('TODAY',Today);
	SetDate('DT',Today);  {shorter versions}
	SetStr('TIME', TimeNow.Digit5); {time now}
	SetStr('TN', TimeNow.Digit5); {time now}
	SetStr('NOW', TimeNow.Digit5); {time now}
end;

{*****************************************************
 **   SETTING UP/INSERTING CODES                   ***
 *****************************************************}
function TFormCodeCollection.Compare(Key1, Key2: Pointer): Integer;
begin
	if PFormCode(Key1)^.Code^ < PFormCode(Key2)^.Code^ then Compare := -1
		else if PFormCode(Key1)^.Code^ = PFormCode(Key2)^.Code^ then Compare := 0
			else Compare := 1;
end;

{used for setting codes.... setprefix before setting. Saves a lot of
code at setformcodes time}
procedure TFormCodeCollection.SetPrefix;
begin
	if (S<>'') and (S[length(S)]<>'.') then Prefix := S + '.' else Prefix := S;
end;

{============= SET CODE =========================}
{want to overwrite with a new code, not ignore it}
procedure TFormCodeCOllection.Insert(Item : pointer);
var Index : integer;
		IndexCode, NewCode : Pstring;
		B : boolean;
begin
	if Prefix<>'' then begin
		{set prefix}
		NewCode := NewStr(Prefix+PFormCode(Item)^.Code^);
		disposeStr(PFormCode(Item)^.Code);
		PFormCode(Item)^.Code := NewCode;
	end else
		NewCode := PFormCode(Item)^.Code;

	{now check v. carefully for either a previous code...}
	if Search(Item, Index) then AtFree(Index); {do as well as below 'cos it's quick}

	{or codes with the same beginning and a .xxx afterwards...}
	{Need to catch such things as TO.ADD.TOWN which will have to be wiped
	by a new TO.ADD but not TO.A}
	repeat
		Search(Item, INdex);
		B := (Index>=0) and (Index<Count);
		if B then begin
			IndexCode := PFormCode(At(index))^.Code;
			B := (length(IndexCode^)>length(NewCode^)) and  {longer}
						(Copy(IndexCode^,1,length(NewCode^)) =NewCode^) and {matches newcode}
						(IndexCode^[length(NewCode^)+1]='.'); {and is followed by dot}
			if B then AtFree(Index);
		end;
	until not B;

	inherited Insert(Item);
end;

{--- Shorthand access to inserting new codes -----}
procedure TFormCodeCollection.SetStr(const NCode : TFCodeStr; const NReplace : string);
begin
	Insert(New(PStringFormCode, init(NCode, NReplace)));
end;

procedure TFormCodeCollection.SetFunc(const NCode : TFCodeStr; NFunc : TFormFunc; NInfo : PObject);
begin
	Insert(New(PFuncFormCode, init(NCode, NFunc, NInfo)));
end;

procedure TFormCodeCollection.SetDate(const NCode : TFCodeStr; NDate : TDate);
begin
	Insert(New(PDateFormCode, init(NCode, NDate)));
end;

function TFormCOdeCollection.GetFormCode(const Code : TFCodeStr) : PFormCode;
var SearchCode : PFormCOde;
		Index : integer;
begin
	New(SearchCode, Init(ucase(Code)));  {for search}

	if Search(SearchCode, Index) then
		{it exists! so replace}
		GetFormCode := PFormCode(At(Index))
	else
		GetFormCode := nil;

	dispose(SearchCode, Done);
end;

{gets as above, but splits by full stops - ie date.age, etc}
function TFormCodeCollection.DottedGetFormCode(var Code,SubCode : TFCodeStr) : PFormCode;
var Found : boolean;
		FormCode : PFormCode;
begin
	FormCode := nil;
	Found := False;
	SubCode := '';

	while (Code<>'') and (FormCode=nil) do begin
		FormCode := GetFormCode(Code);

		if FormCode=nil then begin
			{split by full stops}
			if SubCode='' then SubCode := LAstWord(Code) else SubCode := LastWord(Code)+'.'+SubCode;
			Code := DelLastWord(Code);
		end;
	end;

	DottedGetFormCode := FormCode;

end;


{*****************************************************
 **      QUICK DECODING                            ***
 *****************************************************}
{quick decode - pass code and it returns an ordinary string. handy for
doing a quick check, w/o messing about with longstrings, etc.
Returns Code if not found}
function TFormCodeCOllection.QDecode(const Code : TFCodeStr) : string;
var LString : TLongString;
		FormCode : PFormCode;
begin
	LSNew(LString);
	if Decode(Code, '', LString) then
		QDecode := LS2String(LString)
	else
		QDecode := Code;
	LSDIspose(LString);
end;

{============== DECODE LINE ======================}
{used for setup, eg calling wordperfect, etc}
function TFormCodeCollection.QDecodeStr(Str : string) : string;
var	LString : TLongString;

begin
	LSNew(LString);
	LSAppendStr(LString, Str);
	DecodeLString(Lstring,True);
	QDecodeStr := LS2String(LString);
	LSDispose(LString);
end;

{*****************************************************
 **      DECODE SINGLE CODE                        ***
 *****************************************************}

{decodes single code, with parameter already split, and returns in LString.
Returns true if successfully decoded}
function TFormCodeCollection.Decode(Code, Param : TFCodeStr; var LString : TLongString) : boolean;
var FormCode : PFormCode;
		SubCode : TFCodeStr;
		Found : boolean;
		SCode : PSCodeItem;

begin
	Decode := False;

	{first check user short form codes}
	if Code<>'' then begin
		SCode := GetSCode(scUserFormCodes, Code);
		if SCode = nil then Scode := GetScode(scUserFormCodes, Code+Param); {try with parameter}
		if SCode<>nil then begin
			LSClear(LString);
			if PUserFormSCOde(SCode)^.Replace<>nil then {might be blank}
				LSAppendStr(LString, PUserFormSCode(Scode)^.Replace^);
			Decode := True;
			exit;
		end;
	end;

	{code comes in form xx.yyy.zzz etc, so gradually split down}
	SubCode := '';
	Found := False;

	while (Code<>'') and (not Found) do begin

		FormCode := GetFormCode(Code);  {for search}

		if FormCode<>nil then
			{it exists! so replace}
			Found := FormCode^.Replace(SubCode, Param, @Self, LString);

		if Found then begin
			{add remainder of subcode for further decoding eg <AGE.DAYS> --> <DOB.AGE.DAYS>}
			if (SubCode<>'') and (LSGetChar(LString,0)='<') then	LSAppendStr(LString, '.'+SubCode)
		end else begin
			{split by full stops}
			if SubCode='' then SubCode := LAstWord(Code) else SubCode := LastWord(Code)+'.'+SubCode;
			Code := DelLastWord(Code);
		end;
	end;

	Decode := Found;
end;

{*****************************************************************
 ***                 DECODE & FORMAT                           ***
 *****************************************************************}
{pass complete code in brackets (eg <DT/F> or [  RTITLE  ] and this
will do the rest....}

{DecodeLStr takes a long string and decodes all codes found within it
The major problem with ordinary strings is that this may come to longer
than 256 chars, so we use a "longstring" type, defined in the lstrings
unit, which allows up to 65535 chars and is not nul-terminated (which might
cause problems with WP, etc, otherwise we could use the pascal strings
unit)}
procedure TFormCOdeCollection.SplitCode(OrigCode : TFCodeStr; var Code, Param : TFCodeStr);
var P : string; {type checking fails with Param....}
begin
	Code := ucase(delspace(OrigCode)); {remove spaces and convert to upper case}

	{Split code & parameter}
	P := '';
	if ucase(Copy(Code,1,3))<>'ESC' then begin
		{special case of HTML end-block markers, eg </TITLE>, which need to be
		left as is}
		if Code[1]<>'/' then begin
			P := Code;	Code := SplitBy(P, ' /'); {see minilib - splits by space or slash}
			{should be done by splitby	DelCharL(Param, ' ');	DelCharL(Param, '/'); {make sure excess removed too}
			if P<>'' then P := '/'+P; {above splitby removes first spaces & slashes}
		end;
	end;

	Param := P;
end;


procedure TFormCodeCollection.DecodeAndFormat(Code : TFCodeStr; var Replace : TLongString);
var BType : char;
		Justify : integer;
		I : integer;
		W : word;
		Width : word;
		OrigCode : string;
		S,SS : string;
		Param : TFCodeStr;
		Len : TLength;
		Lstring : TLongString;



begin
	{get format type - check brackets}
	BType := Code[1]; {bracket type}
	Justify := juLeft; {left}
	if Code[2]=' ' then
		if Code[Length(Code)-2]=' ' then
			Justify := juCentre {centralise}
		else
			Justify := juRight; {right}
	Width := length(Code);

	LSClear(Replace);
	LSAppendStr(Replace,Code); {if it's not decoded,default to leave it}

	{split code & parameter}
	OrigCode := copy(Code,2,length(Code)-2); {remove brackets & preserve}
	SplitCode(OrigCode, Code, Param);

	{safety check}
	if ucase(Copy(Code,1,3))<>'ESC' then begin {ESC codes may be quite long, and are decoded from OrigCode}
		if Length(Code)>=(sizeof(TFCodeStr)-1) then
			ProgramWarning('Code too long - over '+N2Str(sizeof(TFCodeStr))+' chars'#13+Code,hcFormCodeErrorMsg);
		if Length(Param)>=(sizeof(TFCodeStr)-1) then
			ProgramWarning('Parameter too long - over '+N2Str(sizeof(TFCodeStr))+' chars'#13+Code+Param,hcFormCodeErrorMsg);
	end;

	{special case of pound/currency at beginning - make it a parameter}
	if ((Code[1] = 'œ') or (Code[1] = '$')) and (length(Code)>1) then begin
		Param := Param + ' /'+Code[1];
		Code := Copy(Code,2,length(Code));
	end;

	{another special case of comma or ; at end - make it a parameter}
	if (length(Code)>1) and ((Code[length(Code)] = ',') or (Code[length(Code)]=';')) then begin
		Param := Param + ' /'+Code[length(Code)];
		Code := Copy(Code,1, length(Code)-1);
	end;

	{========= TRANSLATE! ======================}
	{--- Do normal decode ----}
	if Code<>'' then if Decode(Code, Param, Replace) then Code := '';

	{--- Plain text (quotes) ----}
	{This can be useful mainly for user formcodes, where a code is replaced with
		more text, and automatically formatted with, eg, curley brackets of different
		width in different forms}
	if Code[1]='"' then begin
		{need to work with Replace rather than Code as Code is uppercase}
		LSDelete(Replace, 1, LSPos('"', Replace)); {remove first quote}
		LSDelete(Replace, LSPos('"', Replace), Replace.Length); {remove last quote}
		Code := ''; {code has been dealt with}
	end;

	{--- Currency symbol -----}
	if (Code='œ') or (Code='¾') then begin
		Code := '';
		String2LS('<$>', Replace); {use <$> as interface currency symbol, set by filter}
	end;

	{Carriage return}
	if Code = 'CR' then begin
		String2LS(CRLF, Replace);
		if Param<>'' then for I := 2 to S2Num(Param) do LSAppendStr(Replace, CRLF);
		Code := '';
	end;

	{ESC codes}
	if ucase(Copy(Code,1,3)) = 'ESC' then begin
		{Param has been set to upper case, so we must use OrigCode}
		String2LS( DecodeESC(OrigCode), Replace);
		Code := '';
	end;

	{Group of codes, within a set of brackets eg {<TYPE> <MAKE> <MODEL>     }
	if Pos(Code[1],'{[<')>0 then begin
		LSClear(Replace);
		String2LS(OrigCode, Replace);
		Code := '';
		{now this will be re-decoded below}
	end;

	{=============== PARAMETERS =========================}
	{check for parameters now for modifications to replace}
	if Code='' then begin {check only if decoded}

		{Comma - replace CR's with commas, semicolon - replace with spaces}
		if (IsParam(Param, '/,') or IsParam(Param, '/;')) and (LSLen(Replace)>1) then begin
			while LSPos(CRLF, Replace)<>LSNotFound do begin
				W := LSPos(CRLF, Replace);
				if IsParam(Param, '/,') then LSSetChar(Replace, W, ',') else LSSetChar(Replace, W, #0);
				LSSetChar(Replace, W+1, ' ');  {and a space}
			end;
			if LSGetString(Replace, LSLen(Replace)-1,2)=', ' then LSSetLen(Replace, LSLen(Replace)-2);  {chop off last comma if any}
			RemoveParam(Param, '/,'); RemoveParam(Param, '/;');
		end;

		{upper case}
		if IsParam(Param, '/U') then begin
			LSUcase(Replace);
			RemoveParam(Param, '/U'); {remove from parameter}
		end;

		{Pound/currency sign}
		if IsParam(Param, '/œ') or IsParam(Param, '/$') then
			LSInsertStr(Replace, '<$>', 0); {should be set by filter to be decoded below}

		{measurement in imperial/metric}
		if Pos('/MI', Param)>0 then begin
			Len.SetToString(LS2String(Replace));
			if ValErr=0 then String2LS(Len.Text(unInches, dcAuto, 0), Replace);
			RemoveParam(Param, '/MI'); {remove from parameter}
		end;
		if Pos('/MM', Param)>0 then begin
			Len.SetToString(LS2String(Replace));
			if ValErr=0 then String2LS(Len.Text(unMeters, dcAuto, 0), Replace);
			RemoveParam(Param, '/MM'); {remove from parameter}
		end;
		if Pos('/MC', Param)>0 then begin {Centimeters}
			Len.SetToString(LS2String(Replace));
			if ValErr=0 then String2LS(Len.Text(unCentiMeters, dcAuto, 0), Replace);
			RemoveParam(Param, '/MC'); {remove from parameter}
		end;


		{=== Number/sign formatting =====}
		{swap +/- sign}
		if (pos('/CR-', Param)>0) or (pos('/DB-', Param)>0) or (Pos('/DC-', Param)>0)
				or (pos('/(-', Param)>0) or (pos('/-+', Param)>0) then begin
			if LSGetChar(Replace, 0)='-' then
				LSDelete(Replace,1,1) {remove minus sign}
			else
				LSInsertStr(Replace,'-',0);
			RemoveParam(Param, '/-+');
		end;

		{mark with DB/CR/Brackets not plus/minus sign}
		if IsParam(Param, '/CR') or IsParam(Param, '/DB') or isParam(Param, '/DC') then begin

			if LSGetChar(replace, 0)='-' then
				{negative}
				if IsParam(Param, '/DB') or IsParam(Param, '/DC') then LSAppendStr(Replace, 'DB') else LSAppendStr(Replace, '  ')
			else
				{positive}
				if IsParam(Param, '/CR') or IsParam(Param, '/DC') then LSAppendStr(Replace, 'CR') else LSAppendStr(Replace, '  ');

			RemoveParam(Param, GetParam(Param, '/DC')); {remove /DC or /DC- from parameter}
			RemoveParam(Param, GetParam(Param, '/CR')); {remove /DC or /DC- from parameter}
			RemoveParam(Param, GetParam(Param, '/DB')); {remove /DC or /DC- from parameter}
		end;

		{mark with plus sign if positive}
		if IsParam(Param, '/+') then begin
			if (LSGetChar(Replace,1)<>'-') and (S2Real(LS2String(Replace))<>0) then LSInsertStr(Replace,'+',0);
			RemoveParam(Param, '/+'); {remove from parameter}
		end;

		{mark with brackets if negative}
		if IsParam(Param, '/(') then begin
			if LSGetChar(Replace, 0)='-' then begin
				LSInsertStr(Replace, '(',0); LSAppendStr(Replace, ')');
			end else
				LSAppendStr(Replace,' '); {to make sure both +/- line up}
			RemoveParam(Param, GetParam(Param, '/(')); {remove /( or /(- from parameter}
		end;


	end; {if code ''}

	{blanks if code not defined or zero}
	if Pos('/BL',Param)>0 then begin
		if Code<>'' then begin
			LSClear(Replace); {code not decoded}
			Code := ''; {set to decoded so that formatting works}
		end else
			if (LSGetChar(Replace,0)='0') and (S2Real(LS2String(Replace))=0) then
				{decoded to 0}
				LSClear(Replace);

		{if another code follows /BL (ie /BLxxx) then *that* replaces if blank}
		if (LSLen(Replace) = 0) and (GetParam(Param, '/BL')<>'/BL') then
			Decode(ucase(Copy(GetParam(Param, '/BL'),4,99)), '',Replace);

		RemoveParam(Param, '/BL');
	end;

	{----- IF Statements -----}
	{At the moment only handles a kind of "IF another code is/is not blank"}
	{Two codes - old one /IFNBL and /IFBL, new ones ? and ?!.  The new ? is
	intended to become a more complete IF statement system, ?! being if not}
	if (pos('/IF', Param)>0) or (pos('/?', Param)>0) then begin

		S := GetParam(Param, '/?'); {get complete parameter}
		RemoveParam(Param, S);

		{old system - convert}
		if S='' then begin
			S := GetParam(Param, '/IF');
			RemoveParam(Param, S);
			if copy(S,1,5)='/IFBL' then S := '/?'+copy(S,6,length(S));
			if copy(S,1,6)='/IFNBL' then S := '/?!'+copy(S,7,length(S));
		end;

		{extract statement after "if" into SS}
		if copy(S,1,3)='/?!' then SS := copy(S,4,length(S)) else SS := copy(S,3,length(S));

		{only existing check is: as a code, is it blank?}
		LSNew(LString);
		String2LS(SS, LString);
		Decode(SS,'/BL',LString); {pass parameter /BL which will set to '' if zero or undefined}

		if LSLen(LString)=0 then begin
			if S[3] = '!' then LSClear(Replace) {it is blank, and ? is do if blank, ?! not do if blank}
		end else begin
			if S[3] <> '!' then LSClear(Replace) {it isn't blank, and ?! is do if not blank, ? not do if not blank}
		end;

		if LSLen(Replace)>0 then begin
			{get rid of brackets & parameter - use OrigCode}
			String2LS(Copy(OrigCode,1,pos('/?',OrigCode)-1),Replace);
		end;

		LSDispose(LString);

	end;

	{============= FORMATTING ==========================}
	if (Code='') then begin

		{Now whatever replace is, it might contain some more codes, so decode that}
		{also, it may contain a code & rubbish, eg WP has <#3##6#243<TONAM>>, but
		have to prevent it from looping, ie when a code is replaced, don't want it
		doing a writecodedstr if nothing's been changed}
		{Let DecodeLString handle all that}
		if ((LSPos('<',Replace)<>65535) or (LSPos('{',Replace)<>65535) or (LSPos('[',Replace)<>65535)) then
			DeCodeLString(Replace,True);

		{set width}
		if pos('/W',Param)>0 then begin
			S := GetParam(Param, '/W'); {get complete parameter}
			RemoveParam(Param, S);
			Width := S2Num(Copy(S,3,4));
		end;

		{Format by bracket type}
		if BType = '[' then LSJustify(Replace, Width, Justify);
		if BType = '{' then WordWrapAndJustify(Replace, Width, Justify);

		{If the parameter is numerical, and Replace has been set to something,
		then extract that number's line number}
		if (LSLen(REplace)>0) and
				(Copy(Param,1,2) >= '/1') and (Copy(Param,1,2) <= '/9') then begin
			if S2Num(Copy(Param,2,1))>LSNumLines(Replace) then
				S := space(Width)
			else
				S := LSGetLine(Replace, S2Num(Copy(Param,2,1)));
			String2LS(S, Replace);
		end;
	end;

end;

{*****************************************************************
 ***                 DECODE LONG STRING                        ***
 *****************************************************************}
procedure TFormCodeCollection.DeCodeLString(var LString : TLongString; const ASCIIForm : boolean);
var	BPos1,BPos2 : word; {bracket positions}
		CRPos : word;
		Code : string;
		Replace,LineSoFar : TLongString;
		XPos,Ypos : word;

begin
	LSNew(REplace); {work string for individual code}
	LSNew(LineSoFar);

	GetBracketPair(LString,0,BPos1,BPos2); {get first bracket position}

	{Keep going until all codes replaced}
	while (BPos1<>65535) and (BPos2<>65535) do begin {while it's finding brackets}

		{check if small enough for string to type to deal with - otherwise ignore
			(probably odd chars in WP header, or whatever}
		if BPos2-BPos1<255 then begin

			{Extract code. Replacement string defaults to code}
			Code := LSGetString(LString, BPos1, BPos2-BPos1+1);
			LSDelete(LString, BPos1, BPos2-BPos1+1); {delete code from working line}


			DecodeAndFormat(Code, Replace);

			{now add indents to replace depending on position so far}
			if ASCIIForm then begin
				LSCopy(LineSoFar, LString, 0,BPos1);
				XPos := 0; YPos := 0;
				LSXYPos(LineSoFar, XPos, YPos); {get xpos up to here}
				if XPos>0 then begin
					CRPos := LSPos(CRLF, Replace);
					while CRPos<>65535 do begin
						LSInsertStr(Replace, space(Xpos), CRPos+2);
						CRPos := LSPosFrom(CRLF, Replace, CRPos+XPos+2);
					end;
			 end;
			end;

			{insert replacement string back into main string}
			LSInsert(LString, Replace, BPos1);

			GetBracketPair(LString, BPos1+LSLen(Replace),BPos1,BPos2);
		end else
			GetBracketPair(LString, BPos1+1,BPos1,BPos2);

	end;	{while still bracket pairs found}

	LSDispose(Replace);
	LSDispose(LineSoFar);
end;

{************************************
 ***        INITIALISATION        ***
 ************************************}
begin
{$IFDEF fixit} writeln('Forms...'); {$ENDIF}
	RegisterSCodeType(scUserFormCodes, 'USERFORM.SC', 'User-defined Form Codes', CreateUserFormScode);
	RegisterType(RUserFormSCode);
end.
