Thumbnail erstellen mit bicubic verfahren.

[shifter]

Hallo,

ich versuche seit längeren Zeit eine möglichkeit zu finden Thumb's zu erstellen. Wenn ich auf den normalen weg Bilder verkleinere bekommt man zimlich schlechte qualität.
Wenn ich Bilder mit dem Photoshop verkleinere gibts da ne möglichkeit das Bild neu zu berechnen mit Bikubisch diese verfahren liefert die beste qualität.
Unter PHP kann man ohne weiteres die GD Library nutzen damit ist man auch gut bedient.

Gibt's ne möglichkeit mit Delphi sowas zu realizieren ? Na gut die möglichkeit gibt's mit sicherheit - aber wie ?


Mfg
Seba

[teebee]

In der JCL gibt es die unit jclgraphics.pas, dort gibt es eine Funktion Stretch, die verschiedene Algorithmen erlaubt. Normalerweise ist schon das schnellste Verfahren immernoch besser als StretchDraw aus der VCL.

Download hier

Gruß, teebee

EDIT: Link hinzugefügt

[Jelly]

Oder man verwendet die Graphics32 Bibliothek.

[teebee]

Ich habe vor einiger Zeit mal getestet, und festgestellt, dass das Verkleinern von sehr großen Bildern mit der Graphics32 viel langsamer war als mit der jclgraphics. Ob das mit der aktuellen Version immernoch so ist, weiß ich allerdings nicht.

Gruß, teebee

[Jelly]

Das kann natürlich sein, nur die Frage ist, ob da relevant ist.
Mir persönlich ist die JVCL (JCL) einfach zu überladen, und hab die deshalb nicht installiert.

[shifter]

Erstman möchte ich mich bedanken bei euch für die Antworten.
Ich werde natürlich alle möglichkeiten mir sofort angucken,
in prinzip ist mir die Qualität wichtiger als geschwindigkeit,
wobei mann muss es auswiegen :).

Zitat:

Zitat von Jelly

Oder man verwendet die Graphics32 Bibliothek.

Kannst Du mir Tip geben wie sich es Anwendet ?



Gruss
seba

[Jelly]

Zitat:

Zitat von shifter

Kannst Du mir Tip geben wie sich es Anwendet ?

Hier ein schneller, unsauberer, unkommentierter, funktionierender Code :-)
Ist dazu gedacht, vom aktuellen Fenster ein Screenshot zu schiessen, und diesen sowohl in Originalgrösse als auch als Thumbnail zu speichern.

Auf dem Form brauchts ein TImage32, Name: img... Die Breite des img wird genutzt für die Thumbnailgrösse, die Höhe wird skaliert.

Delphi-Quellcode:

procedure TForm1.MakeScreenShot;
var
  B: TBitmap;
  B2 : TBitMap ;
  S: string;
  H : THandle ;
  R, RClient : TRect ;
  Thumb : TBitmap32 ;
  JPeg, ThumbJpeg : TJPEGImage ;
  FN : string ;
  Dir, Root, BMP, tnBMP, JPG, tnJPG : string ;

  function AnyFileExists (Root : string) : boolean ;
  begin
       if FileExists (Root + '.jpg') or
          FileExists (Root + '.bmp')
       then Result := true
       else Result := false ;
  end ;

  function Makefilename (Orig : string) : string ;
  var
   F : string ;
   T : string ;
   i, p : integer ;
  begin
       F := includetrailingbackslash (extractFilePath (application.exename)) ;
       F := F + 'ScreenShots\' ;
       forcedirectories (F) ;
       p := pos ('%D',uppercase(Orig)) ;
       if p <> 0 then begin
          Delete (Orig,p,2) ;
          Insert ('%.2d',Orig,p) ;
          F := F + Orig ;
          i := 1 ;
          Result := Format (F,[i]) ;
          while AnyFileExists (Result) do begin
             i := i + 1 ;
             Result := Format (F,[i]) ;
          end ;
       end else begin
          Result := F + Orig ;
       end ;
  end ;

  procedure ResizeImage(Dst, Src: TBitmap32; const NewWidth: integer);
  var
  Percent : single ;
  begin
       Percent := NewWidth / Src.Width ;
       if Percent = 1 then Dst.Assign(Src)
       else begin
           with Dst do begin
              SetSize(Max(Round(Src.Width * Percent), 1), Max(Round(Src.Height * Percent), 1));
             Draw(Rect(0, 0, Width, Height), Rect(0, 0, Src.Width, Src.Height),
             Src);
           end;
       end;
  end;

begin
  H := GetForeGroundWindow ;
  //H := GetActiveWindow ;

  if H <> 0 then begin
      GetWindowRect (H,R) ;

      FN := MakeFileName (txtFN.text) ;
      Root := ExtractFilename (FN) ;
      Dir := IncludeTrailingBackSlash (ExtractFilePath(FN)) ;
      Root := copy (Root,1,length(Root)-length(ExtractFileExt(Root))) ;
      BMP := FN + '.bmp' ;
      JPG := FN + '.jpg' ;
      tnBMP := Dir + 'tn_' + Root + '.bmp' ;
      tnJPG := Dir + 'tn_' + Root + '.jpg' ;

      { Screencapture in Image1 zeichnen }
      B := Image1.Picture.Bitmap ;
      B.Width := R.Right-R.Left ;
      B.Height := R.Bottom-R.Top ;
      BitBlt(B.Canvas.handle, 0,0 , B.Width, B.Height, GetDc(0), R.left, R.Top, SRCCOPY);

      { Graphics32 nutzen zum Thumbnail erstellen aus Image1 }
      img.Bitmap.Assign(Image1.Picture);
      img.Bitmap.resampler := TDraftResampler.Create (img.Bitmap) ;
      img.ScaleMode := smResize ;

      { Vollbild speichern }
      if chkBMP.Checked then image1.Picture.SaveToFile(BMP);
      JPeg := TJPegImage.create ;
      JPeg.CompressionQuality := StrToInt (txtQuality.text) ;
      JPeg.Assign (B) ;
      if chkJPG.checked then JPeg.SaveToFile (JPG) ;
      JPeg.free ;

      { Thumbnail speichern }
      Thumb := TBitMap32.Create ;
      ResizeImage (Thumb,Img.Bitmap,Img.Width) ;
      if chkBMP.Checked then Thumb.SaveToFile(tnBMP);
      B2 := TBitmap.create ;
      JPeg := TJPegImage.create ;
      B2.Assign(Thumb);
      JPeg.CompressionQuality := StrToInt (txtQuality.text) ;    // 0-100
      JPeg.Assign (B2) ;
      if chkJPG.checked then JPeg.SaveToFile (tnJPG) ;
      JPeg.free ;
      B2.free ;
  end ;
end ;

[shifter]

Hi,

DANKE erstmal für den SourceCode,
ich finde hier aber nicht wo man den Algorithmen einstellen kann.

Macht er das Standart messig mit Bikubisch ?

gruss
seba

[shifter]

Hi,

ich habe mir den Graphics32 etwas zu brust genommen,

das ist der hammer schlecht hin !

Ich bedanke mich bei Euch allen für Eure hilfe,
und bis demnächst.

Grüsse aus Wuppertal.

[Jelly]

Zitat:

Zitat von shifter

Macht er das Standart messig mit Bikubisch ?

Keine Ahnung ?
Bei den älteren Versionen von der Lib konnte man das recht leicht einstellen, über

Delphi-Quellcode:

img.Bitmap.StretchFilter := sfLinear ;

Bei der letzten Version jedoch läuft das jetzt über

Delphi-Quellcode:

img.Bitmap.resampler := TDraftResampler.Create (img.Bitmap) ;

Was es alles an Resampler gibt, weiss ich nicht... Würd mich aber auch freuen, wenn mir da einer Näheres zu erzählen könnt.