Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
lazarus-project / usr / share / lazarus / 2.0.10 / components / aggpas / src / agg_rounded_rect.pas
Size: Mime:
//----------------------------------------------------------------------------
// Anti-Grain Geometry - Version 2.4 (Public License)
// Copyright (C) 2002-2005 Maxim Shemanarev (http://www.antigrain.com)
//
// Anti-Grain Geometry - Version 2.4 Release Milano 3 (AggPas 2.4 RM3)
// Pascal Port By: Milan Marusinec alias Milano
//                 milan@marusinec.sk
//                 http://www.aggpas.org
// Copyright (c) 2005-2006
//
// Permission to copy, use, modify, sell and distribute this software
// is granted provided this copyright notice appears in all copies.
// This software is provided "as is" without express or implied
// warranty, and with no claim as to its suitability for any purpose.
//
//----------------------------------------------------------------------------
// Contact: mcseem@antigrain.com
//          mcseemagg@yahoo.com
//          http://www.antigrain.com
//
//----------------------------------------------------------------------------
//
// Rounded rectangle vertex generator
//
// [Pascal Port History] -----------------------------------------------------
//
// 17.01.2006-Milano: Unit port establishment
//
{ agg_rounded_rect.pas }
unit
 agg_rounded_rect ;

INTERFACE

{$I agg_mode.inc }

uses
 agg_basics ,
 agg_vertex_source ,
 agg_arc ;

type
 rounded_rect = object(vertex_source )
   m_x1  ,
   m_y1  ,
   m_x2  ,
   m_y2  ,
   m_rx1 ,
   m_ry1 ,
   m_rx2 ,
   m_ry2 ,
   m_rx3 ,
   m_ry3 ,
   m_rx4 ,
   m_ry4 : double;

   m_status : unsigned;
   m_arc    : arc;

   constructor Construct; overload;
   constructor Construct(x1 ,y1 ,x2 ,y2 ,r : double ); overload;

   procedure rect(x1 ,y1 ,x2 ,y2 : double );

   procedure radius(r : double ); overload;
   procedure radius(rx ,ry : double ); overload;
   procedure radius(rx_bottom ,ry_bottom ,rx_top ,ry_top : double ); overload;
   procedure radius(rx1 ,ry1 ,rx2 ,ry2 ,rx3 ,ry3 ,rx4 ,ry4 : double ); overload;

   procedure normalize_radius;

   procedure approximation_scale_(s : double );
   function  _approximation_scale : double;

   procedure rewind(path_id : unsigned ); virtual;
   function  vertex(x ,y : double_ptr ) : unsigned; virtual;

  end;

{ GLOBAL PROCEDURES }


IMPLEMENTATION
{ LOCAL VARIABLES & CONSTANTS }
{ UNIT IMPLEMENTATION }
{ CONSTRUCT }
constructor rounded_rect.Construct;
begin
 m_x1 :=0;
 m_y1 :=0;
 m_x2 :=0;
 m_y2 :=0;
 m_rx1:=0;
 m_ry1:=0;
 m_rx2:=0;
 m_ry2:=0;
 m_rx3:=0;
 m_ry3:=0;
 m_rx4:=0;
 m_ry4:=0;

 m_status:=0;

 m_arc.Construct;

end;

{ CONSTRUCT }
constructor rounded_rect.Construct(x1 ,y1 ,x2 ,y2 ,r : double );
begin
 Construct;

 m_x1 :=x1;
 m_y1 :=y1;
 m_x2 :=x2;
 m_y2 :=y2;
 m_rx1:=r;
 m_ry1:=r;
 m_rx2:=r;
 m_ry2:=r;
 m_rx3:=r;
 m_ry3:=r;
 m_rx4:=r;
 m_ry4:=r;

 if x1 > x2 then
  begin
   m_x1:=x2;
   m_x2:=x1;

  end;

 if y1 > y2 then
  begin
   m_y1:=y2;
   m_y2:=y1;

  end; 

end;

{ RECT }
procedure rounded_rect.rect;
begin
 m_x1:=x1;
 m_y1:=y1;
 m_x2:=x2;
 m_y2:=y2;

 if x1 > x2 then
  begin
   m_x1:=x2;
   m_x2:=x1;

  end;

 if y1 > y2 then
  begin
   m_y1:=y2;
   m_y2:=y1;

  end;

end;

{ RADIUS }
procedure rounded_rect.radius(r : double );
begin
 m_rx1:=r;
 m_ry1:=r;
 m_rx2:=r;
 m_ry2:=r;
 m_rx3:=r;
 m_ry3:=r;
 m_rx4:=r;
 m_ry4:=r;

end;

{ RADIUS }
procedure rounded_rect.radius(rx ,ry : double );
begin
 m_rx1:=rx;
 m_rx2:=rx;
 m_rx3:=rx;
 m_rx4:=rx;
 m_ry1:=ry;
 m_ry2:=ry;
 m_ry3:=ry;
 m_ry4:=ry;

end;

