Grafik drehen

[OnlyOne]

Hallo

Ich will ein Bild um sein Zentrum drehen. Dies funktioniert auch soweit nur dauert es viel zu lang.
Unter zu lang versteh ich 8 Sekunden für ein Bild von 3000x1000 Pixel.

Meiner Meinung nach liegt es an folgender Zeile:
NeuesBild.Canvas.Pixels[xneu,yneu]:=BildKopie.Canvas.Pixels[xalt,yalt]; Wenn ihr einen schnelleren Weg wisst sagt bescheid.

Hier der gesamte Quellcode für die Übersicht:

Delphi-Quellcode:

procedure TForm1.BT_DrehenClick(Sender: TObject);
Var
    xalt,yalt,xneu,yneu,breite,hoehe,xm,ym:integer;
    b,g,s,c:single;
begin
  g:=strtofloat(ED_Grad.Text);
  Breite:=Image1.Width;
  Hoehe:=Image1.Height;
  BildKopie:=TBitmap.Create;
  BildKopie.SetSize(Breite,Hoehe);
  BildKopie.Pixelformat:=pf1bit;     //schwarz weiß
  BildKopie.Canvas.Draw(0, 0, Image1.Picture.Graphic); //BildKopie:=Image1
  NeuesBild:=TBitmap.Create;
  NeuesBild.SetSize(Breite,Hoehe); // 1xKopie 1xLeer clwhite
  BildKopie.Pixelformat:=pf1bit;
  NeuesBild.Canvas.Brush.Color:=clwhite;
  NeuesBild.Canvas.Pen.Color:=clwhite;
  NeuesBild.Canvas.Rectangle(0,0,Breite,Hoehe);

  xm:=round(breite/2);
  ym:=round(hoehe/2);
  b:=(g/360*2*PI);
  s:=SIN(b);
  c:=COS(b);
  for yalt := 0 to Hoehe-1 do
    for xalt := 0 to Breite-1 do
    begin
      xneu:=round((xalt-xm)*c-(yalt-ym)*s)+xm;
      yneu:=round((xalt-xm)*s+(yalt-ym)*c)+ym;
      NeuesBild.Canvas.Pixels[xneu,yneu]:=BildKopie.Canvas.Pixels[xalt,yalt];
    end;
  Image1.Picture.Assign(NeuesBild);                    //Image1:=NeuesBild
  BildKopie.Free;
  NeuesBild.Free;
end;

Danke im Voraus
Gruß OnlyOne

[Popov]

Problem allgemein bekannt. Guck dir mal die Eigenschaft ScanLine von TBitmap an.

[Bjoerk]

Was wesentlich schneller geht ist das Canvas zu drehen, zum Beispiel hier.

[pelzig]

Zitat von Bjoerk:

Was wesentlich schneller geht ist das Canvas zu drehen, zum Beispiel hier.

Statt das Bild im Rahmen zu drehen, hängt man einfach den Rahmen anders auf?

Manche Lösungen beeindrucken mich immer wieder...

Quadratische Grüße
pelzig

[OnlyOne]

Danke für die Lösungen aber

Die ScanLine Methode funktioniert in diesem Fall nicht weil ich meine Bitmap so verschiebe, dass die Mitte auf (0|0) liegt,
es dann gedreht wird und schließlich wieder zurück verschoben wird. Und mit ScanLine ist mein Bitmap nach der ersten Verschiebung außerhalb des Bereichs.
Hier mal bisschen Quellcode zu Scan Line:

Delphi-Quellcode:

VAR PixelsAlt,PixelsNeu: PRGBTripleArray;

for yalt := 0 to Hoehe-1 do
  begin
  PixelsAlt := BildKopie.ScanLine[yalt];
    for xalt := 0 to Breite-1 do
    begin
      xneu:=round((xalt-xm)*c-(yalt-ym)*s)+xm;
      yneu:=round((xalt-xm)*s+(yalt-ym)*c)+ym;
      //NeuesBild.Canvas.Pixels[xneu,yneu]:=BildKopie.Canvas.Pixels[xalt,yalt];
      PixelsNeu := NeuesBild.ScanLine[yneu];
      PixelsNeu[xneu]:=PixelsAlt[xalt];
    end;
  end;

Lösung Nummer 2 klingt sehr schön aber funktioniert leider nicht.
(EDIT: Es ist keine Veränderung auf dem Image sichtbar. )

Delphi-Quellcode:

Procedure TForm1.SetCanvasZoomAndRotation(ACanvas: TCanvas; Zoom: Double; Angle: Double; CenterpointX, CenterpointY: Double);
var
  form: tagXFORM;
  rAngle: Double;
begin
  rAngle := DegToRad(Angle);
  SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  form.eM11 := Zoom * Cos(rAngle);
  form.eM12 := Zoom * Sin(rAngle);
  form.eM21 := Zoom * (-Sin(rAngle));
  form.eM22 := Zoom * Cos(rAngle);
  form.eDx := CenterpointX;
  form.eDy := CenterpointY;
  SetWorldTransform(ACanvas.Handle, form);
end;

procedure TForm1.BT_DrehenClick(Sender: TObject);
Var BildKopie:TBitmap;
begin
  BildKopie:=TBitmap.Create;
  BildKopie.SetSize(Image1.Width,Image1.Height);
  BildKopie.Canvas.Draw(0,0,Image1.Picture.Graphic);
  SetCanvasZoomAndRotation(BildKopie.Canvas,1,strtofloat(ED_Grad.Text),Image1.Width/2,Image1.Height/2);
  Image1.Picture.Bitmap := nil;
  Image1.Picture.Assign(BildKopie);
  BildKopie.Free;
