Graphics32-Frage!!

[bingo72]

Hallo Experten!!

Ich verwende Graphics32 mit inkludiertem Filter zum Resizen von Images nach folgenden Muster:

Delphi-Quellcode:

function TfmMain.RescalePic(aFileName: String; aPic: TImage; aCount: Integer): TBitmap;
Var
  R: TKernelResampler;
  ASrcImage: TBitMap32;
  ADstImage: TBitMap32;
  ABmp: TBitMap;
  AJPeg: TJPegImage;
  AScale: Extended;
  lPageIndex : Integer;
begin
  // Zum Abspeichern als Jpeg
  AJPeg     := TJPEGImage.Create;

  // als Buffer von TImage32 zu TJpeg
  ABmp      := TBitMap.Create;
  // Originalbild
  ASrcImage := TBitmap32.Create;
  // verkleinertes Bild
  ADstImage := TBitMap32.Create;

  Screen.Cursor := crHourGlass;

  try
    // Datei laden
    ASrcImage.LoadFromFile(aFileName);

    // Skalierungsfaktor (z.B. 0.5 zum Verkleinern auf 50 %
    // in diesem Beispiel wir das Bild max. 300 Pixel breit oder hoch sein
    //AScale := (300 / Max(ASrcImage.Width, ASrcImage.Height));

    // Zielbild Größe einstellen
    ADstImage.Width  := 300;//Round(ASrcImage.Width * AScale);
    ADstImage.Height := 400;//Round(ASrcImage.Height * AScale);

    R := TKernelResampler.Create(ASrcImage);
    //R.Kernel := TLanczosKernel.Create;
    lPageIndex := pcMinimize.ActivePageIndex;
    R.Kernel := fFilter[aCount].Create;

    // Zielbild ist fertig
    ADstImage.Draw(ADstImage.BoundsRect, ASrcImage.BoundsRect, ASrcImage);

    // direkt geht es leider nicht in das AJpeg
    ABmp.Assign(ADstImage);

    //if AJPeg.CompressionQuality <> defJpegQuality then
      //AJPeg.CompressionQuality := defJpegQuality;

    //AJPeg.Assign(ABmp);

    aPic.Picture.Bitmap := ABmp;
    result := ABmp;

    // TDMImmoBild(DataModule).StoreImages(AJPeg);
    //AJPeg.SaveToFile('C:\Dokumente und Einstellungen\Thomas\Desktop\reklame1.jpg');

  finally
    Application.ProcessMessages;
    Screen.Cursor := crDefault; 
    AJPeg.Free;
    //ABmp.Free; 
    ADstImage.Free;
    ASrcImage.Free;
  end;
end;

Nun das funktioniert ja auch alles ganz schön, wenn man 32-bit-Images darstellen kann. Für meine Anwendung kann ich aber nicht immer blind davon ausgehen, daß die Graphikkarten auf Kundenrechnern 32-bit darstellen können.
Wir haben auch noch einen antiken Win95-Rechner für Testzwecke herumstehen und der meckert sobald die Draw-Methode von TBitmap32 aufgerufen wird. Auch kein Wunder, denn ein Blick auf die Bildschirmoptionen verrät, daß er nur 16- bzw. 24 bit darstellen kann.
Nun suche ich nach einer Art 'Ersatzlösung' für genau diese, wenn auch sicherlich wenige Fälle.

Daher meine Frage: Was würdet ihr für die Fälle tun, wo der Rechner keine 32-bit Farben dastellen kann??

LG
Thomas

[SirThornberry]

ich würde es generell als 24bit raus geben. Letzendlich werden ja nur 24 bit Farben und die restlichen 8 bit bestimmen einfach nur das Mischverhältnis zum Hintergrund. Also kannst du auch selbst die 24bit Farbe berechnen.

http://www.delphipraxis.net/internal...=751121#751121

Du kannst übrigens auf Draw verzichten und die Bilddaten direkt kopieren (also die BildDaten aus dem Speicher von TBitmap32 in den BildSpeicher von TBitmap kopieren)

[bingo72]

Hallo Thornberry!!

Klingt interessant...

Nur noch eine Frage...wie kopiere ich das Source-Image richtig?? Denn im Draw stecken ja auch die Ausmasse für das neue Image...

Habs mal so probiert...

