Registriert seit: 11. Apr 2003
Ort: Moestroff (Luxemburg)
3.741 Beiträge
Delphi 2007 Professional
|
Re: Thumbnail erstellen mit bicubic verfahren.
29. Aug 2006, 14: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 ;
|