end;

Habe auch schon versucht das Image direkt zu drehen mit : SetCanvasZoomAndRotation(Image1.Picture.Bitmap.Canvas,...);
Wahrscheinlich habe ich irgendwo einen Denkfehler.
Bin für alle Lösungen offen

[Bjoerk]

Zitat von OnlyOne:

Danke für die Lösungen aber [..] Wahrscheinlich habe ich irgendwo einen Denkfehler. Bin für alle Lösungen offen

Ja, ist etwas tricky. Man muß dabei berücksichtigen das dein Drehpunkt (Center) nicht der Drehpunkt von SetWorldTransform ist. Hab Dir mal ein paar Methoden rauskopiert.

Ich hoffe damit nicht wieder ein "Vorsagen-Verstoß" begangen zu haben..

Delphi-Quellcode:

type
  TRotationZoomCanvas = class
  private
    procedure SetCanvas(const Value: TCanvas);
  protected
    FCanvas: TCanvas;
    FAngle: double;
    FZoom: double;
    procedure SetRotationZoom(OffsetX, OffsetY: double);
    procedure Reset;
  public
    procedure Draw(X, Y: integer; Graphic: TGraphic);
    procedure StretchDraw(ARect: TRect; Graphic: TGraphic);
    property Canvas: TCanvas read FCanvas write SetCanvas;
    property Angle: double read FAngle write FAngle;
    property Zoom: double read FZoom write FZoom;
  end;

implementation

procedure TRotationZoomCanvas.SetCanvas(const Value: TCanvas);
begin
  FCanvas := Value;
  SetGraphicsMode(FCanvas.Handle, GM_ADVANCED);
  // SetMapMode(FCanvas.Handle, MM_ANISOTROPIC);
  FZoom := 1;
end;

procedure TRotationZoomCanvas.Draw(X, Y: integer; Graphic: TGraphic);
var
  O: TPoint;
begin
  O.X := X + Graphic.Width div 2;
  O.Y := Y + Graphic.Height div 2;
  SetRotationZoom(O.X, O.Y);
  FCanvas.Draw(X - O.X, Y - O.Y, Graphic);
  Reset;
end;

procedure TRotationZoomCanvas.StretchDraw(ARect: TRect; Graphic: TGraphic);
var
  O: TPoint;
begin
  O.X := (ARect.Left + ARect.Right) div 2;
  O.Y := (ARect.Top + ARect.Bottom) div 2;
  SetRotationZoom(O.X, O.Y);
  FCanvas.StretchDraw(Rect(ARect.Left - O.X, ARect.Top - O.Y,
    ARect.Right - O.X, ARect.Bottom - O.Y), Graphic);
  Reset;
end;

procedure TRotationZoomCanvas.Reset;
var
  Angle, Zoom: double;
begin
  Angle := FAngle;
  Zoom := FZoom;
  FAngle := 0;
  FZoom := 1;
  SetRotationZoom(0, 0);
  FAngle := Angle;
  FZoom := Zoom;
end;

procedure TRotationZoomCanvas.SetRotationZoom(OffsetX, OffsetY: double);
var
  Mat: tagXFORM;
  C, S: double;
begin
  C := FZoom * Cos(0.0174532925199433 * FAngle);
  S := FZoom * Sin(0.0174532925199433 * FAngle);
  Mat.eM11 := C;
  Mat.eM12 := S;
  Mat.eM21 := -S;
  Mat.eM22 := C;
  Mat.eDx := OffsetX;
  Mat.eDy := OffsetY;
  SetWorldTransform(FCanvas.Handle, Mat);
end;

..

procedure TCanvasToolsExampleForm.Button1Click(Sender: TObject);
begin
  FRotationZoomCanvas.Canvas := Canvas;
  FRotationZoomCanvas.Zoom := 1.5;
  FRotationZoomCanvas.Angle := 30;
  FRotationZoomCanvas.Draw(100, 100, FBitmap);
end;

[bcvs]

Zitat von pelzig:

Statt das Bild im Rahmen zu drehen, hängt man einfach den Rahmen anders auf?

frei nach Loriot "Das Bild hängt schief"

[pelzig]

Zitat von bcvs:

Zitat von pelzig:

Statt das Bild im Rahmen zu drehen, hängt man einfach den Rahmen anders auf?

frei nach Loriot "Das Bild hängt schief"

Ich wäre echt *NIE* auf "Canvasdrehen" gekommen!

mfg
pelzig

[Harry Stahl]

Zitat von OnlyOne:

Hallo

Ich will ein Bild um sein Zentrum drehen. Dies funktioniert auch soweit nur dauert es viel zu lang.
Unter zu lang versteh ich 8 Sekunden für ein Bild von 3000x1000 Pixel.

Leider hast Du nicht dabei geschrieben, ob es letztendlich um eine Bearbeitung des Bitmaps geht oder nur um die Anzeige.

Falls es nur um die Anzeige geht, könntest Du das mit einer neueren Delphi-Version auch ganz einfach mit einem FMX-Projekt lösen. Hier müsste man nur ein Bitmap in ein TImage laden und den Wert "RotationAngle" entsprechend manipulieren. Die Anzeige geht da sehr schnell, auch mit größeren Bildern.

Hier kann man sich bei Interesse ein kurzes Video zu diesem Thema ansehen: http://youtu.be/IOU2cRnp2Lo

[EWeiss]

Hatten wir schon des Öfteren.
Sorry das ich meinen Kram dafür zu rate ziehe.

http://www.delphipraxis.net/130998-a...-rotation.html

Wie sich das allerdings bei größeren Auflösungen verhält musst halt testen.

gruss