whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

27 Visitors Online


 
...rotate a bitmap around a point?
Autor: The_Flo
Homepage: http://www.the-flo.de.cx
[ Print tip ]  


Tip Rating (16):  
     


// 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 nötig
  // 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 gegenüber srcbit
  // change of FPoint in the new picture in relation on srcbit
  
Topoverh := TopOverh + FPoint.y;
  Leftoverh := LeftOverh + FPoint.x;

  // erstmal mit Hintergrundfarbe füllen
  // 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 füllen 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;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners