Einzelnen Beitrag anzeigen

Benutzerbild von Jelly
Jelly

Registriert seit: 11. Apr 2003
Ort: Moestroff (Luxemburg)
3.741 Beiträge
 
Delphi 2007 Professional
 
#7

Re: Thumbnail erstellen mit bicubic verfahren.

  Alt 29. Aug 2006, 13:54
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 ;
  Mit Zitat antworten Zitat