svn/view/gridaxes.pas

unit gridaxes;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2009, SHIRAISHI Kazuo *)
(***************************************)


interface

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


implementation

uses Types, SysUtils,Graphics,
     base,affine,graphsys,arithmet;

{**************}
{axes and grids}
{**************}

function convtodevice(x,y:extended; var i,j:integer):boolean;
begin
   result:=currenttransform.transform(x,y)
       and MyGraphSys.ConvToDevicex(x,i)
       and MyGraphSys.ConvToDevicey(y,j);
end;

function convtovirtual(i,j:integer; var x,y:extended):boolean;
begin
    x:=MyGraphSys.virtualx(i);
    y:=MyGraphSys.virtualy(j);
    result:=currenttransform.invtransform(x,y);
end;

function getboundary(var xmin,xmax,ymin,ymax:extended):boolean;
 function imax(a,b:integer):integer;
 begin
    if a<b then imax:=b
    else imax:=a
 end;
 function max(a,b:extended):extended;
 begin
    if a<b then max:=b
    else max:=a
 end;
 function min(a,b:extended):extended;
 begin
    if a<b then min:=a
    else min:=b
 end;
var
  p:array[1..4]of array[1..2] of extended;
  i:integer;
  w:word;
  cont:boolean;
begin
  cont:=true;
  with MyGraphSys.ClipRect do
    begin
    cont:=convtovirtual(left,top,p[1][1],p[1][2])
      and convtovirtual(left,bottom,p[2][1],p[2][2])
      and convtovirtual(right,top,p[3][1],p[3][2])
      and convtovirtual(right,bottom,p[4][1],p[4][2]);
    end;
{
  w:=iMax(system.round(MyGraphSys.Gwidth),System.Round(MyGraphSys.GHeight))*3 div 2;
  convtovirtual(0,0,p[1][1],p[1][2]);
  convtovirtual(0,w,p[2][1],p[2][2]);
  convtovirtual(w,0,p[3][1],p[3][2]);
  convtovirtual(w,w,p[4][1],p[4][2]);
}
  if cont then
    begin
      xmin:=p[1][1];
      for i:=2 to 4 do xmin:=min(p[i][1],xmin);
      xmax:=p[1][1];
      for i:=2 to 4 do xmax:=max(p[i][1],xmax);
      ymin:=p[1][2];
      for i:=2 to 4 do ymin:=min(p[i][2],ymin);
      ymax:=p[1][2];
      for i:=2 to 4 do ymax:=max(p[i][2],ymax);
    end;
  result:=cont;
end;


procedure line1(a1,b1,a2,b2:integer);
begin
  with MyGraphSys do
   line(a1,b1,a2,b2,axescolor,psSolid,linewidth);
end;

procedure line2(a1,b1,a2,b2:integer);
begin
  MyGraphSys.line(a1,b1,a2,b2,axescolor,psDot,1);
end;

function axessub:boolean;
var
   xmin,xmax,ymin,ymax:extended;
   i1,i2,j1,j2:integer;
begin
   axessub:=true;

   if getboundary(xmin,xmax,ymin,ymax)then
     begin
       if convtodevice(xmin,0,i1,j1) and
          convtodevice(xmax,0,i2,j2) then
          line1(i1,j1,i2,j2);

       if convtodevice(0,ymin,i1,j1) and
          convtodevice(0,ymax,i2,j2) then
          line1(i1,j1,i2,j2);
     end;
end;

function ceil(x:extended):extended;forward;
function floor(x:extended):extended;
begin
   if x>=0 then floor:=int(x)
   else       floor:=-ceil(-x)
 end;

function ceil(x:extended):extended;
begin
   if x>=0 then
      begin
          if int(x)=x then
              ceil:=int(x)
          else
              ceil:=int(x)+1
      end
   else ceil:=-floor(-x)
end;

function marksub(sx,sy:extended):boolean;
var
   x,y:extended;
   xmin,xmax,ymin,ymax:extended;
   i,j:integer;
   svpointstyle:byte;
   svpointcolor:integer;
begin
   marksub:=true;
   if (sx=0) or (sy=0) then exit;

   svpointstyle:=MyGraphSys.pointstyle;
   svpointcolor:=MyGraphSys.pointcolor;
   MyGraphSys.pointstyle:=2;
   MyGraphSys.PointColor:=axescolor;

   if getboundary(xmin,xmax,ymin,ymax) then
     begin
       xmin:=floor(xmin/sx)*sx;
       ymin:=floor(ymin/sy)*sy;
       xmax:=ceil(xmax/sx)*sx;
       ymax:=ceil(ymax/sy)*sy;

       x:=xmin;
       if (sx>0) and ((xmax-xmin)/sx<1024) then
       while (x<=xmax +sx/2) do
            begin
                if convtodevice(x,0,i,j) then
                   MyGraphSys.putmark0(i,j);
                x:=x+sx;
                idle;
            end;

       y:=ymin;
       if (sy>0) and ((ymax-ymin)/sy<1024) then
       while (y<=ymax +sy/2) do
            begin
                if convtodevice(0,y,i,j) then
                   MyGraphSys.putmark0(i,j);
                y:=y+sy;
                idle;
            end;
     end;
   MyGraphSys.pointstyle:=svpointstyle;
   MyGraphSys.pointcolor:=svpointcolor;
