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:

Delphi-Quellcode:

NeuesBild.Canvas.Pixels[xneu,yneu]:=BildKopie.Canvas.Pixels[xalt,yalt];

Wenn ihr einen schnelleren Weg wisst sagt bescheid. :D

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:

Zitat von Bjoerk (Beitrag 1295314)

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? :oops:

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 :

Delphi-Quellcode:

SetCanvasZoomAndRotation(Image1.Picture.Bitmap.Canvas,...);

Wahrscheinlich habe ich irgendwo einen Denkfehler.
Bin für alle Lösungen offen :)

[bcvs]

Zitat:

Zitat von pelzig (Beitrag 1295339)

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

frei nach Loriot "Das Bild hängt schief" :)

[pelzig]

Zitat:

Zitat von bcvs (Beitrag 1295343)

Zitat:

Zitat von pelzig (Beitrag 1295339)

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

frei nach Loriot "Das Bild hängt schief" :)

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

mfg
pelzig

[Sir Rufo]

Zitat:

Zitat von pelzig (Beitrag 1295346)

Zitat:

Zitat von bcvs (Beitrag 1295343)

Zitat:

Zitat von pelzig (Beitrag 1295339)

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

frei nach Loriot "Das Bild hängt schief" :)

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

mfg
pelzig

Wenn du auf ein Blatt Papier etwas "gedreht" schreiben möchtest, wie machst du das dann?
Papier bleibt vor dir liegen wie es ist und du verdrehst dir das Handgelenk, oder drehst du evtl. doch das Papier?

Die meisten Dinge passieren exakt so wie in der Realität ;)

[pelzig]

Zitat:

Zitat von Sir Rufo (Beitrag 1295348)

Zitat:

Zitat von pelzig (Beitrag 1295346)

Zitat:

Zitat von bcvs (Beitrag 1295343)

Zitat:

Zitat von pelzig (Beitrag 1295339)

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

frei nach Loriot "Das Bild hängt schief" :)

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

mfg
pelzig

Wenn du auf ein Blatt Papier etwas "gedreht" schreiben möchtest, wie machst du das dann?
Papier bleibt vor dir liegen wie es ist und du verdrehst dir das Handgelenk, oder drehst du evtl. doch das Papier?

Die meisten Dinge passieren exakt so wie in der Realität ;)

Bin "Beidhänder", kann rückwärts Schreiben und spiegelverkehrt ganz gut Lesen.

Was ist denn die "Realität"? Deine "Realität"? Meine "Realität"?

Mein Schwanz ist kürzer als Deiner!

MfG
pelzig

[Bjoerk]

Zitat:

Zitat von OnlyOne (Beitrag 1295342)

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;