Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi [erledigt] Scanline - was ist falsch? (https://www.delphipraxis.net/112631-%5Berledigt%5D-scanline-ist-falsch.html)

mr.winkle 24. Apr 2008 17:58


[erledigt] Scanline - was ist falsch?
 
Hallo Leute, ich arbeite mich gerade in den Umgang mit Scanline ein und habe folgende Prozedur:
Delphi-Quellcode:
procedure Transform(i1,i2:timage; p:pointarray);

  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
    vector(v.x,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;

  procedure setzen(n1,n2:tpoint; b1,b2:tbitmap);
  type PixArray = array [1..3] of Byte;
  var  p1,p2: ^PixArray;
  begin
    p1:=b1.scanline[n1.y];
    inc(p1,n1.X);
    p2:=b2.scanline[n2.y];
    inc(p2,n2.X);
    p2^[1]:=p1^[1];
    p2^[2]:=p1^[2];
    p2^[3]:=p1^[3];
  end;

var A,B,C,D,v,x:tvector;
    i,j:integer;
    b1,b2:tbitmap;
begin

  if length(p)<>4 then
    begin
    showmessage('Kein Rechteck festgelegt');
    exit;
    end;

  b1:=i1.Picture.Bitmap;
  b2:=i2.Picture.Bitmap;
  b1.PixelFormat:= pf24Bit;
  b2.PixelFormat:= pf24Bit;
 
  A:=makevector(p[0]); D:=makevector(p[3]);
  B:=makevector(p[1]); C:=makevector(p[2]);

  for i:=0 to i2.Width-1 do
    begin
    v:=sub(add(B,multiply(sub(C,B),i/i2.Width)),add(A,multiply(sub(D,A),i/i2.Width)));
    for j:=0 to i2.Height-1 do
      begin
      x:=add(add(A,multiply(sub(D,A),i/i2.Width)),multiply(v,j/i2.Height));
      //i2.Canvas.Pixels[i,j]:=i1.canvas.Pixels[round(x.X),round(x.Y)];
      setzen(point(i,j),point(round(x.x),round(x.y)),b1,b2);            //Das hier soll das eine Zeile darüber bewirken
      end;
    end;
  i2.Refresh;
  i2.Repaint;
end;
Und es funktioniert soweit alles wenn ich die gerade wegkommentierte Zeile benutze, also nicht mit der Prozedur "setze" arbeite.
"Setze" soll bewirken, dass der Punkt n2 auf Bitmap b2 die gleiche Farbe erhält wie der Punkt n1 auf dem Bitmap b1, ich bekommen aber eine "Bereichsüberschreitung bei Zeilenindex" - weiß aber nicht wo ich diese zu suchen habe.

Wo liegt der Fehler? Ist die "setze" Prozedur überhaupt in den Anfängen schonmal richtig?

mfg, mr.winkle

Lossy eX 25. Apr 2008 08:34

Re: [erledigt] Scanline - was ist falsch?
 
Auch wenn die Frage als erledigt gekennzeichnet ist würde ich dir empfehlen die Struktur etwas umzustellen. Denn du greifst für jedes Pixel 2 Mal auf Scanline zu. Scanline ist schnell keine Frage. Aber in deinem Falle wohl nur gerade doppelt so schnell wie die Methode über Pixels, denn ScanLines macht intern auch einiges.

Die Methode setzen würde ich direkt in die Schleifen einbauen, denn zur Übergabe musst du 2 TPoints erstellen und übergeben und innerhalb zerlegst du sie wieder. Das kann man sich sparen. Außerdem ist der Zugriff auf b1 Zeilen für Zeile und Pixel für Pixel fortlaufend. Das könntest du so lösen in dem du dir in der ersten Schleife das Scanline geben lässt und diesen in der zweiten Schleife immer ein Pixel weiter setzt. Beim 2ten Bitmap geht das so leider nicht. Da solltest du evtl ein dynamisches Array erzeugen und dir darin die Pointer von ScanLine cachen.

Delphi-Quellcode:
var
  X, Y: Integer;
  pDestPix, pTempPix: PRGBTriple;
  Rows: array of Pointer;
begin
  // Pointer der Scanlines cachen
  Setlength(Rows, B1.Height);
  for Y := 0 to B1.Height -1 do
    Rows[Y] := B1.ScanLine[Y];

  for Y := 0 to B2.Height -1 do begin
    // Zeilenanfang
    pDestPix := B2.ScanLine[Y];

    for X := 0 to B2.Width -1 do begin
      // Vektor berechnen

      // Pointer aus dem Cache holen
      pTempPix := Rows[Round(X.Y)];
      Inc(pTempPix, Round(X.X);

      // pixel zuweisen
      pDestPix^.rgbtRed  := pTempPix^.rgbtRed;
      pDestPix^.rgbtGreen := pTempPix^.rgbtGreen;
      pDestPix^.rgbtBlue := pTempPix^.rgbtBlue;

      // nächstes Pixel der Zeile auswählen
      Inc(pDestPix);
    end;
  end;

  Setlength(Rows, 0);
end;
Oder ist es wichtig, dass du die Bilder Spaltenweise verarbeitest? Denn wenn ja (was ich nicht denke), dann solltest du die Scanlines des zweiten Bildes auch noch cachen. Ich denke es wird sich lohnen.

PS: Evtl lohnt es sich auch die Bilder als 32 Bit zu benutzen. Denn dann könntest du die Pixel auch auch PDWord oder PCardinal ansprechen und mit einem einzigen Befehl kopieren anstelle jetzt "umständlich" Byte für Byte. Da 32 Bit genau die Größe eines CPU Registers sind dürfte das das Kopieren noch mal gut vereinfachen. Weniger Befehle mit passender Datengröße = Schneller

PPS: Ich weiß nicht ob das so gut ist, wenn du für die Größe die Höhe des Images und nicht die des Bitmaps verwendest. Denn das Bitmap könnte unter Umständen auch mal kleiner als das Image sein?

mr.winkle 25. Apr 2008 10:44

Re: [erledigt] Scanline - was ist falsch?
 
Danke sehr für die ausführliche und hilfreiche Antwort! :hi:
Die setze-Prozedur hatte ich entworfen, da es der direkten Methode über canvas.pixel am nächsten kommt, dass das ineffizient ist ist mir mittlerweile klar ;)
Problem war, das mein Algorithmus Spaltenweise gearbeitet hat. Allerdings war das umstellen im Nachhinein keine schwierige Angelegenheit und ich bin auch die Setze Prozedur losgeworden.
Das Umstellen auf 32 Bit werde ich auf jeden Fall noch machen, das wusste ich vorher noch gar nicht.
Der "fertige" Algorithmus ist momentan auf dem Weg in die CodeLib, siehe hier: Bildbereich gerade ziehen
Wäre wirklich nett wenn du dort noch einmal drüberschauen könntest, wie gesagt, die Umstellung auf 32 Bit mache ich gerade und das mit den Imeages und Bitmaps werde ich auch noch anders regeln.
Vielen Dank!

mfg, mr.winkle

Umgesetzt:
Delphi-Quellcode:
function showarea(input:tbitmap; area:arrayoftpoint; nHeight,nWidth: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;
    bit        :tbitmap;
    p1,p2       :^pcardinal;
    rows       :array of pointer;
begin
  //Quell- und Zielbitmap initialisieren
  input.PixelFormat :=pf32bit;
  bit              :=tbitmap.Create;
  bit.Height       :=nHeight;
  bit.Width        :=nWidth;
  bit.PixelFormat  :=pf32bit;
  //Bereichsprüfung
  if length(p)<4 then bit.Canvas.TextOut(10,10,'Bereich nicht genügend festgelegt') else
    begin
    //Pointer des Quellbitmaps cachen
    Setlength(Rows, input.Height);
    for i:=0 to input.Height-1 do rows[i]:=input.ScanLine[i];
    //Vektoren initialisieren
    A:=makevector(p[0]); D:=makevector(p[3]);
    B:=makevector(p[1]); C:=makevector(p[2]);
    //Start des Durchlaufs
    for i:=0 to bit.height-1 do
      begin
      p1:=bit.ScanLine[i];
      //Vertikalen Vektor berechnen und verschieben
      v:=sub(add(D,multiply(sub(C,D),i/bit.Height)),add(A,multiply(sub(B,A),i/bit.height)));
      for j:=0 to bit.width-1 do
        begin
        //Vektor zum gewünschten Pixel
        x:=add(add(A,multiply(sub(B,A),i/bit.width)),multiply(v,j/bit.Width));
        //Pixel in das Zielbitmap übertragen
        p2:=rows[round(x.y)];
        inc(p2,round(x.x));
        p1^:=p2^;
        inc(p1);
        end;
      end;
    end;
  result:=bit;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:11 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz