{

  Copyright (c) 1997-2003 by CoolDev.Com. Part of CoolControls package.

}

{$I versions.inc}
unit CoolPolygons;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, CoolCtrls,
  Dialogs, CoolLists;

type
  TCustomPolygones = class;

  // Identificates the point position relatively to the polygone.
  //  
  // <TABLE>
  // Value         Meaning
  // --------      --------
  // ptOnHandle    Point is on the handle (Vertexe) of the polygone.
  // ptOnSide      Point is on the polygone's side.
  // ptNowhere     Point is either within or outside the polygone (we do ngot care).
  // </TABLE>
  TPointPosition = (ptOnHandle, ptOnSide, ptNowhere);
  // Event fired when the mouse click within the polygone occurs.
  TPolygonEvent = procedure(Sender: TObject; Index: Integer; Pt: TPoint) of Object;

  // TSinglePolygon represents a polygon. It contains various parameters of the polygon 
  // such as coordinates of its vertices, colors,transparency flags.
  TSinglePolygon = class(TCollectionItem)
  private
    FColor,
    FLineColor,
    FHandleColor: TColor;
    FTransparent: Boolean;
    FTransparentEdges: Boolean;
    FPoints: TPointList;
    procedure SetPoints(Value: TPointList);
    procedure SetTransparent(Value: Boolean);
    procedure SetTransparentEdges(Value: Boolean);
    procedure SetColor(Value: TColor);
    procedure SetLineColor(Value: TColor);
    procedure SetHandleColor(Value: TColor);
    procedure PaintPolygon(Canvas: TCanvas);
    function PointOnSide(var PointActive, PointBefore, PointAfter: TPoint): Boolean;
    function PointOnHandle(var PointActive, PointBefore, PointAfter: TPoint): Boolean;
    procedure PointsChange(Sender: TObject);
  protected
    {$IFNDEF VER90}
    function GetDisplayName: string; override;
    {$ENDIF}
  public
    {$IFDEF DELPHI4_OR_ABOVE}
    constructor Create(Collection: TCollection); overload; override;
    constructor Create(ACollection: TCollection; AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean); reintroduce; overload; virtual;
    {$ELSE}
    constructor Create(Collection: TCollection); override;
    procedure Initialize(AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean); virtual;
    {$ENDIF}
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    // Use to determine whether given point is placed within the polygone.
    //
    // Result:
    //   Returns boolean value that indicates whether the point belongs to polgone.
    function PointWithinPolygon(PointActive: TPoint): Boolean;
  published
    // Use Color property to specify background color of the polygon when it is not transparent.
    property Color: TColor read FColor write SetColor default clBtnFace;
    // Use LineColor to specify color of the polygon's edges when they are visible.
    property LineColor: TColor read FLineColor write SetLineColor default clBlack;
    // Use HandleColor to specify color of the polygone's handles (vertices) when they are visible.
    property HandleColor: TColor read FHandleColor write SetHandleColor default clBlack;
    // Use Points property to access list of the polygone's verteces coordinates.
    property Points: TPointList read FPoints write SetPoints;
    // Use Transparent property to determine whenever polygon is (should be) a transparent one.
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    // Use TransparentEdges to set up transparency of then polygon's edges and handles.
    property TransparentEdges: Boolean read FTransparentEdges write SetTransparentEdges default False;
  end;

  // TPolygones is collection of the TSinglePolygon type objects.
  TPolygones = class(TCollection)
  private
    FComp: TComponent;
    function GetItem(Index: Integer): TSinglePolygon;
    procedure SetItem(Index: Integer; Value: TSinglePolygon);
  protected
    {$IFNDEF VER90}
    function GetOwner: TPersistent; override;
    {$ENDIF}
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(Comp: TComponent);
    function Add(AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean): TSinglePolygon;
    property Items[Index: Integer]: TSinglePolygon read GetItem write SetItem; default;
  end;

  // Determines the action allowed to perform
  //
  // <TABLE>
  // Value                         Meaning
  // -------                       ----------
  // emAllowAddPolygone            It's possible to add polygone.
  // emAllowAddHandle              It's possible to add handle.
  // emAllowResize                 It's possible to resize the polygone.
  // </TABLE>
  TEditModes = (emAllowAddPolygone, emAllowAddHandle, emAllowResize);
  // Set of the  TEditModes flags.
  TEditMode = set of TEditModes;

  // TCustomPolygones is base class for TCoolPolygones and TCoolPolyRegions controls.
  // Has all necessary methods and properties to create and maintain list of the any geometrical
  // figures.
  TCustomPolygones = class(TGraphicControl)
  private
    FAboutBox: TCCAboutBox;

    FDefColor,
    FDefEditLineColor,
    FDefEditHandleColor,
    FDefNormalLineColor,
    FDefNormalHandleColor: TColor;

    FPoints: TPointList;
    FPolygones: TPolygones;

    FActivePoint,
    FPrevPoint,
    FNextPoint: TPoint;

    FPointPosition: TPointPosition;
    FPolygonIndex: Integer;
    FTransparent: Boolean;

    FEditable: Boolean;
    FEditMode: TEditMode;
    FPaintBorders: Boolean;

    FHandleSize: Integer;

    FOnPolygonMove,
    FOnPolygonClick: TPolygonEvent;

    procedure PaintPolygones(Canv: TCanvas);
    procedure PaintPoints(Canv: TCanvas);
    procedure PaintEditHandle(Canv: TCanvas; Pt: TPoint);
    procedure SetHandleSize(Value: Integer);
    procedure SetPoints(Value: TPointList);
    procedure SetTransparent(Value: Boolean);
    procedure SetPaintBorders(Value: Boolean);
  protected
    procedure PointsChange(Sender: TObject); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure FastRepaint; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    // DefColor determines what color newly created and added polygones will have by default.
    property DefColor: TColor read FDefColor write FDefColor default clBtnFace;
    // DefEditLineColor determines what color will be used to draw lines of the vertex whose coordinates are  being modified visually.
    property DefEditLineColor: TColor read FDefEditLineColor write FDefEditLineColor default clRed;
    // DefEditLineColor determines what color will be used to draw vertex whose coordinates are  being modified visually.
    property DefEditHandleColor: TColor read FDefEditHandleColor write FDefEditHandleColor default clRed;
    // DefNormalLineColor determines what color will be used to draw edges of the newly created polygones by default.
    property DefNormalLineColor: TColor read FDefNormalLineColor write FDefNormalLineColor default clBlack;
    // DefNormalLineColor determines what color will be used to draw vertices of the newly created polygones by default.
    property DefNormalHandleColor: TColor read FDefNormalHandleColor write FDefNormalHandleColor default clBlack;
    // Use Editable property to determine if the coordinates of the polygones' vertices can be modified visually in design and run time 
    // (dragged to new location).
    //
    // See Also:
    //    EditMode
    property Editable: Boolean read FEditable write FEditable default True;
    // Allows manipulate the edit-mode flags and decide what editing action is allowed and what is not.
    // Polygone should be Editable in order for this property's flags to work
    //
    // <TABLE>
    // Value                         Meaning
    // -------                       ----------
    // emAllowAddPolygone            It's possible to add polygone.
    // emAllowAddHandle              It's possible to add handle.
    // emAllowResize                 It's possible to resize the polygone.
    // </TABLE>
    //
    // See Also:
    //    Editable
    property EditMode: TEditMode read FEditMode write FEditMode default [emAllowAddPolygone, emAllowAddHandle, emAllowResize];
    // Use HandleSize to specify the size of the polygones' handles when they are visible.
    property HandleSize: Integer read FHandleSize write SetHandleSize default 3;
    // Use PaintBorders to enable the control's bounding rectangle run-time painting.
    property PaintBorders: Boolean read FPaintBorders write SetPaintBorders default False;
    // While you are creating new polygone, Points will contain coordinates of the 
    // verteces you have created already. They can be modified, saved and 
    // loaded back. Once new polygon has been created Points will be 
    // cleared up till you decide to create new polygon.
    property Points: TPointList read FPoints write SetPoints;
    // Run-time and read only. Returns the position of the last mouse click.
    property PointPosition: TPointPosition read FPointPosition;
    // Use Polygones to access the collection of the TSinglePolygon object previously created and
    // contained by the control.
    property Polygones: TPolygones read FPolygones write FPolygones;
    // Determines whether newly created polygones should be transparent.
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    // Event fired when click within polygone occurs.
    property OnPolygonClick: TPolygonEvent read FOnPolygonClick write FOnPolygonClick;
    // Event fired when polygone vetrteces being moved.
    property OnPolygonMove: TPolygonEvent read FOnPolygonMove write FOnPolygonMove;
  published
    // Displays information about the control and package version.
    property About: TCCAboutBox read FAboutBox write FAboutBox;
  end;

  // TCoolPolygones  allows easily paint and edit any type of geometrical  figure. 
  // Allows to create and edit image maps in just few seconds directly in form  designer. 
  // Save, load and modify list of polygones.
  //
  // Control can be used in design time and in run time. Editable property determines 
  // how the control will behave. If Editable is False clicking on the control 
  // WILL NOT cause adding of the polygon's handle otherwise such a handle will be added. IN DESIGN TIME AS WELL.
  //
  // When Editable is True in Design time control has the same behavior as it would 
  // in run-time which means when you click on the control it will not be just selected 
  // as usually but handle will be added instead. So you can use form designer as a 
  // component designer and ADD POLYGONES VISUALLY IN DESIGN TIME!! You need to hold Ctrl key 
  // for this.
  //
  // There is a way to change the coordinates of the polygones verteces VISUALLY in DESIGN 
  // and RUN TIME! Click on the handle of the plolygon and DRAG IT to chosen 
  // location. Then release the mouse button. You can add new vertex to the polygon by 
  // clicking on its side!
  TCoolPolygones = class(TCustomPolygones)
  private
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  published
    property Color;
    property DefColor;
    property DefEditLineColor;
    property DefEditHandleColor;
    property DefNormalLineColor;
    property DefNormalHandleColor;
    property Editable;
    property EditMode;
    property HandleSize;
    property ParentColor;
    property Points;
    property Polygones;
    property Transparent;
    property Align;
    property Cursor;
    property Visible;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnPolygonClick;
    property OnPolygonMove;
  end;

  // TCoolPolyRegions class allows to create forms of any shape.
  //
  // Control can be used in design time and in run time. Editable property 
  // determines how the control will behave. If Editable is False clicking 
  // on the control WILL NOT cause adding of the polygon's handle 
  // otherwise such a handle will be added. IN DESIGN TIME AS WELL.
  //
  // When Editable is True in Design time control has the same behavior as 
  // it would in run-time which means when you click on the control it will 
  // not be just selected as usually but handle will be added instead. So you 
  // can use form designer as a component designer and ADD POLYGONES VISUALLY 
  // IN DESIGN TIME!! You need to hold Ctrl key for this.
  //
  // There is a way to change the coordinates of the polygones verteces 
  // VISUALLY in DESIGN and RUN TIME! Click on the handle of the plolygon and 
  // DRAG IT to chosen location. Then release the mouse button. You can add 
  // new vertex to the polygon by clicking on its side!
  TCoolPolyRegions = class(TCustomPolygones)
  private
    FActive: Boolean;
    procedure SetPolyRegiones;
    procedure SetActive(Value: Boolean);
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  protected
    procedure Loaded; override;
    procedure ApplyPolygones; virtual;
    procedure PointsChange(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive default False;
    property DefColor;
    property DefEditLineColor;
    property DefEditHandleColor;
    property DefNormalLineColor;
    property DefNormalHandleColor;
    property Editable;
    property EditMode;
    property HandleSize;
    property Points;
    property Polygones;
    property Transparent;
    property Align;
    property Cursor;
    property Visible;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnPolygonClick;
    property OnPolygonMove;
  end;

  // Determine what action should take place once you activate the TCoolImageShape control.
  // 
  // <TABLE>
  // Value                 Meaning
  // -------------         --------
  // caExclude             Color values that stored in Colors property will be excluded from resulting complex region. You can threat them as transparent colors.
  // caInclude             Color values that stored in Colors property will be the only ones used to create resulting complex region.
  // </TABLE>
  //
  TColorsAction = (caExclude, caInclude);

  // TCoolImageShape control can  be used to create forms of any shape 
  // based on the color structure of the specified bitmap. You can specify 
  // colors to be included or excluded from the resulting complex regions that 
  // later to be applied to the form.
  TCoolImageShape = class(TGraphicControl)
  private
    FRgn: HRGN;
    FAboutBox: TCCAboutBox;

    FActive: Boolean;
    FBitmap: TBitmap;
    FColors: TColorList;
    FColorsAction: TColorsAction;
    FFastCreate: Boolean;

    FMoveParent: Boolean;
    FOnChangeState: TNotifyEvent;

    procedure SetActive(Value: Boolean);
    procedure SetBitmap(Value: TBitmap);
    procedure SetColors(Value: TColorList);
    procedure SetColorsAction(Value: TColorsAction);
    procedure BitmapChanged(Sender: TObject);
    function GetColorsRegion: HRGN;
    procedure SetColorsRegion;

    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    property Align;
    {$IFDEF DELPHI4_OR_ABOVE}
    property AutoSize;
    {$ENDIF}
    procedure Paint; override;
    procedure Loaded; override;
    {$IFDEF DELPHI4_OR_ABOVE}
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    {$ENDIF}
    procedure ApplyRegions; dynamic;
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AdjustAppearance;
  published
    // Displays information about the control and package version.
    property About: TCCAboutBox read FAboutBox write FAboutBox;
    // Use Active to apply region information to the form. When Active is True 
    // created region is selected into the form, when false form restored to original state.
    property Active: Boolean read FActive write SetActive default False;
    // Use Bitmap to assign the image that will be used as a region template for your form.
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    // Use Colors to assign the list of the colors that will be used to create the temlate 
    // either being included or excluded from the region. 
    property Colors: TColorList read FColors write SetColors;
    // Use ColorsAction do determine what action should take place once you activate the control.
    // 
    // <TABLE>
    // Value             Meaning
    // --------          ----------
    // caExclude         Color values that stored in Colors property will be excluded from resulting complex region. You can threat them as transparent colors.
    // caInclude         Color values that stored in Colors property will be the only ones used to create resulting complex region.
    // </TABLE>
    property ColorsAction: TColorsAction read FColorsAction write SetColorsAction default caExclude;
    // Use FastCreate to switch between two different algorithms which used to generate masks. 
    // When FastCreate is True the resulting region will be created few times faster however it 
    // may not work correctly with Windows NT (Windows95/98 only). Generally if you like the speed 
    // your region used to be generated with leave FastCreate False otherwise you may want to set 
    // it to True and see what happens. In the worst case you will not see resulting mask and form 
    // will be all transparent. No GPF(s) will be produced though.
    property FastCreate: Boolean read FFastCreate write FFastCreate default False;
    // Use MoveParent to specify whether you want the parent form to be moved by the control.
    property MoveParent: Boolean read FMoveParent write FMoveParent default False;
    // Event occurs every time value of the Active property changes.
    property OnChangeState: TNotifyEvent read FOnChangeState write FOnChangeState;
    {$IFDEF DELPHI4_OR_ABOVE}
    property Anchors;
    property Constraints;
    {$ENDIF}
    property DragCursor;
    {$IFDEF DELPHI4_OR_ABOVE}
    property DragKind;
    {$ENDIF}
    property DragMode;
    property Enabled;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    {$IFDEF DELPHI5_OR_ABOVE}
    property OnContextPopup;
    {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF DELPHI4_OR_ABOVE}
    property OnEndDock;
    {$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    {$IFDEF DELPHI4_OR_ABOVE}
    property OnStartDock;
    {$ENDIF}
    property OnStartDrag;
  end;

// Converts TPointList type parameter into the array of points.
//
// Parameters:
//   AArray - open array of TPoint values to be filled with the values taken from AList.
//   ALst   - TPointList object with the TPoint values.
procedure ArrayFromList(var AArray: array of TPoint; AList: TPointList);
// Fills rectangles in the specified points.
//
// Parameters: 
//   Canvas  - TCanvas object where all the painting will occur.
//   Points  - TPointList object with the points to draw rectangles around.
//   Offset  - Used to determine the width and height of the rectangles (Width = Height = 2*Offset)
procedure PolyRects(Canvas: TCanvas; Points: TPointList; Offset: Integer);
// Builds region from the rectangles provided in the Rects list.
//
// Parameters:
//   Rects   - List object that contains rectangles to build the region from.
//   RWidth  - Initial width of the region.
//   RHeight - Initial height of the region.
//
// Result:
//   If successful returns created region handle otherwise -1. 
function RgnFromRects(Rects: TRectList; RWidth, RHeight: Integer): HRGN;

implementation

procedure ArrayFromList(var AArray: array of TPoint; AList: TPointList);
var
  I: Integer;
begin
  FillChar(AArray, SizeOf(AArray), 0);
  for I := 0 to Pred(AList.Count) do
    AArray[I] := AList[I];
end;

function PointsFakeEqual(APoint1, APoint2: TPoint; Offset: Integer): Boolean;
begin
  Result := PtInRect(Rect(APoint1.X-Offset, APoint1.Y-Offset, APoint1.X+Offset, APoint1.Y+Offset), APoint2);
end;

procedure PolyRects(Canvas: TCanvas; Points: TPointList; Offset: Integer);
var
  I: Integer;
begin
  for I := Pred(Points.Count) downto 0 do
    with Points[I] do
      Canvas.FillRect(Rect(X-Offset, Y-Offset, X+Offset, Y+Offset));
end;

function RgnFromRects(Rects: TRectList; RWidth, RHeight: Integer): HRGN;
var
  I: Integer;
  Pr: PRect;
  PData: PRGNDATA;
begin
  GetMem(PData, SizeOf(TRgnData)+(Rects.Count*SizeOf(TRect)));
  try
    PData^.rdh.dwSize := SizeOf(TRgnData);
    PData^.rdh.iType := RDH_RECTANGLES;
    PData^.rdh.nCount := Rects.Count;
    PData^.rdh.nRgnSize := SizeOf(TRect);
    PData^.rdh.rcBound.Left := 0;
    PData^.rdh.rcBound.Top := 0;
    PData^.rdh.rcBound.Right := RWidth;
    PData^.rdh.rcBound.Bottom := RHeight;
    Pr := @PData^.Buffer;

    for I := 0 to Pred(Rects.Count) do
    begin
      Pr^ := Rects.Items[I];
      Inc(Pr);
    end;

    Result := ExtCreateRegion(nil, SizeOf(TRgnDATA)+(Rects.Count*SizeOf(TRect)), PData^);
  finally
    FreeMem(PData, SizeOf(TRgnData)+(Rects.Count*SizeOf(TRect)));
  end;
end;

{TSinglePolygon}
constructor TSinglePolygon.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FPoints := TPointList.Create;
  FPoints.OnChange := PointsChange;
  FColor := clBtnFace;
  FLineColor := clBlack;
  FHandleColor := clBlack;
  FTransparent := False;
  FTransparentEdges := False;
end;

destructor TSinglePolygon.Destroy;
begin
  FPoints.Free;
  inherited Destroy;
end;

{$IFDEF DELPHI4_OR_ABOVE}
constructor TSinglePolygon.Create(ACollection: TCollection; AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean);
begin
  Create(ACollection);

  FColor := AColor;
  FLineColor := ALineColor;
  FHandleColor := AHandleColor;
  FTransparent := ATransparent;

  if Assigned(APoints) then
    FPoints.Assign(APoints);
end;
{$ELSE}
procedure TSinglePolygon.Initialize(AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean);
begin
  FColor := AColor;
  FLineColor := ALineColor;
  FHandleColor := AHandleColor;
  FTransparent := ATransparent;

  if Assigned(FPoints) then
    FPoints.Assign(APoints);
end;
{$ENDIF}

{$IFNDEF VER90}
function TSinglePolygon.GetDisplayName: string;
begin
  Result := inherited GetDisplayName;
end;
{$ENDIF}

procedure TSinglePolygon.Assign(Source: TPersistent);
begin
   if (Source is TSinglePolygon) then
   begin
     FColor := TSinglePolygon(Source).Color;
     FLineColor := TSinglePolygon(Source).LineColor;
     FHandleColor := TSinglePolygon(Source).HandleColor;
     FTransparent := TSinglePolygon(Source).Transparent;
     FPoints.Assign(TSinglePolygon(Source).Points);
     Exit;
   end;
  inherited Assign(Source);
end;

procedure TSinglePolygon.SetPoints(Value: TPointList);
begin
  FPoints.Assign(Value);
  Changed(False);
end;

procedure TSinglePolygon.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Changed(False);
  end;
end;

procedure TSinglePolygon.SetTransparentEdges(Value: Boolean);
begin
  if FTransparentEdges <> Value then
  begin
    FTransparentEdges := Value;
    Changed(False);
  end;
end;

procedure TSinglePolygon.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed(False);
  end;
end;

procedure TSinglePolygon.SetLineColor(Value: TColor);
begin
  if FLineColor <> Value then
  begin
    FLineColor := Value;
    Changed(False);
  end;
end;

procedure TSinglePolygon.SetHandleColor(Value: TColor);
begin
  if FHandleColor <> Value then
  begin
    FHandleColor := Value;
    Changed(False);
  end;
end;

procedure TSinglePolygon.PointsChange(Sender: TObject);
begin
  Changed(False);
end;

procedure TSinglePolygon.PaintPolygon(Canvas: TCanvas);
const
  PenStyles: array[Boolean] of TPenStyle = (psSolid, psClear);
  BrushStyles: array[Boolean] of TBrushStyle = (bsSolid, bsClear);
var
  PointsArray: array[0..MaxWord] of TPoint;
begin
  if FPoints.Count <> 0 then
    with Canvas do
    begin
      ArrayFromList(PointsArray, FPoints);

      Brush.Color := FColor;
      Brush.Style := BrushStyles[FTransparent];

      Pen.Color := FLineColor;
      Pen.Style := PenStyles[FTransparentEdges];

      Polygon(Slice(PointsArray, FPoints.Count));

      Brush.Color := FHandleColor;
      Brush.Style := BrushStyles[FTransparentEdges];

      if TPolygones(Collection).FComp is TCustomPolygones then
        PolyRects(Canvas, FPoints, TCustomPolygones(TPolygones(Collection).FComp).FHandleSize);
    end;
end;

function TSinglePolygon.PointOnSide(var PointActive, PointBefore, PointAfter: TPoint): Boolean;
var
  I: Integer;
  S, R, L: Real;
begin
  Result := False;

  for I := 0 to FPoints.Count-1 do
  begin
    PointBefore := FPoints[I];

    if I = FPoints.Count-1 then
      PointAfter := FPoints[0] else
        PointAfter := FPoints[Succ(I)];

    if TPolygones(Collection).FComp is TCustomPolygones then
      if not (PointsFakeEqual(PointBefore, PointActive, TCustomPolygones(TPolygones(Collection).FComp).FHandleSize) or PointsFakeEqual(PointAfter, PointActive, TCustomPolygones(TPolygones(Collection).FComp).FHandleSize)) then
      begin
        L := Sqrt(Sqr(PointAfter.X-PointBefore.X) + Sqr(PointAfter.Y-PointBefore.Y));

        if L <> 0 then
        begin
          R := ((PointBefore.Y-PointActive.Y)*(PointBefore.Y-PointAfter.Y)-(PointBefore.X-PointActive.X)*(PointAfter.X-PointBefore.X)) / Sqr(L);
          S := ((PointBefore.Y-PointActive.Y)*(PointAfter.X-PointBefore.X)-(PointBefore.X-PointActive.X)*(PointAfter.Y-PointBefore.Y)) / Sqr(L);

          if (S < 0.01) and (S > -0.01) and (R > 0) and (R < 1) then
          begin
            if I = FPoints.Count-1 then
              FPoints.Add(PointActive) else
                FPoints.Insert(Succ(I), PointActive);

            Result := True;
            Break;
          end;
        end;
      end;
  end;
end;

function TSinglePolygon.PointOnHandle(var PointActive, PointBefore, PointAfter: TPoint): Boolean;
var
  I: Integer;
begin
  Result := False;

  if TPolygones(Collection).FComp is TCustomPolygones then
    for I := 0 to FPoints.Count-1 do
      if PointsFakeEqual(FPoints[I], PointActive, TCustomPolygones(TPolygones(Collection).FComp).FHandleSize) then
      begin
        if (I <> 0) and (I <> FPoints.Count-1) then
        begin
          PointBefore := FPoints[Pred(I)];
          PointAfter := FPoints[Succ(I)];
        end else
        if I = 0 then
        begin
          PointBefore := FPoints[FPoints.Count-1];
          PointAfter := FPoints[Succ(I)];
        end else
        if I = FPoints.Count-1 then
        begin
          PointBefore := FPoints[Pred(I)];
          PointAfter := FPoints[0];
        end;

        PointActive := FPoints[I];
        Result := True;
        Break;
      end;
end;

function TSinglePolygon.PointWithinPolygon(PointActive: TPoint): Boolean;
var
  Rgn: HRGN;
  PointsArray: array [0..MaxWord] of TPoint;
begin
  ArrayFromList(PointsArray, FPoints);
  Rgn := CreatePolygonRgn(PointsArray, FPoints.Count, ALTERNATE);
  Result := PtInRegion(Rgn, PointActive.X, PointActive.Y);
  DeleteObject(Rgn);
end;

{TPolygones}
constructor TPolygones.Create(Comp: TComponent);
begin
  inherited Create(TSinglePolygon);
  FComp := Comp;
end;

function TPolygones.GetItem(Index: Integer): TSinglePolygon;
begin
  Result := TSinglePolygon(inherited GetItem(Index));
end;

procedure TPolygones.SetItem(Index: Integer; Value: TSinglePolygon);
begin
  inherited SetItem(Index, Value);
end;

{$IFNDEF VER90}
function TPolygones.GetOwner: TPersistent;
begin
  Result := FComp;
end;
{$ENDIF}

procedure TPolygones.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
  if FComp is TCustomPolygones then
    TCustomPolygones(FComp).Invalidate;
end;

function TPolygones.Add(AColor, ALineColor, AHandleColor: TColor; APoints: TPointList; ATransparent: Boolean): TSinglePolygon;
begin
  {$IFDEF DELPHI4_OR_ABOVE}
  Result := TSinglePolygon.Create(Self, AColor, ALineColor, AHandleColor, APoints, ATransparent);
  {$ELSE}
  Result := TSinglePolygon.Create(Self);
  Result.Initialize(AColor, ALineColor, AHandleColor, APoints, ATransparent);
  {$ENDIF}
end;

{TCustomPolygones}
constructor TCustomPolygones.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(Left, Top, 100, 100);
  FPolygones := TPolygones.Create(Self);
  FPoints := TPointList.Create;
  FPoints.OnChange := PointsChange;

  FDefColor := clBtnFace;
  FDefEditLineColor := clRed;
  FDefEditHandleColor := clRed;
  FDefNormalLineColor := clBlack;
  FDefNormalHandleColor := clBlack;

  FPointPosition := ptNoWhere;
  FPolygonIndex := -1;
  FHandleSize := 3;
  FTransparent := False;

  FEditable := True;
  FEditMode := [emAllowAddPolygone, emAllowAddHandle, emAllowResize];
  FPaintBorders := False;
end;

destructor TCustomPolygones.Destroy;
begin
  FPolygones.Free;
  FPoints.Free;
  inherited Destroy;
end;

procedure TCustomPolygones.SetPoints(Value: TPointList);
begin
  FPoints.Assign(Value);
  Invalidate;
end;

procedure TCustomPolygones.SetHandleSize(Value: Integer);
begin
  if FHandleSize <> Value then
  begin
    FHandleSize := Value;
    Invalidate;
  end;
end;

procedure TCustomPolygones.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent  := Value;
    Invalidate;
  end;
end;

procedure TCustomPolygones.SetPaintBorders(Value: Boolean);
begin
  if FPaintBorders <> Value then
  begin
    FPaintBorders := Value;
    Invalidate;
  end;
end;

procedure TCustomPolygones.PaintPolygones(Canv: TCanvas);
var
  I: Integer;
begin
  if FPolygones.Count <> 0 then
    for I := 0 to Pred(FPolygones.Count) do
      FPolygones[I].PaintPolygon(Canv);
end;

procedure TCustomPolygones.PaintPoints(Canv: TCanvas);
var
  PointsArray: array [0..MaxWord] of TPoint;
begin
  if FPoints.Count <> 0 then
    with Canv do
    begin
      Pen.Color := FDefEditLineColor;
      Pen.Style := psSolid;
      Brush.Color := FDefEditHandleColor;

      ArrayFromList(PointsArray, FPoints);
      PolyLine(Slice(PointsArray, FPoints.Count));
      PolyRects(Canv, FPoints, FHandleSize);
    end;
end;

procedure TCustomPolygones.PaintEditHandle(Canv: TCanvas; Pt: TPoint);
begin
  with Canv, Pt do
  begin
    Pen.Color := FDefEditLineColor;
    Brush.Style := bsClear;
    Pen.Style := psDot;
    MoveTo(FPrevPoint.X, FPrevPoint.Y);
    LineTo(X, Y);
    MoveTo(FNextPoint.X, FNextPoint.Y);
    LineTo(X, Y);
    Pen.Style := psSolid;
    Brush.Style := bsSolid;
    Brush.Color := FDefEditHandleColor;
    FillRect(Rect(X-FHandleSize, Y-FHandleSize, X+FHandleSize, Y+FHandleSize));
  end;
end;

procedure TCustomPolygones.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);

  if Assigned(FOnPolygonClick) then
    for I := 0 to Pred(FPolygones.Count) do
      with FPolygones[I] do
        if PointWithinPolygon(Point(X, Y)) then
        begin
          if Assigned(FOnPolygonClick) then
            FOnPolygonClick(Self, I, Point(X, Y));

          Break;
        end;

  if (Button = mbLeft) and FEditable then
  begin
    FPolygonIndex := -1;
    FPointPosition := ptNoWhere;

    for I := 0 to Pred(FPolygones.Count) do
      with FPolygones[I] do
      begin
        FActivePoint := Point(X, Y);
        if PointOnHandle(FActivePoint, FPrevPoint, FNextPoint) and (emAllowResize in FEditMode) then
        begin
          FPointPosition := ptOnHandle;
          FPolygonIndex := I;
          Exit;
        end;
        if PointOnSide(FActivePoint, FPrevPoint, FNextPoint) and (emAllowAddHandle in FEditMode) then
        begin
          FPointPosition := ptOnSide;
          FPolygonIndex := I;
          Exit;
        end;
      end;
      
    if (emAllowAddPolygone in FEditMode) then
    begin
      if (FPoints.Count >= 3) and (PointsFakeEqual(Point(X, Y), FPoints[0], FHandleSize)) then
      begin
        FPolygones.Add(FDefColor, FDefNormalLineColor, FDefNormalHandleColor, FPoints, FTransparent);
        FPoints.Clear;
      end else
      begin
        FPoints.Add(Point(X, Y));
      end;
    end;
  end;
end;

procedure TCustomPolygones.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  TempDC: HDC;
  OldBmp, TempBmp: HBITMAP;
begin
  inherited MouseMove(Shift, X, Y);

  if Assigned(FOnPolygonMove) then
    for I := 0 to Pred(FPolygones.Count) do
      with FPolygones[I] do
        if PointWithinPolygon(Point(X, Y)) then
        begin
          if Assigned(FOnPolygonMove) then
            FOnPolygonMove(Self, I, Point(X, Y));

          Break;
        end;

  if (FPointPosition = ptOnHandle) and (FPolygonIndex <> -1) and FEditable and (emAllowResize in FEditMode) then
  begin
    TempDC := CreateCompatibleDC(Canvas.Handle);
    try
      TempBmp := CreateCompatibleBitmap(Canvas.Handle, Parent.Width, Parent.Height);
      try
        OldBmp := SelectObject(TempDC, TempBmp);

        SendMessage(Parent.Handle, WM_ERASEBKGND, TempDC, 0);
        SendMessage(Parent.Handle, WM_PAINT, TempDC, 0);
        BitBlt(Canvas.Handle, 0, 0, Width, Height, TempDC, Left, Top, SRCCOPY);
        PaintEditHandle(Canvas, Point(X, Y));

        SelectObject(TempDC, OldBmp);
      finally
        DeleteObject(TempBmp);
      end;
    finally
      DeleteDC(TempDC);
    end;
  end;
end;

procedure TCustomPolygones.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbLeft) and FEditable and (emAllowAddHandle in FEditMode) then
    if (FPointPosition = ptOnHandle) and (FPolygonIndex <> -1) then
      with FPolygones[FPolygonIndex] do
      begin
        I := Points.IndexOf(FActivePoint);
        if I <> -1 then
        begin
          Points.Delete(I);
          Points.Insert(I, Point(X, Y));
        end;
        FPolygonIndex := -1;
        FPointPosition := ptNoWhere;
      end;
