home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / Rotate_Ex / MainUnit.pas next >
Encoding:
Pascal/Delphi Source File  |  2004-07-14  |  2.9 KB  |  114 lines
  1. unit MainUnit;
  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, QGraphics, QControls, QForms, QDialogs,
  32.   GR32, GR32_Image, GR32_Transforms, Math, GR32_RangeBars;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     Src: TImage32;
  37.     Dst: TImage32;
  38.     Angle: TGaugeBar;
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure AngleChange(Sender: TObject);
  41.   public
  42.     procedure ScaleRot(Alpha: Single);
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.xfm}
  51.  
  52. procedure TForm1.FormCreate(Sender: TObject);
  53. begin
  54.   Dst.Bitmap.SetSize(Src.Bitmap.Width, Src.Bitmap.Height);
  55.  
  56.   // erase the transparency of edge pixels
  57.   SetBorderTransparent(Src.Bitmap, Rect(0, 0, Src.Bitmap.Width - 1, Src.Bitmap.Height - 1));
  58.  
  59.   // show the picture
  60.   ScaleRot(0);
  61. end;
  62.  
  63. procedure TForm1.ScaleRot(Alpha: Single);
  64. var
  65.   SrcR: Integer;
  66.   SrcB: Integer;
  67.   T: TAffineTransformation;
  68.   Sx, Sy, Scale: Single;
  69. begin
  70.   SrcR := Src.Bitmap.Width - 1;
  71.   SrcB := Src.Bitmap.Height - 1;
  72.   T := TAffineTransformation.Create;
  73.   T.SrcRect := FloatRect(0, 0, SrcR + 1, SrcB + 1);
  74.   try
  75.     // shift the origin
  76.     T.Clear;
  77.  
  78.     // move the origin to a center for scaling and rotation
  79.     T.Translate(-SrcR / 2, -SrcB / 2);
  80.     T.Rotate(0, 0, Alpha);
  81.     Alpha := Alpha * 3.14159265358979 / 180;
  82.  
  83.     // get the width and height of rotated image (without scaling)
  84.     Sx := Abs(SrcR * Cos(Alpha)) + Abs(SrcB * Sin(Alpha));
  85.     Sy := Abs(SrcR * Sin(Alpha)) + Abs(SrcB * Cos(Alpha));
  86.  
  87.     // calculate a new scale so that the image fits in original boundaries
  88.     Sx := Src.Bitmap.Width / Sx;
  89.     Sy := Src.Bitmap.Height / Sy;
  90.     scale := Min(Sx, Sy);
  91.  
  92.     T.Scale(Scale, Scale);
  93.  
  94.     // move the origin back
  95.     T.Translate(SrcR / 2, SrcB / 2);
  96.  
  97.     // transform the bitmap
  98.     Dst.BeginUpdate;
  99.     Dst.Bitmap.Clear(clGray32);
  100.     Transform(Dst.Bitmap, Src.Bitmap, T);
  101.     Dst.EndUpdate;
  102.     Dst.Repaint;
  103.   finally
  104.     T.Free;
  105.   end;
  106. end;
  107.  
  108. procedure TForm1.AngleChange(Sender: TObject);
  109. begin
  110.   ScaleRot(-Angle.Position);
  111. end;
  112.  
  113. end.
  114.