AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi Thumbnail erstellen mit bicubic verfahren.
Thema durchsuchen
Ansicht
Themen-Optionen

Thumbnail erstellen mit bicubic verfahren.

Ein Thema von shifter · begonnen am 29. Aug 2006 · letzter Beitrag vom 30. Aug 2006
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:35 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz