Procedure zum Exakten Verkleinern von Jpegs

[Hazardos]

Hallo,

ich haber mir vor einiger zeit mal eine Procedure zusammengebastelt, die jeden einzelnen Pixel im exakten Verhältnis berechnet.

Ein beispiel:

Der Größenfaktor von originalgröße zu kopiegröße beträgt 1,9...
So wird der erste Pixel der Kopie zu 90% aus dem Ersten und zu 10 % aus dem Zweiten Pixel des Originals berechnet...

Ich würde es begrüßen, wenn sich manche hier mal die Procedure anschauen und folgende Punkte hier reinschreiben...
- kann man die Procedure bei gleichem Ergebnis beschleunigen?? Wie??
- Kann man das Resultat noch verbessern... ?
- Wenn die ursprüngliche Grafik nur aus 4 Pixeln besteht, müsste das Resultat ein gleichmäßiger Verlauf der 4 sein, in jedem Eckpixel der neuen Grafik müsste die Farbe des Pixels der originalgrafik wiederzufinden sein, aber befindet sich das gewünschte Ergebnis nur in einem Viertel der Endgrafik. Weist einfach der originalgrafik (hier tmp) die breite und höhe 2 zu und setzt die pixel [0..1,0..1] auf je eine andere Farbe und schaut es euch selbst an. Warum ist das so und wie kann man dies beheben ?
[edit]- Allgemeine Kritik der Vorgehensweise etc...[/edit]

Im Grunde bin ich mit dem ergebnis mehr als zufrieden, es ist halt nur nicht perfekt...

Danke schonmal fürs Feedback...

[Khabarakh]

Ich werde mir mal deinen Code zu Gemüte führen (ein paar Kommentare wären gut gewesen ), aber:

Delphi-Quellcode:

function Vorkomma (z : real) : Integer;
// Ne Menge Code

Trunc
function Nachkomma (z : real) : Real; Ceil
function mkslash (s : string) : string; IncludeTrailingPathDelimiter

[edit] Ich arbeite mich vor:

Delphi-Quellcode:

 if Nachkomma (YPos + YFak) <> 0 then 
   Yend := Vorkomma (YPos + YFak) + 1
 else
   Yend := Vorkomma (YPos + YFak);

Yend := Ceil(YPos + YFak);
Hier könnte deine Funktion sogar schieflaufen, da durch die Ungenauigkeit von Fließkommavariablen ein Gleich/Ungleich-Vergleich von diesen meistens nicht das gewünschte Ergebnis liefert.

[edit2]

Delphi-Quellcode:

p : pbytearray;
(p[x0*3+2],p[x0*3+1],p[x0*3])

PRGBTriple

[edit3]
Tut mir leid, aber ich blicke da einfach nicht durch .
Ich würde es einfach so machen :

Delphi-Quellcode:

uses GR32;

procedure Foo(NewWidth, NewHeight: Integer; ...);
var 
  From, To: TBitmap32;
  xFactor, yFactor: Single;
  x, y: Integer;
begin
  From := TBitmap32.Create;
  From.LoadFromFile(...);
  To := TBitmap32.Create;
  xFactor := NewWidth / From.Width;
  yFactor := NewHeight / From.Height;
  To.SetSize(NewWidth, NewHeight);
  for x := 0 to From.Width - 1 do
    for y := 0 to From.Height - 1 do
      To.PixelF[x * xFactor, y * yFactor] := From.Pixel[x, y];
  ...

GR32-Lib

PS: Warum verwendest du ScanLine und nachher doch Pixel ?

[Cicaro]

Also eine solche Prozedur hab' ich auch schon Programmiert. Dabei hab' ich mir das Leben etwas einfacher gemacht als du:
man braucht:
- 2 Streckfaktoren
- 1 Hilfsbitmap
- 2 for-Schleifen
Man muss zunächst das Hilfsbitmap strecken und mithilfe der for-Schleifen Pixel für Pixel die Farbe berechnen die im ursprünglichen Bitmap auszulesen ist. Wenn man aber berechnet, wo das Pixel[x,y], liegt, so landet man meist zwischen 4 Pixeln. Und nun der Trick: je nach dem, wo man genau zwischen den 4 Pixeln landet, sollte man die 4 Pixel in diesem Verhältnis, das man immer wieder neu berechnen muss, zueinander mischen (mein Programm erzielt damit übrigens erstaunlich gute Ergebnisse). Schließlich kopiert man das Bitmap in das alte und schon ist der Kram fertig.
Allerdings ist diese Vorgehensweise SEHR zeitaufwendig.

