1 unit imagetest; 2 3 {$mode objfpc} 4 5 interface 6 7 uses 8 Classes, Math, Forms, Graphics, Dialogs, 9 StdCtrls, ComCtrls, ExtCtrls, LCLIntf, LCLType, IntfGraphics, FPImage; 10 11 type 12 13 { TfrmImage } 14 15 TfrmImage = class(TForm) 16 btnSaveJPEG: TButton; 17 btnResize: TButton; 18 btnRotate: TButton; 19 imageDepths: TImage; 20 MyImage: TImage; 21 Label1: TLabel; 22 trackJPEG: TTrackBar; 23 procedure btnResizeClick(Sender: TObject); 24 procedure btnRotateClick(Sender: TObject); 25 procedure btnSaveJPEGClick(Sender: TObject); 26 procedure FormCreate(Sender: TObject); 27 private 28 29 public 30 procedure RotateBitmap(ASource: TBitmap; ADest: TCanvas; x, y, Angle: integer); 31 end; 32 33 var 34 frmImage: TfrmImage; 35 36 implementation 37 38 {$R *.lfm} 39 40 { TfrmImage } 41 42 procedure TfrmImage.FormCreate(Sender: TObject); 43 var 44 MyBitmap: TBitmap; 45 begin 46 // Create a 100x100 bitmap and draw to it 47 MyBitmap := TBitmap.Create; 48 MyBitmap.PixelFormat := pf4bit; 49 MyBitmap.Width := 80; 50 MyBitmap.Height := 80; 51 // MyBitmap. 52 // MyBitmap.Canvas.Brush.Color := RGBA(0,0,0,0); 53 MyBitmap.Canvas.Pen.Color := clBlue; 54 MyBitmap.Canvas.Rectangle(20, 20, 60, 60); 55 imageDepths.Canvas.Draw(0, 0, MyBitmap); 56 // 57 MyBitmap.PixelFormat := pf32bit; 58 MyBitmap.Width := 80; 59 MyBitmap.Height := 80; 60 MyBitmap.Canvas.Brush.Color := TColor($F2F2F2); 61 MyBitmap.Canvas.Pen.Color := clBlue; 62 MyBitmap.Canvas.Rectangle(20, 20, 60, 60); 63 imageDepths.Canvas.Draw(100, 0, MyBitmap); 64 MyBitmap.Free; 65 end; 66 67 procedure TfrmImage.RotateBitmap(ASource: TBitmap; ADest: TCanvas; x, y, Angle: integer); 68 var 69 SrcIntfImg, TempIntfImg: TLazIntfImage; 70 ImgHandle,ImgMaskHandle: HBitmap; 71 px, py : Integer; 72 CurColor : TFPColor; 73 TempBitmap: TBitmap; 74 75 ToX,ToY : Integer; 76 Xo,Yo : Integer; 77 beta : Single; 78 MinX,MaxX : Integer; 79 MinY,MaxY : Integer; 80 Dx,Dy : Integer; 81 82 procedure RotatePts(Var aX,aY : Integer); 83 Var Xr,Yr : Integer; 84 begin 85 //Change new axe 86 xr:=aX-Xo; 87 yr:=aY-Yo; 88 89 //Rotation 90 aX:=Xo+Round(Xr*Cos(Beta)+Yr*Sin(Beta)); 91 aY:=Yo+Round(Xr*Sin(Beta)*-1+Cos(Beta)*Yr); 92 end; 93 94 begin 95 SrcIntfImg:=TLazIntfImage.Create(0,0); 96 SrcIntfImg.LoadFromBitmap(ASource.Handle,ASource.MaskHandle); 97 TempIntfImg:=TLazIntfImage.Create(0,0); 98 99 //Calculate the Sin and Cos of beta for later. 100 Beta:=(Angle)*Pi/180; 101 102 try 103 TempIntfImg.LoadFromBitmap(ASource.Handle,ASource.MaskHandle); 104 TempBitmap:=TBitmap.Create; 105 106 Xo:= SrcIntfImg.Width div 2; //Center of rotation for x 107 Yo:= SrcIntfImg.Height div 2; //Center of rotation for y 108 px:=xo; 109 py:=yo; 110 111 //Calc new size after rotation 112 px:=0; 113 py:=0; 114 RotatePts(px,py); 115 toX:=0; 116 toY:=SrcIntfImg.Height; 117 RotatePts(ToX,ToY); 118 119 MinX:=Min(px+x,Tox+x); 120 MaxX:=Max(px+x,Tox+x); 121 MinY:=Min(py+y,Toy+y); 122 MaxY:=Max(py+y,Toy+y); 123 124 px:=SrcIntfImg.Width; 125 py:=0; 126 RotatePts(px,py); 127 toX:=SrcIntfImg.Width; 128 toY:=SrcIntfImg.Height; 129 RotatePts(ToX,ToY); 130 131 MaxX:=MaxIntValue([px+x,Tox+x,MaxX]); 132 MaxY:=MaxIntValue([py+y,Toy+y,MaxY]); 133 MinX:=MinIntValue([px+x,Tox+x,MinX]); 134 MinY:=MinIntValue([py+y,Toy+y,MinY]); 135 136 TempIntfImg.Width :=(MaxX-MinX)+1; 137 TempIntfImg.Height:=(MaxY-MinY)+1; 138 TempIntfImg.FillPixels(FPColor(0, 0, 0, 0)); 139 140 Dx:=(TempIntfImg.Width div 2)-Xo; 141 Dy:=(TempIntfImg.Height div 2)-Yo; 142 143 for py:=0 to SrcIntfImg.Height-1 do 144 begin 145 for px:=0 to SrcIntfImg.Width-1 do 146 begin 147 CurColor:=SrcIntfImg.Colors[px,py]; 148 149 ToX:=Px; ToY:=py; 150 RotatePts(ToX,ToY); 151 152 try 153 TempIntfImg.Colors[ToX+Dx,ToY+Dy]:=CurColor; 154 except 155 end; 156 end; 157 end; 158 159 TempIntfImg.CreateBitmaps(ImgHandle,ImgMaskHandle,false); 160 TempBitmap.Handle:=ImgHandle; 161 TempBitmap.MaskHandle:=ImgMaskHandle; 162 ADest.Draw(x-dx,y-dy,TempBitmap); 163 finally 164 SrcIntfImg.Free; 165 TempIntfImg.Free; 166 TempBitmap.Free; 167 end; 168 end; 169 170 procedure TfrmImage.btnSaveJPEGClick(Sender: TObject); 171 var 172 jpeg: TJPEGImage; 173 Points: array[0..2] of TPoint; 174 SaveDialog: TSaveDialog; 175 begin 176 jpeg := TJPEGImage.Create; 177 SaveDialog := TSaveDialog.Create(nil); 178 try 179 // Create a blue triangle image 180 // on a black background 181 jpeg.Width := 100; 182 jpeg.Height := 100; 183 jpeg.Canvas.Brush.Color := clBlue; 184 Points[0] := Point(50, 25); 185 Points[1] := Point(25, 75); 186 Points[2] := Point(75, 75); 187 jpeg.Canvas.Polygon(Points); 188 189 // Prepares the save dialog and the 190 // compression configurations 191 SaveDialog.DefaultExt := 'jpg'; 192 jpeg.CompressionQuality := trackJPEG.Position; 193 194 // Saves the file 195 if SaveDialog.Execute then 196 jpeg.SaveToFile(SaveDialog.FileName); 197 finally 198 // Releases the objects 199 jpeg.Free; 200 SaveDialog.Free; 201 end; 202 end; 203 204 procedure TfrmImage.btnResizeClick(Sender: TObject); 205 var 206 MyBitmap: TBitmap; 207 begin 208 // Create a 100x100 bitmap and draw to it 209 MyBitmap := TBitmap.Create; 210 MyBitmap.Width := 100; 211 MyBitmap.Height := 100; 212 MyBitmap.Canvas.Brush.Color := clBlue; 213 MyBitmap.Canvas.Pen.Color := clBlue; 214 MyBitmap.Canvas.Rectangle(20, 20, 80, 80); 215 // Now resize it to 200x100 216 MyBitmap.Width := 200; 217 MyBitmap.Canvas.CopyRect( 218 Bounds(0, 0, 200, 100), 219 MyBitmap.Canvas, 220 Bounds(0, 0, 100, 100)); 221 MyImage.Canvas.Draw(0, 0, MyBitmap); 222 MyBitmap.Free; 223 224 { LCLIntf.StretchBlt( 225 MyBitmap.Canvas.Handle, 0, 0, 200, 100, 226 MyBitmap.Canvas.Handle, 0, 0, 100, 100, SRCCOPY);} 227 end; 228 229 procedure TfrmImage.btnRotateClick(Sender: TObject); 230 var 231 MyBitmap: TBitmap; 232 begin 233 // Create a 100x100 bitmap and draw to it 234 MyBitmap := TBitmap.Create; 235 MyBitmap.Width := 100; 236 MyBitmap.Height := 100; 237 MyBitmap.Canvas.Brush.Color := clBlue; 238 MyBitmap.Canvas.Pen.Color := clBlue; 239 MyBitmap.Canvas.Rectangle(20, 20, 80, 80); 240 RotateBitmap(MyBitmap, MyImage.Canvas, 0, 0, 40); 241 MyBitmap.Free; 242 end; 243 244 end. 245 246