end;

procedure TCustomPolygones.PointsChange(Sender: TObject);
begin
  if FPoints.Count = 0 then
    Invalidate else
    FastRepaint;
end;

procedure TCustomPolygones.FastRepaint;
begin
  PaintPoints(Canvas);
  PaintPolygones(Canvas);
end;

procedure TCustomPolygones.Paint;
begin
  inherited Paint;

  with Canvas do
  begin
    if not FTransparent then
    begin
      Brush.Color := Self.Color;
      FillRect(ClientRect);
    end;

    FastRepaint;

    if FPaintBorders or (csDesigning in ComponentState) then
    begin
      Pen.Color := clBlack;
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Bottom);
      Pen.Style := psSolid;
      Brush.Style := bsSolid;
    end;
  end;
end;

procedure TCustomPolygones.Assign(Source: TPersistent);
begin
  if Source is TCustomPolygones then
  begin
    DefColor := TCustomPolygones(Source).DefColor;
    DefEditLineColor := TCustomPolygones(Source).DefEditLineColor;
    DefEditHandleColor := TCustomPolygones(Source).DefEditHandleColor;
    DefNormalLineColor := TCustomPolygones(Source).DefNormalLineColor;
    DefNormalHandleColor := TCustomPolygones(Source).DefNormalHandleColor;
    Editable := TCustomPolygones(Source).Editable;
    EditMode := TCustomPolygones(Source).EditMode;
    HandleSize := TCustomPolygones(Source).HandleSize;
    PaintBorders := TCustomPolygones(Source).PaintBorders;
    Points.Assign(TCustomPolygones(Source).Points);
    Polygones.Assign(TCustomPolygones(Source).Polygones);
    Transparent := TCustomPolygones(Source).Transparent;
    OnPolygonClick := TCustomPolygones(Source).OnPolygonClick;
    OnPolygonMove := TCustomPolygones(Source).OnPolygonMove;
    Exit;
  end;
  inherited Assign(Source);
end;

{TCoolPolygones}
procedure TCoolPolygones.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  if FEditable and (MK_CONTROL and Message.Keys <> 0) then
  begin
    if Assigned(TForm(Owner).Designer) then
      TForm(Owner).Designer.Modified;

    Message.Result := 1;
    Exit;
  end;
  inherited;
end;

{TCoolPolyRegions}
constructor TCoolPolyRegions.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTransparent := True;
  FActive := False;
end;

destructor TCoolPolyRegions.Destroy;
begin
  if not (csDestroying in Owner.ComponentState) then
    Active := False;

  inherited Destroy;
end;

procedure TCoolPolyRegions.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    ApplyPolygones;
  end;
end;

procedure TCoolPolyRegions.SetPolyRegiones;
var
  PointsArray: array [0..MaxWord] of TPoint;
  Verteces: array [0..MaxWord] of Integer;
  Rgn: HRGN;
  I,K,N: Integer;
  P: TPoint;
begin
  if Polygones.Count <> 0 then
  begin
    N := 0;
    for I := 0 to Pred(Polygones.Count) do
    begin
      Verteces[I] := Polygones[I].Points.Count;
      for K := 0 to Pred(Polygones[I].Points.Count) do
      begin
        PointsArray[N + K] := Polygones[I].Points[K];
      end;
      N := N + Verteces[I];
    end;

    Rgn := CreatePolyPolygonRgn(PointsArray, Verteces, Polygones.Count, ALTERNATE);
    P := ClientOrigin;
    OffsetRgn(Rgn, P.X-TWinControl(Owner).Left, P.Y-TWinControl(Owner).Top);
    SetWindowRgn(TWinControl(Owner).Handle, Rgn, True);
    DeleteObject(Rgn);
  end;