Beschleunigen lässt sich diese Prozedur mit ScanLine, denn die Pixelzuweisung beansprucht relativ viel Zeit. Ansonsten versuche weniger mit Gleitkommata zu arbeiten (sollte der Ablauf auch beschleunigen)!

[Cicaro]

Hier, hab' hier irgendwie 'was ausgekramt:

Delphi-Quellcode:

procedure DrawStretched(B:TBitmap;xp,yp:Real);

  var
    H:TBitmap;
    p1,p2,p3,p4:Real;
    x,y:Integer;
    Rr,Gg,Bb:Byte;

begin
  H:=TBitmap.Create;
  H.PixelFormat:=pf32Bit;
  H.Width:=Round(B.Width*xp);
  H.Height:=Round(B.Height*yp);

  for x:=0 to H.Width-1 do
    for y:=0 to H.Height-1 do
      begin
        p1:=1-x/xp+Trunc(x/xp)+1-y/yp+Trunc(y/yp);p2:=x  /xp-Trunc(x/xp)+1-y/yp+Trunc(y/yp);
        p3:=1-x/xp+Trunc(x/xp)+y  /yp-Trunc(y/yp);p4:=x  /xp-Trunc(x/xp)+y  /yp-Trunc(y/yp);

        Rr:=Trunc((GetRed(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)])*p1+
          GetRed(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)])*p2+
          GetRed(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)+1])*p3+
          GetRed(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)+1])*p4)/4);

        Gg:=Trunc((GetGreen(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)])*p1+
          GetGreen(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)])*p2+
          GetGreen(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)+1])*p3+
          GetGreen(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)+1])*p4)/4);

        Bb:=Trunc((GetBlue(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)])*p1+
          GetBlue(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)])*p2+
          GetBlue(B.Canvas.Pixels[Trunc(x/xp),Trunc(y/yp)+1])*p3+
          GetBlue(B.Canvas.Pixels[Trunc(x/xp)+1,Trunc(y/yp)+1])*p4)/4);

        H.Canvas.Pixels[x,y]:=Bb*65536+Gg*256+Rr;
      end;
  B.Assign(H);
  H.Free;
end;

Müsste glaub' ich gute Ergebnisse liefern, wenn die Streckfaktoren nicht zu groß bzw. nicht zu klein sind.

Hier der Vollständigkeit halber:

Delphi-Quellcode:

function GetRed(C:TColor):Byte;
begin
  Result:=C;
end;

function GetGreen(C:TColor):Byte;
begin
  Result:=C shr 8;
end;

function GetBlue(C:TColor):Byte;
begin
  Result:=C shr 16;
end;

[Khabarakh]

Ich will gar nicht wissen, wie lange das mit Pixel[] dauert .

Delphi-Quellcode:

function GetRed(C:TColor):Byte;
begin
  Result:=C;
end;

Das wird die Bereichsprüfung aber gar nicht gut finden.

[dizzy]

Was spricht gegen die bei Delphi vorhandenen Funktionen GetRValue (bzw. mit G oder B)?
Und mit Pixels bist du so langsam unterwegs wie es nur geht. Mit der Graphics32 gehts schnell, einfach und schön. Ich nehme sie mittlerweile für alles her was ich mit Bitmaps mache.

Gruss,
Fabian

[Cicaro]

Zitat von Khabarakh:

Ich will gar nicht wissen, wie lange das mit Pixel[] dauert .

Delphi-Quellcode:

function GetRed(C:TColor):Byte;
begin
  Result:=C;
end;

Das wird die Bereichsprüfung aber gar nicht gut finden.

Wieso nicht ?

Aber hier hab' ich das Verkleinern nochmal mit ScanLine hingeschmiert:

Delphi-Quellcode:

procedure DrawStretched(B:TBitmap;xp,yp:Real);

