home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / GR32_Layers.pas < prev    next >
Pascal/Delphi Source File  |  2004-12-19  |  35KB  |  1,171 lines
  1. unit GR32_Layers;
  2.  
  3. (* ***** BEGIN LICENSE BLOCK *****
  4.  * Version: MPL 1.1
  5.  *
  6.  * The contents of this file are subject to the Mozilla Public License Version
  7.  * 1.1 (the "License"); you may not use this file except in compliance with
  8.  * the License. You may obtain a copy of the License at
  9.  * http://www.mozilla.org/MPL/
  10.  *
  11.  * Software distributed under the License is distributed on an "AS IS" basis,
  12.  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13.  * for the specific language governing rights and limitations under the
  14.  * License.
  15.  *
  16.  * The Original Code is Graphics32
  17.  *
  18.  * The Initial Developer of the Original Code is
  19.  * Alex A. Denisov
  20.  *
  21.  * Portions created by the Initial Developer are Copyright (C) 2000-2004
  22.  * the Initial Developer. All Rights Reserved.
  23.  *
  24.  * Contributor(s):
  25.  *
  26.  * ***** END LICENSE BLOCK ***** *)
  27.  
  28. interface
  29.  
  30. {$INCLUDE GR32.inc}
  31.  
  32. uses
  33. {$IFDEF CLX}
  34.   Qt, Types, QControls, QGraphics, QForms,
  35.   {$IFDEF LINUX}Libc, {$ENDIF}
  36.   {$IFDEF MSWINDOWS}Windows, {$ENDIF}
  37. {$ELSE}
  38.   Windows, Controls, Graphics, Forms,
  39. {$ENDIF}
  40.   Classes, SysUtils, GR32;
  41.  
  42. const
  43.   { Layer Options Bits }
  44.   LOB_VISIBLE           = $80000000; // 31-st bit
  45.   LOB_GDI_OVERLAY       = $40000000; // 30-th bit
  46.   LOB_MOUSE_EVENTS      = $20000000; // 29-th bit
  47.   LOB_NO_UPDATE         = $10000000; // 28-th bit
  48.   LOB_NO_CAPTURE        = $08000000; // 27-th bit
  49.   LOB_RESERVED_26       = $04000000; // 26-th bit
  50.   LOB_RESERVED_25       = $02000000; // 25-th bit
  51.   LOB_RESERVED_24       = $01000000; // 24-th bit
  52.   LOB_RESERVED_MASK     = $FF000000;
  53.  
  54. type
  55.   TCustomLayer = class;
  56.   TPositionedLayer = class;
  57.   TLayerClass = class of TCustomLayer;
  58.  
  59.   { TCoordXForm - transformations from bitmap image to buffer origin }
  60.   TCoordXForm = record
  61.     ScaleX: TFixed;       // bitmap image to buf
  62.     ScaleY: TFixed;       
  63.     ShiftX: Integer;
  64.     ShiftY: Integer;
  65.     RevScaleX: TFixed;
  66.     RevScaleY: TFixed;
  67.   end;
  68.   PCoordXForm = ^TCoordXForm;
  69.  
  70.   TLayerCollection = class(TPersistent)
  71.   private
  72.     FCoordXForm: PCoordXForm;
  73.     FItems: TList;
  74.     FMouseEvents: Boolean;
  75.     FMouseListener: TCustomLayer;
  76.     FUpdateCount: Integer;
  77.     FOwner: TComponent;
  78.     FOnChanging: TNotifyEvent;
  79.     FOnChange: TNotifyEvent;
  80.     FOnGDIUpdate: TNotifyEvent;
  81.     function GetCount: Integer;
  82.     procedure InsertItem(Item: TCustomLayer);
  83.     procedure RemoveItem(Item: TCustomLayer);
  84.     procedure SetMouseEvents(Value: Boolean);
  85.     procedure SetMouseListener(Value: TCustomLayer);
  86.   protected
  87.     procedure BeginUpdate;
  88.     procedure Changed;
  89.     procedure Changing;
  90.     procedure EndUpdate;
  91.     function  FindLayerAtPos(X, Y: Integer; OptionsMask: Cardinal): TCustomLayer;
  92.     function  GetItem(Index: Integer): TCustomLayer;
  93.     function  GetOwner: TPersistent; override;
  94.     procedure GDIUpdate;
  95.     procedure SetItem(Index: Integer; Value: TCustomLayer);
  96.     function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): TCustomLayer;
  97.     function MouseMove(Shift: TShiftState; X, Y: Integer): TCustomLayer;
  98.     function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): TCustomLayer;
  99.     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  100.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  101.     property OnGDIUpdate: TNotifyEvent read FOnGDIUpdate write FOnGDIUpdate;
  102.   public
  103.     constructor Create(AOwner: TComponent);
  104.     destructor Destroy; override;
  105.     function  Add(ItemClass: TLayerClass): TCustomLayer;
  106.     procedure Assign(Source: TPersistent); override;
  107.     procedure Clear;
  108.     procedure Delete(Index: Integer);
  109.     function  Insert(Index: Integer; ItemClass: TLayerClass): TCustomLayer;
  110.     property Count: Integer read GetCount;
  111.     property CoordXForm: PCoordXForm read FCoordXForm write FCoordXForm;
  112.     property Owner: TComponent read FOwner;
  113.     property Items[Index: Integer]: TCustomLayer read GetItem write SetItem; default;
  114.     property MouseListener: TCustomLayer read FMouseListener write SetMouseListener;
  115.     property MouseEvents: Boolean read FMouseEvents write SetMouseEvents;
  116.   end;
  117.  
  118.   TLayerState = (lsMouseLeft, lsMouseRight, lsMouseMiddle);
  119.   TLayerStates = set of TLayerState;
  120.  
  121.   TPaintLayerEvent = procedure(Sender: TObject; Buffer: TBitmap32) of object;
  122.   THitTestEvent = procedure(Sender: TObject; X, Y: Integer; var Passed: Boolean) of object;
  123.  
  124.   TCustomLayer = class(TPersistent)
  125.   private
  126.     FCursor: TCursor;
  127.     FFreeNotifies: TList;
  128.     FLayerCollection: TLayerCollection;
  129.     FLayerStates: TLayerStates;
  130.     FLayerOptions: Cardinal;
  131.     FOnHitTest: THitTestEvent;
  132.     FOnMouseDown: TMouseEvent;
  133.     FOnMouseMove: TMouseMoveEvent;
  134.     FOnMouseUp: TMouseEvent;
  135.     FOnPaint: TPaintLayerEvent;
  136.     FTag: Integer;
  137.     FOnDestroy: TNotifyEvent;
  138.     function  GetIndex: Integer;
  139.     function  GetMouseEvents: Boolean;
  140.     function  GetVisible: Boolean;
  141.     procedure SetCursor(Value: TCursor);
  142.     procedure SetLayerCollection(Value: TLayerCollection);
  143.     procedure SetLayerOptions(Value: Cardinal);
  144.     procedure SetMouseEvents(Value: Boolean);
  145.     procedure SetVisible(Value: Boolean);
  146.   protected
  147.     procedure AddNotification(ALayer: TCustomLayer);
  148.     procedure Changed;
  149.     procedure Changing;
  150.     function  DoHitTest(X, Y: Integer): Boolean; virtual;
  151.     procedure DoPaint(Buffer: TBitmap32);
  152.     function  GetOwner: TPersistent; override;
  153.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
  154.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
  155.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
  156.     procedure Notification(ALayer: TCustomLayer); virtual;
  157.     procedure Paint(Buffer: TBitmap32); virtual;
  158.     procedure PaintGDI(Canvas: TCanvas); virtual;
  159.     procedure RemoveNotification(ALayer: TCustomLayer);
  160.     procedure SetIndex(Value: Integer); virtual;
  161.   public
  162.     constructor Create(ALayerCollection: TLayerCollection); virtual;
  163.     destructor Destroy; override;
  164.     procedure BeforeDestruction; override;
  165.     procedure BringToFront;
  166.     function  HitTest(X, Y: Integer): Boolean;
  167.     procedure SendToBack;
  168.     procedure SetAsMouseListener;
  169.     property Cursor: TCursor read FCursor write SetCursor;
  170.     property Index: Integer read GetIndex write SetIndex;
  171.     property LayerCollection: TLayerCollection read FLayerCollection write SetLayerCollection;
  172.     property LayerOptions: Cardinal read FLayerOptions write SetLayerOptions;
  173.     property LayerStates: TLayerStates read FLayerStates;
  174.     property MouseEvents: Boolean read GetMouseEvents write SetMouseEvents;
  175.     property Tag: Integer read FTag write FTag;
  176.     property Visible: Boolean read GetVisible write SetVisible;
  177.     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  178.     property OnHitTest: THitTestEvent read FOnHitTest write FOnHitTest;
  179.     property OnPaint: TPaintLayerEvent read FOnPaint write FOnPaint;
  180.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  181.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  182.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  183.   end;
  184.  
  185.   TPositionedLayer = class(TCustomLayer)
  186.   private
  187.     FLocation: TFloatRect;
  188.     FScaled: Boolean;
  189.     procedure SetLocation(const Value: TFloatRect);
  190.     procedure SetScaled(Value: Boolean);
  191.   protected
  192.     function DoHitTest(X, Y: Integer): Boolean; override;
  193.     procedure DoSetLocation(const NewLocation: TFloatRect); virtual;
  194.   public
  195.     constructor Create(ALayerCollection: TLayerCollection); override;
  196.     function GetAdjustedLocation: TFloatRect;
  197.     property Location: TFloatRect read FLocation write SetLocation;
  198.     property Scaled: Boolean read FScaled write SetScaled;
  199.   end;
  200.  
  201.   TBitmapLayer = class(TPositionedLayer)
  202.   private
  203.     FBitmap: TBitmap32;
  204.     FAlphaHit: Boolean;
  205.     FCropped: Boolean;
  206.     procedure BitmapChanged(Sender: TObject);
  207.     procedure SetBitmap(Value: TBitmap32);
  208.     procedure SetCropped(Value: Boolean);
  209.   protected
  210.     function DoHitTest(X, Y: Integer): Boolean; override;
  211.     procedure Paint(Buffer: TBitmap32); override;
  212.   public
  213.     constructor Create(ALayerCollection: TLayerCollection); override;
  214.     destructor Destroy; override;
  215.     property AlphaHit: Boolean read FAlphaHit write FAlphaHit;
  216.     property Bitmap: TBitmap32 read FBitmap write SetBitmap;
  217.     property Cropped: Boolean read FCropped write SetCropped;
  218.   end;
  219.  
  220.   TDragState = (dsNone, dsMove, dsSizeL, dsSizeT, dsSizeR, dsSizeB,
  221.     dsSizeTL, dsSizeTR, dsSizeBL, dsSizeBR);
  222.   TRBHandles = set of (rhCenter, rhSides, rhCorners, rhFrame,
  223.     rhNotLeftSide, rhNotRightSide, rhNotTopSide, rhNotBottomSide,
  224.     rhNotTLCorner, rhNotTRCorner, rhNotBLCorner, rhNotBRCorner);
  225.   TRBResizingEvent = procedure(
  226.     Sender: TObject;
  227.     const OldLocation: TFloatRect;
  228.     var NewLocation: TFloatRect;
  229.     DragState: TDragState;
  230.     Shift: TShiftState) of object;
  231.  
  232.   TRubberbandLayer = class(TPositionedLayer)
  233.   private
  234.     FChildLayer: TPositionedLayer;
  235.     FFrameStipplePattern: TArrayOfColor32;
  236.     FFrameStippleStep: Single;
  237.     FHandleFrame: TColor32;
  238.     FHandleFill: TColor32;
  239.     FHandles: TRBHandles;
  240.     FHandleSize: Integer;
  241.     FMinWidth: Single;
  242.     FMaxHeight: Single;
  243.     FMinHeight: Single;
  244.     FMaxWidth: Single;
  245.     FOnUserChange: TNotifyEvent;
  246.     FOnResizing: TRBResizingEvent;
  247.     procedure SetFrameStippleStep(const Value: Single);
  248.     procedure SetChildLayer(Value: TPositionedLayer);
  249.     procedure SetHandleFill(Value: TColor32);
  250.     procedure SetHandleFrame(Value: TColor32);
  251.     procedure SetHandles(Value: TRBHandles);
  252.     procedure SetHandleSize(Value: Integer);
  253.   protected
  254.     IsDragging: Boolean;
  255.     DragState: TDragState;
  256.     OldLocation: TFloatRect;
  257.     MouseShift: TFloatPoint;
  258.     function  DoHitTest(X, Y: Integer): Boolean; override;
  259.     procedure DoResizing(var OldLocation, NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState); virtual;
  260.     procedure DoSetLocation(const NewLocation: TFloatRect); override;
  261.     function  GetDragState(X, Y: Integer): TDragState; virtual;
  262.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  263.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  264.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  265.     procedure Notification(ALayer: TCustomLayer); override;
  266.     procedure Paint(Buffer: TBitmap32); override;
  267.     procedure UpdateChildLayer;
  268.   public
  269.     constructor Create(ALayerCollection: TLayerCollection); override;
  270.     procedure SetFrameStipple(const Value: Array of TColor32);
  271.     property ChildLayer: TPositionedLayer read FChildLayer write SetChildLayer;
  272.     property Handles: TRBHandles read FHandles write SetHandles;
  273.     property HandleSize: Integer read FHandleSize write SetHandleSize;
  274.     property HandleFill: TColor32 read FHandleFill write SetHandleFill;
  275.     property HandleFrame: TColor32 read FHandleFrame write SetHandleFrame;
  276.     property FrameStippleStep: Single read FFrameStippleStep write SetFrameStippleStep;
  277.     property MaxHeight: Single read FMaxHeight write FMaxHeight;
  278.     property MaxWidth: Single read FMaxWidth write FMaxWidth;
  279.     property MinHeight: Single read FMinHeight write FMinHeight;
  280.     property MinWidth: Single read FMinWidth write FMinWidth;
  281.     property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
  282.     property OnResizing: TRBResizingEvent read FOnResizing write FOnResizing;
  283.   end;
  284.  
  285. implementation
  286.  
  287. uses TypInfo, GR32_Image, GR32_LowLevel, GR32_Transforms;
  288.  
  289. { mouse state mapping }
  290. const
  291.   CStateMap: array [TMouseButton] of TLayerState =
  292.     (lsMouseLeft, lsMouseRight, lsMouseMiddle);
  293.  
  294. type
  295.   TImage32Access = class(TCustomImage32);
  296.  
  297. { TLayerCollection }
  298.  
  299. function TLayerCollection.Add(ItemClass: TLayerClass): TCustomLayer;
  300. begin
  301.   Result := ItemClass.Create(Self);
  302. end;
  303.  
  304. procedure TLayerCollection.Assign(Source: TPersistent);
  305. var
  306.   I: Integer;
  307.   Item: TCustomLayer;
  308. begin
  309.   if Source is TLayerCollection then
  310.   begin
  311.     BeginUpdate;
  312.     try
  313.       while FItems.Count > 0 do TCustomLayer(FItems.Last).Free;
  314.       for I := 0 to TLayerCollection(Source).Count - 1 do
  315.       begin
  316.         Item := TLayerCollection(Source).Items[I];
  317.         Add(TLayerClass(Item.ClassType)).Assign(Item);
  318.       end;
  319.     finally
  320.       EndUpdate;
  321.     end;
  322.     Exit;
  323.   end;
  324.   inherited Assign(Source);
  325. end;
  326.  
  327. procedure TLayerCollection.BeginUpdate;
  328. begin
  329.   if FUpdateCount = 0 then Changing;
  330.   Inc(FUpdateCount);
  331. end;
  332.  
  333. procedure TLayerCollection.Changed;
  334. begin
  335.   if Assigned(FOnChange) then FOnChange(Self);
  336. end;
  337.  
  338. procedure TLayerCollection.Changing;
  339. begin
  340.   if Assigned(FOnChanging) then FOnChanging(Self);
  341. end;
  342.  
  343. procedure TLayerCollection.Clear;
  344. begin
  345.   BeginUpdate;
  346.   try
  347.     while FItems.Count > 0 do TCustomLayer(FItems.Last).Free;
  348.   finally
  349.     EndUpdate;
  350.   end;
  351. end;
  352.  
  353. constructor TLayerCollection.Create(AOwner: TComponent);
  354. begin
  355.   FOwner := AOwner;
  356.   FItems := TList.Create;
  357.   FMouseEvents := True;
  358. end;
  359.  
  360. procedure TLayerCollection.Delete(Index: Integer);
  361. begin
  362.   TCollectionItem(FItems[Index]).Free;
  363. end;
  364.  
  365. destructor TLayerCollection.Destroy;
  366. begin
  367.   FUpdateCount := 1; // disable update notification
  368.   if FItems <> nil then Clear;
  369.   FItems.Free;
  370.   inherited;
  371. end;
  372.  
  373. procedure TLayerCollection.EndUpdate;
  374. begin
  375.   Dec(FUpdateCount);
  376.   if FUpdateCount = 0 then Changed;
  377.   Assert(FUpdateCount >= 0, 'Unpaired EndUpdate');
  378. end;
  379.  
  380. function TLayerCollection.FindLayerAtPos(X, Y: Integer; OptionsMask: Cardinal): TCustomLayer;
  381. var
  382.   I: Integer;
  383. begin
  384.   for I := Count - 1 downto 0 do
  385.   begin
  386.     Result := Items[I];
  387.     if (Result.LayerOptions and OptionsMask) = 0 then Continue; // skip to the next one
  388.     if Result.HitTest(X, Y) then Exit;
  389.   end;
  390.   Result := nil;
  391. end;
  392.  
  393. procedure TLayerCollection.GDIUpdate;
  394. begin
  395.   if (FUpdateCount = 0) and Assigned(FOnGDIUpdate) then FOnGDIUpdate(Self);
  396. end;
  397.  
  398. function TLayerCollection.GetCount: Integer;
  399. begin
  400.   Result := FItems.Count;
  401. end;
  402.  
  403. function TLayerCollection.GetItem(Index: Integer): TCustomLayer;
  404. begin
  405.   Result := FItems[Index];
  406. end;
  407.  
  408. function TLayerCollection.GetOwner: TPersistent;
  409. begin
  410.   Result := FOwner;
  411. end;
  412.  
  413. function TLayerCollection.Insert(Index: Integer; ItemClass: TLayerClass): TCustomLayer;
  414. begin
  415.   BeginUpdate;
  416.   try
  417.     Result := Add(ItemClass);
  418.     Result.Index := Index;
  419.   finally
  420.     EndUpdate;
  421.   end;
  422. end;
  423.  
  424. procedure TLayerCollection.InsertItem(Item: TCustomLayer);
  425. begin
  426.   BeginUpdate;
  427.   try
  428.     FItems.Add(Item);
  429.     Item.FLayerCollection := Self;
  430.   finally
  431.     EndUpdate;
  432.   end;
  433. end;
  434.  
  435. function TLayerCollection.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): TCustomLayer;
  436. begin
  437.   if MouseListener <> nil then Result := MouseListener
  438.   else Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
  439.  
  440.   if (Button = mbLeft) and (Result <> MouseListener) and
  441.     ((Result = nil) or ((Result.FLayerOptions and LOB_NO_CAPTURE) = 0)) then
  442.     MouseListener := Result; // capture the mouse
  443.  
  444.   if Assigned(MouseListener) then
  445.   begin
  446.     Include(MouseListener.FLayerStates, CStateMap[Button]);
  447.     MouseListener.MouseDown(Button, Shift, X, Y);
  448.   end;
  449. end;
  450.  
  451. function TLayerCollection.MouseMove(Shift: TShiftState; X, Y: Integer): TCustomLayer;
  452. begin
  453.   Result := MouseListener;
  454.   if Result = nil then Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
  455.   if Assigned(Result) then Result.MouseMove(Shift, X, Y)
  456.   else if FOwner is TControl then Screen.Cursor := TControl(FOwner).Cursor;
  457. end;
  458.  
  459. function TLayerCollection.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): TCustomLayer;
  460. begin
  461.   Result := MouseListener;
  462.   if Result = nil then Result := FindLayerAtPos(X, Y, LOB_MOUSE_EVENTS);
  463.  
  464.   if Assigned(Result) then
  465.   begin
  466.     Exclude(Result.FLayerStates, CStateMap[Button]);
  467.     Result.MouseUp(Button, Shift, X, Y);
  468.   end;
  469.  
  470.   if Assigned(MouseListener) and
  471.     (MouseListener.FLayerStates *
  472.       [lsMouseLeft, lsMouseRight, lsMouseMiddle] = []) then
  473.     MouseListener := nil; // reset mouse capture
  474. end;
  475.  
  476. procedure TLayerCollection.RemoveItem(Item: TCustomLayer);
  477. begin
  478.   BeginUpdate;
  479.   try
  480.     FItems.Remove(Item);
  481.     Item.FLayerCollection := nil;
  482.   finally
  483.     EndUpdate;
  484.   end;
  485. end;
  486.  
  487. procedure TLayerCollection.SetItem(Index: Integer; Value: TCustomLayer);
  488. begin
  489.   TCollectionItem(FItems[Index]).Assign(Value);
  490. end;
  491.  
  492. procedure TLayerCollection.SetMouseEvents(Value: Boolean);
  493. begin
  494.   FMouseEvents := Value;
  495.   MouseListener := nil;
  496. end;
  497.  
  498. procedure TLayerCollection.SetMouseListener(Value: TCustomLayer);
  499. begin
  500.   if Value <> FMouseListener then
  501.   begin
  502.     if FMouseListener <> nil then
  503.       FMouseListener.FLayerStates := FMouseListener.FLayerStates -
  504.         [lsMouseLeft, lsMouseRight, lsMouseMiddle];
  505.     FMouseListener := Value;
  506.   end;
  507. end;
  508.  
  509. { TCustomLayer }
  510.  
  511. procedure TCustomLayer.AddNotification(ALayer: TCustomLayer);
  512. begin
  513.   if not Assigned(FFreeNotifies) then FFreeNotifies := TList.Create;
  514.   if FFreeNotifies.IndexOf(ALayer) < 0 then FFreeNotifies.Add(ALayer);
  515. end;
  516.  
  517. procedure TCustomLayer.BeforeDestruction;
  518. begin
  519.   if Assigned(FOnDestroy) then FOnDestroy(Self);
  520.   inherited;
  521. end;
  522.  
  523. procedure TCustomLayer.BringToFront;
  524. begin
  525.   Index := LayerCollection.Count;
  526. end;
  527.  
  528. procedure TCustomLayer.Changed;
  529. begin
  530.   if (FLayerCollection <> nil) and ((FLayerOptions and LOB_NO_UPDATE) = 0) then
  531.   begin
  532.     if Visible then FLayerCollection.Changed
  533.     else if (FLayerOptions and LOB_GDI_OVERLAY) <> 0 then
  534.       FLayerCollection.GDIUpdate;
  535.   end;
  536. end;
  537.  
  538. procedure TCustomLayer.Changing;
  539. begin
  540.   if Visible and (FLayerCollection <> nil) and
  541.     ((FLayerOptions and LOB_NO_UPDATE) = 0) then
  542.     FLayerCollection.Changing;
  543. end;
  544.  
  545. constructor TCustomLayer.Create(ALayerCollection: TLayerCollection);
  546. begin
  547.   LayerCollection := ALayerCollection;
  548.   FLayerOptions := LOB_VISIBLE;
  549. end;
  550.  
  551. destructor TCustomLayer.Destroy;
  552. var
  553.   I: Integer;
  554. begin
  555.   if FFreeNotifies <> nil then
  556.   begin
  557.     for I := FFreeNotifies.Count - 1 downto 0 do
  558.     begin
  559.       TCustomLayer(FFreeNotifies[I]).Notification(Self);
  560.       if FFreeNotifies = nil then Break;
  561.     end;
  562.     FFreeNotifies.Free;
  563.     FFreeNotifies := nil;
  564.   end;
  565.   SetLayerCollection(nil);
  566.   inherited;
  567. end;
  568.  
  569. function TCustomLayer.DoHitTest(X, Y: Integer): Boolean;
  570. begin
  571.   Result := True;
  572. end;
  573.  
  574. procedure TCustomLayer.DoPaint(Buffer: TBitmap32);
  575. begin
  576.   Paint(Buffer);
  577.   if Assigned(FOnPaint) then FOnPaint(Self, Buffer);
  578. end;
  579.  
  580. function TCustomLayer.GetIndex: Integer;
  581. begin
  582.   if FLayerCollection <> nil then Result := FLayerCollection.FItems.IndexOf(Self)
  583.   else Result := -1;
  584. end;
  585.  
  586. function TCustomLayer.GetMouseEvents: Boolean;
  587. begin
  588.   Result := FLayerOptions and LOB_MOUSE_EVENTS <> 0;
  589. end;
  590.  
  591. function TCustomLayer.GetOwner: TPersistent;
  592. begin
  593.   Result := FLayerCollection;
  594. end;
  595.  
  596. function TCustomLayer.GetVisible: Boolean;
  597. begin
  598.   Result := FLayerOptions and LOB_VISIBLE <> 0;
  599. end;
  600.  
  601. function TCustomLayer.HitTest(X, Y: Integer): Boolean;
  602. begin
  603.   Result := DoHitTest(X, Y);
  604.   if Assigned(FOnHitTest) then FOnHitTest(Self, X, Y, Result);
  605. end;
  606.  
  607. procedure TCustomLayer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  608. begin
  609.   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
  610. end;
  611.  
  612. procedure TCustomLayer.MouseMove(Shift: TShiftState; X, Y: Integer);
  613. begin
  614.   Screen.Cursor := Cursor;
  615.   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y);
  616. end;
  617.  
  618. procedure TCustomLayer.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  619. begin
  620.   Screen.Cursor := crDefault;
  621.   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
  622. end;
  623.  
  624. procedure TCustomLayer.Notification(ALayer: TCustomLayer);
  625. begin
  626.   // do nothing by default
  627. end;
  628.  
  629. procedure TCustomLayer.Paint(Buffer: TBitmap32);
  630. begin
  631.   // descendants override this method
  632. end;
  633.  
  634. procedure TCustomLayer.PaintGDI(Canvas: TCanvas);
  635. begin
  636.   // descendants override this method
  637. end;
  638.  
  639. procedure TCustomLayer.RemoveNotification(ALayer: TCustomLayer);
  640. begin
  641.   if FFreeNotifies <> nil then
  642.   begin
  643.     FFreeNotifies.Remove(ALayer);
  644.     if FFreeNotifies.Count = 0 then
  645.     begin
  646.       FFreeNotifies.Free;
  647.       FFreeNotifies := nil;
  648.     end;
  649.   end;
  650. end;
  651.  
  652. procedure TCustomLayer.SendToBack;
  653. begin
  654.   Index := 0;
  655. end;
  656.  
  657. procedure TCustomLayer.SetAsMouseListener;
  658. begin
  659.   FLayerCollection.MouseListener := Self;
  660.   Screen.Cursor := Cursor;
  661. end;
  662.  
  663. procedure TCustomLayer.SetCursor(Value: TCursor);
  664. begin
  665.   if Value <> FCursor then
  666.   begin
  667.     FCursor := Value;
  668.     if FLayerCollection.MouseListener = Self then Screen.Cursor := Value;
  669.   end;
  670. end;
  671.  
  672. procedure TCustomLayer.SetIndex(Value: Integer);
  673. var
  674.   CurIndex: Integer;
  675. begin
  676.   CurIndex := GetIndex;
  677.   if (CurIndex >= 0) and (CurIndex <> Value) then
  678.     with FLayerCollection do
  679.     begin
  680.       if Value < 0 then Value := 0;
  681.       if Value >= Count then Value := Count - 1;
  682.       if Value <> CurIndex then
  683.       begin
  684.         if Visible then BeginUpdate;
  685.         try
  686.           FLayerCollection.FItems.Move(CurIndex, Value);
  687.         finally
  688.           if Visible then EndUpdate;
  689.         end;
  690.       end;
  691.     end;
  692. end;
  693.  
  694. procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
  695. begin
  696.   if FLayerCollection <> Value then
  697.   begin
  698.     if FLayerCollection <> nil then
  699.     begin
  700.       if FLayerCollection.MouseListener = Self then
  701.         FLayerCollection.MouseListener := nil;
  702.       FLayerCollection.RemoveItem(Self);
  703.     end;
  704.     if Value <> nil then Value.InsertItem(Self);
  705.   end;
  706. end;
  707.  
  708. procedure TCustomLayer.SetLayerOptions(Value: Cardinal);
  709. begin
  710.   Changing;
  711.   FLayerOptions := Value;
  712.   Changed;
  713. end;
  714.  
  715. procedure TCustomLayer.SetMouseEvents(Value: Boolean);
  716. begin
  717.   if Value then LayerOptions := LayerOptions or LOB_MOUSE_EVENTS
  718.   else LayerOptions := LayerOptions and not LOB_MOUSE_EVENTS;
  719. end;
  720.  
  721. procedure TCustomLayer.SetVisible(Value: Boolean);
  722. begin
  723.   if Value then LayerOptions := LayerOptions or LOB_VISIBLE
  724.   else LayerOptions := LayerOptions and not LOB_VISIBLE;
  725. end;
  726.  
  727. { TPositionedLayer }
  728.  
  729. constructor TPositionedLayer.Create(ALayerCollection: TLayerCollection);
  730. begin
  731.   inherited;
  732.   with FLocation do
  733.   begin
  734.     Left := 0;
  735.     Top := 0;
  736.     Right := 64;
  737.     Bottom := 64;
  738.   end;
  739.   FLayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS;
  740. end;
  741.  
  742. function TPositionedLayer.DoHitTest(X, Y: Integer): Boolean;
  743. begin
  744.   with GetAdjustedLocation do
  745.     Result := (X >= Left) and (X < Right) and (Y >= Top) and (Y < Bottom);
  746. end;
  747.  
  748. procedure TPositionedLayer.DoSetLocation(const NewLocation: TFloatRect);
  749. begin
  750.   FLocation := NewLocation;
  751. end;
  752.  
  753. function TPositionedLayer.GetAdjustedLocation: TFloatRect;
  754.  
  755.   procedure AdjustPoint(var APoint: TFloatPoint);
  756.   begin
  757.     with APoint, FLayerCollection.CoordXForm^ do
  758.     begin
  759.       X := X * ScaleX / 65536 + ShiftX;
  760.       Y := Y * ScaleY / 65536 + ShiftY;
  761.     end;
  762.   end;
  763.  
  764. begin
  765.   Result := FLocation;
  766.   if Scaled and Assigned(FLayerCollection) and Assigned(FLayerCollection.CoordXForm) then
  767.     with Result do
  768.     begin
  769.       AdjustPoint(TopLeft);
  770.       AdjustPoint(BottomRight);
  771.     end;
  772. end;
  773.  
  774. procedure TPositionedLayer.SetLocation(const Value: TFloatRect);
  775. begin
  776.   Changing;
  777.   DoSetLocation(Value);
  778.   Changed;
  779. end;
  780.  
  781. procedure TPositionedLayer.SetScaled(Value: Boolean);
  782. begin
  783.   if Value <> FScaled then
  784.   begin
  785.     Changing;
  786.     FScaled := Value;
  787.     Changed;
  788.   end;
  789. end;
  790.  
  791. { TBitmapLayer }
  792.  
  793. procedure TBitmapLayer.BitmapChanged(Sender: TObject);
  794. begin
  795.   Changed;
  796. end;
  797.  
  798. constructor TBitmapLayer.Create(ALayerCollection: TLayerCollection);
  799. begin
  800.   inherited;
  801.   FBitmap := TBitmap32.Create;
  802.   FBitmap.OnChange := BitmapChanged;
  803. end;
  804.  
  805. function TBitmapLayer.DoHitTest(X, Y: Integer): Boolean;
  806. var
  807.   BitmapX, BitmapY: Integer;
  808.   LayerWidth, LayerHeight: Integer;
  809. begin
  810.   Result := inherited DoHitTest(X, Y);
  811.   if Result and AlphaHit then
  812.   begin
  813.     with GetAdjustedLocation do
  814.     begin
  815.       LayerWidth := Round(Right - Left);
  816.       LayerHeight := Round(Bottom - Top);
  817.       if (LayerWidth < 0.5) or (LayerHeight < 0.5) then Result := False
  818.       else
  819.       begin
  820.         // check the pixel alpha at (X, Y) position
  821.         BitmapX := Round((X - Left) * Bitmap.Width / LayerWidth);
  822.         BitmapY := Round((Y - Top) * Bitmap.Height / LayerHeight);
  823.         if Bitmap.PixelS[BitmapX, BitmapY] and $FF000000 = 0 then Result := False;
  824.       end;
  825.     end;
  826.   end;
  827. end;
  828.  
  829. destructor TBitmapLayer.Destroy;
  830. begin
  831.   FBitmap.Free;
  832.   inherited;
  833. end;
  834.  
  835. procedure TBitmapLayer.Paint(Buffer: TBitmap32);
  836. var
  837.   SrcRect, DstRect, ClipRect: TRect;
  838.   ImageRect: TRect;
  839.   LayerWidth, LayerHeight: Single;
  840. begin
  841.   if Bitmap.Empty then Exit;
  842.   DstRect := MakeRect(GetAdjustedLocation);
  843.   SrcRect := MakeRect(0, 0, Bitmap.Width, Bitmap.Height);
  844.   ClipRect := Buffer.ClipRect;
  845.   if Cropped and (LayerCollection.FOwner is TCustomImage32) and
  846.     not (TImage32Access(LayerCollection.FOwner).PaintToMode) then
  847.   begin
  848.     with DstRect do
  849.     begin
  850.       LayerWidth := Right - Left;
  851.       LayerHeight := Bottom - Top;
  852.     end;
  853.     if (LayerWidth < 0.5) or (LayerHeight < 0.5) then Exit;
  854.     ImageRect := TCustomImage32(LayerCollection.FOwner).GetBitmapRect;
  855.     IntersectRect(ClipRect, ClipRect, ImageRect);
  856.   end;
  857.   StretchTransfer(Buffer, DstRect, ClipRect, FBitmap, SrcRect,
  858.     FBitmap.StretchFilter, FBitmap.DrawMode, FBitmap.OnPixelCombine);
  859. end;
  860.  
  861. procedure TBitmapLayer.SetBitmap(Value: TBitmap32);
  862. begin
  863.   FBitmap.Assign(Value);
  864. end;
  865.  
  866. procedure TBitmapLayer.SetCropped(Value: Boolean);
  867. begin
  868.   if Value <> FCropped then
  869.   begin
  870.     FCropped := Value;
  871.     Changed;
  872.   end;
  873. end;
  874.  
  875. { TRubberbandLayer }
  876.  
  877. constructor TRubberbandLayer.Create(ALayerCollection: TLayerCollection);
  878. begin
  879.   inherited;
  880.   FHandleFrame := clBlack32;
  881.   FHandleFill := clWhite32;
  882.   FHandles := [rhCenter, rhSides, rhCorners, rhFrame];
  883.   FHandleSize := 3;
  884.   FMinWidth := 10;
  885.   FMinHeight := 10;
  886.   FLayerOptions := LOB_VISIBLE or LOB_MOUSE_EVENTS;
  887.   SetFrameStipple([clWhite32, clWhite32, clBlack32, clBlack32]);
  888.   FFrameStippleStep := 1;
  889. end;
  890.  
  891. function TRubberbandLayer.DoHitTest(X, Y: Integer): Boolean;
  892. begin
  893.   Result := GetDragState(X, Y) <> dsNone;
  894. end;
  895.  
  896. procedure TRubberbandLayer.DoResizing(var OldLocation,
  897.   NewLocation: TFloatRect; DragState: TDragState; Shift: TShiftState);
  898. begin
  899.   if Assigned(FOnResizing) then
  900.     FOnResizing(Self, OldLocation, NewLocation, DragState, Shift);
  901. end;
  902.  
  903. procedure TRubberbandLayer.DoSetLocation(const NewLocation: TFloatRect);
  904. begin
  905.   inherited;
  906.   UpdateChildLayer;
  907. end;
  908.  
  909. function TRubberbandLayer.GetDragState(X, Y: Integer): TDragState;
  910. var
  911.   R: TRect;
  912.   dh_center, dh_sides, dh_corners: Boolean;
  913.   dl, dt, dr, db, dx, dy: Boolean;
  914.   Sz: Integer;
  915. begin
  916.   Result := dsNone;
  917.   Sz := FHandleSize + 1;
  918.   dh_center := rhCenter in FHandles;
  919.   dh_sides := rhSides in FHandles;
  920.   dh_corners := rhCorners in FHandles;
  921.   R := MakeRect(GetAdjustedLocation);
  922.   with R do
  923.   begin
  924.     Dec(Right);
  925.     Dec(Bottom);
  926.     dl := Abs(Left - X) <= Sz;
  927.     dr := Abs(Right - X) <= Sz;
  928.     dx := Abs((Left + Right) div 2 - X) <= Sz;
  929.     dt := Abs(Top - Y) <= Sz;
  930.     db := Abs(Bottom - Y) <= Sz;
  931.     dy := Abs((Top + Bottom) div 2 - Y) <= Sz;
  932.   end;
  933.  
  934.   if dr and db and dh_corners and not(rhNotBRCorner in FHandles) then Result := dsSizeBR
  935.   else if dl and db and dh_corners and not(rhNotBLCorner in FHandles) then Result := dsSizeBL
  936.   else if dr and dt and dh_corners and not(rhNotTRCorner in FHandles) then Result := dsSizeTR
  937.   else if dl and dt and dh_corners and not(rhNotTLCorner in FHandles) then Result := dsSizeTL
  938.   else if dr and dy and dh_sides and not(rhNotRightSide in FHandles) then Result := dsSizeR
  939.   else if db and dx and dh_sides and not(rhNotBottomSide in FHandles) then Result := dsSizeB
  940.   else if dl and dy and dh_sides and not(rhNotLeftSide in FHandles) then Result := dsSizeL
  941.   else if dt and dx and dh_sides and not(rhNotTopSide in FHandles) then Result := dsSizeT
  942.   else if dh_center and PtInRect(R, Point(X, Y)) then Result := dsMove;
  943. end;
  944.  
  945. procedure TRubberbandLayer.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  946. var
  947.   ALoc: TFloatRect;
  948. begin
  949.   if IsDragging then Exit;
  950.   DragState := GetDragState(X, Y);
  951.   IsDragging := DragState <> dsNone;
  952.   if IsDragging then
  953.   begin
  954.     OldLocation := Location;
  955.     ALoc := GetAdjustedLocation;
  956.     case DragState of
  957.       dsMove: MouseShift := FloatPoint(X - ALoc.Left, Y - ALoc.Top);
  958.     else
  959.       MouseShift := FloatPoint(0, 0);
  960.     end;
  961.   end;
  962.   inherited;
  963. end;
  964.  
  965. procedure TRubberbandLayer.MouseMove(Shift: TShiftState; X, Y: Integer);
  966. const
  967.   CURSOR_ID: array [TDragState] of TCursor = (crDefault, crDefault, crSizeWE,
  968.     crSizeNS, crSizeWE, crSizeNS, crSizeNWSE, crSizeNESW, crSizeNESW, crSizeNWSE);
  969. var
  970.   Mx, My: Single;
  971.   L, T, R, B, W, H: Single;
  972.   ALoc, NewLocation: TFloatRect;
  973.  
  974.   procedure IncLT(var LT, RB: Single; Delta, MinSize, MaxSize: Single);
  975.   begin
  976.     LT := LT + Delta;
  977.     if RB - LT < MinSize then LT := RB - MinSize;
  978.     if MaxSize >= MinSize then if RB - LT > MaxSize then LT := RB - MaxSize;
  979.   end;
  980.  
  981.   procedure IncRB(var LT, RB: Single; Delta, MinSize, MaxSize: Single);
  982.   begin
  983.     RB := RB + Delta;
  984.     if RB - LT < MinSize then RB := LT + MinSize;
  985.     if MaxSize >= MinSize then if RB - LT > MaxSize then RB := LT + MaxSize;
  986.   end;
  987.  
  988. begin
  989.   if not IsDragging then
  990.   begin
  991.     DragState := GetDragState(X, Y);
  992.     if DragState = dsMove then Screen.Cursor := Cursor
  993.     else Screen.Cursor := CURSOR_ID[DragState];
  994.   end
  995.   else
  996.   begin
  997.     Mx := X - MouseShift.X;
  998.     My := Y - MouseShift.Y;
  999.     if Scaled then with Location do
  1000.     begin
  1001.       ALoc := GetAdjustedLocation;
  1002.       if IsRectEmptyF(ALoc) then Exit;
  1003.       Mx := (Mx - ALoc.Left) / (ALoc.Right - ALoc.Left) * (Right - Left) + Left;
  1004.       My := (My - ALoc.Top) / (ALoc.Bottom - ALoc.Top) * (Bottom - Top) + Top;
  1005.     end;
  1006.  
  1007.     with OldLocation do
  1008.     begin
  1009.       L := Left; T := Top; R := Right; B := Bottom; W := R - L; H := B - T;
  1010.     end;
  1011.  
  1012.     if DragState = dsMove then
  1013.     begin
  1014.       L := Mx; T := My; R := L + W; B := T + H;
  1015.     end
  1016.     else
  1017.     begin
  1018.       if DragState in [dsSizeL, dsSizeTL, dsSizeBL] then
  1019.         IncLT(L, R, Mx - L, MinWidth, MaxWidth);
  1020.       if DragState in [dsSizeR, dsSizeTR, dsSizeBR] then
  1021.         IncRB(L, R, Mx - R, MinWidth, MaxWidth);
  1022.       if DragState in [dsSizeT, dsSizeTL, dsSizeTR] then
  1023.         IncLT(T, B, My - T, MinHeight, MaxHeight);
  1024.       if DragState in [dsSizeB, dsSizeBL, dsSizeBR] then
  1025.         IncRB(T, B, My - B, MinHeight, MaxHeight);
  1026.     end;
  1027.  
  1028.     NewLocation := FloatRect(L, T, R, B);
  1029.     DoResizing(OldLocation, NewLocation, DragState, Shift);
  1030.  
  1031.     if (NewLocation.Left <> Location.Left) or
  1032.       (NewLocation.Right <> Location.Right) or
  1033.       (NewLocation.Top <> Location.Top) or
  1034.       (NewLocation.Bottom <> Location.Bottom) then
  1035.     begin
  1036.       Location := NewLocation;
  1037.       if Assigned(FOnUserChange) then FOnUserChange(Self);
  1038.     end;
  1039.   end;
  1040. end;
  1041.  
  1042. procedure TRubberbandLayer.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1043. begin
  1044.   IsDragging := False;
  1045.   inherited;
  1046. end;
  1047.  
  1048. procedure TRubberbandLayer.Notification(ALayer: TCustomLayer);
  1049. begin
  1050.   if ALayer = FChildLayer then FChildLayer := nil;
  1051.   if FChildLayer <> nil then FLayerOptions := FLayerOptions or LOB_NO_UPDATE
  1052.   else FLayerOptions := FLayerOptions and not LOB_NO_UPDATE;
  1053. end;
  1054.  
  1055. procedure TRubberbandLayer.Paint(Buffer: TBitmap32);
  1056. var
  1057.   Cx, Cy: Integer;
  1058.   R: TRect;
  1059.  
  1060.   procedure DrawHandle(X, Y: Integer);
  1061.   begin
  1062.     Buffer.FillRectTS(X - FHandleSize, Y - FHandleSize, X + FHandleSize, Y + FHandleSize, FHandleFill);
  1063.     Buffer.FrameRectTS(X - FHandleSize, Y - FHandleSize, X + FHandleSize, Y + FHandleSize, FHandleFrame);
  1064.   end;
  1065.  
  1066. begin
  1067.   R := MakeRect(GetAdjustedLocation);
  1068.   with R do
  1069.   begin
  1070.     if rhFrame in FHandles then
  1071.     begin
  1072.       Buffer.SetStipple(FFrameStipplePattern);
  1073.       Buffer.StippleCounter := 0;
  1074.       Buffer.StippleStep := FFrameStippleStep;
  1075.       Buffer.FrameRectTSP(Left, Top, Right, Bottom);
  1076.     end;
  1077.     if rhCorners in FHandles then
  1078.     begin
  1079.       If not(rhNotTLCorner in FHandles) then DrawHandle(Left, Top);
  1080.       If not(rhNotTRCorner in FHandles) then DrawHandle(Right, Top);
  1081.       If not(rhNotBLCorner in FHandles) then DrawHandle(Left, Bottom);
  1082.       If not(rhNotBRCorner in FHandles) then DrawHandle(Right, Bottom);
  1083.     end;
  1084.     if rhSides in FHandles then
  1085.     begin
  1086.       Cx := (Left + Right) div 2;
  1087.       Cy := (Top + Bottom) div 2;
  1088.       If not(rhNotTopSide in FHandles) then DrawHandle(Cx, Top);
  1089.       If not(rhNotLeftSide in FHandles) then DrawHandle(Left, Cy);
  1090.       If not(rhNotRightSide in FHandles) then DrawHandle(Right, Cy);
  1091.       If not(rhNotBottomSide in FHandles) then DrawHandle(Cx, Bottom);
  1092.     end;
  1093.   end;
  1094. end;
  1095.  
  1096. procedure TRubberbandLayer.SetChildLayer(Value: TPositionedLayer);
  1097. begin
  1098.   if FChildLayer <> nil then RemoveNotification(FChildLayer);
  1099.   FChildLayer := Value;
  1100.   if Value <> nil then
  1101.   begin
  1102.     Location := Value.Location;
  1103.     Scaled := Value.Scaled;
  1104.     AddNotification(FChildLayer);
  1105.   end;
  1106.   if FChildLayer <> nil then FLayerOptions := FLayerOptions or LOB_NO_UPDATE
  1107.   else FLayerOptions := FLayerOptions and not LOB_NO_UPDATE;
  1108. end;
  1109.  
  1110. procedure TRubberbandLayer.SetHandleFill(Value: TColor32);
  1111. begin
  1112.   if Value <> FHandleFill then
  1113.   begin
  1114.     FHandleFill := Value;
  1115.     FLayerCollection.GDIUpdate;
  1116.   end;
  1117. end;
  1118.  
  1119. procedure TRubberbandLayer.SetHandleFrame(Value: TColor32);
  1120. begin
  1121.   if Value <> FHandleFrame then
  1122.   begin
  1123.     FHandleFrame := Value;
  1124.     FLayerCollection.GDIUpdate;
  1125.   end;
  1126. end;
  1127.  
  1128. procedure TRubberbandLayer.SetHandles(Value: TRBHandles);
  1129. begin
  1130.   if Value <> FHandles then
  1131.   begin
  1132.     FHandles := Value;
  1133.     FLayerCollection.GDIUpdate;
  1134.   end;
  1135. end;
  1136.  
  1137. procedure TRubberbandLayer.SetHandleSize(Value: Integer);
  1138. begin
  1139.   if Value < 1 then Value := 1;
  1140.   if Value <> FHandleSize then
  1141.   begin
  1142.     FHandleSize := Value;
  1143.     FLayerCollection.GDIUpdate;
  1144.   end;
  1145. end;
  1146.  
  1147. procedure TRubberbandLayer.SetFrameStipple(const Value: Array of TColor32);
  1148. var
  1149.   L: Integer;
  1150. begin
  1151.   L := High(Value) + 1;
  1152.   SetLength(FFrameStipplePattern, L);
  1153.   Move(Value[0], FFrameStipplePattern[0], L shl 2);
  1154. end;
  1155.  
  1156. procedure TRubberbandLayer.SetFrameStippleStep(const Value: Single);
  1157. begin
  1158.   if Value <> FFrameStippleStep then
  1159.   begin
  1160.     FFrameStippleStep := Value;
  1161.     FLayerCollection.GDIUpdate;
  1162.   end;
  1163. end;
  1164.  
  1165. procedure TRubberbandLayer.UpdateChildLayer;
  1166. begin
  1167.   if Assigned(FChildLayer) then FChildLayer.Location := Location;
  1168. end;
  1169.  
  1170. end.
  1171.