////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// tgrng: Tag Range routines.                                                 //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20260729 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_tgrng; // "Identify range" routines.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, graphics, forms, controls,
 _crw_alloc, _crw_fpu, _crw_ef, _crw_str, _crw_colors,
 _crw_dbglog;

////////////////////////////////////////////////////////////////////////////////
// The Tag Range Index/Color Model support.
// Color model corresponds to CIE 1931 standard with some modifications:
// uses named color and sometimes more "light" (with some white component)
// to use all colors as background for black text.
////////////////////////////////////////////////////////////////////////////////

const
 tgrng_L4 = -4; // Lo Fatal      MediumPurple    Аварийное понижение
 tgrng_L3 = -3; // Lo Error      SteelBlue       Критичное понижение
 tgrng_L2 = -2; // Lo Alarm      CornflowerBlue  Тревожное понижение
 tgrng_L1 = -1; // Lo Warn       Aqua=Cyan       Заметное  понижение
 tgrng_M0 =  0; // Middle/Normal Lime            Среднее/Нормальное
 tgrng_H1 = +1; // Hi Warn       Yellow          Заметное  превышение
 tgrng_H2 = +2; // Hi Alarm      DarkOrange      Тревожное превышение
 tgrng_H3 = +3; // Hi Error      Tomato          Критичное превышение
 tgrng_H4 = +4; // Hi Fatal      Red             Аварийное превышение

const
 PrimaryTagRangeColorsAsText = 'MediumPurple'   +EOL  // L4
                              +'SteelBlue'      +EOL  // L3
                              +'CornflowerBlue' +EOL  // L2
                              +'Cyan'           +EOL  // L1
                              +'Lime'           +EOL  // M0
                              +'Yellow'         +EOL  // H1
                              +'DarkOrange'     +EOL  // H2
                              +'Tomato'         +EOL  // H3
                              +'Red'            +EOL; // H4

type
 ETagRangeFail = class(ESoftException);
 TTagRangeIndex = tgrng_L4..tgrng_H4;
 TTagRangeEdges = packed array[TTagRangeIndex] of Double;
 TTagRangeColors = packed array[TTagRangeIndex] of TColor;
 TTagRangeParams = record
  Edges  : TTagRangeEdges;
  Colors : TTagRangeColors;
  procedure ResetEdges;
  procedure ResetColors(aColors:LongString='');
 end;
 TTagRangeEditDialog=function(tag:Integer; var Edges,Colors:LongString; Title,Hint,Params:LongString):TModalResult;
 TTagRange = class(TMasterObject)
 private
  myEdges:TTagRangeEdges;
  myColors:TTagRangeColors;
  function  GetEdges:TTagRangeEdges;
  procedure SetEdges(const X:TTagRangeEdges);
  function  GetEdge(i:Integer):Double;
  procedure SetEdge(i:Integer; const X:Double);
  function  GetEdgesAsText:LongString;
  procedure SetEdgesAsText(S:LongString);
  function  GetColors:TTagRangeColors;
  procedure SetColors(const P:TTagRangeColors);
  function  GetColorsAsText:LongString;
  procedure SetColorsAsText(const P:LongString);
  function  GetL4:Double;
  procedure SetL4(const X:Double);
  function  GetL3:Double;
  procedure SetL3(const X:Double);
  function  GetL2:Double;
  procedure SetL2(const X:Double);
  function  GetL1:Double;
  procedure SetL1(const X:Double);
  function  GetM0:Double;
  procedure SetM0(const X:Double);
  function  GetH1:Double;
  procedure SetH1(const X:Double);
  function  GetH2:Double;
  procedure SetH2(const X:Double);
  function  GetH3:Double;
  procedure SetH3(const X:Double);
  function  GetH4:Double;
  procedure SetH4(const X:Double);
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Edge[i:Integer]:Double  read GetEdge         write SetEdge; default;
  property  Edges:TTagRangeEdges    read GetEdges        write SetEdges;
  property  EdgesAsText:LongString  read GetEdgesAsText  write SetEdgesAsText;
  property  Colors:TTagRangeColors  read GetColors       write SetColors;
  property  ColorsAsText:LongString read GetColorsAsText write SetColorsAsText;
  property  L4:Double               read GetL4           write SetL4;
  property  L3:Double               read GetL3           write SetL3;
  property  L2:Double               read GetL2           write SetL2;
  property  L1:Double               read GetL1           write SetL1;
  property  M0:Double               read GetM0           write SetM0;
  property  H1:Double               read GetH1           write SetH1;
  property  H2:Double               read GetH2           write SetH2;
  property  H3:Double               read GetH3           write SetH3;
  property  H4:Double               read GetH4           write SetH4;
 public
  function  ValidRanges:Boolean;
  function  RangeIndex(const X:Double):Integer;
  function  RangeColor(const X:Double; Def:TColor=clNone):TColor;
  function  AssignFromCookies(const args:LongString):Boolean;
  function  IndexToColor(i:Integer):TColor;
 private
  class var Def:TTagRangeParams;
  class var Prime:TTagRangeParams;
  class var EditDlg:TTagRangeEditDialog;
  class procedure ResetPrime;
 public
  class procedure ResetDefaults;
  class procedure CheckDefaults;
  class function  CanShowModal(aLevel:Integer=0):Boolean;
  class property  EditDialog:TTagRangeEditDialog write EditDlg;
  class function  RunEditDialog(tag:Integer; var Edges,Colors:LongString; Title,Hint,Params:LongString):Integer;
 public
  class function  DefIndexToColor(i:Integer):TColor;
  class function  DefaultEdges:TTagRangeEdges;
  class function  DefaultColors:TTagRangeColors;
  class function  FallbackColors:TTagRangeColors;
  class function  DefaultColorsAsText:LongString;
  class function  FallbackColorsAsText:LongString;
  class function  InRangeOfIndex(i:Integer):Boolean;
  class procedure ResetEdges(out aEdges:TTagRangeEdges);
  class function  ValidEdges(const aEdges:LongString):Boolean; overload;
  class function  ValidEdges(const aEdges:TTagRangeEdges):Boolean; overload;
  class function  EdgesToCookies(const R:TTagRangeEdges; Sep:LongString=';'):LongString;
  class function  CookiesToEdges(const args:LongString):TTagRangeEdges;
  class function  ResetDefaultColors(Pal:LongString=''):Boolean; overload;
  class function  ResetDefaultColors(const Pal:TTagRangeColors):Boolean; overload;
  class function  ResetColors(out P:TTagRangeColors; Pal:LongString=''):Boolean;
  class function  ColorsToString(const P:TTagRangeColors; Sep:LongString=''):LongString;
  class function  ValidColors(const aColors:TTagRangeColors):Boolean; overload;
  class function  ValidColors(const aColors:LongString):Boolean; overload;
  class function  ValidColor(C:LongString):Boolean; overload;
  class function  ValidColor(C:TColor):Boolean; overload;
  class procedure SubstituteLtGtAliases(const P:TText);
 end;

 {
 expr:='L4=0|L3=5|L2=10|L1=15|M0=20|H1=60|H2=70|H3=90|H4=100|';
 expr:='L4=0;L3=5;L2=10;L1=15;M0=20;H1=60;H2=70;H3=90;H4=100;';
 expr+='Palette=MediumPurple,SteelBlue,CornflowerBlue,Aqua,Lime,Yellow,DarkOrange,Tomato,Red';
 tr:=NewTagRange(expr);
 }
function NewTagRange(const args:LongString=''):TTagRange;

procedure Kill(var TheObject:TTagRange); overload;

function dlc_TagRangeLog:Integer;
function dlc_TagRangeBug:Integer;

implementation

//////////////////
// Logger routines
//////////////////

function dlc_TagRangeLog:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_TagRangeLog');
 Result:=dlc;
end;