type
  TPixel = record
            B,G,R:Byte;
           end;

var
  P,Pp1,Pp2,Pp3,Pp4:^TPixel;
  H:TBitmap;
  p1,p2,p3,p4:Real;
  x,y:Integer;

begin
  H:=TBitmap.Create;
  H.PixelFormat:=pf24Bit;
  H.Width:=Round(B.Width*xp);
  H.Height:=Round(B.Height*yp);

  for y:=0 to H.Height-2 do
    begin
      P:=H.ScanLine[y];

      for x:=0 to H.Width-1 do
        begin
          Pp1:=B.ScanLine[Trunc(y/yp)];
          Pp2:=B.ScanLine[Trunc(y/yp)];
          Pp3:=B.ScanLine[Trunc(y/yp)+1];
          Pp4:=B.ScanLine[Trunc(y/yp)+1];

          Inc(Pp1,Trunc(x/xp));
          Inc(Pp2,Trunc(x/xp)+1);
          Inc(Pp3,Trunc(x/xp));
          Inc(Pp4,Trunc(x/xp)+1);

          p1:=1-x/xp+Trunc(x/xp)+1-y/yp+Trunc(y/yp);
          p2:=x  /xp-Trunc(x/xp)+1-y/yp+Trunc(y/yp);
          p3:=1-x/xp+Trunc(x/xp)+y  /yp-Trunc(y/yp);
          p4:=x  /xp-Trunc(x/xp)+y  /yp-Trunc(y/yp);

          P.R:=Trunc((Pp1.R*p1+Pp2.R*p2+Pp3.R*p3+Pp4.R*p4)/4);
          P.G:=Trunc((Pp1.G*p1+Pp2.G*p2+Pp3.G*p3+Pp4.G*p4)/4);
          P.B:=Trunc((Pp1.B*p1+Pp2.B*p2+Pp3.B*p3+Pp4.B*p4)/4);
          Inc(P);
        end;
    end;
  B.Assign(H);
  H.Free;
end;

Zitat von dizzy:

Was spricht gegen die bei Delphi vorhandenen Funktionen GetRValue (bzw. mit G oder B)?

Nur das es schneller geht die Function zu schreiben als in der Delphihilfe nach dieser 'Irgendwas-mit-hole-nur-die-Rotanteile-aus-TColor-heraus-Function' zu suchen.

[SirThornberry]

@dizzy: Gegen "GetRValue" spricht das man eigentlich auch ohne diesen Aufruf an den Farbwert kommt. Schließlich bekommt man mit Scanline du zeile zu den Pixeln. Und kann dementsprechend das Pixel direkt ansprechen, und bei diesem wiederum auch direkt die einzelnen Farbwerte.

Delphi-Quellcode:

type
  TRGBLine = array[0..65000] of TRGBTriple;
  PRGBLine = ^TRGBLine;
[...]
RGBLine := Bitmap.ScanLine[Y]; //Y-Line holen
RGBLine[X].rgbtRed //und mit diesem stück kann man dann auf den Rot-Wert von Pixel-X aus Zeile Y zugreifen (ohne zusätzlichen Funktionaufruf und somit ohne das erst was auf dem Stack abgelegt werden muss)

@Cicaro: Warum deklarierst du dir noch ein "TPixel". Wie weiter oben im Thread schon steht gibts von haus aus schon "TRGBTriple" was zu 100 deinem "TPixel" entspricht (außer von der Variablen-Benennung)

[dizzy]

Zitat von SirThornberry:

@dizzy: Gegen "GetRValue" spricht das man eigentlich auch ohne diesen Aufruf an den Farbwert kommt. Schließlich bekommt man mit Scanline du zeile zu den Pixeln. Und kann dementsprechend das Pixel direkt ansprechen, und bei diesem wiederum auch direkt die einzelnen Farbwerte.

Bei Scanline ist das ja auch was ganz was anderes. Es ging mir um die o.g. Variante mit Pixels. Und selbst dort würde ich ganz auf Methodenaufrufe dafür verzichten, da ein Klammernpaar und ein shr X und and Y schnell geschrieben sind, und somit einen call sparen .
Aber das Argument von Cicaro für's Neuschreiben lass ich mal gelten .