unit TermoPdvColors;

interface
uses
  Graphics;

  type
    PTermoPdvColorRec =^ TTermoPdvColorRec;
    TTermoPdvColorRec = record
      fromValue: Integer;
      color: Integer;
    end;

  function getTermoPdvColor(schemeNum: integer; value: Integer): Integer;
  function getShemeCount: Integer;
  function getSchemeItemsCount(schemeNum: integer): Integer;
  function getSchemeItem(schemeNum: integer; item: integer): PTermoPdvColorRec;

implementation

var
  colors: array of array of PTermoPdvColorRec;
  schemeCount: Integer = 0;

function getShemeCount: Integer;
begin
  Result := schemeCount;
end;

function getSchemeItemsCount(schemeNum: integer): Integer;
begin
  if schemeNum < schemeCount then
    result := Length(colors[schemeNum])
  else
    Result := 0;
end;

function getSchemeItem(schemeNum: integer; item: integer): PTermoPdvColorRec;
begin
  result := nil;
  if schemeNum < schemeCount then
    if item < Length(colors[schemeNum]) then
      Result := colors[schemeNum, item];
end;


procedure addColor(schemeNum: integer; fromValue: Integer; color: integer);
var
  i,n,k: integer;
begin
  if schemeNum <= Length(colors) then begin
    SetLength(colors, schemeNum+1);
    schemeCount := Length(colors);
  end;

  // add and sort
  n := Length(colors[schemeNum]);
  k:=0;
  for i:=0 to n-1 do
    if fromValue < colors[schemeNum, i].fromValue then
      Break
    else
      inc(k);

  SetLength(colors[schemeNum], n+1);
  for i:=n-1 downto k do
    colors[schemeNum, i+1] := colors[schemeNum, i];

  new( colors[schemeNum, k] );
  colors[schemeNum, k].fromValue := fromValue;
  colors[schemeNum, k].color := color;
end;


function getTermoPdvColor(schemeNum: integer; value: Integer): Integer;
var
  i,n: Integer;
begin
  result := 0;
  if schemeNum >= schemeCount then Exit;
  n := Length(colors[schemeNum]);
  for i:=n-1 downto 0 do
    if value >= colors[schemeNum, i].fromValue then begin
      Result := colors[schemeNum, i].color;
      Exit;
    end;
end;


procedure killTermoPdvColors;
var
  i,j: Integer;
begin
  for i:=0 to Length(colors)-1 do
    for j:=0 to Length(colors[i])-1 do
      Dispose(  colors[i,j]  );
end;



////////////////////////////////////////////////////////////////////////////////
//
////////////////////////////////////////////////////////////////////////////////
procedure initTermoPdvColors;
begin
  // супер-мега-колор-схема
  addColor(0, -50, $00000000);
  addColor(0, -40, $0083013C);
  addColor(0, -30, $00BA0154);
  addColor(0, -20, $00FF0000);

  addColor(0, -5, $00FFFF80);
  addColor(0, 0, $00008000);
  addColor(0, 5, $0000AE00);

  addColor(0, 45, $000000D9);
  addColor(0, 50, $000000B9);

  addColor(0, 10, $0000F000);
  addColor(0, 15, $0091FF91);
  addColor(0, 20, $0080FFFF);

  addColor(0, -15, $00EC7600);
  addColor(0, -10, $00FFB300);

  addColor(0, 25, $0022E3FF);
  addColor(0, 30, $0000ABFD);
  addColor(0, 35, $004977FE);
  addColor(0, 40, $000000FF);

  addColor(0, 60, $00000091);
  addColor(0, 70, $00400080);
  addColor(0, 120, $00FFFFFF);



  // схема для СанСаныча
  addColor(1,  0, clYellow);
  addColor(1, 20, clLime);



  // колор-схема с ошибками
  addColor(2, -4000, $010000FF);
  addColor(2, -50, $00000000);
  addColor(2, -40, $0083013C);
  addColor(2, -30, $00BA0154);
  addColor(2, -20, $00FF0000);

  addColor(2, -5, $00FFFF80);
  addColor(2, 0, $00008000);
  addColor(2, 5, $0000AE00);

  addColor(2, 45, $000000D9);
  addColor(2, 50, $000000B9);

  addColor(2, 10, $0000F000);
  addColor(2, 15, $0091FF91);
  addColor(2, 20, $0080FFFF);

  addColor(2, -15, $00EC7600);
  addColor(2, -10, $00FFB300);

  addColor(2, 25, $0022E3FF);
  addColor(2, 30, $0000ABFD);
  addColor(2, 35, $004977FE);
  addColor(2, 40, $000000FF);

  addColor(2, 60, $00000091);
  addColor(2, 70, $00400080);
  addColor(2, 120, $00FFFFFF);

  addColor(2, 3276, $01FFFFFF);
// }


end;

////////////////////////////////////////////////////////////////////////////////
initialization
  initTermoPdvColors;

finalization
  killTermoPdvColors;

end.
