![]() |
Bildbereich "gerade" ziehen
Liste der Anhänge anzeigen (Anzahl: 2)
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 :cheers:
Delphi-Quellcode:
mfg, mr.winkle
function showarea(input:TBitmap; PointA,PointB,PointC,PointD:TPoint; newHeight,newWidth:Integer):TBitmap;
//Showarea procedure by Thomas Feldmann //feldmann.thomas@googlemail.com //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; 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. |
Re: [Grafik] Bildbereich "gerade" ziehen
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. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:55 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz