unit G_Func;
{=================================================================}
{  Âåðñèÿ ôàéëà 3.0.000                                           }
{  îò 4 äåêàáðÿ 2002 ã.                                           }
{==========================} interface {==========================}

uses
  WinTypes,WinProcs,SysUtils,Forms,Classes, Controls,Graphics,ExtCtrls,
  gltype,glproc,mathobj;

type
 TrsStyle = (rsRect,rsCircle);
 TOrient  = (orVert,orHorz);
 TmrShape = (mrLine,mrLeftTr,mrRightTr,mrDownTr,mrUpTr,mrSplit);

 TgrShape = (grBox,grFrame,grRoundBox,grCircle,grArc,
             grLeftLine,grRightLine,grTopLine,grBottomLine,
             grLeftTr,grRightTr,grUpTr,grDownTr,
             grVertTank,grHorzTank,grPie);
 TgrStyle = (grNone,grLowered,grRaised,grSingle,grBothR,grBothL);

 TtrStyle = (trLeft,trRight,trDown,trUp);

 TvixAlign= (alxNone,alxLeft,alxRight,alxWidth,alxScaled,alxScaledSize);
 TviyAlign= (alyNone,alyTop,alyBottom,alyHeight,alyScaled,alyScaledSize);

 function  PtOnLine(var X,Y,X1,Y1,X2,Y2:Integer):Boolean;
 function  PtOnRect(X,Y,Width:Integer;R:TRect):Boolean;
 function  PtInArc(X,Y:Integer;R:TRect):Boolean;
 function  PtOnArc(X,Y,Width:Integer;R:TRect):Boolean;

 procedure CopyRectToBitmap(Canvas:TCanvas;R:TRect;Image:TBitmap);
 procedure DrawSelectRect(Canvas : TCanvas;R:TRect;pnMode:TPenMode);
 procedure DrawResize(Canvas : TCanvas;R:TRect;rsStyle:TrsStyle);

 procedure SaveColor(var F:TextFile;Color:TColor);
 function  LoadColor(var F:TextFile):LongInt;
 procedure SaveFont(var F:TextFile;FFont:TFont);
 procedure LoadFont(var F:TextFile;var FFont:TFont);

 procedure SaveCanvas(Canvas : TCanvas);
 procedure RestoreCanvas(Canvas : TCanvas);

 procedure DrawLight_(Canvas:TCanvas;R:TRect;clBack:TColor);
 procedure DrawLed_(Canvas:TCanvas;R:TRect;clBack:TColor);

 procedure Frame_(Canvas:TCanvas;var R:TRect;Style:TgrStyle;clLight,clHidden:TColor;Width:Byte);
 procedure Box_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
 procedure Arc_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden:TColor;Width:Byte);
 procedure Circle_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
 procedure Pie_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
 procedure Triangle_(Canvas:TCanvas;R:TRect;trStyle:TtrStyle;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
 procedure VertTank_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);

 procedure mr_Line(Canvas:TCanvas;R:TRect;Orient:TOrient;cl:TColor;Width:Byte);
 procedure mr_Triangle(Canvas:TCanvas;R:TRect;Shape:TmrShape;Style:TgrStyle;clLight,clHidden,clBack:TColor);
 procedure mr_Split(Canvas:TCanvas;R:TRect;Orient:TOrient;clLight,clHidden,clBack:TColor;Width:Byte);

type
 TColorArr  = array [0..ArrayPtrSize] of TColor;
 PColorArr  = ^TColorArr;
 TColorArray = class(TArray)
    Arr   : PColorArr;
    constructor Create(ACount: Integer);
    destructor Destroy;override;
    function Val(I : Integer) : TColor;
    procedure Z(I : Integer;Y : TColor);
    procedure Add(X:TColor);
    procedure ChangeCount(NewCount: Integer);
    procedure AtDelete(IMin,IMax: Integer);
    procedure FillArray(Y : TColor);
 end;

 TSelectObj = class
 private
  FForm  : TForm;
  R      : TRect;
{  Left,
  Right,
  Top,
  Bottom : TColorArray;
  NeedUpdate : Boolean;}
  Hide       : Boolean;
  procedure UpdateSelectRect(aR:TRect);
  procedure SavePixels(aCanvas : TCanvas);
  procedure RestorePixels(aCanvas : TCanvas);
 public
  constructor Create(aForm:TForm;aR : TRect);
  destructor Destroy;override;
  procedure DoSelecting(aCanvas : TCanvas);
  procedure AddSelecting(aCanvas : TCanvas;aR:TRect);
  procedure DelSelecting(aCanvas : TCanvas;aR:TRect);
 end;

 const IsEven : Boolean = True;
 var
    brColor,
    pnColor : TColor;
    pnWidth : Byte;
    pnStyle : TPenStyle;
    pnMode  : TPenMode;
    hhFont  : TFont;


{##############################################################################}

                            IMPLEMENTATION

{##############################################################################}
uses math;
{------------------------------------------------------------------------------}
function  PtOnLine(var X,Y,X1,Y1,X2,Y2:Integer):Boolean;
var dx,dy   : RealType;
    i,k     : integer;
    Pnt     : TPoint;
    R       : TRect;
begin
 Result:=False;
 k:=max(ABS(X2-X1),ABS(Y2-Y1));
 if k-1 <> 0 then dx:=(X2-X1)/(k-1) else dx:=0;
 if k-1 <> 0 then dy:=(Y2-Y1)/(k-1) else dy:=0;
 Pnt.X:=X;Pnt.Y:=Y;

 for i:=0 to k-1 do begin
  R.left:=X1+round(i*dx)-1;
  R.right:=X1+round(i*dx)+1;
  R.top:=Y1+round(i*dy)-1;
  R.bottom:=Y1+round(i*dy)+1;
  if PtInRect(R,Pnt) then begin
   Result:=True;
   exit
  end
 end;
 R.left:=X2-1;
 R.right:=X2+1;
 R.top:=Y2-1;
 R.bottom:=Y2+1;
 if PtInRect(R,Pnt) then Result:=True
end;
{**********************************************************************}
function  PtOnRect;
var R1 : TRect;
begin
 R1:=R;
 InflateRect(R1,-Width,-Width);
 Result:=PtInRect(R,Point(X,Y))and(not PtInRect(R1,Point(X,Y)))
end;
{**********************************************************************}
function  PtInArc;
var cx,cy,
    rx,ry : Double;
begin
 Result:=False;
 if PtInRect(R,Point(X,Y)) then begin
  rx:=(R.Right-R.Left)/2;
  ry:=(R.Bottom-R.Top)/2;
  cx:=R.Left+rx;
  cy:=R.Top+ry;
  Result:= sqr(X-cx)+sqr(Y-cy)-sqr(rx) <= 0;
 end
end;
{**********************************************************************}
function  PtOnArc;
var R1 : TRect;
begin
 R1:=R;
 InflateRect(R1,-Width,-Width);
 Result:=PtInArc(X,Y,R)and(not PtInArc(X,Y,R1))
end;
{*******************************************************************************

                     ÏÐÎÖÅÄÓÐÛ ÊÎÏÈÐÎÂÀÍÈß ÈÇÎÁÐÀÆÅÍÈß Â BITMAP,


*******************************************************************************}
procedure DrawSelectRect;
var ps : TPenStyle;
    pm : TPenMode;
    cl : TColor;
begin
 with Canvas do begin
  InflateRect(r,1,1);
  DrawFocusRect(R);
{  pm:=Pen.Mode;
  ps:=Pen.Style;
  cl:=Pen.Color;
  Pen.Mode:=pnMode;
  Pen.Style:=psDot;
  MoveTo(R.Left,R.Top);
  LineTo(R.Right,R.Top);
  LineTo(R.Right,R.Bottom);
  LineTo(R.Left,R.Bottom);
  LineTo(R.Left,R.Top);
  Pen.Style:=ps;
  Pen.Mode:=pm;
  Pen.Color:=cl;}
 end;
end;
{**********************************************************************}
procedure DrawResize;
var pm : TPenMode;
    cl : TColor;
    w,h,rr : Double;
begin
 with Canvas do begin
  pm:=Pen.Mode;
  cl:=Pen.Color;
  Pen.Color:=clBlack;

  case rsStyle of
   rsRect :
   begin
    Pen.Mode:=pmNotXor;
    MoveTo(R.Left,R.Top);
    LineTo(R.Right,R.Top);
    LineTo(R.Right,R.Bottom);
    LineTo(R.Left,R.Bottom);
//    DrawFocusRect(R);
   end;
   rsCircle :
   begin
    Pen.Mode:=pmNotXor;
{    w:=(R.Right-R.Left)/2;
    h:=(R.Bottom-R.Top)/2;
    rr:=sqrt(sqr(w)+sqr(h));
    w:=w*(1-w/rr);
    InflateRect(R,-round(w),-round(w));}
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Top,R.Left,R.Top);
   end;
  end;

  Pen.Color:=cl;
  Pen.Mode:=pm;
 end;
end;
{**********************************************************************}
procedure CopyRectToBitmap(Canvas:TCanvas;R:TRect;Image:TBitmap);
var Dst,Src : TRect;
begin
 Src:=R;
 with Src do begin
  Image.Width:=Right-Left;
  Image.Height:=Bottom-Top;
 end;
 Dst:=Rect(0,0,Image.Width,Image.Height);
 Image.Canvas.CopyRect(Dst,Canvas,Src);
end;
{*******************************************************************************

                     ÏÐÎÖÅÄÓÐÛ ÑÎÕÐÀÍÅÍÈß È ÐÅÑÒÀÂÐÀÖÈÈ ÊÎÍÒÅÊÑÒÀ ÓÑÒÐÎÉÑÒÂÀ

*******************************************************************************}
 procedure SaveCanvas(Canvas : TCanvas);
 begin
  brColor:=Canvas.Brush.Color;
  pnColor:=Canvas.Pen.Color;
  pnStyle:=Canvas.Pen.Style;
  pnWidth:=Canvas.Pen.Width;
  pnMode :=Canvas.Pen.Mode;
  hhFont.Assign(Canvas.Font);
 end;

 procedure RestoreCanvas(Canvas : TCanvas);
 begin
  Canvas.Brush.Color:=brColor;
  Canvas.Pen.Color:=pnColor;
  Canvas.Pen.Style:=pnStyle;
  Canvas.Pen.Width:=pnWidth;
  Canvas.Pen.Mode:=pnMode;
  Canvas.Font.Assign(hhFont);
 end;
{*******************************************************************************

                     ÏÐÎÖÅÄÓÐÛ ÑÎÕÐÀÍÅÍÈß ØÐÈÔÒÀ È ÖÂÅÒÀ

*******************************************************************************}
procedure SaveColor;
begin
 WriteLn(F,ColorToString(Color));
end;
{**********************************************************************}
function LoadColor;
var s : String;
begin
 ReadLn(F,s);
 IdentToColor(s,Result)
end;
{**********************************************************************}
procedure SaveFont(var F:TextFile;FFont:TFont);
var i,j,k,l : Integer;
const c = ' ';
begin
 WriteLn(F,'Font:');
 WriteLn(F,FFont.Height);
 SaveColor(F,FFont.Color);
 if fsBold in FFont.Style then i:=1 else i:=0;
 if fsItalic in FFont.Style then j:=1 else j:=0;
 if fsUnderLine in FFont.Style then k:=1 else k:=0;
 if fsStrikeOut in FFont.Style then l:=1 else l:=0;
 WriteLn(F,Format('%d%s%d%s%d%s%d',[i,c,j,c,k,c,l]));
 WriteLn(F,FFont.Name);
 WriteLn(F,'End Font:');
end;
{**********************************************************************}
procedure LoadFont;
var i,j,k,l : Integer;
    s       : String;
    fStyle  : TFontStyles;
begin
 ReadLn(F);
 ReadLn(F,i);
 FFont.Height:=i;
 FFont.Color:=LoadColor(F);
 ReadLn(F,i,j,k,l);
 FStyle:=[];
 if i = 1 then Include(fStyle,fsBold);
 if j = 1 then Include(fStyle,fsItalic);
 if k = 1 then Include(fStyle,fsUnderline);
 if l = 1 then Include(fStyle,fsStrikeOut);
 FFont.Style:=fStyle;

 ReadLn(F,s);
 FFont.Name:=s;
 ReadLn(F);
end;
{*******************************************************************************

                 ÃÐÀÔÈ×ÅÑÊÈÅ    ÏÐÎÖÅÄÓÐÛ


*******************************************************************************}
procedure DrawLight_(Canvas:TCanvas;R:TRect;clBack:TColor);
var X,Y,d,dd : Integer;
begin
 with Canvas,R do begin
  if clBack = clBlack then Pen.Color:=clBtnShadow
   else if clBack = clBtnShadow then Pen.Color:=clBtnFace
    else Pen.Color:=clBtnHighLight;
  X:=(Left+Right)div 2;
  Y:=(Top+Bottom)div 2;
  d:=round(0.1*min(Right-Left,Bottom-Top));
  dd:=2*d;
  MoveTo(X,Bottom-1);
  LineTo(X,Top+1);
  MoveTo(Left+1,Y);
  LineTo(Right-1,Y);
  MoveTo(Left+dd,Top+dd);
  LineTo(X-d,Y-d);
  MoveTo(Left+dd,Bottom-dd);
  LineTo(X-d,Y+d);
  MoveTo(Right-dd,Top+dd);
  LineTo(X+d,Y-d);
  MoveTo(Right-dd,Bottom-dd);
  LineTo(X+d,Y+d);
 end
end;
{******************************************************************************}
procedure DrawLed_(Canvas:TCanvas;R:TRect;clBack:TColor);
var X,Y,d : Integer;
begin
 with Canvas,R do begin
  if clBack = clBlack then Pen.Color:=clBtnShadow
   else if clBack = clBtnShadow then Pen.Color:=clBtnFace
    else Pen.Color:=clBtnHighLight;
  X:=(Left+Right)div 2;
  Y:=(Top+Bottom)div 2;
  d:=round(0.2*min(Right-Left,Bottom-Top));
  Arc(Left+d,Top+d,Right-d,Bottom-d,X,Top+d,Left+d,Y);
 end
end;
{******************************************************************************}
procedure Frame_;
begin
 with Canvas do
  case Style of
   grRaised  : Frame3D(Canvas,R,clLight,clHidden,Width);
   grLowered : Frame3D(Canvas,R,clHidden,clLight,Width);
   grSingle  : begin
                Brush.Color:=clLight;
                FrameRect(R);
                InflateRect(R,-Width,-Width);
               end;
   grBothR   : begin
                Frame3D(Canvas,R,clHidden,clLight,Width);
                Frame3D(Canvas,R,clLight,clHidden,Width);
               end;
   grBothL   : begin
                Frame3D(Canvas,R,clLight,clHidden,Width);
                Frame3D(Canvas,R,clHidden,clLight,Width);
               end;
  end;
end;
{******************************************************************************}
procedure Box_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
begin
 with Canvas do begin
  Frame_(Canvas,R,Style,clLight,clHidden,Width);
  Brush.Color:=clBack;
  FillRect(R)
 end;
end;
{******************************************************************************}
procedure Arc_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden:TColor;Width:Byte);
begin
 InflateRect(R,-Width div 2,-Width div 2);
 with Canvas do
  case Style of
  grRaised,
  grLowered :
   begin
    Pen.Width:=Width;

    if Style = grRaised then Pen.Color:=clHidden else Pen.Color:=clLight;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);

    if Style = grLowered then Pen.Color:=clHidden else Pen.Color:=clLight;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);
   end;
  grSingle  :
   begin
    Pen.Color:=clLight;
    Pen.Width:=Width;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Top,R.Left,R.Top);
   end;
  grBothR   :
   begin
    Pen.Width:=Width;
    Pen.Color:=clLight;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
    InflateRect(R,-Width,-Width);
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);

    Pen.Color:=clHidden;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
    InflateRect(R,Width,Width);
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);
   end;
   grBothL   :
    begin
     Pen.Width:=Width;

     Pen.Color:=clHidden;
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
     InflateRect(R,-Width,-Width);
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);

     Pen.Color:=clLight;
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
     InflateRect(R,Width,Width);
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);
    end;
   end;
