view/BASICAcc/graphlib.pas

unit graphlib;
{$IFDEF FPC}
  {$MODE Delphi}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2009, SHIRAISHI Kazuo *)
(***************************************)

{********}
interface
{********}
uses arrays,baslib;

function PixelX(x:extended):longint;                               overload;
function PixelY(x:extended):longint;                               overload;
function WindowX(x:extended):extended;                              overload;
function WindowY(x:extended):extended;                              overload;

procedure SetColorMix(cc:double; er,eg,eb:double; InsideofWhen:boolean); overload;
procedure SetWindow(l,r,b,t:double; insideofWhen:boolean);          overload;
procedure SetViewPort(l,r,b,t:double; insideofWhen:boolean);        overload;
procedure SetDeviceWindow(l,r,b,t:double; insideofWhen:boolean);    overload;
procedure SetDeviceViewport(l,r,b,t:double; insideofWhen:boolean);  overload;

const
    MaxLineStyle=5;
    MaxPointStyle=7;
    MaxAreaStyleIndex=6;

procedure SetPointColor(x:double; InsideOfWhen:boolean); overload;
procedure setLineColor(x:double; InsideOfWhen:boolean);  overload;
procedure setAreaColor(x:double; InsideOfWhen:boolean);  overload;
procedure setTextColor(x:double; InsideOfWhen:boolean);  overload;
procedure setAllColor(x:double; InsideOfWhen:boolean);   overload;
procedure SetPointColor(const s:string; InsideOfWhen:boolean);overload;
procedure setLineColor(const s:string; InsideOfWhen:boolean);overload;
procedure setAreaColor(const s:string; InsideOfWhen:boolean);overload;
procedure setTextColor(const s:string; InsideOfWhen:boolean);overload;
procedure setAllColor(const s:string; InsideOfWhen:boolean); overload;
procedure SetAxisColor(x:double; InsideOfWhen:boolean);      overload;
procedure SetAxisColor(const s:string; InsideOfWhen:boolean);overload;


procedure setPointStyle(x:double; InsideOfWhen:boolean); overload;
procedure setLineStyle(x:double; InsideOfWhen:boolean);  overload;
procedure setLineWidth(x:double; InsideOfWhen:boolean);  overload;
procedure setAreaStyle(const s:string);
procedure setAreaStyleIndex(x:double; InsideOfWhen:boolean); overload;
procedure setTextHeight(x:double; InsideOfWhen:boolean);     overload;
procedure setTextAngle(x:double; AngleDegrees:boolean);      overload;
procedure setTextJustify( s1,s2:string; InsideOfWhen:boolean);


function ColorOfName(s:string; insideofWhen:boolean):LongInt;
function ColorIndex(r,g,b:double):LongInt;                    overload;


procedure SetClip(const s:string; insideofwhen:boolean);
procedure SetTextFont(const s:string; x:double);              overload;
procedure SetTextBackGround(const s:string);
procedure SetBitmapSize(x,y:double);                          overload;

procedure GraphPoints(const a:array of double);
procedure GraphLines(const a:array of Double);
procedure BeamOff;
procedure PlotPoints(const a:array of double);
procedure PlotLines(const a:array of Double);
procedure GraphArea(const a: array of double);
procedure PlotArea(const a:array of double);

procedure PlotText(x,y:double; const s:string);                            overload;
procedure PlotTextUsing(x,y:double; const form:string; a:array of const);  overload;
procedure GraphText(x,y:double; const s:string);                           overload;
procedure GraphTextUsing(x,y:double; const form:string; a:array of const); overload;
procedure PlotLabel(x,y:double; const s:string);                           overload;
procedure PlotLabelUsing(x,y:double; const form:string; a:array of const); overload;
procedure GraphLabel(x,y:double; const s:string);                          overload;
procedure GraphLabelUsing(x,y:double; const form:string; a:array of const); overload;
procedure PlotLetters(x,y:double; const s:string);                          overload;
procedure PlotLettersUsing(x,y:double; const form:string; a:array of const); overload;

procedure MatPlotPoints(const x,y:TArray1N);overload;
procedure MatPlotPoints(const m:TArray2N);overload;
procedure MatPlotLines(const x,y:TArray1N);overload;
procedure MatPlotLines(const m:TArray2N);overload;
procedure MatPlotArea(const x,y:TArray1N);overload;
procedure MatPlotArea(const m:TArray2N);overload;

procedure MatPlotPointsLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotPointsLimit(n:double; const m:TArray2N);overload;
procedure MatPlotLinesLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotLinesLimit(n:double; const m:TArray2N);overload;
procedure MatPlotAreaLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotAreaLimit(n:double; const m:TArray2N);overload;

procedure MatPlotCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);  overload;
procedure MatGraphCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean); overload;

{GET & LOCATE}
procedure PointAt(x0,y0:Double; LocateSt:boolean);                        overload;
procedure GetPoint(var x,y:Double; NoBeamOff:boolean; Locatest:boolean);  overload;
procedure MousePoll(var x,y,l,r:Double);                                  overload;
procedure MatGetPointVarilen(m:TArray2N; Locatest:boolean); overload;     overload;
procedure MatGetPointVarilen(m1,m2:TArray1N; Locatest:boolean); overload; overload;
procedure MatGetPoint(m1,m2:TArray1N; Locatest:boolean); overload;        overload;
procedure MatGetPoint(m:TArray2N; Locatest:boolean);overload;             overload;


Procedure LocateChoice( var x:Double);overload;
Procedure LocateChoice(n:Double; var x:Double);overload;
Procedure LocateChoice(n,i0:Double; var x:Double);overload;
Procedure LocateChoice(const a:TArray1S; var x:Double);overload;

procedure LocateValue(n:Double; var x:double; name0:ansistring);overload;
procedure LocateValue(n:Double; left0,right0:double; var x:double; name0:ansistring);overload;
procedure LocateValue(n:Double; left0,right0,ini0:double; var x:double; name0:ansistring);overload;
procedure LocateValueNowait(n:Double; var x:double; name0:ansistring);overload;
procedure LocateValueNowait(n:Double; left0,right0:double; var x:double; name0:ansistring);overload;
procedure LocateValueNowait(n:Double; left0,right0,ini0:double; var x:double; name0:ansistring);overload;
procedure LocateValue(n:Double; ini0:double; var x:double; name0:ansistring);overload;
procedure LocateValueNowait(n:Double; ini0:double; var x:double; name0:ansistring);overload;


{ASK Statements}
function ASkWindow(var x1,x2,y1,y2:double):integer;                   overload;
function ASkViewport(var x1,x2,y1,y2:double):integer;                 overload;
function ASkDeviceWindow(var x1,x2,y1,y2:double):integer;             overload;
function ASkDeviceViewport(var x1,x2,y1,y2:double):integer;           overload;

function  AskPixelSize( var var1,var2:double):integer;                  overload;
function  AskPixelSize( var var1,var2:integer):integer;                  overload;
function  AskPixelSize(n1,n2,n3,n4:double; var var1,var2:double):integer;overload;
function  AskPixelSize(n1,n2,n3,n4:double; var var1,var2:integer):integer;overload;
function  AskPixelValue(x,y:double; var var1:double):integer;            overload;
function  AskPixelArray(x,y:double; a:Tarray2N):integer;                 overload;
function  AskPixelArray(x,y:double; a:Tarray2N; s:TStrVar):integer;      overload;

function getlinecolor(var x:double):integer;            overload;
function getlinestyle(var x:double):integer;            overload;
function getlinewidth(var x:double):integer;            overload;
function getpointcolor(var x:double):integer;           overload;
function getpointstyle(var x:double):integer;           overload;
function getareacolor(var x:double):integer;            overload;
function gettextcolor(var x:double):integer;            overload;
function getmaxcolor(var x:double):integer;             overload;
function getaxiscolor(var x:double):integer;            overload;
function getMaxPointDevice(var x:double):integer;       overload;
function getMaxMultiPointDevice(var x:double):integer;  overload;
function getMaxChoiceDevice(var x:double):integer;      overload;
function getMaxValueDevice(var x:double):integer;       overload;
function getAreaStyleIndex(var x:double):integer;       overload;
function getmaxlinestyle(var x:double):integer;         overload;
function getmaxpointstyle(var x:double):integer;        overload;