function dlc_TagRangeBug:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_TagRangeBug');
 Result:=dlc;
end;

////////////////////
// Service routines.
////////////////////

function IsNotNan(const x:Double):Boolean; inline;
begin
 Result:=not Math.IsNan(x);
end;

procedure Kill(var TheObject:TTagRange);
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

function NewTagRange(const args:LongString=''):TTagRange;
begin
 Result:=nil;
 try
  Result:=TTagRange.Create;
  if IsNonEmptyStr(args) then begin
   if not Result.AssignFromCookies(args)
   then Kill(Result);
  end;
 except
  on E:Exception do BugReport(E,nil,'NewTagRange');
 end;
end;

/////////////////////////////////
// TTagRangeParams implementation
/////////////////////////////////

procedure TTagRangeParams.ResetEdges;
var i:Integer;
begin
 for i:=Low(Edges) to High(Edges) do Edges[i]:=_Nan;
end;

procedure TTagRangeParams.ResetColors(aColors:LongString='');
var i:Integer; w:LongString;
begin
 aColors:=TrimDef(aColors,PrimaryTagRangeColorsAsText);
 for i:=Low(Colors) to High(Colors) do begin
  w:=ExtractWord(i-Low(Colors)+1,aColors,ScanSpaces);
  Colors[i]:=StringToColor(w);
 end;
 if not TTagRange.ValidColors(Colors) then begin
  Colors:=TTagRange.FallbackColors;
  if DebugLogEnabled(dlc_TagRangeBug) then begin
   DebugLog(dlc_TagRangeBug,'Error reset primary colors '+aColors);
   DebugLog(dlc_TagRangeBug,'Use fallback colors '+TTagRange.ColorsToString(Colors,','));
  end;
 end;
 if DebugLogEnabled(dlc_TagRangeLog) then begin
  DebugLog(dlc_TagRangeBug,'Set Prime colors '+TTagRange.ColorsToString(Colors,','));
 end;
end;

///////////////////////////
// TTagRange implementation
///////////////////////////

constructor TTagRange.Create;
begin
 inherited Create;
 CheckDefaults;
end;

destructor TTagRange.Destroy;
begin
 inherited Destroy;
end;

procedure TTagRange.AfterConstruction;
begin
 inherited AfterConstruction;
 ResetColors(myColors);
 ResetEdges(myEdges);
end;

procedure TTagRange.BeforeDestruction;
begin
 inherited BeforeDestruction;
end;

class procedure TTagRange.ResetPrime;
begin
 Prime.ResetEdges;
 Prime.ResetColors;
end;

class procedure TTagRange.ResetDefaults;
begin
 Def:=Prime;
end;

class procedure TTagRange.CheckDefaults;
begin
 if not ValidColor(Prime.Colors[tgrng_M0]) then begin
  ResetPrime; ResetDefaults;
 end;
 if not ValidEdges(Def.Edges) then ResetDefaults;
 if not ValidColors(Def.Colors) then ResetDefaults;
end;

class function TTagRange.FallbackColors:TTagRangeColors;
const Fallback:TTagRangeColors=
      ($DB7093,$B48246,$ED9564,$FFFF00,$00FF00,$00FFFF,$008CFF,$4763FF,$0000FF);
begin
 Result:=Fallback;
end;

class function TTagRange.FallbackColorsAsText:LongString;
begin
 Result:=ColorsToString(DefaultColors,',');
end;

class function TTagRange.CanShowModal(aLevel:Integer=0):Boolean;
begin
 if not Assigned(Application) then Exit(False);
 if (Application.ModalLevel>aLevel) then Exit(False);
 Result:=True;
end;

class function TTagRange.RunEditDialog(tag:Integer; var Edges,Colors:LongString; Title,Hint,Params:LongString):Integer;
begin
 Result:=mrCancel;
 try
  if not Assigned(EditDlg)
  then Raise ETagRangeFail.Create(ClassName+': Edit Dialog is not defined.');
  if not CanShowModal
  then Raise ETagRangeFail.Create(ClassName+': could not Edit right now.');
  Result:=EditDlg(tag,Edges,Colors,Title,Hint,Params);
 except
  on E:Exception do BugReport(E,nil,ClassName+'.RunEditDialog');
 end;