end;
{******************************************************************************}
procedure Circle_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
begin
 with Canvas do
  case Style of
   grNone    :
    begin
     Brush.Color:=clBack;
     Pen.Color:=clBack;
     Ellipse(R.Left,R.Top,R.Right,R.Bottom);
    end;
   grBothR,
   grBothL,
   grRaised,
   grLowered :
    begin
     Brush.Color:=clBack;
     Ellipse(R.Left,R.Top,R.Right,R.Bottom);
     Arc_(Canvas,R,Style,clLight,clHidden,Width);
    end;
   grSingle  :
    begin
     Brush.Color:=clBack;
     Pen.Color:=clLight;
     Pen.Width:=Width;
     InflateRect(R,-Width div 2,-Width div 2);
     Ellipse(R.Left,R.Top,R.Right,R.Bottom);
    end;
  end;
end;
{******************************************************************************}
procedure Pie_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
var clBrush : TColor;
begin
 clBrush:=RGB(128,128,128)-clHidden;
 clBrush:=RGB(255-GetRValue(clBrush),255-GetGValue(clBrush),255-GetBValue(clBrush));

 with Canvas do
  case Style of
  grRaised,
  grLowered :
   begin
    if Style = grRaised then Pen.Color:=clHidden else Pen.Color:=clLight;
    if Style = grRaised then Brush.Color:=clHidden else Brush.Color:=clBrush;
    Pie(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);

    if Style = grLowered then Pen.Color:=clHidden else Pen.Color:=clLight;
    if Style = grLowered then Brush.Color:=clHidden else Brush.Color:=clBrush;
    Pie(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);

    InflateRect(R,-Width,-Width);
    Brush.Color:=clBack;
    Pen.Color:=clBack;
    Ellipse(R.Left,R.Top,R.Right,R.Bottom);

    InflateRect(R,1,1);
    Arc_(Canvas,R,grLowered,clLight,clHidden,1);
   end;
  grSingle  :
   begin
    Pen.Color:=clLight;
    Pen.Width:=Width;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Top,R.Left,R.Top);
   end;
  grBothR   :
   begin
    Pen.Width:=Width;
    Pen.Color:=clLight;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
    InflateRect(R,-Width,-Width);
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);

    Pen.Color:=clHidden;
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
    InflateRect(R,Width,Width);
    Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);
   end;
   grBothL   :
    begin
     Pen.Width:=Width;

     Pen.Color:=clHidden;
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
     InflateRect(R,-Width,-Width);
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);

     Pen.Color:=clLight;
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Right,R.Top,R.Left,R.Bottom);
     InflateRect(R,Width,Width);
     Arc(R.Left,R.Top,R.Right,R.Bottom,R.Left,R.Bottom,R.Right,R.Top);
    end;
   end;