function ASkTextHeight(var x:double):integer;                      overload;
function AskTextAngle(var x:double):integer;                       overload;
function AskTextAngleRad(var x:double):integer;                    overload;
function AskDeviceSize(var x,y:double; t:TStrVar):integer;         overload;
function AskBitmapSize(var x,y:double):integer;                    overload;
function AskTextJustify(h,v:TStrVar):integer;                      overload;
function AskTextWidth(const s:string; var width:double):integer;   overload;
function AskColorMix(ColorIndex:double; var red,green,blue:double):integer; overload;
function AskClip(svar:TStrvar):integer;
function AskColorMode(svar:TStrvar):integer;
function AskBeamMode(svar:TStrvar):integer;

procedure FLOOD( x,y:double);
procedure FLOODFill( x,y:double);


function drawaxes0(x,y:double):boolean;
function drawgrid0(x,y:double):boolean;
function drawaxes2(x,y:double):boolean;
function drawgrid2(x,y:double):boolean;
function drawcircle(x,y:double):boolean;
function drawdisk(x,y:double):boolean;

Procedure GSAVE(const fname,pf:string);

{*************}
implementation
{*************}
uses
  Forms, Classes, SysUtils, Graphics,
  MyUtils, base,float,affine,graphsys,format,LocateFrm,locatech, gridaxes;

function PixelX(x:extended):longint;
begin
  with MyGraphSys do
    result:=DeviceX(x) - DeviceX(left);
end;

function PixelY(x:extended):longint;
begin
  with MyGraphSys do
    result:=DeviceY(bottom) - DeviceY(x)
end;

function WindowX(x:extended):extended;
begin
  with MyGraphSys do
    result:=VirtualX( DeviceX(left) + LongIntRound(x) )
end;

function WindowY(x:extended):extended;
begin
  with MyGraphSys do
    result:=VirtualY( DeviceY(bottom) - LongIntRound(x))
end;

{*********}
{SET COLOR}
{*********}
const
   idxColorMax=255;
   ercodeColor=11085;

procedure SetPointColor(x:double; InsideOfWhen:boolean); overload;
var
   c:LongInt;
begin
 c:=LongIntRound(x) and $ffffff;
 if (InsideOfWhen or not JISSetWindow)
    and not MyPalette.PaletteDisabled
    and ((c<0) or (c>idxColorMax)) then
         setexception(ercodeColor);
 MyGraphSys.PointColor:=c
end;

procedure setLineColor(x:double; InsideOfWhen:boolean); overload;
var
   c:LongInt;
begin
 c:=LongIntRound(x) and $ffffff;
 if (InsideOfWhen or not JISSetWindow)
    and not MyPalette.PaletteDisabled
    and ((c<0) or (c>idxColorMax)) then
         setexception(ercodeColor);
 MyGraphSys.SetLineColor(c)
end;

procedure setAreaColor(x:double; InsideOfWhen:boolean); overload;
var
   c:LongInt;
begin
 c:=LongIntRound(x) and $ffffff;
 if (InsideOfWhen or not JISSetWindow)
    and not MyPalette.PaletteDisabled
    and ((c<0) or (c>idxColorMax)) then
         setexception(ercodeColor);
 MyGraphSys.areaColor:=c
end;

procedure setTextColor(x:double; InsideOfWhen:boolean); overload;
var
   c:LongInt;
begin
 c:=LongIntRound(x) and $ffffff;
 if (InsideOfWhen or not JISSetWindow)
    and not MyPalette.PaletteDisabled
    and ((c<0) or (c>idxColorMax)) then
         setexception(ercodeColor);
 MyGraphSys.SetTextColor(c)
end;

procedure setAllColor(x:double; InsideOfWhen:boolean); overload;
var
   c:LongInt;
begin
 c:=LongIntRound(x) and $ffffff;
 if (InsideOfWhen or not JISSetWindow)
    and not MyPalette.PaletteDisabled
    and ((c<0) or (c>idxColorMax)) then
         setexception(ercodeColor);
 MyGraphSys.PointColor:=c;
 MyGraphSys.SetLineColor(c);
 MyGraphSys.AreaColor:=c;
 MyGraphSys.SetTextColor(c);
end;


function ColorOfName(s:string; insideofWhen:boolean):LongInt;
var
   i:integer;
begin
          for i:=1 to length(s) do s[i]:=upcase(s[i]);
          if (s='BLACK') or (s='���') then
             result:=Black
          else if (s='BLUE')or (s='���')  then
             result:=Blue
          else if (s='RED') or (s='���') then
             result:=Red
          else if s='MAGENTA' then
             result:=Magenta
          else if (s='GREEN') or (s='���') then
             result:=Green
          else if s='CYAN' then
             result:=cyan
          else if (s='YELLOW') or (s='���') then
             result:=Yellow
          else  if (s='WHITE') or (s='���') then
             result:=White
          else if s='GRAY' then
             result:=clGray
          else if s='NAVY' then
             result:=clNAVY
          else if s='SILVER' then
             result:=clSILVER
          else if s='LIME' then
             result:=clGREEN
          else
             begin
               result:=-1;
               if insideofwhen or not JISSetWindow then
                                 setexception(11085);
             end;
end;

function ColorIndex(r,g,b:double):LongInt;
begin
   result:= MyPalette.colorindex(LongIntRound(r*255)
                                +LongIntRound(g*255)*$100
                                +LongIntRound(b*255)*$10000);
end;

procedure SetPointColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            MyGraphSys.PointColor:=c;
     end
end;

procedure setLineColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            MyGraphSys.SetLineColor(c);
     end
end;

procedure setAreaColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            MyGraphSys.AreaColor:=c;
     end
end;

procedure setTextColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            MyGraphSys.SetTextColor(c);
     end
end;

procedure setAllColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            SetAllColor(c,InsideOfWhen);
     end
end;

procedure SetAxisColor(x:double; InsideOfWhen:boolean);overload;
var
   c:LongInt;
begin
   c:=LongIntRound(x);
   if c>=0 then
      GraphSys.axescolor:=c
end;

procedure SetAxisColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:LongInt;
   color:LongInt;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            SetAxisColor(c,InsideOfWhen);
     end
end;


function CoordinateTest(var l,r,b,t:double; insideofwhen:boolean):boolean;
begin
    if currenttransform<>nil then
               setexception(11004);
    if ((l=r) or (b=t)) then
         if InsideOfWhen or not JISSetWindow then
              setexception(11051)
         else
              result:=false
      else
         result:=true;
end;

procedure SetWindow(l,r,b,t:double; insideofWhen:boolean);
begin
   if CoordinateTest(l,r,b,t,insideofwhen)then
      MyGraphSys.setWindow(l,r,b,t) ;
   Application.ProcessMessages;
end;

function TestInterval(const l,r,b,t:extended):boolean;
begin
   result:=(0<=l) and (r<=1) and (0<=b) and (t<=1)
end;

procedure SetViewPort(l,r,b,t:double; InsideOfWhen:boolean);
begin
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if testInterval(l,r,b,t) then
         MyGraphSys.setViewport(l,r,b,t)
     else if InsideOfWhen or not JISSetWindow then
              setexception(11052);
end;

procedure SetDeviceWindow(l,r,b,t:double; InsideOfWhen:boolean);
begin
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if testInterval(l,r,b,t) then
         MyGraphSys.setDeviceWindow(l,r,b,t)
     else if InsideOfWhen or not JISSetWindow then
              setexception(11053);
end;

procedure SetDeviceViewPort(l,r,b,t:double; InsideOfWhen:boolean);
begin
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if (l<r) and (b<t) then
          MyGraphSys.setDeviceViewport(l,r,b,t)
     else if InsideOfWhen or not JISSetWindow then
              setexception(11054);
end;

{*********}
{SET COLOR}
{*********}

{*************}
{SET COLOR MIX}
{*************}

 procedure SetColorMixSub(c:byte;r,g,b:byte);
var
   col:TColor;
begin
  col:=r+g*word($100)+b*longint($10000) ;
  with MyGraphSys do
    begin
       MyPalette[c]:=col ;
       setlinecolor(linecolor);
       settextcolor(textcolor);
    end;
end;

procedure SetColorMix(cc:double; er,eg,eb:double; InsideofWhen:boolean);
var
   c,r,g,b:byte;
