unit legendu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PGDsgFrm, PGSubCls;

 const
  maxst=19;

type
  Tlegendf = class(TForm)
    cdlg: TColorDialog;
    capb: TPGCaptionBar;
    PGCaptionBarGlyph1: TPGCaptionBarGlyph;
    PGCaptionBarSystemButton1: TPGCaptionBarSystemButton;
    PGCaptionBarButton1: TPGCaptionBarButton;
    MinusButt: TPGCaptionBarButton;
    PlusButt: TPGCaptionBarButton;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure PGCaptionBarButton1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure PlusButtClick(Sender: TObject);
    procedure MinusButtClick(Sender: TObject);
  private
    { Private declarations }
     h,w:integer;

  public
    { Public declarations }
    lgndcols:array [1..maxst] of TColor;
    mlgndcols:array [1..maxst] of TColor;
    captions:array [1..maxst] of ShortString;
    nlgndcols:integer;
  end;

var
  legendf: Tlegendf;

implementation

{$R *.DFM}

procedure Tlegendf.FormPaint(Sender: TObject);
var
 tr:TRect;
 i,j:integer;
 xi,yi,r,d,din,mw,tw:integer;
begin
 h:=font.Height;
 if h<0 then h:=-h+6;
// h:=20;
 r:=round(0.2*h);
 d:=r+r;
 din:=round(d*0.6);
 xi:=5+d;
 with canvas do
 begin
  setbkmode(handle,transparent);
  settextalign(handle,ta_bottom or ta_left);
  brush.color:=clwhite;
  fillrect(clientrect);
  mw:=0;
  for i:=1 to nlgndcols do
  begin
   if i<=(nlgndcols-2) then brush.color:=mlgndcols[i] else brush.color:=clwhite;
   pen.color:=clblack;
   yi:=5+i*h-h + h div 2;
   ellipse(xi-d,yi-d,xi+d,yi+d);
   if i<=(nlgndcols-2) then  brush.color:=clwhite else brush.color:=mlgndcols[i] ;
   ellipse(xi-din,yi-din,xi+din,yi+din);
   brush.color:=clwhite;
   settextcolor(handle,mlgndcols[i]);
   tw:=textwidth(captions[i]);
   if tw>mw then mw:=tw;
   textout(xi+d+6,yi+d,captions[i]);
  end;
  clientheight:=yi+d+5;
  clientwidth:=xi+d+6+mw+6;
 end;
end;

procedure Tlegendf.FormCreate(Sender: TObject);
var
 i:integer;
 tl:TStringList;
begin
 nlgndcols:=19;
 for i:=1 to nlgndcols-2 do
 begin
  lgndcols[i]:=rgb(100+random(156),100+random(156),100+random(156));
 end;
 lgndcols[nlgndcols-1]:=clgreen;
 lgndcols[nlgndcols]:=clred;

 if FileExists('legend.col') then
 begin
  tl:=TStringList.Create;
  tl.loadfromfile('legend.col');
  for i:=0 to tl.count-1 do lgndcols[i+1]:=TColor(strtoint(tl[i]));
  tl.free;
 end;
 captions[1]:='failed';
 captions[2]:='offline';
 captions[3]:='pickup';
 captions[4]:='flash';
// captions[4]:='queued';
 captions[5]:='online';
 captions[6]:='standby';
 captions[7]:='surveillance';
 captions[8]:='preempted';
 captions[9]:='comm fail';
 captions[10]:='CPS';
 captions[11]:='local drop';
 captions[12]:='transition';
 captions[13]:='undef';
 captions[14]:='green confict';
 captions[15]:='flash request';
 captions[16]:='local flash';
 captions[17]:='splt';
 captions[18]:='MSG';
 captions[19]:='SSG';

end;

procedure Tlegendf.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
 i:integer;
begin
 i:=y div h;
 if i<0 then exit;
 if i>=nlgndcols then exit;
 inc(i);
// caption:=inttostr(i);
 if cdlg.execute then
 begin
  mlgndcols[i]:=cdlg.Color;
  repaint;
 end;
end;

procedure Tlegendf.FormShow(Sender: TObject);
var
 i:integer;
begin
 for i:=1 to maxst do mlgndcols[i]:=lgndcols[i];
end;

procedure Tlegendf.PGCaptionBarButton1Click(Sender: TObject);
var
 i:integer;
begin
 for i:=1 to nlgndcols do lgndcols[i]:=mlgndcols[i];
end;

procedure Tlegendf.FormDestroy(Sender: TObject);
var
 i:integer;
 tl:TStringList;
begin
 tl:=TStringList.Create;
 for i:=1 to nlgndcols do
 tl.add(inttostr(integer(lgndcols[i])));
 deletefile('legend.col');
 tl.savetofile('legend.col');
 tl.free;
end;

procedure Tlegendf.FormKeyPress(Sender: TObject; var Key: Char);
var
 h:integer;
begin
 h:=font.height;
 if key='+' then
 begin
  if abs(h)>20 then exit;
  if h<0 then dec(h) else inc(h);
  font.height:=h;
 end
 else if key='-' then
 begin
  if abs(h)<7 then exit;
  if h<0 then inc(h) else dec(h);
  font.height:=h;
 end
 else if key=' ' then
 begin
  font.size:=8;
 end;
 repaint;
end;

procedure Tlegendf.PlusButtClick(Sender: TObject);
var
 h:integer;
begin
 h:=font.height;
 if abs(h)>20 then exit;
 if h<0 then dec(h) else inc(h);
 font.height:=h;
end;

procedure Tlegendf.MinusButtClick(Sender: TObject);
var
 h:integer;
begin
 h:=font.height;
 if abs(h)>20 then exit;
 if h<0 then inc(h) else dec(h);
 font.height:=h;

end;

end.