end;

procedure TCoolPolyRegions.ApplyPolygones;
begin
  if FActive then
    SetPolyRegiones else
      SetWindowRgn(TWinControl(Owner).Handle, 0, True);
end;

procedure TCoolPolyRegions.PointsChange(Sender: TObject);
begin
  inherited PointsChange(Sender);
end;

procedure TCoolPolyRegions.Loaded;
begin
  inherited Loaded;
  ApplyPolygones;
end;

procedure TCoolPolyRegions.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  if FEditable and (MK_CONTROL and Message.Keys <> 0) then
  begin
    if Assigned(TForm(Owner).Designer) then
      TForm(Owner).Designer.Modified;

    Message.Result := 1;
    Exit;
  end;
  inherited;
end;

{TCoolImageShape}
constructor TCoolImageShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(Left, Top, 100, 100);
  FBitmap := TBitmap.Create;
  FBitmap.OnChange := BitmapChanged;
  FColors := TColorList.Create;
  FColorsAction := caExclude;
  FActive := False;
  FFastCreate := False;
  FMoveParent := False;
  {$IFDEF DELPHI4_OR_ABOVE}
  AutoSize := True;
  {$ENDIF}
end;

destructor TCoolImageShape.Destroy;
begin  
  if not (csDestroying in Owner.ComponentState) then
    Active := False;

  if FRgn <> ERROR then
    DeleteObject(FRgn);

  FBitmap.Free;
  FColors.Free;
  inherited Destroy;
