Schwarzes Bild nach Größenänderung mit GR32

[ManuMF]

Hallo, ich habe ein Problem mit folgender Funktion, die mir ein Bild laden soll und es verkleinert an ein TImage übergeben soll:

Delphi-Quellcode:

procedure TVSForm.BildLaden(BDName: String; BMP: TBitmap);

var JPG: TJpegImage;
    TmpBMP: TBitmap32;

begin
  TmpBMP := TBitmap32.Create;
  try
    if ((AnsiLowerCase(ExtractFileExt(BDName)) = '.jpg') or (AnsiLowerCase(ExtractFileExt(BDName)) = '.jpeg')) then
    begin
      JPG := TJpegImage.Create;
      try
        JPG.LoadFromFile(BDName);
        TmpBMP.Assign(JPG);
      finally
        FreeAndNil(JPG);
      end;
    end
    else if (AnsiLowerCase(ExtractFileExt(BDName)) = '.bmp') then
      TmpBMP.LoadFromFile(BDName);

    TmpBMP.SetSize(188, 142);
    BMP.Assign(TmpBMP);
  finally
    FreeAndNil(TmpBMP);
  end;
end;

//Aufruf
BildLaden('Name', VSBild.Picture.Bitmap);

allerdings wird nur ein komplet schwarzes Bild übergeben, sonst keine Fehler.

:arrow: auch wenn ich direkt Bitmap32.LoadFromFile -> SetSize -> SaveToFile ausführe, ist das Ergebnis schwarz, es sollte also nicht an der Art der Übergabe meiner Prozedure liegen.

Aber woran könnte es dann liegen?

[ManuMF]

Niemand eine Idee? :(

Ich weiß, es fehlen noch 3:26, aber nachher kann ich nicht an den PC ;-)

[winx]

Hi,

du solltest wohl einen StrechtFilter verwenden, oder ab der
version 1.81 einen Resampler...

weisst du wie das geht???
Bin da auch am rumprobieren...hab das Problem das ich nach dem Drehen eines
Bildes immer einen schwarzen Hintergrung bekomme. In der früheren Version
war der Hintergrund immer weiss...

vielleicht können wir uns gegenseitig helfen :gruebel:

gruß,
winx

[winx]

Hi,

versuch mal folgendes:

Delphi-Quellcode:

procedure TForm1.BildLaden(BDName: String; BMP: TBitmap32);
var JPG: TJpegImage;
    TmpBMP: TBitmap32;
begin
  TmpBMP := TBitmap32.Create;
  try
    if ((AnsiLowerCase(ExtractFileExt(BDName)) = '.jpg') or (AnsiLowerCase(ExtractFileExt(BDName)) = '.jpeg')) then
    begin
      JPG := TJpegImage.Create;
      try
        JPG.LoadFromFile(BDName);
        TmpBMP.Assign(JPG);
      finally
        FreeAndNil(JPG);
      end;
    end
    else if (AnsiLowerCase(ExtractFileExt(BDName)) = '.bmp') then
      TmpBMP.LoadFromFile(BDName);

    //TmpBMP.SetSize(188, 142);
    BMP.Assign(TmpBMP);

  finally
    FreeAndNil(TmpBMP);
  end;
end;

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
  //Aufruf
  BildLaden('C:\\alba.jpg', Image321.Bitmap);
  Paint;
  
end;

hast du ne lösung für den schwarzen hintergrund??? wie krieg ich den weiss???

[DGL-luke]

ok... setsize setzt das bild komplett zurück, es bekommt dabei auch ein neues handle. die hilfedatei ist da leider nicht besonders klar, bzw. da steht überhaupt nix drin, das sagt, wie sich der bildinhalt verhält.

@winx: Dein Codeschnipsel lässt das resizen einfach komplett weg :stupid:

Also, ich werd mich jetzt sofort dransetzen und n demoprogramm schreiben (wenn ichs selber hinbekomm). Mehr als zwei Stunden soll ich nciht brauchen.

[DGL-luke]

sodele... siehe anhang.

lädt bmps (nativ) und jpegs (TPicture-Erweiterung jpeg-Unit).

Original kommt ins linke Image, Nach Klick auf "Skalieren" kommt skaliertes bild ins rechte image.

:oops: die implementation des labels links oben hab ich leider vergessen.

EDIT: unter Examples/Resampling gibts entsprechende Demos. (GR32 1.8.1)

[winx]

Hi,

erstmal danke :-) Ich hab das bei mir auch bemerkt...

Ne andere Frage. Weisst du auch ne Lösung für das problem, das mein hintergrund immer schwarz ist???
Mir ist es möglich alle Bilder usw zu drehen und zu strecken.
allerdings ist der Hintergrund immer schwarz...in meiner alten Version
(ich habe des Projekt von D7 importiert) war er weiß...

[ManuMF]

Cool, danke, jetzt klappt es endlich :thumb:

Hier noch mal meine Funktion, die das Ändern übernimmt:

Delphi-Quellcode:

procedure GroesseAnpassen(BDatei: String);

var GF_O, GF_Z, GF_K: TBitmap32;
    KRS: TKernelResampler;
    Rect_Z: TRect;
    Rect_O: TRect;

begin
  GF_O := TBitmap32.Create;
  GF_Z := TBitmap32.Create;
  GF_K := TBitmap32.Create;

  try
    KRS := TKernelResampler.Create(GF_Z);
    KRS.Kernel := TLanczosKernel.Create;

    GF_O.LoadFromFile(BDatei);
    GF_Z.SetSize(Screen.DesktopWidth, Screen.DesktopHeight);

    Rect_Z := Screen.DesktopRect;

    Rect_O.TopLeft := Point(0, 0);
    Rect_O.BottomRight := Point(GF_O.Width, GF_O.Height);

    KRS.Resample(GF_Z, Rect_Z, Rect_Z, GF_O, Rect_O, DmOpaque, nil);

    GF_Z.SaveToFile(BDatei);
  finally
    FreeAndNil(GF_O);
    FreeAndNil(GF_Z);
    FreeAndNil(GF_K);
  end;
end;

So klappt es auf jeden Fall.
Wenn etwas nicht in Ordnung (Überflüssiges, Vergessenes) ist, bitte schreiben! :)

[winx]

Hi,

also ich bekomme hier den Fehler:

Delphi-Quellcode:

    PT:=TProjectiveTransformation.create;
    PT.Srcrect:=Floatrect(0,0,bmpact.width-1,bmpact.height-1);
    //SetBorderTransparent(bmpact,Rect(0, 0, bmpact.Width - 1, bmpact.Height - 1));

    PT.X0:=CalcMousePosfromX(TransformPoint(TM,CADPoint(0,1)).X);
    PT.Y0:=CalcMousePosfromY(TransformPoint(TM,CADPoint(0,1)).Y);
    PT.X1:=CalcMousePosfromX(TransformPoint(TM,CADPoint(1,1)).X);
    PT.Y1:=CalcMousePosfromY(TransformPoint(TM,CADPoint(1,1)).Y);
    PT.X2:=CalcMousePosfromX(TransformPoint(TM,CADPoint(1,0)).X);
    PT.Y2:=CalcMousePosfromY(TransformPoint(TM,CADPoint(1,0)).Y);
    PT.X3:=CalcMousePosfromX(TransformPoint(TM,CADPoint(0,0)).X);
    PT.Y3:=CalcMousePosfromY(TransformPoint(TM,CADPoint(0,0)).Y);

    GR32_Transforms.Transform(ABitmap,bmpact,PT);

    PT.free;

das Bild bmpact ist danach schräg, und der Hintergrund ist (da es ja immer rechteckig dargestellt wird)
schwarz statt weiss!!!

So ein Dreck...weiss jemand was da bei der Transformation schief geht?

[DGL-luke]

der hintergrund ist eben schwarz statt weiß - sollte ja wohl irgendwo eine einstellung dazu geben.

Eventuell wird da auch direkt das Alpha auf 0 gestellt - immerhin ist da ja rein gar nichts. also einfach alle durchgehen, wenn alpha 0, alpha auf 255/1 stellen und weiss machen.

EDIT: Du solltest das über TColor32Entry(Bitmap.Pixel[x,y]).A herausfinden können.