begin
      if (cc<0) or (cc>maxColor) or MyPalette.PaletteDisabled then
         if InsideOfWhen or not JISSetWindow then
               setexception(11085);

      if (er<0) or (er>1) or (eg<0) or (eg>1) or (eb<0) or (eb>1) then
         if InsideOfWhen or not JISSetWindow then
               setexception(11088);
     c:=LongIntRound(cc);
     r:=LongIntRound(er*255);
     g:=LongIntRound(eg*255);
     b:=LongIntRound(eb*255);
     setcolormixsub(c,r,g,b);
end;

procedure setPointStyle(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
  c:=LongIntRound(x);
  if (c>0) and (c<=maxpointstyle) then
    MyGraphSys.pointstyle:=c
  else if insideofwhen  or not JISSetWindow then
           setexception(11056) ;
end;

procedure setLineStyle(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
   s:TPenStyle;
begin
  c:=LongIntRound(x);
  if (c>0) and (c<=5) then
  begin
    case c of
      1:  s:=psSolid;
      2:  s:=psDash;
      3:  s:=psDot;
      4:  s:=psDashDot;
      5:  s:=psDashDotDot;
    end;
    MyGraphSys.setPenStyle(s);
  end
    else
          if insideofwhen  or not JISSetWindow then
             setexception(11062)
end;


procedure setAreaStyleIndex(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
  c:=LongIntRound(x);
  if (c>0) and (c<=6) then
    MyGraphSys.SetAreaStyleIndex(c)
  else if insideofwhen  or not JISSetWindow then
           setexception(11000) ;
end;

procedure setTextHeight(x:double; InsideOfWhen:boolean);
begin
   if x>0 then
        MyGraphSys.SetTextHeight(x)
   else if insideofWhen or not JISSetWindow then
        setexception(11073);
end;
procedure setLineWidth(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
   c:=LongIntRound(x);
   if c>0 then
      MyGraphSys.setlinewidth(c);
end;

procedure setTextAngle(x:double; AngleDegrees:boolean);
var
  a:Integer;
begin
  if not Angledegrees then
      x:=x * 180. / PI;
   a:=SysTem.Round(x - Floor(x/360.0 ) * 360.0 );
   MyGraphSys.textangle:=a;
end;

procedure setAreaStyle(const s:string);
var
   c:TAreaStyle;
begin
   if UpperCase(s)='HOLLOW' then c:=asHollow
   else if UpperCase(s)='SOLID' then c:=asSolid
   else if UpperCase(s)='HATCH' then c:=asHatch
   else setexception(11000);
   MyGraphSys.SetAreaStyle(c);
end;

procedure setTextJustify( s1,s2:string; InsideOfWhen:boolean);
 var
   h:tjHorizontal;
   v:tjVirtical;
  begin
    s1:=ansiUpperCase(s1);
    s2:=ansiUpperCase(s2);

     h:=tjLEFT;
     while (h<=tjRIGHT) and (Hjustification[h]<>s1) do inc(h);
     if system.ord(h)<=system.ord(tjRIGHT) then
        MyGraphSys.Hjustify:=h
     else if insideofwhen or not JISSetWindow then
         setexception(4102) ;

    v:=tjTOP;
    while (v<=tjBOTTOM) and (Vjustification[v]<>s2) do inc(v);
    if system.ord(v)<=system.ord(tjBOTTOM) then
       MyGraphSys.Vjustify:=v
    else if insideofwhen  or not JISSetWindow then
       setexception(4102) ;
end;


(*
procedure setpointcolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.PointColor:=c;
end;

procedure setlinecolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.setlinecolor(c);
end;

procedure setareacolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.areacolor:=c ;
end;

procedure settextcolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.settextcolor(c);
end;
*)

procedure SetClip(const s:string; insideofwhen:boolean);
begin
   with MyGraphSys do
   if Uppercase(s)='ON' then setclip(true)
   else if Uppercase(s)='OFF' then setclip(false)
   else if InsideOfWhen or not JISSetWindow then
                        setexception(4101);
end;

procedure SetTextFont(const s:string; x:double);
begin
    MyGraphSys.SetTextFont(s, LongIntRound(x));
end;

procedure SetTextBackGround(const s:string);
begin
  if UpperCase(s)='TRANSPARENT' then iBKmode:=TRANSPARENT
   else if UpperCase(s)='OPAQUE' then iBKmode:=OPAQUE
   else setexception(11000);
end;

procedure SetBitmapSize(x,y:double);
begin
   try
     MyGraphSys.setBitmapSize(LongIntRound(x),LongIntRound(y))
   except
     setexception(9050);
   end;
end;

{*************************}
{PLOT POINT and PLOT LINES}
{*************************}
var
   x0,y0:extended;

procedure ProjectivePlotTo(const x1,y1:extended);
var
  a,b,s,t,u,x,y:extended;
label
  Retry1,Retry2;
begin
  with CurrentTransform do
    begin
      if MyGraphSys.beam=true then
        begin
          a:=x1-x0;
          b:=y1-y0;
          s:=ox*a+oy*b;
          t:=-(ox*x0+oy*y0+oo);
          if s<>0 then
            begin
               t:=t/s;

               if (t>0 - 1e-14) and (t<=1 + 1e-14) then
                 begin

                   u:=t;
                 Retry1:
                   u:=u-0.0001;
                   if u>0 then
                     begin
                       x:=a*u+x0;
                       y:=b*u+y0;
                       if transform(x,y) then
                          MyGraphSys.PlotTo(x,y)
                       else
                          GOTO Retry1;
                     end;

                   MyGraphSys.beam:=false;

                   u:=1-t;
                 Retry2:
                   u:=u-0.0001;
                   if u>0 then
                     begin
                       x:=a*(1-u)+x0;
                       y:=b*(1-u)+y0;
                       if transform(x,y) then
                          MyGraphSys.PlotTo(x,y)
                       else
                          GOTO Retry2;
                     end;
                 end;
            end;
        end;

      x:=x1;
      y:=y1;
      if transform(x,y) then
         MyGraphSys.PlotTo(x,y);
      x0:=x1;
      y0:=y1;
      MyGraphSys.beam:=true;
    end;
end;

type
   TPointArray=array[ 0..1023] of TPoint;
   PPointArray=^TPointArray;

procedure GraphPoints(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   GetMem(p,sizeof(double)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            MyGraphSys.putMark(x,y);
          end;
   finally
        FreeMem(p, sizeof(double)*Length(a));
   end;
 MyGraphSys.ThinRepaint;
end;


procedure PlotPoints(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   with MyGraphSys do
     if BeamMode=bmRigorous then beam:=false;

   GetMem(p,sizeof(double)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            if currenttransform.transform(x,y) then
               MyGraphSys.putMark(x,y);
          end;
   finally
        FreeMem(p, sizeof(double)*Length(a));
   end;
 MyGraphSys.ThinRepaint;
end;

procedure GraphLines(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   MyGraphSys.beam:=false;
   GetMem(p,sizeof(double)*Length(a));
   try
        for i:=0 to High(a) div 2 do
           begin
             x:=a[2*i];
             y:=a[2*i+1];
             MyGraphSys.PlotTo(x,y);
           end
    finally
        FreeMem(p, sizeof(double)*Length(a));
   end;
   MyGraphSys.beam:=false;
  MyGraphSys.ThinRepaint;
end;

procedure PlotLines(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   GetMem(p,sizeof(double)*Length(a));
   try
      if (CurrentTransform=nil) or CurrentTransform.IsAffine then
        for i:=0 to High(a) div 2 do
           begin
             x:=a[2*i];
             y:=a[2*i+1];
             if currenttransform.transform(x,y) then
                MyGraphSys.PlotTo(x,y);
           end
      else
        for i:=0 to High(a) div 2 do
           begin
             x:=a[2*i];
             y:=a[2*i+1];
             ProjectivePlotTo(x,y)
           end;
    finally
        FreeMem(p, sizeof(double)*Length(a));
   end;
  MyGraphSys.ThinRepaint;
end;

procedure BeamOff;
begin
   MyGraphSys.beam:=false;
end;

{*********}
{PLOT AREA}
{*********}

type
   TCoordinate=Packed Record
               x,y:extended;
           end;
   TCoordinateArray=Packed Array[0..1023] of TCoordinate;
   PCoordinateArray=^TCoordinateArray;

 function NormalSegment(const x0,y0,x1,y1:extended):boolean;
var
  a,b,s,t:extended;
begin
  result:=true;
  if CurrentTransform=nil then exit;
  with CurrentTransform do
    begin
      a:=x1-x0;
      b:=y1-y0;
      s:=ox*a+oy*b;
      t:=-(ox*x0+oy*y0+oo);
      if s<>0 then
        begin
           t:=t/s;
           if (t>=0) and (t<=1) then
              result:=false;
        end
      else if t=0 then
        result:=false;
    end
end;

function TestNormalSegments(p:PCoordinateArray; count:integer):boolean;
var
   i:integer;
begin
   result:=true;
   for i:=0 to count-1 do
       result:=result and NormalSegment(p^[i].x, p^[i].y,
                           p^[(i+1)mod count].x, p^[(i+1)mod count].y);
end;


function Inner(x,y:extended; p:PCoordinateArray; count:integer):boolean;
var
  i:integer;
  x0,y0,x1,y1,y2:extended;
  xt:extended;
begin
  if (p^[0].x = p^[count-1].x) and (p^[0].y = p^[count-1].y) then dec(count);

  result:=false;

  for i:=0 to count -1 do
    begin
       x0:=p^[i].x;
       y0:=p^[i].y;
       x1:=p^[(i+1) mod count].x;
       y1:=p^[(i+1) mod count].y;
       y2:=p^[(i+2) mod count].y;

       if (y0 - y) * (y - y1) >0 then
          begin
             xt:=(x1-x0)/(y1-y0)*(y-y0)+x0;
             if x=xt then begin result:=true; exit end
             else if x<xt then result:=not result;
          end
       else if y=y1 then
          begin
            if (y0=y1) then
               begin
                 if ((x -x0)*(x - x1)<=0) then
                    begin result:=true ; exit end ;
               end
            else if (y=y1) and ((y0 - y1)*(y1 - y2)>0) then
               begin
                 if x<x1 then result:= not result
               end
          end
    end;
end;

function ReMakeList(p:PCoordinateArray; q:PPointArray; count:integer; GRAPHst:boolean):integer; //���������������������
var
  i,index:integer;
  x,y:extended;
begin
  result:=0;
  for i:=0 to count-1 do
    begin
      x:=p^[i].x;
      y:=p^[i].y;
      if GRAPHst or currenttransform.transform(x,y) then
         begin
           q^[result].x:=restrict(MyGraphSys.deviceX(x));
           q^[result].y:=restrict(MyGraphSys.deviceY(y));
           inc(result)
        end
    end;
end;


procedure ProjectivePolygonSub(p:PCoordinateArray; lim:integer);
var
   q:PPointArray;
   a,b:integer;
   x,y,yy:extended;
begin
     if TestNormalSegments(p,lim) then
       begin
         GetMem(q,lim*sizeof(TPoint));
         try
           MyGraphSys.Polygon(slice(q^,ReMakeList(p,q,lim,false)));
         finally
           Freemem(q,lim*sizeof(TPoinT));
         end
       end
     else
       with MyGraphSys do
         for b:=ClipRect.top to Cliprect.Bottom do
           begin
             yy:=virtualY(b);
             for a:=ClipRect.Left to Cliprect.Right do
                begin
                   x:=virtualX(a);
                   y:=yy;
                   if currenttransform.invtransform(x,y) then
                       if inner(x,y,p,lim) then
                          PutColor(a,b,areacolor);
                end;
           end;
end;

procedure PlotAreaProjective(Const a:Array of double);
var
   P:PCoordinateArray;
   i:integer;
   count:integer;
begin
   count:=Length(a) div 2;
   GetMem(p, count*SizeOf(TCoordinate));
   try
      for i:=0 to count -1 do
         begin
            p^[i].x:=a[2*i];
            p^[i].y:=a[2*i+1];
         end;
      ProjectivePolygonSub(p,count);
   finally
      FreeMem(p, count*SizeOf(TCoordinate));
   end;
end;

procedure PlotAreaNormal(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   GetMem(p,sizeof(TPoint)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            if not currenttransform.transform(x,y) then exit;
            p^[i].x:=restrict(MyGraphSys.deviceX(x));
            p^[i].y:=restrict(MyGraphSys.deviceY(y));
          end;
      MyGraphSys.Polygon(Slice(p^,Length(a) div 2));
   finally
      FreeMem(p, sizeof(TPoint)*Length(a));
   end;
end;

procedure PlotArea(const a: array of double);      overload;
begin
   with MyGraphSys do
     if BeamMode=bmRigorous then beam:=false;

   if (CurrentTransform=nil) or CurrentTransform.IsAffine then
      PlotAreaNormal(a)
    else
      PlotAreaProjective(a);
 MyGraphSys.ThinRepaint;
end;

procedure GraphArea(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   BeamOff;
   GetMem(p,sizeof(TPoint)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            p^[i].x:=restrict(MyGraphSys.deviceX(x));
            p^[i].y:=restrict(MyGraphSys.deviceY(y));
          end;
      MyGraphSys.Polygon(Slice(p^,Length(a) div 2));
   finally
      FreeMem(p, sizeof(TPoint)*Length(a));
   end;
 MyGraphSys.ThinRepaint;
end;


{*********}
{PLOT TEXT}
{*********}


procedure GraphText(x,y:double; const s:string);
begin
   with MyGraphSys do beam:=false;
   MyGraphSys.PutText(x,y,s);
 MyGraphSys.ThinRepaint;
end;

procedure PlotText(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotText(x,y,s);
 MyGraphSys.ThinRepaint;
end;

function TextUsing(const form:string; a:array of const):String;
var
  i,code,c:integer;
  s:string;
begin
   i:=1;
   s:=literals(form,i);
   for c:=0 to High(a) do
      begin
        with a[c] do
          case VType of
            vtInteger:   s:=s + formatEx(VInteger,form,i,code);
            vtInt64:     s:=s + formatEx(VINT64^,form,i,code);
            vtExtended:  s:=s + formatEx(VExtended^,form,i,code);
            vtchar:      s:=s + formatStr(VChar,form,i,code);
            vtString:    s:=s + formatStr(VString^,form,i,code);
            vtAnsiString:s:=s + formatStr(string(VAnsiString),form,i,code);
          end;
        s:=s +literals(form,i)
      end;
    result:=s;
end;

procedure PlotTextUsing(x,y:double; const form:string; a:array of const);
begin
   PlotText(x,y,TextUsing(form,a));
end;

procedure GraphTextUsing(x,y:double; const form:string; a:array of const);
begin
   GraphText(x,y,TextUsing(form,a));
end;

procedure GraphLabel(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   MyGraphSys.PutText(x,y,s);
  MyGraphSys.ThinRepaint;
end;

procedure PlotLabel(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
       MyGraphSys.PutText(x,y,s);
  MyGraphSys.ThinRepaint;
end;

procedure PlotLetters(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotLetters(x,y,s);
   MyGraphSys.ThinRepaint;
end;

procedure GraphLabelUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLabel(x,y,TextUsing(form,a));
end;

procedure PlotlabelUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLabel(x,y,TextUsing(form,a));
end;


procedure PlotLettersUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLetters(x,y,TextUsing(form,a));
end;


{********}
{MAT PLOT}
{********}


procedure MatPlotPointsSub(n:integer; const m1,m2:TArray1N);overload;
var
   i:integer;
   x,y:double;
begin
   for i:=0 to n-1 do
      begin
         x:=m1.elements[i];
         y:=m2.elements[i];
         if currenttransform.transform(x,y) then
            MyGraphSys.putMark(x,y);
      end;
end;

procedure MatPlotPointsSub(n:integer; const m:TArray2N);overload;
var
   i:integer;
   s:integer;
   x,y:double;
begin
   s:=m.size2;
   if s<=1 then
      setexception(6401);

   for i:=0 to n-1 do
      begin
         x:=m.elements[i*s];
         y:=m.elements[i*s+1];
         if currenttransform.transform(x,y) then
            MyGraphSys.putMark(x,y);
      end;
end;


function SetCoordinate(p:PPointArray; n:integer; x,y:TArray1N):boolean;overload;
var
   i:integer;
   xx,yy:double;
begin
   result:=false;
   for i:=0 to n-1 do
     begin
        xx:=x.elements[i];
        yy:=y.elements[i];
        if not currenttransform.transform(xx,yy) then exit;
        p^[i].x:=restrict(MyGraphSys.deviceX(xx));
        p^[i].y:=restrict(MyGraphSys.deviceY(yy));
     end;
   result:=true;
end;

function SetCoordinate(p:PPointArray; n:integer; m:TArray2N):boolean;overload;
var
   i:integer;
   s:integer;
   xx,yy:double;
begin
   result:=false;
   s:=m.Size2;
   if s<=1 then
      setexception(6401);

   for i:=0 to n-1 do
     begin
        xx:=m.elements[i*s];
        yy:=m.elements[i*s+1];
        if not currenttransform.transform(xx,yy) then exit;
        p^[i].x:=restrict(MyGraphSys.deviceX(xx));
        p^[i].y:=restrict(MyGraphSys.deviceY(yy));
     end;
   result:=true;
end;


procedure MatPlotLinesSub(n:integer; const x,y:TArray1N);overload;
var
   p:PPointArray;
begin
   BeamOff;
   Getmem(p,n*sizeof(TPoint));
   try
      if SetCoordinate(p,n,x,y) then
         MyGraphSys.PolyLine(slice(p^,n));
   finally
      Freemem(p,n*sizeof(TPoint));
   end;
   MyGraphSys.beam:=false;
   MyGraphSys.ThinRepaint;
end;

procedure MatPlotLinesSub(n:integer; const m:TArray2N);overload;
var
   p:PPointArray;
begin
   BeamOff;
   Getmem(p,n*sizeof(TPoint));
   try
      if SetCoordinate(p,n,m) then
         MyGraphSys.PolyLine(slice(p^,n));
   finally
      Freemem(p,n*sizeof(TPoint));
   end;
   MyGraphSys.beam:=false;
   MyGraphSys.ThinRepaint;
end;

procedure MatPlotAreaSub(n:integer; const x,y:TArray1N);overload;
var
   p:PDoubleArray;
   i:integer;
begin
   if n<3 then setexception(11100);
   Getmem(p,2*n*sizeof(Double));
   try
      for i:=0 to n-1 do
         begin
           p^[2*i]:=x.elements^[i];
           p^[2*i+1]:=y.elements^[i];
         end;
      PlotArea(slice(p^,2*n))
   finally
      Freemem(p,2*n*sizeof(Double));
   end;
   MyGraphSys.ThinRepaint;
end;

procedure MatPlotAreaSub(n:integer; const m:TArray2N);overload;
begin
   if n<3 then setexception(11100);
   PlotArea(slice(m.elements^,n*2))
end;


procedure MatPlotPoints(const x,y:TArray1N);overload;
begin
   if x.Size=y.Size then
      MatPlotPointsSub(x.Size, x, y)
   else
      SetException(6401);
end;

procedure MatPlotPoints(const m:TArray2N);overload;
begin
    MatPlotPointsSub(m.Size1, m)
end;

procedure MatPlotLines(const x,y:TArray1N);overload;
begin
   if (x.Size=y.Size) then
      MatPlotLinesSub(x.Size, x, y)
   else
      SetException(6401);
end;

procedure MatPlotLines(const m:TArray2N);overload;
begin
   MatPlotLinesSub(m.size1, m)
end;

procedure MatPlotArea(const x,y:TArray1N);overload;
begin
   if (x.Size=y.Size) then
      MatPlotAreaSub(x.Size, x, y)
   else
      SetException(6401);
end;


procedure MatPlotArea(const m:TArray2N);overload;
begin
   MatPlotAreaSub(m.size1, m)
end;

procedure MatPlotPointsLimit(n:double; const x,y:TArray1N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>=0) and (nn<=x.size1) and (nn<=y.size1) then
         MatPlotPointsSub(nn, x,y)
      else
         SetException(6402)
end;

procedure MatPlotPointsLimit(n:double; const m:TArray2N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>=0) and (nn<=m.size1)  then
         MatPlotPointsSub(nn, m)
      else
         SetException(6402)
end;


procedure MatPlotLinesLimit(n:double; const x,y:TArray1N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>0) and (nn<=x.size1) and (nn<=y.size1) then
         MatPlotLinesSub(nn, x,y)
      else
         SetException(6402)
end;

procedure MatPlotLinesLimit(n:double; const m:TArray2N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>0) and (nn<=m.size1)  then
         MatPlotLinesSub(nn, m)
      else
         SetException(6402)
end;

procedure MatPlotAreaLimit(n:double; const x,y:TArray1N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>0) and (nn<=x.size1) and (nn<=y.size1) then
         MatPlotAreaSub(nn, x,y)
      else
         SetException(6402)
end;


procedure MatPlotAreaLimit(n:double; const m:TArray2N);overload;
var
   nn:integer;
begin
   nn:=LongIntRound(n);
   if (nn>0) and (nn<=m.size1)  then
         MatPlotAreaSub(nn, m)
      else
         SetException(6402)
end;


{**************}
{MAT PLOT CELLS}
{**************}

procedure MatCells(p:TArray2N; const x1,y1,x2,y2:double; GRAPHst,insideofWhen:boolean);
var
   a,b,i,j:integer;
   color:longint;
   x,y,w,h:extended;
   xx,yy,dx,dy:extended;
   //colorbyte:^byte;
   svDrawMode:boolean;
   PaletteDisabled:boolean;
   red,green,blue:byte;
   Points:array[1..4]of TPoint;
   a1,b1,a2,b2,a3,b3,a4,b4:extended;
   f:boolean;
begin
   if p.size=0 then exit;

   f:=false;
   if (MyGraphSys is TScreenBMPGraphSys)
     and ((CurrentTransform=nil)
       or CurrentTransform.IsAffine and (abs(CurrentTransform.det)>1/1024)) then
   begin

     PaletteDisabled:=MyPalette.PaletteDisabled;
     svDrawMode:=GraphSys.HiddenDrawMode;
     MyGraphSys.SetHiddenDrawMode(true);

      x:=MyGraphSys.virtualX(0);
      y:=MyGraphSys.virtualY(0);
     dx:=MyGraphSys.virtualX(1);
     dy:=MyGraphSys.virtualY(1);
     if not GRAPHst then
        begin
          currenttransform.invtransform(x,y);
          currenttransform.invtransform(dx,dy);
        end;
     dx:=dx-x;
     dy:=y-dy;

     if (x2-x1)*dx<0 then
         dx:=-dx;
     if (y2-y1)*dy<0 then
         dy:=-dy;
     w:=p.size1/(x2-x1+dx);
     h:=p.size2/(y2-y1+dy);

     with TScreenBMPGraphSys(MyGraphSys) do
     for b:=ClipRect.top to Cliprect.Bottom do
       begin
         (*
         colorbyte:=BitMap1.ScanLine[b];
         *)
         y:=virtualY(b);
         yy:=y;
         for a:=ClipRect.Left to Cliprect.Right do
            begin
                 x:=virtualX(a);
                 y:=yy;
                 if not GRAPHst then
                    currenttransform.invtransform(x,y);
                 i:=floor(w*(x-x1)+1e-9 {���������������������});
                 j:=floor(h*(y-y1)+1e-9 {���������������������});
                (*
                 if  (i>=0) and (i<p.size[1]) and (j>=0) and (j<p.size[2]) then
                   begin
                     with p do color:=ItemEvaLInteger(i*size[2]+j);
                     if (color>=0) and
                     ((color<=maxcolor) or PaletteDisabled) then
                     begin
                        if not PaletteDisabled then
                           color:=MyPalette[color];
                        red:=byte(color);
                        color:=color shr 8;
                        green:=byte(color);
                        color:=color shr 8;
                        blue:=byte(color);
                        colorbyte^:=blue;
                        inc(colorbyte);
                        colorbyte^:=green;
                        inc(colorbyte);
                        colorbyte^:=red;
                        inc(colorbyte);
                        inc(colorbyte);
                     end;
                   end
                 else
                   inc(colorbyte,4);  //32���������BMP
                *)

                 if  (i>=0) and (i<p.size1) and (j>=0) and (j<p.size2) then
                   begin
                     with p do color:=LongintRound(elements^[i*size2+j]);
                     if not ((color>=0) and (color<=maxcolor) or PaletteDisabled) then f:=true;
                     if not PaletteDisabled then
                           color:=MyPalette[color];
                     Bitmap1.Canvas.pixels[a,b]:=color;
                   end;

            end;
       end;
     MyGraphSys.setHiddenDrawMode(SvDrawMode);
   end
  else if (CurrentTransform<>nil) and (abs(CurrentTransform.det)>1/1024) and
        ((MyGraphSys is TScreenBMPGraphSys) or
                                     not   (NormalSegment(x1,y1,x1,y2)
                                        and NormalSegment(x1,y2,x2,y2)
                                        and NormalSegment(x2,y2,x2,y1)
                                        and NormalSegment(x2,y1,x1,y1))) then
     begin
       w:=(p.size1-0.0001)/(x2-x1);
       h:=(p.size2-0.0001)/(y2-y1);

       with MyGraphSys do
         for b:=ClipRect.top to Cliprect.Bottom do
           begin
             yy:=virtualY(b);
             for a:=ClipRect.Left to Cliprect.Right do
                begin
                   x:=virtualX(a);
                   y:=yy;
                   if currenttransform.invtransform(x,y) then
                     try
                       i:=floor(w*(x-x1)+1e-9 {���������������������});
                       j:=floor(h*(y-y1)+1e-9 {���������������������});
                       if  (i>=0) and (i<p.size1) and (j>=0) and (j<p.size2) then
                         begin
                           with p do color:=LongintRound(elements^[i*size2+j]);
                           if not ((color>=0) and (color<=maxcolor) or PaletteDisabled) then f:=true;
                           PutColor(a,b,color);
                         end;
                     except
                     end;
                end;
           end;
     end
   else
     begin
       w:=(x2-x1)/p.size1;
       h:=(y2-y1)/p.size2;
       x:=x1;
       y:=y1;
       for i:=0 to p.size1-1 do
        begin
          for j:=0 to p.size2-1 do
           begin
             with p do color:=LongIntRound(elements^[i*size2+j]);
             if not ((color>=0) and (color<=maxcolor) or PaletteDisabled) then f:=true;
             x:=x1+w*i; xx:=x+w;
             y:=y1+h*j; yy:=y+h;
             a1:=x; b1:=y;
             a2:=xx;b2:=y;
             a3:=xx;b3:=yy;
             a4:=x; b4:=yy;
             if GRAPHst or
                currenttransform.transform(a1,b1) and
                currenttransform.transform(a2,b2) and
                currenttransform.transform(a3,b3) and
                currenttransform.transform(a4,b4) then
               begin
                 with MyGraphSys do
                 begin
                   Points[1].x:=DeviceX(a1);  Points[1].y:=DeviceY(b1);
                   Points[2].x:=DeviceX(a2);  Points[2].y:=DeviceY(b2);
                   Points[3].x:=DeviceX(a3);  Points[3].y:=DeviceY(b3);
                   Points[4].x:=DeviceX(a4);  Points[4].y:=DeviceY(b4);
                 end;
                 MyGraphsys.ColorPolygon( Points, color);
               end;
           end;
         end;
     end;
   if insideofwhen and f then setexception(11085)
end;

procedure MatPlotCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);
begin
   MatCells(p,x1,y1,x2,y2,false,insideofWhen);
   MyGraphSys.ThinRepaint;
end;

procedure MatGraphCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);
begin
   MatCells(p,x1,y1,x2,y2,true,insideofWhen);
   MyGraphSys.ThinRepaint;
end;

{************}
{GET & LOCATE}
{************}
procedure PointAt(x0,y0:Double; LocateSt:boolean);
var
  vx,vy:integer;
begin
   if LocateSt or CurrentTransform.transform(x0,y0) then
     begin
      vx:=MyGraphSys.deviceX(x0);
      vy:=MyGraphSys.deviceY(y0);
      MyGraphSys.MoveMouse(vx,vy);
     end;
end;

procedure GetPointSub(var x,y:Double; NoBeamOff:boolean; LocateSt:boolean);
var
  vx,vy:integer;
begin
    with MyGraphSys do
      beam:=beam and ((BeamMode=bmImmortal) or NoBeamOff);
    MyGraphSys.getpoint(vx,vy);
    x:=MyGraphSys.virtualX(vx);
    y:=MyGraphSys.virtualY(vy);
    if LOCATEst or currenttransform.invtransform(x,y) then
      begin
      end
    else
      setexception(-3009)
end;

procedure GetPoint(var x,y:Double; NoBeamOff:boolean; Locatest:boolean);
begin
   GetPointSub(x,y,NoBeamOff,Locatest)
end;

procedure MousePoll(var x,y,l,r:Double);
var
   vx,vy:integer;
   left,right:boolean;
begin
   MyGraphSys.MousePol(vx,vy,left,right);
   x:=MyGraphSys.virtualX(vx);
   y:=MyGraphSys.virtualY(vy);
   if currenttransform.invtransform(x,y) then
      begin
         l:=byte(left);
         r:=byte(right);
      end
   else
      setexception(-3009)
end;


Procedure LocateChoice( var x:Double);
begin
  LocateChoice(8,x)
end;

Procedure LocateChoice(n:Double; var x:Double);
begin
  if n=1 then n:=8;
  LocateChoice(n,0,x)
end;


Procedure LocateChoice(n,i0:Double; var x:Double);
var
  dev0,ini0:integer;
  capts:TStringList;
  i:integer;
begin
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
   dev0:=LongIntRound(n);
   ini0:=LongIntRound(i0);
   if (dev0>255) or (dev0<=0) then
       setexception(11140);
   capts:=TStringList.create;
   try
      for i:=1 to dev0 do
          Capts.Add(inttostr(i));
       x:=LocateChoiceForm.Choice(dev0,ini0,Capts)
   finally
       capts.free
   end;
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
end;

Procedure LocateChoice(const a:TArray1S; var x:Double);
var
  dev0,ini0:integer;
  capts:TStringList;
  i:integer;
begin
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
   ini0:=0;
   dev0:=a.Size1;
   if (dev0>255) or (dev0<=0) then
       setexception(11140);
   capts:=TStringList.create;
   try
      with a do
           begin
             for i:=0 to size-1 do
                capts.add(elements^[i]);
           end;
       x:=LocateChoiceForm.Choice(dev0,ini0,Capts);
   finally
       capts.free
   end;
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
end;

procedure LocateValue(n:Double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(false,false,false,0,1,0.5,name0);
   2:  x:=LocateForm.Value2(false,false,false,0,1,0.5,name0);
   3:  x:=LocateForm.Value3(false,false,false,0,1,0.5,name0);
   4:  x:=LocateForm.Value4(false,false,false,0,1,0.5,name0);
   5:  x:=LocateForm.Value5(false,false,false,0,1,0.5,name0);
  end;
end;

procedure LocateValue(n:Double; left0,right0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(true,false,false,left0,right0,0.5,name0);
   2:  x:=LocateForm.Value2(true,false,false,left0,right0,0.5,name0);
   3:  x:=LocateForm.Value3(true,false,false,left0,right0,0.5,name0);
   4:  x:=LocateForm.Value4(true,false,false,left0,right0,0.5,name0);
   5:  x:=LocateForm.Value5(true,false,false,left0,right0,0.5,name0);
  end;
end;

procedure LocateValue(n:Double; left0,right0,ini0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(true,true,false,left0,right0,ini0,name0);
   2:  x:=LocateForm.Value2(true,true,false,left0,right0,ini0,name0);
   3:  x:=LocateForm.Value3(true,true,false,left0,right0,ini0,name0);
   4:  x:=LocateForm.Value4(true,true,false,left0,right0,ini0,name0);
   5:  x:=LocateForm.Value5(true,true,false,left0,right0,ini0,name0);
  end;
end;

procedure LocateValueNowait(n:Double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(false,false,true,0,0,0,name0);
   2:  x:=LocateForm.Value2(false,false,true,0,0,0,name0);
   3:  x:=LocateForm.Value3(false,false,true,0,0,0,name0);
   4:  x:=LocateForm.Value4(false,false,true,0,0,0,name0);
   5:  x:=LocateForm.Value5(false,false,true,0,0,0,name0);
  end;
end;

procedure LocateValueNowait(n:Double; left0,right0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(true,false,true,left0,right0,0,name0);
   2:  x:=LocateForm.Value2(true,false,true,left0,right0,0,name0);
   3:  x:=LocateForm.Value3(true,false,true,left0,right0,0,name0);
   4:  x:=LocateForm.Value4(true,false,true,left0,right0,0,name0);
   5:  x:=LocateForm.Value5(true,false,true,left0,right0,0,name0);
  end;
end;

procedure LocateValueNowait(n:Double; left0,right0,ini0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(true,true,true,left0,right0,ini0,name0);
   2:  x:=LocateForm.Value2(true,true,true,left0,right0,ini0,name0);
   3:  x:=LocateForm.Value3(true,true,true,left0,right0,ini0,name0);
   4:  x:=LocateForm.Value4(true,true,true,left0,right0,ini0,name0);
   5:  x:=LocateForm.Value5(true,true,true,left0,right0,ini0,name0);
  end;
end;

procedure LocateValue(n:Double; ini0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(false,true,false,0,0,ini0,name0);
   2:  x:=LocateForm.Value2(false,true,false,0,0,ini0,name0);
   3:  x:=LocateForm.Value3(false,true,false,0,0,ini0,name0);
   4:  x:=LocateForm.Value4(false,true,false,0,0,ini0,name0);
   5:  x:=LocateForm.Value5(false,true,false,0,0,ini0,name0);
  end;
end;

procedure LocateValueNowait(n:Double; ini0:double; var x:double; name0:ansistring);overload;
begin
  case LongIntRound(n) of
   1:  x:=LocateForm.Value1(false,true,false,0,0,ini0,name0);
   2:  x:=LocateForm.Value2(false,true,false,0,0,ini0,name0);
   3:  x:=LocateForm.Value3(false,true,false,0,0,ini0,name0);
   4:  x:=LocateForm.Value4(false,true,false,0,0,ini0,name0);
   5:  x:=LocateForm.Value5(false,true,false,0,0,ini0,name0);
  end;
end;


procedure MatGetPointVarilen(m:TArray2N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:integer;
   x,y:extended;
   i:integer;
   left,right:boolean;
begin
  MyGraphsys.beam:=false;
       vx0:=low(integer);
       vy0:=low(integer);

       maxlen:=m.MaxSize div 2;
       m.size2:=2;

       repeat
           sleep(10);
           MyGraphSys.MousePol(vx,vy,left,right)
       until left=false;
       repeat
           sleep(10);
           MyGraphSys.MousePol(vx,vy,left,right)
       until left=true;
       i:=0;
       while (i<maxlen) and (left=true) do
         begin
           if (vx<>vy0)or(vy<>vy0) then
             begin
               x:=MyGraphsys.virtualX(vx);
               y:=MyGraphsys.VirtualY(vy);
               if Locatest or CurrentTransform.InvTransform(x,y) then
                 with m do
                   begin
                     elements^[i*size2]:=x;
                     elements^[i*size2+1]:=y;
                   end
               else
                 setexception(-3009)  ;
             end;
           inc(i);
           sleep(20);
           MyGraphSys.MousePol(vx,vy,left,right)
         end;
       if i=maxlen then beep;

       m.size1:=i;
end;

procedure MatGetPointVarilen(m1,m2:TArray1N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:integer;
   x,y:extended;
   i:integer;
   left,right:boolean;
begin
   MyGraphsys.beam:=false;
   vx0:=low(integer);
   vy0:=low(integer);

   maxlen:=min(m1.MaxSize,m2.MaxSize);

   repeat
       sleep(10);
       MyGraphSys.MousePol(vx,vy,left,right)
   until left=false;
   repeat
       sleep(10);
       MyGraphSys.MousePol(vx,vy,left,right)
   until left=true;

   i:=0;
   while (i<maxlen) and (left=true) do
     begin
       if (vx<>vy0)or(vy<>vy0) then
         begin
           x:=MyGraphsys.virtualX(vx);
           y:=MyGraphsys.VirtualY(vy);
           if Locatest or CurrentTransform.InvTransform(x,y) then
              begin
                 m1.elements^[i]:=x;
                 m2.elements^[i]:=y;
              end
           else
             setexception(-3009)  ;
         end;
       inc(i);
       sleep(20);
       MyGraphSys.MousePol(vx,vy,left,right)
     end;
   if i=maxlen then beep;

   m1.size1:=i;
   m2.size1:=i;
end;

procedure MatGetPoint(m1,m2:TArray1N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:integer;
   x,y:extended;
   i:integer;
   left,right:boolean;

begin
   maxlen:=m1.size1;
   if maxlen<>m2.size1 then  setexception(6401);

   MyGraphsys.beam:=false;

   for i:=0 to maxlen-1 do
     begin
        MyGraphsys.getpoint(vx,vy);
        x:=MyGraphsys.virtualX(vx);
        y:=MyGraphsys.VirtualY(vy);
        if Locatest or CurrentTransform.InvTransform(x,y) then
             begin
               m1.elements^[i]:=x;
               m2.elements^[i]:=y;
             end
        else
           setexception(-3009) ;
     end;
end;

procedure MatGetPoint(m:TArray2N; Locatest:boolean);overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:integer;
   x,y:extended;
   i:integer;
   left,right:boolean;
begin
   if m.size2<2 then
       setexception(6401);
   maxlen:=m.size1;

   MyGraphsys.beam:=false;

   for i:=0 to maxlen-1 do
     begin
        MyGraphsys.getpoint(vx,vy);
        x:=MyGraphsys.virtualX(vx);
        y:=MyGraphsys.VirtualY(vy);
        if Locatest or CurrentTransform.InvTransform(x,y) then
           with m do
             begin
                elements^[i*size2]:=x;
                elements^[i*size2+1]:=y;
             end
        else
           setexception(-3009) ;
     end;
end;

{**************}
{ASK Statements}
{**************}
function ASkWindow(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=left;
      x2:=right;
      y1:=bottom;
      y2:=top;
    end;
end;

function ASkViewport(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=VPleft;
      x2:=VPright;
      y1:=VPbottom;
      y2:=VPtop;
    end;
end;

function ASkDeviceWindow(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=DWleft;
      x2:=DWright;
      y1:=DWbottom;
      y2:=DWtop;
    end;
end;

function ASkDeviceViewport(var x1,x2,y1,y2:double):integer;
var
   l,r,b,t:extended;
begin
  result:=0;
   MyGraphSys.AskDeviceViewPort(l,r,b,t);
   x1:=l;
   x2:=r;
   y1:=b;
   y2:=t;
end;


function AskPixelSize( var var1,var2:double):integer;overload;
begin
  result:=0;
  var1:=MyGraphSys.GWidth;
  var2:=MyGraphSys.GHeight
end;


function AskPixelSize(n1,n2,n3,n4:double; var var1,var2:double):integer;overload;

    function Floor(x:extended):extended; assembler;
    asm
        FLD x
        FLDCW RoundNins
        FRNDINT
        FLDCW RoundMost
    end;
    function Ceil(x:extended):extended; assembler;
    asm
        FLD x
        FLDCW RoundPlus
        FRNDINT
        FLDCW RoundMost
    end;
const eps=1e-15;
var
   t:extended;
   x1,x2,y1,y2:extended;
begin
    result:=0;
    (*
    if n1>n3 then begin t:=n3; n3:=n1; n1:=t end;
    if n2<n4 then begin t:=n4; n4:=n2; n2:=t end;
    *)
    with MyGraphSys do
    if (n1-n3)*(right-left)>0 then begin t:=n3; n3:=n1; n1:=t end;    //2011.11.6
    with MyGraphSys do
    if (n2-n4)*(top-bottom)<0 then begin t:=n4; n4:=n2; n2:=t end;    //2011.11.6

    x1:=ceil(MyGraphSys.DeviceX(n1)-eps);
    x2:=floor(MyGraphSys.DeviceX(n3)+eps);
    y1:=ceil(MyGraphSys.DeviceY(n2)-eps);
    y2:=floor(MyGraphSys.DeviceY(n4)+eps);
    var1:=x2-x1+1;
    var2:=y2-y1+1;
        (*
        if MyGraphSys is TScreenGraphSys then
          begin
            x1:=ceil((n1-left)*TScreenGraphSys(MyGraphSys).HMulti-eps);
            x2:=floor((n3-left)*TScreenGraphSys(MyGraphSys).HMulti+eps);
            y1:=ceil((top-n2)*TScreenGraphSys(MyGraphSys).VMulti-eps);
            y2:=floor((top-n4)*TScreenGraphSys(MyGraphSys).VMulti+eps);
            var1.assignX(x2-x1+1);
            var2.assignX(y2-y1+1)
          end
        else
          begin
            var1.assignX(0);
            var2.assignX(0)
          end
        *)
end;

function AskPixelSize( var var1,var2:integer):integer;overload;
var
   x1,x2:double;
begin
  result:=AskPixelsize(x1,x2);
  var1:=System.Round(x1);
  var2:=System.Round(x2);
end;

function AskPixelSize(n1,n2,n3,n4:double; var var1,var2:integer):integer;overload;
var
   x1,x2:double;
begin
  result:=AskPixelsize(n1,n2,n3,n4,x1,x2);
  var1:=System.Round(x1);
  var2:=System.Round(x2);
end;


function AskPixelValue(x,y:double; var var1:double):integer;
begin
  result:=0;
  var1:=MyGraphSys.ColorIndexOf(MyGraphSys.DeviceX(x),MyGraphSys.DeviceY(y))
end;

function AskPixelArraySub(x,y:double; a:Tarray2N):boolean;
var
   x1,y1:longint;
   i,j:longint;
   c:integer;
begin
       x1:=MyGraphSys.DeviceX(x);
       y1:=MyGraphSys.DeviceY(y);
       result:=true;
       if a<>nil then
          begin
             for i:=0 to a.size1-1 do
                 for j:=0 to a.size2-1 do
                     begin
                         c:=MyGraphSys.ColorIndexOf(x1+i,y1+j);
                         with a do elements^[i*size2+j]:=c;
                         if c=-1 then result:=false;
                     end;
          end;

end;

function AskPixelArray(x,y:double; a:Tarray2N):integer; overload;
begin
  result:=0;
  AskPixelArraySub(x,y,a)
end;

function AskPixelArray(x,y:double; a:Tarray2N; s:TStrVar):integer; overload;
begin
  result:=0;
   if AskPixelArraySub(x,y,a) then
      s.str:= 'ABSENT'
   else
      s.str:='PRESENT';
   s.free
end;

function getlinecolor(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.linecolor;
end;

function getlinestyle(var x:double):integer;
begin
    result:=0;
    x:=Integer(MyGraphSys.PenStyle) + 1;
end;

function getlinewidth(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.linewidth;
end;

function getpointcolor(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.pointcolor;
end;

function getpointstyle(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.pointstyle;
end;

function getareacolor(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.areacolor;
end;

function gettextcolor(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.textcolor;
end;

function getmaxcolor(var x:double):integer;
begin
    result:=0;
    if mypalette.PaletteDisabled then
      x:=$ffffff
    else
      x:=GraphSys.maxcolor;
end;

function getaxiscolor(var x:double):integer;
begin
    result:=0;
    x:=GraphSys.axescolor;
end;

function getMaxPointDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxMultiPointDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxChoiceDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxValueDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getAreaStyleIndex(var x:double):integer;
begin
    result:=0;
    x:=MyGraphSys.AreaStyleIndex;
end;

function getmaxlinestyle(var x:double):integer;
begin
    result:=0;
    x:=MaxLineStyle
end;

function getmaxpointstyle(var x:double):integer;
begin
    result:=0;
    x:=MaxPointStyle
end;

function ASkTextHeight(var x:double):integer;
begin
  result:=0;
  x:=MyGraphSys.gettextheight;
end;

function AskTextAngle(var x:double):integer;
begin
   result:=0;
   x:=MyGraphSys.TextAngle;
end;

function AskTextAngleRad(var x:double):integer;
begin
   result:=0;
   x:=MyGraphSys.TextAngle/180.0*PI;
end;


function AskDeviceSize(var x,y:double; t:TStrVar):integer;
var
   w,h:extended;
   s:string;
begin
   result:=0;
   MyGraphSys.AskDeviceSize(w,h,s);
   x:=w;
   y:=h;
   t.str:=s;
   t.free;
end;

function AskBitmapSize(var x,y:double):integer;
begin
   result:=0;
     x:=MyGraphSys.GWidth;
     y:=MyGraphSys.GHeight;
end;

function AskTextJustify(h,v:TStrVar):integer;
begin
  result:=0;
  with MyGraphSys do
    begin
      h.str:=HJustification[HJustify];
      v.str:=VJustification[VJustify];
      h.free;
      v.free;
    end;
end;

function AskTextWidth(const s:string; var width:double):integer;
begin
   result:=0;
   with MyGraphSys do
       width:=VirtualX(textwidth(s))-VirtualX(0);
end;

procedure AskColorMixSub(cc:integer;var r,g,b:byte);
var
   col:TColor;
begin
   col:=MyPalette[cc];
   b:=(col and $ff0000) div $10000;
   g:=(col and $00ff00) div $100;
   r:=col and $0000ff;
end;

function AskColorMix(ColorIndex:double; var red,green,blue:double):integer;
var
   cc:longint;
   r,g,b:byte;
begin
   result:=0;
     cc:=LongIntRound(ColorIndex);
     if (cc<0) or (cc>maxcolor) and not MyPalette.paletteDisabled then
       begin
          red:=0;
          green:=0;
          blue:=0;
          result:=11086;
       end
     else
       begin
         askColorMixSub(cc,r,g,b);
         red:=r/255;
         green:=g/255;
         blue:=b/255;
       end;
end;

function AskClip(svar:TStrvar):integer;
var
   s:string;
begin
   result:=0;
   if MyGraphSys.clip then s:='ON' else s:='OFF';
   svar.str:=s;
   svar.free;
end;

function AskAreaStyle(svar:TStrvar):integer;
var
   s:string;
begin
   result:=0;
    case MyGraphSys.AreaStyle of
      asSolid: s:='SOLID';
      asHollow:s:='HOLLOW';
      asHATCH: s:='HATCH';
    end;
    svar.str:=s;
    svar.free;
end;

function AskColorMode(svar:TStrvar):integer;
begin
   result:=0;
   svar.str:=MyGraphSys.AskColorMode;
   svar.free;
end;

function AskBeamMode(svar:TStrvar):integer;
begin
   result:=0;
   svar.str:=MyGraphSys.AskBeamMode;
   svar.free;
end;


procedure FLOOD( x,y:double);
var
  a,b:longint;
begin
 if currenttransform.transform(x,y) then
   begin
     a:=MyGraphSys.deviceX(x);
     b:=MyGraphSys.deviceY(y);
     MyGraphSys.FLOOD(a,b);
   end;
end;

procedure FLOODFill( x,y:double);
var
  a,b:longint;
begin
  if currenttransform.transform(x,y) then
    begin
     a:=MyGraphSys.deviceX(x);
     b:=MyGraphSys.deviceY(y);
     MyGraphSys.FLOODFill(a,b);
    end;
end;


{***********}
{Grid & Axes}
{***********}

function drawaxes0(x,y:double):boolean;
begin
   result:=gridaxes.drawaxes0(x,y);
end;

function drawgrid0(x,y:double):boolean;
begin
   result:=gridaxes.drawgrid0(x,y);
end;

function drawaxes2(x,y:double):boolean;
begin
   result:=gridaxes.drawaxes2(x,y);
end;

function drawgrid2(x,y:double):boolean;
begin
   result:=gridaxes.drawgrid2(x,y);
end;

function drawcircle(x,y:double):boolean;
begin
   result:=gridaxes.drawcircle(x,y);
end;

function drawdisk(x,y:double):boolean;
begin
   result:=gridaxes.drawdisk(x,y);
end;

{*****}
{GSAVE}
{*****}
Procedure GSAVE(const fname,pf:string);
var
  ext:string;
  n,i:integer;
begin
  ext:=UpperCase( ExtractFileExt(fname));
  try
    if (ext='.BMP')  then
       begin
        if lowercase(pf)='4bit' then
          MyGraphSys.SaveFileFormat(fname,pf4bit)
        else if lowercase(pf)='1bit' then
          MyGraphSys.SaveFileFormat(fname,pf1bit)
        else
          MyGraphSys.SaveBMPFile(fname)
       end
    else if (ext='.JPG') or (ext='.JPEG') or (ext='.JPE') then
       begin
          n:=0;
          i:=POS('%',pf);
          if i>0 then
            {$R-}
            SYSTEM.VAL(copy(pf,1,i-1),n,i);
            {$R+}
          if (n<0) or (n>100) then n:=0;
          MyGraphSys.SaveJpegFile(fname,n) ;
       end
     else if ext='.GIF' then
          MyGraphSys.SaveGIFFile(fname)
     else if ext='.EMF' then
          MyGraphSys.SaveEMFFile(fname)
     else
       setexception(9052)
  except
    setexception(9052)
  end;
end;


end.