{ RADIUS }
procedure rounded_rect.radius(rx_bottom ,ry_bottom ,rx_top ,ry_top : double );
begin
 m_rx1:=rx_bottom;
 m_rx2:=rx_bottom;
 m_rx3:=rx_top;
 m_rx4:=rx_top;
 m_ry1:=ry_bottom;
 m_ry2:=ry_bottom;
 m_ry3:=ry_top;
 m_ry4:=ry_top;

end;

{ RADIUS }
procedure rounded_rect.radius(rx1 ,ry1 ,rx2 ,ry2 ,rx3 ,ry3 ,rx4 ,ry4 : double );
begin
 m_rx1:=rx1;
 m_ry1:=ry1;
 m_rx2:=rx2;
 m_ry2:=ry2;
 m_rx3:=rx3;
 m_ry3:=ry3;
 m_rx4:=rx4;
 m_ry4:=ry4;

end;

{ NORMALIZE_RADIUS }
procedure rounded_rect.normalize_radius;
var
 dx ,dy  ,k ,t : double;

begin
 dx:=Abs(m_y2 - m_y1 );
 dy:=Abs(m_x2 - m_x1 );

 k:=1.0;

 try
  t:=dx / (m_rx1 + m_rx2 );

  if t < k then
   k:=t;

 except
 end;

 try
  t:=dx / (m_rx3 + m_rx4 );

  if t < k then
   k:=t;

 except
 end;

 try
  t:=dy / (m_ry1 + m_ry2 );

  if t < k then
   k:=t;

 except
 end;

 try
  t:=dy / (m_ry3 + m_ry4 );

  if t < k then
   k:=t;

 except
 end;  

 if k < 1.0 then
  begin
   m_rx1:=m_rx1 * k;
   m_ry1:=m_ry1 * k;
   m_rx2:=m_rx2 * k;
   m_ry2:=m_ry2 * k;
   m_rx3:=m_rx3 * k;
   m_ry3:=m_ry3 * k;
   m_rx4:=m_rx4 * k;
   m_ry4:=m_ry4 * k;

  end;

end;

{ APPROXIMATION_SCALE_ }
procedure rounded_rect.approximation_scale_;
begin
 m_arc.approximation_scale_(s );

end;

{ _APPROXIMATION_SCALE }
function rounded_rect._approximation_scale;
begin
 result:=m_arc._approximation_scale;

end;

{ REWIND }
procedure rounded_rect.rewind;
begin
 m_status:=0;

end;

{ VERTEX }
function rounded_rect.vertex;
var
 cmd : unsigned;

label
 _1 ,_2 ,_3 ,_4 ,_5 ,_6 ,_7 ,_8 ;

begin
 cmd:=path_cmd_stop;

 case m_status of
  0 :
   begin
    m_arc.init  (m_x1 + m_rx1 ,m_y1 + m_ry1 ,m_rx1 ,m_ry1 ,pi ,pi + pi * 0.5 );
    m_arc.rewind(0 );

    inc(m_status );

    goto _1;

   end;

  1 :
  _1:
   begin
    cmd:=m_arc.vertex(x ,y );

    if is_stop(cmd ) then
     begin
      inc(m_status );

      goto _2;

     end
    else
     begin
      result:=cmd;

      exit;

     end;

   end;

  2 :
  _2:
   begin
    m_arc.init  (m_x2 - m_rx2 ,m_y1 + m_ry2 ,m_rx2 ,m_ry2 ,pi + pi * 0.5 ,0.0 );
    m_arc.rewind(0 );

    inc(m_status );

    goto _3;

   end;

  3 :
  _3:
   begin
    cmd:=m_arc.vertex(x ,y );

    if is_stop(cmd ) then
     begin
      inc(m_status );

      goto _4;

     end
    else
     begin
      result:=path_cmd_line_to;

      exit;

     end;

   end;

  4 :
  _4: 
   begin
    m_arc.init  (m_x2 - m_rx3 ,m_y2 - m_ry3 ,m_rx3 ,m_ry3 ,0.0 ,pi * 0.5 );
    m_arc.rewind(0 );

    inc(m_status );

    goto _5;

   end;

  5 :
  _5:
   begin
    cmd:=m_arc.vertex(x ,y );

    if is_stop(cmd ) then
     begin
      inc(m_status );

      goto _6;

     end
    else
     begin
      result:=path_cmd_line_to;

      exit;

     end;

   end;

  6 :
  _6:
   begin
    m_arc.init  (m_x1 + m_rx4 ,m_y2 - m_ry4 ,m_rx4 ,m_ry4 ,pi * 0.5 ,pi );
    m_arc.rewind(0 );

    inc(m_status );

    goto _7;

   end;

  7 :
  _7:
   begin
    cmd:=m_arc.vertex(x ,y );

    if is_stop(cmd ) then
     begin
      inc(m_status );

      goto _8;

     end
    else
     begin
      result:=path_cmd_line_to;

      exit;

     end;

   end;

  8 :
  _8:
   begin
    cmd:=path_cmd_end_poly or path_flags_close or path_flags_ccw;

    inc(m_status );

   end;

 end;

 result:=cmd;

end;

END.