end;

function TTagRange.ValidRanges:Boolean;
begin
 if Assigned(Self)
 then Result:=ValidEdges(myEdges)
 else Result:=False;
end;

function TTagRange.RangeIndex(const X:Double):Integer;
begin
 Result:=tgrng_M0;
 if IsNan(X) then Exit;
 if not Assigned(Self) then Exit;
 if IsNotNan(myEdges[tgrng_H4]) and (X>=myEdges[tgrng_H4]) then Exit(tgrng_H4);
 if IsNotNan(myEdges[tgrng_H3]) and (X>=myEdges[tgrng_H3]) then Exit(tgrng_H3);
 if IsNotNan(myEdges[tgrng_H2]) and (X>=myEdges[tgrng_H2]) then Exit(tgrng_H2);
 if IsNotNan(myEdges[tgrng_H1]) and (X>=myEdges[tgrng_H1]) then Exit(tgrng_H1);
 if IsNotNan(myEdges[tgrng_L4]) and (X<=myEdges[tgrng_L4]) then Exit(tgrng_L4);
 if IsNotNan(myEdges[tgrng_L3]) and (X<=myEdges[tgrng_L3]) then Exit(tgrng_L3);
 if IsNotNan(myEdges[tgrng_L2]) and (X<=myEdges[tgrng_L2]) then Exit(tgrng_L2);
 if IsNotNan(myEdges[tgrng_L1]) and (X<=myEdges[tgrng_L1]) then Exit(tgrng_L1);
end;

function TTagRange.RangeColor(const X:Double; Def:TColor=clNone):TColor;
begin
 if Assigned(Self)
 then Result:=IndexToColor(RangeIndex(X))
 else Result:=Def;
end;

function  TTagRange.GetColors:TTagRangeColors;
begin
 if Assigned(Self)
 then Result:=myColors
 else Result:=TTagRange.DefaultColors;
end;

procedure TTagRange.SetColors(const P:TTagRangeColors);
begin
 if Assigned(Self) and ValidColors(P)
 then myColors:=P;
end;

function  TTagRange.GetColorsAsText:LongString;
begin
 if Assigned(Self)
 then Result:=ColorsToString(myColors,',')
 else Result:='';
end;

procedure TTagRange.SetColorsAsText(const P:LongString);
begin
 if Assigned(Self)
 then ResetColors(myColors,P);
end;

function TTagRange.GetEdges:TTagRangeEdges;
begin
 if Assigned(Self)
 then Result:=myEdges
 else TTagRange.ResetEdges(Result);
end;

procedure TTagRange.SetEdges(const X:TTagRangeEdges);
begin
 if Assigned(Self) and ValidEdges(X)
 then myEdges:=X;
end;

function TTagRange.GetEdge(i:Integer):Double;
begin
 if Assigned(Self) and InRange(i,Low(myEdges),High(myEdges))
 then Result:=myEdges[i]
 else Result:=_Nan;
end;

procedure TTagRange.SetEdge(i:Integer; const X:Double);
begin
 if Assigned(Self) and InRange(i,Low(myEdges),High(myEdges))
 then myEdges[i]:=X;
end;

function TTagRange.GetEdgesAsText:LongString;
begin
 if Assigned(Self)
 then Result:=EdgesToCookies(myEdges,';')
 else Result:='';
end;

procedure TTagRange.SetEdgesAsText(S:LongString);
begin
 if Assigned(Self) and ValidEdges(S)
 then myEdges:=CookiesToEdges(S);
end;

function TTagRange.GetL4:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_L4]
 else Result:=_Nan;
end;

procedure TTagRange.SetL4(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_L4]:=X;
end;