Delphi-Quellcode:

....
    ABmp.Width  := 300;//Round(ASrcImage.Width * AScale);
    ABmp.Height := 400;//Round(ASrcImage.Height * AScale);

    R := TKernelResampler.Create(ASrcImage);
    //R.Kernel := TLanczosKernel.Create;
    lPageIndex := pcMinimize.ActivePageIndex;
    R.Kernel := fFilter[aCount].Create;

    // Zielbild ist fertig
    //ADstImage.Draw(ADstImage.BoundsRect, ASrcImage.BoundsRect, ASrcImage);


    // direkt geht es leider nicht in das AJpeg
    ABmp.Assign(ASrcImage);
    .....

Aber da zeichnet er das Bild wieder in Originalgröße hin und vermutlich auch ohne Komprimierung oder??

LG
Thomas

[SirThornberry]

oh, ich glaub auch. ich seh gerade erst das der Filter wohl erst im Draw greift und das Bild nicht direkt ändert.
Dann wäre es wohl das einfachste das Bild in 24bit zu wandeln und es mit dieser Farbtiefe durch Draw zu resizen. Wird die Alphamaske bei den 32bit-Bitmaps berücksichtigt oder bleibt diese ungenutzt? Wenn sie nicht ungenutzt bleibt müsstest du diese heraustrennen, als eigenes Bild auch in der größe verändern und wieder vereinen mit dem richtigen Bild. (so hab ichs bisher gemacht weil StretchBlt die Alphamaske auch nicht berücksichtigt)

[bingo72]

Ich hab mich jetzt herumgespielt, wie ich denn ursprünglich ein JPEG über ein Bitmap (denn das brauch ich ja um mit PixelFormat, die Farbtiefe zu reduzieren) ein Bitmap32 bekomme....bislang ohne Erfolg...

Und NEIN, ich brauch den Alphakanal nicht....soll heissen ich rufe nirgends irgendwas mit Alphakanal eines Bildes auf...

LG
Thomas

[bingo72]

Hat noch jemand eine Idee?? Ich stehe momentan ziemlich am Schlauch!!

[SirThornberry]

brauchst du das TBitmap32 nur für die Skalierung oder warum verwendest du TBitmap32 anstelle von TBitmap?
Und was ist das Eingangsformat? JPEG oder Bitmap?

[bingo72]

Hallo Thornberry!!

Ich brauch das Bitmap32 nur für die Skalierung, weil der Filter nur mit der TBitmap32.Draw-Methode angewendet wird.
Habe z.b. auch die StretchDraw-Methode getestet, aber das Ergebnis kannst Du vergessen, wenn in dem Bild eine Schrift oder so drinnen ist.
Das Bitmap32 hat eben eine viel größere Farbpalette zur Verfügung und kann daher auch feine Übergänge exakter darstellen.

[bingo72]

Achja Eingangsformat wäre jpeg!!

[SirThornberry]

dann ist es ja eigentlich ganz einfach:

Delphi-Quellcode:

var
  lBmp  : TBitmap;
  lJpg  : TJPEGImage;
begin
  lBmp  := TBitmap.Create();
  lJpg  := TJPEGImage.Create();
  lJpg.LoadFromFile(FileName);
  lBmp.Assign(lBmp);
  lBmp.PixelFormat := pf24Bit;
  [...]
  ASrcImage.Assign(lBmp);
  [...]
  lJpg.Assign(ADstImage);
  lJpg.SaveToFile(FileName);
  lBmp.Free;
  lJpg.Free;
end;

[bingo72]

Leider hilft auch Dein letzter Vorschlag nicht...

Es scheint wirklich so zu sein, daß bei Graphikkarten die keine 32bit- Farbtiefe darstellen können, eine Verwendung von Graphics32 nicht möglich ist??!!

[SirThornberry]

sind bei der Graphics32 keine Quelltexte dabei? dann könntest du ja schauen wie der Resampling-Algorythmus aussieht

[bingo72]

Ich hab jetzt nochmals alles durchdebugt und es stellt ihn beim Resampling in der Draw-Methode auf...

[SirThornberry]

Aber es ist eben die Frage bei welchem Teil in der Resampling-Methode. Es muss ja versucht werden funktionen zu verwenden welche mit der aktuellen Farbtiefe zu tun haben (obwohl die aktuelle Farbtiefe eigentlich da nicht rein gehört weil es nicht um die anzeige geht)

