Bildbereich "gerade" ziehen

[mr.winkle]

Die Prozedur gibt einen beliebigen durch vier Punkte festgelegten Bereich in einem separaten Image aus.
Dank Scanline funktioniert das ziemlich schnell und gut. Das Bild wird automatisch richtig gedreht und die Proportionen angepasst damit sie perfekt in das Ziel-Image passen.
Ein Beispiel Projekt sowie ein Screenshot hängt an.
Der Code ist frei verfügbar, den kleinen Kommentar in der Prozedur aber bitte da lassen

Delphi-Quellcode:

function showarea(input:TBitmap; PointA,PointB,PointC,PointD:TPoint; newHeight,newWidth:Integer):TBitmap;
  //Showarea procedure by Thomas Feldmann
  //[e-mail]

  //Im folgenden werden Methoden zum Rechnen mit Vektoren bereitgestellt
  type tvector=record
    x,y:double;
    end;

  function vector(vx,vy:double):tvector;
  begin
    result.x:=vx;
    result.y:=vy;
  end;

  function makevector(v:tpoint):tvector;
  begin
    result.x:=v.x;
    result.y:=v.y;
  end;

  function multiply(vektor:tvector; number:double):tvector;
  begin
    result:=vector(vektor.x*number,vektor.y*number);
  end;

  function add(v1,v2:tvector):tvector;
  begin
    result:=vector(v1.x+v2.x,v1.y+v2.y);
  end;

  function sub(v1,v2:tvector):tvector;
  begin
    result:=vector(v1.x-v2.x,v1.y-v2.y);
  end;

var A,B,C,D,v,x :tvector;
    i,j         :integer;
    p1,p2       :^DWORD;
    rows        :array of pointer;
begin
  //Quell- und Zielbitmap initialisieren
  input.PixelFormat :=pf32bit;
  result            :=tbitmap.Create;
  result.PixelFormat:=pf32bit;
  result.Height     :=newHeight;
  result.Width      :=newWidth;
  //Umwandlung von TPoint nach TVector
  A:=makevector(PointA);  D:=makevector(PointD);
  B:=makevector(PointB);  C:=makevector(PointC);
  //Pointer des Quellbitmaps cachen
  Setlength(Rows, input.Height);
  for i:=0 to input.Height-1 do rows[i]:=input.ScanLine[i];
  //Start des Durchlaufs
  for i:=0 to newHeight-1 do
    begin
    p1:=result.ScanLine[i];
    //Horizontalen Vektor berechnen und verschieben
    v:=sub(add(D,multiply(sub(C,D),i/newHeight)),add(A,multiply(sub(B,A),i/newheight)));
    for j:=0 to newWidth-1 do
      begin
      //Vektor zum gewünschten Pixel
      x:=add(add(A,multiply(sub(B,A),i/newwidth)),multiply(v,j/newWidth));
      //Pixel in das Zielbitmap übertragen
      p2:=rows[round(x.y)];
      inc(p2,round(x.x));
      p1^:=p2^;
      inc(p1);
      end;
    end;
end;

mfg, mr.winkle

EDIT: Funktion angepasst, die Demo hat allerdings noch den alten Source, die neue Funktion ist aber wesentlich schneller.
EDIT2: Die von Lossy eX (zurecht) kritisierten Punkte wurden behoben und das neue Beispielprojekt hochgeladen.

[Lossy eX]

Sehr netter Code. Aber ich habe noch ein paar Anmerkungen dazu.

- Das arrayoftpoint macht das so wirklich viel Sinn? Denn eigentlich müssen es immer genau 4 TPoints sein. Dann könnte man das auch als einen Typen mit genau 4 Points definieren. Zu mal aktuell auch alle Punkte nach dem 4ten ignoriert werden. Damit wäre dann auch diese Überprüfung der Länge überflüssig. Und kleine Randnotiz. Fehler auf ein Canvas auszugeben geht gar nicht! Entweder eine Exception auslösen oder einen Rückgabewert. Aber kein PrintText. Da weiß man ja nicht obs geklappt hat oder nicht.

- Beim Zielbitmap solltest du zu erst das Pixelformat setzen. Denn aktuell wird ein Bitmap in der Größe erstellt und danach in 32 Bit konvertiert. Wenn es zu groß ist kann es sogar sein, dass beim Setzen der Breite sogar eine EOutOfResource-Exception (oder so) ausgelöst wird. Weil er evtl versucht Speicher auf der Grafikkarte zu erstellen.

- Etwas was nicht unbedingt ein Fehler ist. Mir persönlich gefällt es nicht so ganz, wenn eine Methode eine Klasseinstanz erstellt und diese dann zurückliefert. Ich gehe da eher immer nach der Premisse wer es erstellt muss es auch wegräumen. Bzw du kannst in der Methode auch dauerhaft mit Result arbeiten. Denn sollte irgendwo in der Mitte der Methode ein Fehler auftreten, dass ist das Bitmap (Bit) dauerhaft im Speicher verschollen. Also ein Speicherloch. Und bei Bitmaps tut das meistens besonders weh.