home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Vcl / RotLayer_Ex / GR32_RotLayer.pas next >
Encoding:
Pascal/Delphi Source File  |  2005-01-12  |  4.7 KB  |  174 lines
  1. unit GR32_RotLayer;
  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. uses
  31.   SysUtils, Classes, Controls, Forms, Graphics, GR32, GR32_Layers, GR32_Transforms;
  32.  
  33. type
  34.   TCustomAffineLayer = class(TCustomLayer)
  35.   private
  36.     FAlphaHit: Boolean;
  37.     FTransformation: TAffineTransformation;
  38.     FBitmapCenter: TFloatPoint;
  39.     FBitmap: TBitmap32;
  40.     procedure BitmapChanged(Sender: TObject);
  41.     procedure SetBitmap(Value: TBitmap32);
  42.   protected
  43.     procedure AdjustTransformation; virtual;
  44.     function DoHitTest(X, Y: Integer): Boolean; override;
  45.     procedure Paint(Buffer: TBitmap32); override;
  46.     property Transformation: TAffineTransformation read FTransformation;
  47.   public
  48.     constructor Create(ALayerCollection: TLayerCollection); override;
  49.     destructor Destroy; override;
  50.     property AlphaHit: Boolean read FAlphaHit write FAlphaHit;
  51.     property Bitmap: TBitmap32 read FBitmap write SetBitmap;
  52.   end;
  53.  
  54.   TAffineLayer = class(TCustomAffineLayer)
  55.   public
  56.     property Transformation;
  57.   end;
  58.  
  59.   TRotLayer = class(TCustomAffineLayer)
  60.   private
  61.     FPosition: TFloatPoint;
  62.     FScaled: Boolean;
  63.     FAngle: Single;
  64.     procedure SetAngle(Value: Single);
  65.     procedure SetPosition(const Value: TFloatPoint);
  66.     procedure SetScaled(Value: Boolean);
  67.     procedure SetBitmapCenter(const Value: TFloatPoint);
  68.   protected
  69.     procedure AdjustTransformation; override;
  70.   public
  71.     property Angle: Single read FAngle write SetAngle;
  72.     property BitmapCenter: TFloatPoint read FBitmapCenter write SetBitmapCenter;
  73.     property Scaled: Boolean read FScaled write SetScaled;
  74.     property Position: TFloatPoint read FPosition write SetPosition;
  75.   end;
  76.  
  77. implementation
  78.  
  79. { TCustomAffineLayer }
  80.  
  81. type TATAccess = class(TAffineTransformation);
  82.  
  83. procedure TCustomAffineLayer.AdjustTransformation;
  84. begin
  85.   // do nothing here
  86. end;
  87.  
  88. procedure TCustomAffineLayer.BitmapChanged(Sender: TObject);
  89. begin
  90.   Transformation.SrcRect := FloatRect(0, 0, Bitmap.Width - 1, Bitmap.Height - 1);
  91.   Changed;
  92. end;
  93.  
  94. constructor TCustomAffineLayer.Create(ALayerCollection: TLayerCollection);
  95. begin
  96.   inherited;
  97.   FBitmap := TBitmap32.Create;
  98.   FBitmap.OnChange := BitmapChanged;
  99.   FTransformation := TAffineTransformation.Create;
  100. end;
  101.  
  102. destructor TCustomAffineLayer.Destroy;
  103. begin
  104.   FTransformation.Free;
  105.   FBitmap.Free;
  106.   inherited;
  107. end;
  108.  
  109. function TCustomAffineLayer.DoHitTest(X, Y: Integer): Boolean;
  110. var
  111.   BX, BY: Integer;
  112.   Pt: TPoint;
  113. begin
  114.   with TATAccess(Transformation) do
  115.     Pt := ReverseTransform(Point(X, Y)); // BX,BY - in 'FBitmap' coordinates
  116.   BX := Pt.X; BY := Pt.Y;
  117.   if PtInRect(Rect(0, 0, Bitmap.Width, Bitmap.Height), Pt) then Result := True;
  118.   if Result and AlphaHit and (Bitmap.PixelS[BX, BY] and $FF000000 = 0) then
  119.     Result := False;
  120. end;
  121.  
  122. procedure TCustomAffineLayer.Paint(Buffer: TBitmap32);
  123. begin
  124.   AdjustTransformation;
  125.   Transform(Buffer, FBitmap, Transformation);
  126. end;
  127.  
  128. procedure TCustomAffineLayer.SetBitmap(Value: TBitmap32);
  129. begin
  130.   FBitmap.Assign(Value);
  131. end;
  132.  
  133. { TRotLayer }
  134.  
  135. procedure TRotLayer.AdjustTransformation;
  136. begin
  137.   Transformation.Clear;
  138.   Transformation.Translate(-BitmapCenter.X, -BitmapCenter.Y);
  139.   Transformation.Rotate(0, 0, Angle);
  140.   Transformation.Translate(Position.X, Position.Y);
  141.   if Scaled and Assigned(LayerCollection) and Assigned(LayerCollection.CoordXForm) then
  142.     with LayerCollection.CoordXForm^ do
  143.     begin
  144.       Transformation.Scale(ScaleX / 65536, ScaleY / 65536);
  145.       Transformation.Translate(ShiftX, ShiftY);
  146.     end;
  147. end;
  148.  
  149. procedure TRotLayer.SetAngle(Value: Single);
  150. begin
  151.   FAngle := Value;
  152.   Changed;
  153. end;
  154.  
  155. procedure TRotLayer.SetBitmapCenter(const Value: TFloatPoint);
  156. begin
  157.   FBitmapCenter := Value;
  158.   Changed;
  159. end;
  160.  
  161. procedure TRotLayer.SetPosition(const Value: TFloatPoint);
  162. begin
  163.   FPosition := Value;
  164.   Changed;
  165. end;
  166.  
  167. procedure TRotLayer.SetScaled(Value: Boolean);
  168. begin
  169.   FScaled := Value;
  170.   Changed;
  171. end;
  172.  
  173. end.
  174.