[bingo72]

Delphi-Quellcode:

function BuildMappingTable(
  DstLo, DstHi: Integer;
  ClipLo, ClipHi: Integer;
  SrcLo, SrcHi: Integer;
  Kernel: TCustomKernel): TMappingTable;
var
  SrcW, DstW, ClipW: Integer;
  Filter: TFilterMethod;
  FilterWidth: TFloat;
  Scale, OldScale: TFloat;
  Center: TFloat;
  Count: Integer;
  Left, Right: Integer;
  I, J, K: Integer;
  Weight: Integer;
begin
  SrcW := SrcHi - SrcLo;
  DstW := DstHi - DstLo;
  ClipW := ClipHi - ClipLo;
  if SrcW = 0 then
  begin
    Result := nil;
    Exit;
  end
  else if SrcW = 1 then
  begin
    SetLength(Result, ClipW);
    for I := 0 to ClipW - 1 do
    begin
      SetLength(Result[I], 1);
      Result[I][0].Pos := 0;
      Result[I][0].Weight := 256;
    end;
    Exit;
  end;
  SetLength(Result, ClipW);
  if ClipW = 0 then Exit;

  if FullEdge then Scale := DstW / SrcW
  else Scale := (DstW - 1) / (SrcW - 1);

  Filter := Kernel.Filter;
  FilterWidth := Kernel.GetWidth;
  K := 0;

  if Scale = 0 then
  begin
    Assert(Length(Result) = 1);
    SetLength(Result[0], 1);
    Result[0][0].Pos := (SrcLo + SrcHi) div 2;
    Result[0][0].Weight := 256;
  end
  else if Scale < 1 then
  begin
    OldScale := Scale;
    Scale := 1 / Scale;
    FilterWidth := FilterWidth * Scale;
    for I := 0 to ClipW - 1 do
    begin
      if FullEdge then
        Center := SrcLo - 0.5 + (I - DstLo + ClipLo + 0.5) * Scale
      else
        Center := SrcLo + (I - DstLo + ClipLo) * Scale;
      Left := Floor(Center - FilterWidth);
      Right := Ceil(Center + FilterWidth);
      Count := -256;
      for J := Left to Right do
      begin
        Weight := Round(256 * Filter((Center - J) * OldScale) * OldScale);
        if Weight <> 0 then
        begin
          Inc(Count, Weight);
          K := Length(Result[I]);
          SetLength(Result[I], K + 1);
          Result[I][K].Pos := [b]Constrain(J, SrcLo, SrcHi - 1);[/b]     --> hier stellt es ihn auf!!     
          Result[I][K].Weight := Weight;
        end;
      end;
     [...]

[edit=SirThornberry]Delphi-Tags gesetzt - Mfg, SirThornberry[/edit]

[SirThornberry]

bist du mal mit F7 durchgesteppt an welcher stelle es genau knallt?

[Edit]Hab den Kommentaar im Quelltext gefunden.
Wie sieht das Meckern aus? welche Meldung kommt?

Kannst du mal in die Funktion/procedure/Methode "Constrain" rein steppen an welcher Stelle es dort knallt?

[bingo72]

Delphi-Quellcode:

function Constrain(const Value, Lo, Hi: Integer): Integer;
{$IFDEF USEINLINING}
begin
  if Value < Lo then Result := Lo
  else if Value > Hi then Result := Hi
  else Result := Value;
{$ELSE}
asm
        CMP       EDX,EAX
        [b]db $0F,$4F,$C2           /// CMOVG     EAX,EDX[/b]  --> hier knallts!!
        CMP       ECX,EAX
        db $0F,$4C,$C1           /// CMOVL     EAX,ECX
{$ENDIF}
end;

Mit folgender Fehlermeldung:

Externe Exception C000001D

[bingo72]

Ja hab mit F7 durchgesteppt, um an die Stelle zu kommen!!

[bingo72]

Der Grund wie sich später herausstellte:

Der PC konnte keine 32-bit-Farben darstellen und von daher kamen die Probleme!! Also Graphics32-Komponenten auch wirklich nur bei 32-bit-Graphikkarten verwenden!!