{ Implements non-native regions with support for managing their Z-order Author: Felipe Monteiro de Carvalho } unit lazregions; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpcanvas; type TLazRegionFillMode = (rfmOddEven, rfmWinding); TPointArray = array of TPoint; { TLazRegionPart } TLazRegionPart = class public function IsPointInPart(AX, AY: Integer): Boolean; virtual; end; { TLazRegionRect } TLazRegionRect = class(TLazRegionPart) public Rect: TRect; function IsPointInPart(AX, AY: Integer): Boolean; override; end; { TLazRegionPolygon } TLazRegionPolygon = class(TLazRegionPart) public Points: array of TPoint; FillMode: TLazRegionFillMode; function IsPointInPart(AX, AY: Integer): Boolean; override; end; {$if defined(ver2_4) or defined(ver2_5) or defined(ver2_6)} TFPCustomRegion = class function GetBoundingRect: TRect; virtual; abstract; function IsPointInRegion(AX, AY: Integer): Boolean; virtual; abstract; end; {$endif} TLazRegion = class(TFPCustomRegion) public // The parts of a region should all be inside valid areas of the region // so if a combination operation removes some areas of the region, then // these areas should be removed from all parts of the region // There is no z-order for the parts, they are all validly inside the region area Parts: TFPList; // of TLazRegionPart IsSimpleRectRegion: Boolean; // Indicates whether this region has only 1 rectangular part Rect: TRect; // Used for performance increase when IsSimpleRectRegion is on constructor Create; virtual; destructor Destroy; override; procedure AddRectangle(ARect: TRect); procedure AddPolygon(var APoints: TPointArray; AFillMode: TLazRegionFillMode); procedure SetAsSimpleRectRegion(ARect: TRect); function GetBoundingRect: TRect; override; function IsPointInRegion(AX, AY: Integer): Boolean; override; end; { This is a region which can hold other region holders inside it } { TLazRegionWithChilds } TLazRegionWithChilds = class(TLazRegion) public Parent: TLazRegionWithChilds; // The order in this list is also the Z-Order of the sub regions inside it // The element with index zero is the bottom-most one Childs: TFPList; // of TLazRegionWithChilds UserData: TObject; // available link to another object constructor Create; override; destructor Destroy; override; function IsPointInRegion(AX, AY: Integer): TLazRegionWithChilds; virtual; end; function IsPointInPolygon(AX, AY: Integer; const APolygon: array of TPoint): Boolean; implementation // The function will return True if the point x,y is inside the polygon, or // False if it is not. // // Original C code: http://www.visibone.com/inpoly/inpoly.c.txt // // Translation from C by Felipe Monteiro de Carvalho // // License: Public Domain function IsPointInPolygon(AX, AY: Integer; const APolygon: array of TPoint): Boolean; var xnew, ynew: Cardinal; xold,yold: Cardinal; x1,y1: Cardinal; x2,y2: Cardinal; i, npoints: Integer; inside: Integer = 0; begin Result := False; npoints := Length(APolygon); if (npoints < 3) then Exit; xold := APolygon[npoints-1].X; yold := APolygon[npoints-1].Y; for i := 0 to npoints - 1 do begin xnew := APolygon[i].X; ynew := APolygon[i].Y; if (xnew > xold) then begin x1:=xold; x2:=xnew; y1:=yold; y2:=ynew; end else begin x1:=xnew; x2:=xold; y1:=ynew; y2:=yold; end; if (((xnew < AX) = (AX <= xold)) // edge "open" at left end and ((AY-y1)*(x2-x1) < (y2-y1)*(AX-x1))) then begin inside := not inside; end; xold:=xnew; yold:=ynew; end; Result := inside <> 0; end; { TLazRegionPart } function TLazRegionPart.IsPointInPart(AX, AY: Integer): Boolean; begin Result := False; end; { TLazRegionRect } function TLazRegionRect.IsPointInPart(AX, AY: Integer): Boolean; begin Result := (AX >= Rect.Left) and (AX <= Rect.Right) and (AY >= Rect.Top) and (AY <= Rect.Bottom); end; { TLazRegionPolygon } function TLazRegionPolygon.IsPointInPart(AX, AY: Integer): Boolean; begin Result := IsPointInPolygon(AX, AY, Points); end; { TLazRegion } constructor TLazRegion.Create; begin inherited Create; Parts := TFPList.Create; IsSimpleRectRegion := True; end; destructor TLazRegion.Destroy; begin Parts.Free; inherited Destroy; end; procedure TLazRegion.AddRectangle(ARect: TRect); var lNewRect: TLazRegionRect; begin lNewRect := TLazRegionRect.Create; lNewRect.Rect := ARect; Parts.Add(lNewRect); end; procedure TLazRegion.AddPolygon(var APoints: TPointArray; AFillMode: TLazRegionFillMode); var lNewPolygon: TLazRegionPolygon; begin lNewPolygon := TLazRegionPolygon.Create; lNewPolygon.Points := APoints; lNewPolygon.FillMode := AFillMode; Parts.Add(lNewPolygon); end; procedure TLazRegion.SetAsSimpleRectRegion(ARect: TRect); begin IsSimpleRectRegion := True; Rect := ARect; end; function TLazRegion.GetBoundingRect: TRect; begin Result := Rect; end; { Checks if a point is inside this region } function TLazRegion.IsPointInRegion(AX, AY: Integer): Boolean; var i: Integer; begin if IsSimpleRectRegion then begin Result := (AX >= Rect.Left) and (AX <= Rect.Right) and (AY >= Rect.Top) and (AY <= Rect.Bottom); end else begin Result := False; for i := 0 to Parts.Count-1 do begin // being inside 1 subpart is enough if TLazRegionPart(Parts.Items[i]).IsPointInPart(AX, AY) then begin Result := True; Exit; end; end; end; end; { TLazRegionWithChilds } constructor TLazRegionWithChilds.Create; begin inherited Create; Childs := TFPList.Create; end; destructor TLazRegionWithChilds.Destroy; begin Childs.Free; inherited Destroy; end; { Returns itself or a child, depending on where the point was found or nil if the point is neither in the region nor in any children Part of the behavior is implemented in TLazRegionWithChilds } function TLazRegionWithChilds.IsPointInRegion(AX, AY: Integer): TLazRegionWithChilds; var i: Integer; lIsInside: Boolean; begin Result := nil; // First check if it is inside itself lIsInside := inherited IsPointInRegion(AX, AY); // If it is, then check if it is in any of the children if lIsInside then begin Result := nil; for i := 0 to Childs.Count-1 do begin Result := TLazRegionWithChilds(Childs.Items[i]).IsPointInRegion(AX, AY); end; // if it wasn't in any sub region, it is really in this region if Result = nil then Result := Self; end; end; end.