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