function TTagRange.GetL3:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_L3]
 else Result:=_Nan;
end;

procedure TTagRange.SetL3(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_L3]:=X;
end;

function TTagRange.GetL2:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_L2]
 else Result:=_Nan;
end;

procedure TTagRange.SetL2(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_L2]:=X;
end;

function TTagRange.GetL1:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_L1]
 else Result:=_Nan;
end;

procedure TTagRange.SetL1(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_L1]:=X;
end;

function TTagRange.GetM0:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_M0]
 else Result:=_Nan;
end;

procedure TTagRange.SetM0(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_M0]:=X;
end;

function TTagRange.GetH1:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_H1]
 else Result:=_Nan;
end;

procedure TTagRange.SetH1(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_H1]:=X;
end;

function TTagRange.GetH2:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_H2]
 else Result:=_Nan;
end;

procedure TTagRange.SetH2(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_H2]:=X;
end;

function TTagRange.GetH3:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_H3]
 else Result:=_Nan;
end;

procedure TTagRange.SetH3(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_H3]:=X;
end;

function TTagRange.GetH4:Double;
begin
 if Assigned(Self)
 then Result:=myEdges[tgrng_H4]
 else Result:=_Nan;
end;

procedure TTagRange.SetH4(const X:Double);
begin
 if Assigned(Self)
 then myEdges[tgrng_H4]:=X;
end;

class function TTagRange.ResetColors(out P:TTagRangeColors; Pal:LongString=''):Boolean;
var i,n,ner:Integer; cn:LongString; cl:TColor;
begin
 Result:=False;
 if IsEmptyStr(Pal) and (@P<>@Def.Colors) and ValidColors(Def.Colors) then begin
  P:=Def.Colors;
  Exit(True);
 end;
 P:=DefaultColors;
 n:=1; cn:=''; cl:=0; ner:=0;
 Pal:=TrimDef(Pal,PrimaryTagRangeColorsAsText);
 for i:=Low(P) to High(P) do begin
  cn:=ExtractWord(n,Pal,ScanSpaces);
  cl:=StringToColor(cn,clNone);
  if not ValidColor(cl) then Inc(ner);
  P[i]:=cl;
  Inc(n);
 end;
 Result:=(ner=0);
end;

class function TTagRange.ResetDefaultColors(const Pal:TTagRangeColors):Boolean;
begin
 Result:=ResetDefaultColors(ColorsToString(Pal));
end;

class function TTagRange.ResetDefaultColors(Pal:LongString=''):Boolean;
var P:TTagRangeColors;
begin
 Result:=False;
 Pal:=TrimDef(Pal,PrimaryTagRangeColorsAsText);
 if ResetColors(P,Pal) then begin
  Def.Colors:=P;
  if DebugLogEnabled(dlc_TagRangeLog) then begin
   DebugLog(dlc_TagRangeBug,'Set Default colors '+ColorsToString(Def.Colors,','));
  end;
  Result:=True;
 end;
end;

class function TTagRange.InRangeOfIndex(i:Integer):Boolean;
begin
 Result:=InRange(i,Low(TTagRangeIndex),High(TTagRangeIndex));
end;

function TTagRange.IndexToColor(i:Integer):TColor;
var il,ih:Integer;
begin
 Result:=clNone;
 if Assigned(Self) then begin
  il:=Low(TTagRangeIndex);
  ih:=High(TTagRangeIndex);
  i:=EnsureRange(i,il,ih);
  Result:=myColors[i];
 end;
end;

class function TTagRange.DefIndexToColor(i:Integer):TColor;
var il,ih:Integer;
begin
 CheckDefaults;
 il:=Low(TTagRangeIndex);
 ih:=High(TTagRangeIndex);
 i:=EnsureRange(i,il,ih);
 Result:=Def.Colors[i];
end;

class function TTagRange.DefaultColors:TTagRangeColors;
begin
 CheckDefaults;
 Result:=Def.Colors;
end;