end;


function gridsub(sx,sy:extended):boolean;
var
   x,y:extended;
   xmin,xmax,ymin,ymax:extended;
   i1,i2,j1,j2:integer;
begin
   gridsub:=true;
   if (sx=0) or (sy=0) then exit;

   getboundary(xmin,xmax,ymin,ymax);
   xmin:=floor(xmin/sx)*sx;
   ymin:=floor(ymin/sy)*sy;
   xmax:=ceil(xmax/sx)*sx;
   ymax:=ceil(ymax/sy)*sy;

   x:=xmin;
   if (sx>0) and ((xmax-xmin)/sx<1024) then
   while (x<=xmax +sx/2) do
        begin
            if convtodevice(x,ymin,i1,j1) and
               convtodevice(x,ymax,i2,j2) then
               line2(i1,j1,i2,j2);
            x:=x+sx;
            idle;
        end;

   y:=ymin;
   if (sy>0) and ((ymax-ymin)/sy<1024) then
   while (y<=ymax +sy/2)  do
        begin
            if convtodevice(xmin,y,i1,j1) and
               convtodevice(xmax,y,i2,j2) then
               line2(i1,j1,i2,j2);
            y:=y+sy;
            idle;
        end;

end;

function str3(x,sx:extended):string;
  function int(sx:extended):longint;
  begin
      result:=trunc(sx);
      if (sx<0) and (result<>sx) then dec(result)
  end;
var
  a,b,n:number;
  i:longint;
begin
  convert(x,a);
  i:=2-int(system.ln(sx)/system.ln(10));
  initlongint(n,i);
  arithmet.round(a,n,b);
  result:=DSTR(b);
end;

function CoordinateSub(sx,sy:extended):boolean;
var
   x,y:extended;
   xmin,xmax,ymin,ymax:extended;
   i,j:integer;
   svtextcolor:integer;
   svTjH:tjHorizontal;
   svTjV:tjVirtical;
   s:string;
begin
   result:=true;
   if (sx=0) or (sy=0) then exit;
   svtextcolor:=MyGraphSys.textcolor;
   MyGraphSys.settextcolor(axesColor);
   svTjH:=MyGraphSys.Hjustify;
   svTjV:=MyGraphSys.Vjustify;
   MyGraphSys.Hjustify:=TjRight;
   MyGraphSys.Vjustify:=TjTop;

   if getboundary(xmin,xmax,ymin,ymax) then
     begin
       xmin:=floor(xmin/sx)*sx;
       ymin:=floor(ymin/sy)*sy;
       xmax:=ceil(xmax/sx)*sx;
       ymax:=ceil(ymax/sy)*sy;

       x:=xmin;
       if (sx<>0) and ((xmax-xmin)/sx<1024) then
       while (x<=xmax +sx/2)  do
            begin
                s:=str3(x,sx);
                if convtodevice(x,0,i,j) then
                   MyGraphSys.textout(i,j,s, MyGraphSys.xdirection(x,0));
                x:=x+sx;
                idle;
            end;

       y:=ymin;
       if (sy<>0) and ((ymax-ymin)/sy<1024) then
       while (y<=ymax +sy/2)  do
            begin
                s:=str3(y,sy);
                if convtodevice(0,y,i,j) then
                   MyGraphSys.textout(i,j,s, MyGraphSys.xdirection(0,y));
                y:=y+sy;
                idle;
            end;
     end;

   MyGraphSys.settextcolor(svTextColor);
   MyGraphSys.Hjustify:=svTjH;
   MyGraphSys.Vjustify:=svTjV;
end;


function drawaxes0(x,y:extended):boolean;
begin
   drawaxes0:=axessub and marksub(x,y)
end;

function drawgrid0(x,y:extended):boolean;
begin
   drawgrid0:=gridsub(x,y) and axessub
end;

function drawaxes2(x,y:extended):boolean;
begin
   drawaxes2:=axessub and marksub(x,y)  and CoordinateSub(x,y)
end;

function drawgrid2(x,y:extended):boolean;
begin
   drawgrid2:=gridsub(x,y) and axessub  and CoordinateSub(x,y)
end;

function drawcircle(x,y:extended):boolean;
var
   points:array[0..360] of TPoint;
   i,j:integer;
   n,k:integer;
begin
   k:=0;
   for n:=0 to 360 do
   begin
     x:=cos(n/180*pi);
     y:=sin(n/180*pi);
     if convtodevice(x,y,i,j) then
        begin
         points[k].x:=restrict(i);
         points[k].y:=restrict(j);
         inc(k)
        end;
   end;
   MyGraphSys.Polyline(Slice(Points,k)) ;
   result:=true;
end;


function drawdisk(x,y:extended):boolean;
var
   points:array[0..359] of TPoint;
   i,j:integer;
   n,k:integer;
begin
   k:=0;
   for n:=0 to 359 do
   begin
     x:=cos(n/180*pi);
     y:=sin(n/180*pi);
     if convtodevice(x,y,i,j) then
       begin
         points[k].x:=restrict(i);
         points[k].y:=restrict(j);
         inc(k);
       end;
   end;
   MyGraphSys.Polygon(Slice(Points,k));
   result:=true;
end;


end.