end;
{******************************************************************************}
procedure Triangle_(Canvas:TCanvas;R:TRect;trStyle:TtrStyle;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
var P1,P2,P3 : TPoint;

procedure GetTrianglePoints;
begin
 case trStyle of
 trLeft   : begin
             P1:=Point(R.Left,(R.Top+R.Bottom)div 2);
             P2:=Point(R.Right,R.Top);
             P3:=Point(R.Right,R.Bottom);
            end;
 trRight  : begin
             P1:=Point(R.Right,(R.Top+R.Bottom)div 2);
             P2:=Point(R.Left,R.Top);
             P3:=Point(R.Left,R.Bottom);
            end;
 trDown  : begin
             P1:=Point((R.Left+R.Right)div 2,R.Bottom);
             P2:=Point(R.Left,R.Top);
             P3:=Point(R.Right,R.Top);
            end;
 trUp    : begin
             P1:=Point((R.Left+R.Right)div 2,R.Top);
             P2:=Point(R.Left,R.Bottom);
             P3:=Point(R.Right,R.Bottom);
            end;
 end;
end;

begin
 InflateRect(R,-Width,-Width);
 GetTrianglePoints;

 with Canvas do begin
  Brush.Color:=clBack;
  if Style <> grNone then Pen.Width:=Width;

  case Style of
   grNone    : Pen.Color:=clBack;
   grBothL,
   grSingle,
   grRaised  : Pen.Color:=clLight;
   grBothR,
   grLowered : Pen.Color:=clHidden;
  end;

  Polygon([P1,P2,P3]);

  case Style of
   grRaised,
   grLowered : begin
                if Style = grLowered then Pen.Color:=clLight else Pen.Color:=clHidden;
                MoveTo(P2.X,P2.Y);
                LineTo(P3.X,P3.Y);
                LineTo(P1.X,P1.Y);
               end;
   grBothL,
   grBothR   : begin
                if Style = grBothR then Pen.Color:=clLight else Pen.Color:=clHidden;
                InflateRect(R,-Width,-Width);
                GetTrianglePoints;
                Polygon([P1,P2,P3]);
              end;
  end;
 end
end;
{******************************************************************************}
procedure VertTank_(Canvas:TCanvas;R:TRect;Style:TgrStyle;clLight,clHidden,clBack:TColor;Width:Byte);
var rr,rx,ry : Integer;
    R1 : TRect;
begin
 rx:=(R.Right-R.Left)div 2;
 ry:=(R.Bottom-R.Top) div 2;
 rr:=round(sqrt(sqr(rx)+sqr(ry)));
 rx:=R.Left+rx;
 ry:=R.Top+ry;
 R1:=Rect(rx-rr,ry-rr,rx+rr,ry+rr);
 with Canvas do
  case Style of
  grRaised,
  grLowered :
   begin
    Pen.Width:=Width;

    if Style = grRaised then Pen.Color:=clHidden else Pen.Color:=clLight;
    MoveTo(R.Left,R.Bottom);
    LineTo(R.Left,R.Top);
    with R1 do
    Arc(Left,Top,Right,Bottom,R.Right,R.Top,R.Left,R.Top);

    if Style = grLowered then Pen.Color:=clHidden else Pen.Color:=clLight;
    MoveTo(R.Right,R.Bottom);
    MoveTo(R.Right,R.Top);
    with R1 do
    Arc(Left,Top,Right,Bottom,R.Left,R.Bottom,R.Right,R.Bottom);
   end;
  grSingle  :
   begin
    Pen.Color:=clLight;
    Pen.Width:=Width;
    MoveTo(R.Left,R.Bottom);
    LineTo(R.Left,R.Top);
    with R1 do
    Arc(Left,Top,Right,Bottom,R.Right,R.Top,R.Left,R.Top);
    MoveTo(R.Right,R.Bottom);
    LineTo(R.Right,R.Top);
    with R1 do
    Arc(Left,Top,Right,Bottom,R.Left,R.Bottom,R.Right,R.Bottom);
   end;
  end
end;
{******************************************************************************}
procedure mr_Line;
begin
 with Canvas do begin
  Pen.Color:=cl;
  Pen.Width:=Width;
  case Orient of
  orVert : begin
            MoveTo(R.Left,R.Top);
            LineTo(R.Right,R.Top);
           end;
  orHorz : begin
            MoveTo(R.Left,R.Top);
            LineTo(R.Left,R.Bottom);
           end;
  end;
 end
end;
{******************************************************************************}
procedure mr_Triangle;
begin
 case Shape of
  mrLeftTr  : Triangle_(Canvas,R,trLeft,Style,clLight,clHidden,clBack,1);
  mrRightTr : Triangle_(Canvas,R,trRight,Style,clLight,clHidden,clBack,1);
  mrDownTr  : Triangle_(Canvas,R,trDown,Style,clLight,clHidden,clBack,1);
  mrUpTr    : Triangle_(Canvas,R,trUp,Style,clLight,clHidden,clBack,1);
 end
end;
{******************************************************************************}
procedure mr_Split;
var y : Integer;
begin
 with Canvas do begin
  Brush.Color:=clBack;
   Frame3D(Canvas,R,clLight,clHidden,pnWidth);
  FillRect(R);

  Pen.Color:=clLight;
  case Orient of
  orHorz : begin
            y:=(R.Left+R.Right)div 2;
            MoveTo(y,R.Top);
            LineTo(y,R.Bottom);
            Pen.Color:=clHidden;
            Inc(y);
            MoveTo(y,R.Top);
            LineTo(y,R.Bottom);
           end;
  orVert : begin
            y:=(R.Top+R.Bottom)div 2;
            MoveTo(R.Left,y);
            LineTo(R.Right,y);
            Pen.Color:=clHidden;
            Inc(y);
            MoveTo(R.Left,y);
            LineTo(R.Right,y);
           end;
  end;
 end
end;

{--------------------------------------------------------------------------}
{                    TColorArray Methods                                     }
{--------------------------------------------------------------------------}
procedure TColorArray.FillArray;
var i : Integer;
begin
  for i:=0 to Count-1 do Arr^[i]:=Y
end;

procedure TColorArray.Add;
var P : Pointer;
begin
 if Size < (Count+1) then begin
  GetMem(P,(count+1)*SOfL);
  if Size > 0 then Move(arr^,P^,count*SOfL);
  if Size > 0 then FreeMem(arr,Size*SOfL);
  arr:=P;
  Size:=Count+1
 end;
 arr^[count]:=X;
 Inc(count)
end;

constructor TColorArray.Create;
begin
  inherited Create(ACount);
  if Size > 0 then GetMem(Arr,Size*SOfL);
  FillArray(0)
end;

destructor TColorArray.Destroy;
begin
 if Size > 0 then FreeMem(Arr,Size*SOfL);
 inherited Destroy
end;

procedure TColorArray.Z;
begin
 Arr^[I]:=Y
end;

function TColorArray.Val;
begin
 Val:=Arr^[I]
end;

procedure TColorArray.ChangeCount;
var Pe   : PColorArr;
begin
  if Size < NewCount then begin
   if NewCount > ArraySize then NewCount:=ArraySize;
   GetMem(Pe,NewCount*SOfL);
   if Size > 0 then Move(Arr^,Pe^,Count*SOfL);
   if Size > 0 then FreeMem(Arr,Size*SOfL);
   Arr:=Pe;
   Size:=NewCount
  end;
  Count:=NewCount
end;

procedure TColorArray.AtDelete;
var i,j : Integer;
begin
  if Imax > Count-1 then Imax:=Count-1;
  if Imin < 0       then Imin:=0;
  if Imin > Imax    then exit;
  j:=0;
  for i:=Imax+1 to Count-1 do begin
   Arr^[Imin+j]:=Arr^[i];
   inc(j)
  end;
  Dec(Count,Imax-Imin+1)
end;
{-------------------------------------------------------------------------------

-------------------------------------------------------------------------------}
constructor TSelectObj.Create;
begin
 FForm:=aForm;
 Hide:=True;
// NeedUpdate:=True;
 R:=aR;
 InflateRect(R,1,1);
{ Left:=TColorArray.Create(R.Right-R.Left+1);
 Right:=TColorArray.Create(R.Right-R.Left+1);
 Top:=TColorArray.Create(R.Bottom-R.Top+1);
 Bottom:=TColorArray.Create(R.Bottom-R.Top+1);}
end;

destructor TSelectObj.Destroy;
begin
{ Left.Free;
 Right.Free;
 Top.Free;
 Bottom.Free;}
 inherited Destroy
end;

procedure TSelectObj.SavePixels;
var i : Integer;
begin
{ if not NeedUpdate then exit;
 for i:=0 to Left.Count-1 do
  Left.arr^[i]:=aCanvas.Pixels[R.Left,R.Top+i];
 for i:=0 to Right.Count-1 do
  Right.arr^[i]:=aCanvas.Pixels[R.Right,R.Top+i];
 for i:=1 to Top.Count-2 do
  Top.arr^[i]:=aCanvas.Pixels[R.Left+i,R.Top];
 for i:=1 to Bottom.Count-2 do
  Bottom.arr^[i]:=aCanvas.Pixels[R.Left+i,R.Bottom];}
end;

procedure TSelectObj.RestorePixels;
var cl : TColor;
    st : TPenStyle;
begin
  with aCanvas do begin
   cl:=Pen.Color;
   st:=Pen.Style;
   Pen.Style:=psSolid;
   Pen.Color:=FForm.Color;
   DoSelecting(aCanvas);
   Pen.Style:=st;
   Pen.Color:=cl
  end
{ for i:=0 to Left.Count-1 do
  aCanvas.Pixels[R.Left,R.Top+i]:=Left.arr^[i];
 for i:=0 to Right.Count-1 do
  aCanvas.Pixels[R.Right,R.Top+i]:=Right.arr^[i];
 for i:=1 to Top.Count-2 do
  aCanvas.Pixels[R.Left+i,R.Top]:=Top.arr^[i];
 for i:=1 to Bottom.Count-2 do
  aCanvas.Pixels[R.Left+i,R.Bottom]:=Bottom.arr^[i];}
end;

procedure TSelectObj.UpdateSelectRect;
begin
{ if (aR.Left-1 = R.Left)and(aR.Bottom+1 = R.Bottom)and(aR.Top-1 = R.Top)and(aR.Right+1 = R.Right) then begin
  NeedUpdate:=False;
  exit
 end;

 NeedUpdate:=True;}
 R:=aR;
 InflateRect(R,1,1);
{ Left.ChangeCount(R.Bottom-R.Top+1);
 Right.ChangeCount(R.Bottom-R.Top+1);
 Top.ChangeCount(R.Right-R.Left+1);
 Bottom.ChangeCount(R.Right-R.Left+1);}
end;

procedure TSelectObj.DoSelecting;
begin
// if not Hide then
 with aCanvas do begin
  MoveTo(R.Left,R.Top);
  LineTo(R.Right,R.Top);
  LineTo(R.Right,R.Bottom);
  LineTo(R.Left,R.Bottom);
  LineTo(R.Left,R.Top)
 end
end;

procedure TSelectObj.AddSelecting;
var aStyle : TPenStyle;
begin
 UpdateSelectRect(aR);
 SavePixels(aCanvas);
 aStyle:=aCanvas.Pen.Style;
 aCanvas.Pen.Style:=psDot;
 try
  DoSelecting(aCanvas);
 finally
  aCanvas.Pen.Style:=aStyle;
  Hide:=False
 end
end;

procedure TSelectObj.DelSelecting;
begin
 RestorePixels(aCanvas);
 UpdateSelectRect(aR);
 SavePixels(aCanvas);
 Hide:=True;
end;
//------------------------------------------------------------------------------
initialization
 hhFont:=TFont.Create;
finalization
 hhFont.Free
end.