class function TTagRange.DefaultColorsAsText:LongString;
begin
 Result:=ColorsToString(DefaultColors,',')
end;

class function TTagRange.DefaultEdges:TTagRangeEdges;
begin
 ResetEdges(Result);
end;

class procedure TTagRange.ResetEdges(out aEdges:TTagRangeEdges);
begin
 aEdges:=Def.Edges;
end;

class function TTagRange.ValidEdges(const aEdges:LongString):Boolean;
var E:TTagRangeEdges;
begin
 if IsEmptyStr(aEdges) then Exit(False);
 E:=CookiesToEdges(aEdges);
 if not ValidEdges(E) then Exit(False);
 Result:=True;
end;

class function TTagRange.ValidEdges(const aEdges:TTagRangeEdges):Boolean;
var i:Integer; a,b,x:Double;
begin
 Result:=False; a:=_Nan; b:=_Nan;
 for i:=Low(aEdges) to High(aEdges) do begin
  x:=aEdges[i]; if IsNotNan(x) then b:=x;
  if IsNotNan(a) and IsNotNan(b) and (a>b) then Exit;
  if IsNotNan(b) then a:=b;
 end;
 Result:=True;
end;

class function TTagRange.EdgesToCookies(const R:TTagRangeEdges; Sep:LongString=';'):LongString;
begin
 Result:=Format('L4=%g;L3=%g;L2=%g;L1=%g;M0=%g;H1=%g;H2=%g;H3=%g;H4=%g',
         [R[tgrng_L4],R[tgrng_L3],R[tgrng_L2],R[tgrng_L1],R[tgrng_M0],
          R[tgrng_H1],R[tgrng_H2],R[tgrng_H3],R[tgrng_H4]]);
 if (Sep<>'') and (Sep<>';')
 then Result:=ReplaceString(Result,';',Sep,[rfReplaceAll]);
end;

class function TTagRange.CookiesToEdges(const args:LongString):TTagRangeEdges;
var R:TTagRangeEdges; x:Double; arg:LongString;
begin
 ResetEdges(Result);
 try
  ResetEdges(R);
  arg:=Trim(args); x:=0;
  if (Pos('|',arg)>0) then begin
   arg:=StringReplace(arg,'|',';',[rfReplaceAll]);
  end;
  if (Pos('=',arg)>0) then begin
   if Str2Real(CookieScan(arg,'L4',Ord(';')),x) then R[tgrng_L4]:=x;
   if Str2Real(CookieScan(arg,'L3',Ord(';')),x) then R[tgrng_L3]:=x;
   if Str2Real(CookieScan(arg,'L2',Ord(';')),x) then R[tgrng_L2]:=x;
   if Str2Real(CookieScan(arg,'L1',Ord(';')),x) then R[tgrng_L1]:=x;
   if Str2Real(CookieScan(arg,'M0',Ord(';')),x) then R[tgrng_M0]:=x;
   if Str2Real(CookieScan(arg,'H1',Ord(';')),x) then R[tgrng_H1]:=x;
   if Str2Real(CookieScan(arg,'H2',Ord(';')),x) then R[tgrng_H2]:=x;
   if Str2Real(CookieScan(arg,'H3',Ord(';')),x) then R[tgrng_H3]:=x;
   if Str2Real(CookieScan(arg,'H4',Ord(';')),x) then R[tgrng_H4]:=x;
  end;
  if ValidEdges(R) then Result:=R;
 except
  on E:Exception do BugReport(E,nil,'CookiesToEdges');
 end;
end;

class function TTagRange.ColorsToString(const P:TTagRangeColors; Sep:LongString=''):LongString;
var i:Integer;
begin
 Result:='';
 for i:=Low(P) to High(P) do begin
  Result+=(ColorToString(P[i])+EOL);
 end;
 if (Result<>'') and (Sep<>'') and (Sep<>EOL)
 then Result:=StringReplace(Trim(Result),EOL,Sep,[rfReplaceAll]);
end;