end;

procedure TCoolImageShape.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    ApplyRegions;
  end;
end;

procedure TCoolImageShape.BitmapChanged(Sender: TObject);
begin
  {$IFDEF DELPHI4_OR_ABOVE}
  if AutoSize and (Bitmap.Width > 0) and (Bitmap.Height > 0) then
  {$ENDIF}
    SetBounds(Left, Top, Bitmap.Width, Bitmap.Height);

  FColors.Clear;
  ApplyRegions;

  Invalidate;
end;

procedure TCoolImageShape.SetBitmap(Value: TBitmap);
begin
  if  FBitmap <> Value then
  begin
    FBitmap.Assign(Value);
    Active := False;
  end;
end;

procedure TCoolImageShape.SetColors(Value: TColorList);
begin
  FColors.Assign(Value);
  ApplyRegions;
end;

procedure TCoolImageShape.SetColorsAction(Value: TColorsAction);
begin
  if FColorsAction <> Value then
  begin
    FColorsAction := Value;
    ApplyRegions;
  end;
end;

function TCoolImageShape.GetColorsRegion: HRGN;
var
  Rgn: HRGN;
  X0, X, Y: Integer;
  Rects: TRectList;
begin
  Result := CreateRectRgn(0, 0, 0, 0);

  Rects := TRectList.Create;
  try
    for Y := 0 to Pred(Bitmap.Height) do
    begin
      X := 0;
      while X < Pred(Bitmap.Width) do
      begin
        X0 := X;
        while X < Pred(Bitmap.Width) do
        begin
          case FColorsAction of
            caExclude:
              if FColors.IndexOf(Bitmap.Canvas.Pixels[X, Y]) <> -1 then
                Break;
            caInclude:
              if FColors.IndexOf(Bitmap.Canvas.Pixels[X, Y]) = -1 then
                Break;
          end;
          Inc(X);
        end;
        if X > X0 then
        begin
          if FFastCreate then
          begin
            Rects.Add(Rect(X0, Y, X, Succ(Y)));
            if Rects.Count = 2000 then
            begin
              Rgn := RgnFromRects(Rects, Bitmap.Width, Bitmap.Height);
              CombineRgn(Result, Result, Rgn, RGN_OR);
              DeleteObject(Rgn);
              Rects.Clear;
            end;
          end else
          begin
            Rgn := CreateRectRgn(X0, Y, X, Succ(Y));
            CombineRgn(Result, Result, Rgn, RGN_OR);
            DeleteObject(Rgn);
          end;
        end;
        Inc(X);
      end;
    end;

    if FFastCreate then
    begin
      Rgn := RgnFromRects(Rects, Bitmap.Width, Bitmap.Height);
      CombineRgn(Result, Result, Rgn, RGN_OR);
      DeleteObject(Rgn);
    end;
  finally
    Rects.Free;
  end;
