home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / graphics32 / Examples / Clx / RotLayer_Ex / MainUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2004-07-14  |  3.1 KB  |  125 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.   QForms, QStdCtrls, QExtCtrls, QControls,
  32.   GR32, GR32_Image, GR32_RotLayer, GR32_Transforms, GR32_RangeBars, Classes;
  33.  
  34. type
  35.   TForm1 = class(TForm)
  36.     ImgView: TImgView32;
  37.     GaugeBar1: TGaugeBar;
  38.     Label1: TLabel;
  39.     GaugeBar2: TGaugeBar;
  40.     Label2: TLabel;
  41.     GaugeBar3: TGaugeBar;
  42.     Label3: TLabel;
  43.     GaugeBar4: TGaugeBar;
  44.     Label4: TLabel;
  45.     CheckBox1: TCheckBox;
  46.     procedure FormCreate(Sender: TObject);
  47.     procedure GaugeBar1Change(Sender: TObject);
  48.     procedure GaugeBar2Change(Sender: TObject);
  49.     procedure GaugeBar4Change(Sender: TObject);
  50.     procedure CheckBox1Click(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.   public
  54.     L: TRotLayer;
  55.     procedure FillBitmap(B: TBitmap32; N: Integer);
  56.   end;
  57.  
  58. var
  59.   Form1: TForm1;
  60.  
  61. implementation
  62.  
  63. uses Math;
  64.  
  65. {$R *.xfm}
  66.  
  67. procedure TForm1.FormCreate(Sender: TObject);
  68. begin
  69.   ImgView.Bitmap.SetSize(200, 200);
  70.   FillBitmap(ImgView.Bitmap, 0);
  71.   L := TRotLayer.Create(ImgView.Layers);
  72.   L.Bitmap := TBitmap32.Create;
  73.   with L.Bitmap do
  74.   begin
  75.     BeginUpdate;
  76.     SetSize(100, 60);
  77.     L.BitmapCenter := FloatPoint(Width / 2, Height / 2);
  78.     FillBitmap(L.Bitmap, 127);
  79.     SetBorderTransparent(L.Bitmap, Rect(0, 0, Width - 1, Height - 1));
  80.     DrawMode := dmBlend;
  81.     StretchFilter := sfLinear;
  82.     EndUpdate;
  83.     Changed;
  84.   end;
  85.   L.Scaled := True;
  86.   L.Position := FloatPoint(100, 100);
  87. end;
  88.  
  89. procedure TForm1.GaugeBar1Change(Sender: TObject);
  90. begin
  91.   L.Angle := GaugeBar1.Position;
  92. end;
  93.  
  94. procedure TForm1.GaugeBar2Change(Sender: TObject);
  95. var
  96.   P: TFloatPoint;
  97. begin
  98.   P := L.Position;
  99.   P.X := GaugeBar2.Position;
  100.   P.Y := GaugeBar3.Position;
  101.   L.Position := P;
  102. end;
  103.  
  104. procedure TForm1.GaugeBar4Change(Sender: TObject);
  105. begin
  106.   ImgView.Scale := Power(10, GaugeBar4.Position / 100);
  107.   ImgView.Update;
  108. end;
  109.  
  110. procedure TForm1.CheckBox1Click(Sender: TObject);
  111. begin
  112.   L.Scaled := not L.Scaled;
  113. end;
  114.  
  115. procedure TForm1.FillBitmap(B: TBitmap32; N: Integer);
  116. var
  117.   X, Y: Integer;
  118. begin
  119.   for Y := 0 to B.Height - 1 do
  120.     for X := 0 to B.Width - 1 do
  121.       B[X, Y] := Color32(Random(127) + N, Random(127) + N, Random(127) + N, Random(127) + N);
  122. end;
  123.  
  124. end.
  125.