Uses Math;

function RotateBitmap(Bitmap: TBitmap; Angle: Double; Color: TColor):TBitmap;
const
MaxPixelCount = 32768;
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..MaxPixelCount] of TRGBTriple;
var
A,
CosTheta,
SinTheta : Extended;
xSrc, ySrc,
xDst, yDst,
xODst, yODst,
xOSrc, yOSrc,
xPrime, yPrime : Integer;
srcRow, dstRow : PRGBTripleArray;
begin
Result := TBitmap.Create;
// Workaround SinCos bug
A := Angle;
while A >= 360 do
A := A - 360;
while A < 0 do
A := A + 360;
// end of workaround SinCos bug
SinCos(A * Pi / 180, SinTheta, CosTheta);
if (SinTheta * CosTheta) < 0 then begin
Result.Width := Round(Abs(Bitmap.Width * CosTheta
- Bitmap.Height * SinTheta));
Result.Height := Round(Abs(Bitmap.Width * SinTheta
- Bitmap.Height * CosTheta));
end
else begin
Result.Width := Round(Abs(Bitmap.Width * CosTheta
+ Bitmap.Height * SinTheta));
Result.Height := Round(Abs(Bitmap.Width * SinTheta
+ Bitmap.Height * CosTheta));
end;
with Result.Canvas do begin
Brush.Color := Color;
Brush.Style := bsSolid;
FillRect(ClipRect);
end;
Result.PixelFormat := pf24bit;
Bitmap.PixelFormat := pf24bit;
xODst := Result.Width div 2;
yODst := Result.Height div 2;
xOSrc := Bitmap.Width div 2;
yOSrc := Bitmap.Height div 2;
if CosTheta < 0 then
Dec(xOSrc);
if SinTheta < 0 then
Dec(yOSrc);
for ySrc := Max(Bitmap.Height, Result.Height)-1 downto 0 do begin
yPrime := ySrc - yODst;
for xSrc := Max(Bitmap.Width, Result.Width)-1 downto 0 do begin
xPrime := xSrc - xODst;
xDst := Round(xPrime * CosTheta - yPrime * SinTheta) + xOSrc;
yDst := Round(xPrime * SinTheta + yPrime * CosTheta) + yOSrc;
if (yDst >= 0) and (yDst < Bitmap.Height) and
(xDst >= 0) and (xDst < Bitmap.Width) and
(ySrc >= 0) and (ySrc < Result.Height) and
(xSrc >= 0) and (xSrc < Result.Width) then begin
srcRow := Bitmap.ScanLine[yDst];
dstRow := Result.Scanline[ySrc];
dstRow[xSrc] := srcRow[xDst];
end;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image2.Picture.Bitmap:= RotateBitmap(Image1.Picture.Bitmap,30,clRED);
end;