1 unit MainUnit1;
2 
3 {$mode objfpc}{$H+}
4 
5 interface
6 
7 {.$DEFINE DEBUG} //Show draw for rotate
8 uses
9   Classes, SysUtils, LCLType, LResources, Forms, Controls, Graphics, Dialogs,
10   Buttons, FPImage, IntfGraphics,Math, StdCtrls;
11 
12 type
13 
14   { TForm1 }
15 
16   TForm1 = class(TForm)
17     Button1: TButton;
18     Button2: TButton;
19     Edit1: TEdit;
20     procedure Button1Click(Sender: TObject);
21     procedure Button2Click(Sender: TObject);
22     procedure Form1Create(Sender: TObject);
23     procedure Form1Destroy(Sender: TObject);
24     procedure FormPaint(Sender: TObject);
25   private
26     FKind: Byte; // 1 = FadeIn 2 = Rotate
27     procedure FadeIn(ABitmap: TBitmap; x, y: integer);
28     procedure Rotate(ABitmap: TBitmap; aCanvas : TCanvas; x, y, Angle : integer);
29 
30   public
31     SampleBitmapABitmap: TBitmap;
32   end;
33 
34 var
35   Form1: TForm1;
36 
37 implementation
38 
39 {$R *.lfm}
40 
41 { TForm1 }
42 
43 procedure TForm1.Button1Click(Sender: TObject);
44 begin
45   FKind := 1;
46   Invalidate;
47 end;
48 
49 procedure TForm1.Button2Click(Sender: TObject);
50 begin
51   FKind := 2;
52   Invalidate;
53 end;
54 
55 procedure TForm1.Form1Create(Sender: TObject);
56 begin
57   FKind := 0;
58   SampleBitmapABitmap:=TBitmap.Create;
59   SampleBitmapABitmap.LoadFromFile(SetDirSeparators('../../images/LazarusForm.bmp'));
60 end;
61 
62 procedure TForm1.Form1Destroy(Sender: TObject);
63 begin
64   SampleBitmapABitmap.Free;
65 end;
66 
67 procedure TForm1.FormPaint(Sender: TObject);
68 begin
69   if FKind = 1 then
70     FadeIn(SampleBitmapABitmap,120,120)
71   else
72   if FKind = 2 then
73     Rotate(SampleBitmapABitmap,Canvas,120,120,StrToIntDef(Edit1.Text,90));
74   FKind := 0;
75 end;
76 
77 procedure TForm1.FadeIn(ABitmap: TBitmap; x, y: integer);
78 var
79   SrcIntfImg, TempIntfImg: TLazIntfImage;
80   ImgHandle,ImgMaskHandle: HBitmap;
81   FadeStep: Integer;
82   px, py: Integer;
83   CurColor: TFPColor;
84   TempBitmap: TBitmap;
85 begin
86   SrcIntfImg:=TLazIntfImage.Create(0,0);
87   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
88   TempIntfImg:=TLazIntfImage.Create(0,0);
89   TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
90   TempBitmap:=TBitmap.Create;
91   for FadeStep:=1 to 32 do
92   begin
93     for py:=0 to SrcIntfImg.Height-1 do
94     begin
95       for px:=0 to SrcIntfImg.Width-1 do
96       begin
97         CurColor:=SrcIntfImg.Colors[px,py];
98         CurColor.Red:=(CurColor.Red*FadeStep) shr 5;
99         CurColor.Green:=(CurColor.Green*FadeStep) shr 5;
100         CurColor.Blue:=(CurColor.Blue*FadeStep) shr 5;
101         TempIntfImg.Colors[px,py]:=CurColor;
102       end;
103     end;
104     TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
105     TempBitmap.Handle:=ImgHandle;
106     TempBitmap.MaskHandle:=ImgMaskHandle;
107     Canvas.Draw(x,y,TempBitmap);
108   end;
109   SrcIntfImg.Free;
110   TempIntfImg.Free;
111   TempBitmap.Free;
112 end;
113 
114 procedure TForm1.Rotate(ABitmap: TBitmap; aCanvas : TCanvas; x, y, Angle: integer);
115 var
116   SrcIntfImg, TempIntfImg: TLazIntfImage;
117   ImgHandle,ImgMaskHandle: HBitmap;
118   px, py    : Integer;
119   CurColor  : TFPColor;
120   TempBitmap: TBitmap;
121 
122   ToX,ToY   : Integer;
123   Xo,Yo     : Integer;
124   beta      : Single;
125   MinX,MaxX : Integer;
126   MinY,MaxY : Integer;
127   Dx,Dy     : Integer;
128 
129   procedure RotatePts(Var aX,aY : Integer);
130   Var Xr,Yr : Integer;
131   begin
132     //Change new axe
133     xr:=aX-Xo;
134     yr:=aY-Yo;
135 
136     //Rotation
137     aX:=Xo+Round(Xr*Cos(Beta)+Yr*Sin(Beta));
138     aY:=Yo+Round(Xr*Sin(Beta)*-1+Cos(Beta)*Yr);
139   end;
140 
141   {$IFDEF DEBUG}
142   procedure Croix(aX,aY : integer; cl : TColor=clBlack);
143   begin
144     aCanvas.pen.Color:=cl;
145     aCanvas.MoveTo(ax-10,ay);
146     aCanvas.LineTo(ax+10,ay);
147     aCanvas.MoveTo(ax,ay-10);
148     aCanvas.LineTo(ax,ay+10);
149   end;
150   {$ENDIF}
151 
152 begin
153   SrcIntfImg:=TLazIntfImage.Create(0,0);
154   SrcIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
155   TempIntfImg:=TLazIntfImage.Create(0,0);
156 
157   //Calculate the Sin and Cos of beta for later.
158   Beta:=(Angle)*Pi/180;
159 
160   try
161     {$IFDEF DEBUG}
162     aCanvas.Brush.Style:=bsSolid;
163     aCanvas.Brush.Color:=Color;
164     aCanvas.FillRect(Rect(0,0,Width,Height-100));
165     aCanvas.Brush.Color:=clWhite;
166     {$ENDIF}
167 
168     TempIntfImg.LoadFromBitmap(ABitmap.Handle,ABitmap.MaskHandle);
169     TempBitmap:=TBitmap.Create;
170 
171     Xo:= SrcIntfImg.Width  div 2; //Center of rotation for x
172     Yo:= SrcIntfImg.Height div 2; //Center of rotation for y
173     px:=xo;
174     py:=yo;
175 
176     //Calc new size after rotation
177     px:=0;
178     py:=0;
179     RotatePts(px,py);
180     toX:=0;
181     toY:=SrcIntfImg.Height;
182     RotatePts(ToX,ToY);
183 
184     MinX:=Min(px+x,Tox+x);
185     MaxX:=Max(px+x,Tox+x);
186     MinY:=Min(py+y,Toy+y);
187     MaxY:=Max(py+y,Toy+y);
188 
189     px:=SrcIntfImg.Width;
190     py:=0;
191     RotatePts(px,py);
192     toX:=SrcIntfImg.Width;
193     toY:=SrcIntfImg.Height;
194     RotatePts(ToX,ToY);
195 
196     MaxX:=MaxIntValue([px+x,Tox+x,MaxX]);
197     MaxY:=MaxIntValue([py+y,Toy+y,MaxY]);
198     MinX:=MinIntValue([px+x,Tox+x,MinX]);
199     MinY:=MinIntValue([py+y,Toy+y,MinY]);
200 
201     {$IFDEF DEBUG}
202     aCanvas.Rectangle(0+x,0+y,SrcIntfImg.Width+x,SrcIntfImg.Height+y);
203     aCanvas.TextOut(xo+x-20,yo+y-20,Format('(%dx%d)',[MaxX-MinX,MaxY-MinY]));
204     {$ENDIF}
205 
206     TempIntfImg.Width :=(MaxX-MinX)+1;
207     TempIntfImg.Height:=(MaxY-MinY)+1;
208     TempIntfImg.FillPixels(FPColor(0, 0, 0, 0));
209 
210     Dx:=(TempIntfImg.Width div 2)-Xo;
211     Dy:=(TempIntfImg.Height div 2)-Yo;
212 
213     for py:=0 to SrcIntfImg.Height-1 do
214     begin
215       for px:=0 to SrcIntfImg.Width-1 do
216       begin
217         CurColor:=SrcIntfImg.Colors[px,py];
218 
219         ToX:=Px; ToY:=py;
220         RotatePts(ToX,ToY);
221 
222         try
223          TempIntfImg.Colors[ToX+Dx,ToY+Dy]:=CurColor;
224         except
225         end;
226       end;
227     end;
228 
229     {$IFDEF DEBUG}
230     Croix(xo+x,yo+y,clblue);
231     px:=SrcIntfImg.Width;
232     py:=SrcIntfImg.Height;
233     RotatePts(px,py);
234     croix(px+x,py+y);
235 
236     px:=SrcIntfImg.Width;
237     py:=0;
238     RotatePts(px,py);
239     croix(px+x,py+y);
240 
241     px:=0;
242     py:=SrcIntfImg.Height;
243     RotatePts(px,py);
244     croix(px+x,py+y);
245 
246     px:=0;
247     py:=0;
248     RotatePts(px,py);
249     croix(px+x,py+y);
250     {$ENDIF}
251 
252     TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false);
253     TempBitmap.Handle:=ImgHandle;
254     TempBitmap.MaskHandle:=ImgMaskHandle;
255     aCanvas.Draw(x-dx,y-dy,TempBitmap);
256 
257     {$IFDEF DEBUG}
258     aCanvas.Brush.Style:=bsClear;
259     aCanvas.Rectangle(x-dx,y-dy,TempBitmap.Width+x-dx,TempBitmap.Height+y-dy);
260     {$ENDIF}
261   finally
262     SrcIntfImg.Free;
263     TempIntfImg.Free;
264     TempBitmap.Free;
265   end;
266 end;
267 
268 end.
269 
270