Procedure zum Exakten Verkleinern von Jpegs

[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.