Вращать Bitmap вокруг точки

// Vektor von FromP nach ToP 
// Vector from FromP to ToP 

function
 TForm1.Vektor(FromP, Top: TPoint): TPoint;
 begin

   Result.x := Top.x - FromP.x;
   Result.y := Top.y - FromP.y;
 end
;

 // neue x Komponente des Verktors 
// new x-component of the vector 
function
 TForm1.xComp(Vektor: TPoint; Angle: Extended): Integer;
 begin

   Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
 end
;

 // neue Y-Komponente des Vektors 
// new y-component of the vector 
function
 TForm1.yComp(Vektor: TPoint; Angle: Extended): Integer;
 begin

   Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
 end
;


 function
 TForm1.RotImage(srcbit: TBitmap; Angle: Extended; FPoint: TPoint;
   Background: TColor): TBitmap;
 { 
 srcbit: TBitmap; // Bitmap dass gedreht werden soll ; Bitmap to be rotated 
 Angle: extended; // Winkel in Bogenma?, angle 
 FPoint: TPoint;  // Punkt um den gedreht wird ; Point to be rotated around 
 Background: TColor): TBitmap;  // Hintergrundfarbe des neuen Bitmaps ; 
                               // Backgroundcolor of the new bitmap 
}
 var

    highest, lowest, mostleft, mostright: TPoint;
   topoverh, leftoverh: integer;
   x, y, newx, newy: integer;
 begin

   Result := TBitmap.Create;

   // Drehwinkel runterrechnen auf eine Umdrehung, wenn notig 
  // Calculate angle down on one rotation, if necessary 
  while
 Angle >= (2 * pi) do

   begin

     angle := Angle - (2 * pi);
   end
;

   // neue Ausma?e festlegen 
  // specify new size 
  if
 (angle <= (pi / 2)) then

   begin

     highest := Point(0,0);                        //OL 
    Lowest := Point(Srcbit.Width, Srcbit.Height); //UR 
    mostleft := Point(0,Srcbit.Height);            //UL 
    mostright := Point(Srcbit.Width, 0);             //OR 
  end

    else
 if
 (angle <= pi) then

   begin

     highest := Point(0,Srcbit.Height);
     Lowest := Point(Srcbit.Width, 0);
     mostleft := Point(Srcbit.Width, Srcbit.Height);
     mostright := Point(0,0);
   end

    else
 if
 (Angle <= (pi * 3 / 2)) then

   begin

     highest := Point(Srcbit.Width, Srcbit.Height);
     Lowest := Point(0,0);
     mostleft := Point(Srcbit.Width, 0);
     mostright := Point(0,Srcbit.Height);
   end

    else

   begin

     highest := Point(Srcbit.Width, 0);
     Lowest := Point(0,Srcbit.Height);
     mostleft := Point(0,0);
     mostright := Point(Srcbit.Width, Srcbit.Height);
   end
;

   topoverh := yComp(Vektor(FPoint, highest), Angle);
   leftoverh := xComp(Vektor(FPoint, mostleft), Angle);
   Result.Height := Abs(yComp(Vektor(FPoint, lowest), Angle)) + Abs(topOverh);
   Result.Width  := Abs(xComp(Vektor(FPoint, mostright), Angle)) + Abs(leftoverh);

   // Verschiebung des FPoint im neuen Bild gegenuber srcbit 
  // change of FPoint in the new picture in relation on srcbit 
  Topoverh := TopOverh + FPoint.y;
   Leftoverh := LeftOverh + FPoint.x;

   // erstmal mit Hintergrundfarbe fullen 
  // at first fill with background color 
  Result.Canvas.Brush.Color := Background;
   Result.Canvas.pen.Color   := background;
   Result.Canvas.Fillrect(Rect(0,0,Result.Width, Result.Height));

   // Start des eigentlichen Rotierens 
  // Start of actual rotation 
  for
 y := 0 to
 srcbit.Height - 1 do

   begin
                       // Zeilen  ; Rows 
    for
 x := 0 to
 srcbit.Width - 1 do

     begin
                    // Spalten ; Columns 
      newX := xComp(Vektor(FPoint, Point(x, y)), Angle);
       newY := yComp(Vektor(FPoint, Point(x, y)), Angle);
       newX := FPoint.x + newx - leftoverh;
       // Verschieben wegen der neuen Ausma?e 
      newy := FPoint.y + newy - topoverh;
       // Move beacause of new size 
      Result.Canvas.Pixels[newx, newy] := srcbit.Canvas.Pixels[x, y];
       // auch das Pixel daneben fullen um Leerpixel bei Drehungen zu verhindern 
      // also fil lthe pixel beside to prevent empty pixels 
      if
 ((angle < (pi / 2)) or

         ((angle > pi) and

         (angle < (pi * 3 / 2)))) then

       begin

         Result.Canvas.Pixels[newx, newy + 1] := srcbit.Canvas.Pixels[x, y];
       end

        else

        begin

         Result.Canvas.Pixels[newx + 1,newy] := srcbit.Canvas.Pixels[x, y];
       end
;
     end
;
   end
;
 end
;


 procedure
 TForm1.Button1Click(Sender: TObject);
 var

   mybitmap, newbit: TBitMap;
 begin

   if
 OpenDialog1.Execute then

   begin

     mybitmap := TBitmap.Create;
     mybitmap.LoadFromFile(OpenDialog1.FileName);
     newbit := RotImage(mybitmap, DegToRad(45),
       Point(mybitmap.Width div
 2, mybitmap.Height div
 2), clBlack);
     Image1.Canvas.Draw(0,0, newBit);
   end
;
 end
;

 end
;

Другое по теме:

• Bitmap без формы
• Bitmap.Scanline для PixelFormat
• Вращение изображения на заданный угол