function TTagRange.AssignFromCookies(const args:LongString):Boolean;
var R:TTagRangeEdges; C,S:LongString;
begin
 Result:=False;
 if Assigned(Self) then
 try
  R:=CookiesToEdges(args);
  if ValidEdges(R) then begin
   Result:=True;
   Edges:=R;
  end;
  if Result and IsNonEmptyStr(args) then begin
   S:=StringReplace(args,'|',';',[rfReplaceAll]);
   C:=CookieScan(S,'Palette',Ord(';'));
   if (C='') then C:=CookieScan(S,'CL',Ord(';'));
   if (C<>'') and ValidColors(C) then ColorsAsText:=C;
  end;
  if Result then begin
   if DebugLogEnabled(dlc_TagRangeLog) then begin
    DebugLog(dlc_TagRangeLog,'Valid SetTagRange '+args);
   end;
  end else begin
   if DebugLogEnabled(dlc_TagRangeBug) then begin
    DebugLog(dlc_TagRangeBug,'Invalid SetTagRange '+args);
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'AssignFromCookies');
 end;
end;

class function TTagRange.ValidColor(C:TColor):Boolean;
begin
 if (C=clNone)  then Exit(False);
 if (C=clBlack) then Exit(False);
 Result:=True;
end;

class function TTagRange.ValidColor(C:LongString):Boolean;
begin
 if not ValidColor(StringToColor(C,clNone)) then Exit(False);
 Result:=True;
end;

class function TTagRange.ValidColors(const aColors:TTagRangeColors):Boolean;
var i:Integer;
begin
 for i:=Low(aColors) to High(aColors) do
 if not ValidColor(aColors[i]) then Exit(False);
 Result:=True;
end;

class function TTagRange.ValidColors(const aColors:LongString):Boolean;
var C:TTagRangeColors;
begin
 if not ResetColors(C,aColors) then Exit(False);
 if not ValidColors(C) then Exit(False);
 Result:=True;
end;

class procedure TTagRange.SubstituteLtGtAliases(const P:TText);
var i,j:Integer; List:TStringList; sn,sv,line:LongString;
 function IsLtGtAlias(const S:LongString):Boolean;
 var L:SizeInt;
 begin
  L:=Length(S);
  if (L<3) then Exit(False);
  if (S[1]<>'<') then Exit(False);
  if (S[L]<>'>') then Exit(False);
  Result:=True;
 end;
begin
 if Assigned(P) and (P.Count>0) then
 try
  sn:=''; sv:='';
  List:=TStringList.Create;
  if Assigned(List) then
  try
   List.Sorted:=True;
   List.UseLocale:=False;
   List.Duplicates:=dupIgnore;
   for i:=P.Count-1 downto 0 do begin
    if (ExtractNameValuePair(P[i],sn,sv)>0) then begin
     if IsEmptyStr(sn) or IsEmptyStr(sv) then continue;
     if IsLtGtAlias(sn) then begin
      if (List.IndexOfName(sn)<0)
      then List.Values[sn]:=sv;
      P.DelLn(i);
     end;
    end;
   end;
   if (List.Count>0) then
   for i:=0 to P.Count-1 do begin
    line:=P[i];
    if (Pos('<',line)=0) then continue;
    if (Pos('>',line)=0) then continue;
    for j:=0 to List.Count-1 do begin
     sn:=List.Names[j]; sv:=List.Values[sn];
     line:=StringReplace(line,sn,sv,[rfReplaceAll,rfIgnoreCase]);
     if (Pos('<',line)=0) or (Pos('>',line)=0) then break;
    end;
    if (line<>P[i]) then P[i]:=line;
   end;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'SubstituteLtGtAliases');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_tgrng;
begin
 dlc_TagRangeLog;
 dlc_TagRangeBug;
end;

procedure Free_crw_tgrng;
begin
end;

initialization

 Init_crw_tgrng;

finalization

 Free_crw_tgrng;

end.

//////////////
// END OF FILE
//////////////