end;

procedure TCoolImageShape.SetColorsRegion;
var
  P: TPoint;
begin
  if FRgn <> ERROR then
    DeleteObject(FRgn);

  if FColors.Count <> 0 then
  begin
    FRgn := GetColorsRegion;

    P := ClientOrigin;
    with Parent do
      OffsetRgn(FRgn, P.X - Left, P.Y - Top);

    SetWindowRgn(Parent.Handle, FRgn, True);
  end;
end;

procedure TCoolImageShape.ApplyRegions;
begin
  if Assigned(FOnChangeState) then
    FOnChangeState(Self);

  if FActive then
  begin
    SetColorsRegion;
  end else
  begin
    SetWindowRgn(Parent.Handle, 0, True);
  end;
end;

procedure TCoolImageShape.AdjustAppearance;
var
  X, Y, I: Integer;
begin
  if Parent is TForm then
    TForm(Parent).BorderStyle := bsNone;

  with Parent do
  begin
    X := Self.Left;
    Y := Self.Top;

    if (X <> 0) or (Y <> 0) then
      for I := 0 to Pred(ControlCount) do
        with Controls[I] do
          SetBounds(Left-X, Top-Y, Width, Height);

    SetBounds(Left, Top, Self.Width, Self.Height);
  end;
end;

procedure TCoolImageShape.Paint;
begin
  with inherited Canvas do
  begin
    StretchDraw(ClientRect, Bitmap);
    if csDesigning in ComponentState then
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  end;
end;

procedure TCoolImageShape.Loaded;
begin
  inherited Loaded;
  ApplyRegions;
end;

procedure TCoolImageShape.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
end;

{$IFDEF DELPHI4_OR_ABOVE}
function TCoolImageShape.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) or (Bitmap.Width > 0) and (Bitmap.Height > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      NewWidth := Bitmap.Width;

    if Align in [alNone, alTop, alBottom] then
      NewHeight := Bitmap.Height;
  end;
end;
{$ENDIF}

procedure TCoolImageShape.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if FMoveParent then
    with Parent do
    begin
      ReleaseCapture;
      SendMessage(Handle, WM_SYSCOMMAND, Succ(SC_MOVE), 0);
    end
    else
    inherited;
end;

end.
