Bisher habe ich in meinem Programm (Delphi 6 Personal) zur Größenänderung von JPGs die Routine Stretchdraw verwendet (s.u.).
Diese habe ich mit
resizepictur(quelldname,savedname,breit, hoch,compression);
aufgerufen; quelldname und savedname sind Strings, breit, hoch und compression sind Integer.
Nun liefert Stretchdraw nur mäßige Bildqualität, so dass ich gerne die immer wieder empfohlene Prozedur Stretch (s.u.: unit resample.pas von Anders Melander) verwenden möchte.
Ich rufe diese Prozedur (s.u.) auf mit:
Stretch(bmpalt, bmpneu, TriangleFilter, dstwidth);
Das läuft zwar ohne Fehlermeldungen; ich erhalte damit aber nur ein weißes JPEG (allerdings immerhin mit den richtigen Abmessungen).
Was mache ich falsch? Für einen Tipp wäre ich sehr dankbar.
Mit freundlichem Gruß
JEPPES
============================================================
[CODE]
//(bisherige) Prozedur mit Stretchdraw:
procedure TForm1.resizepictur(dir: string; savename:string; width, height,compression1: integer);
var i,newheight,newwidth:integer;
bmp:TBitmap;
jpeg:TJpegImage;
jpegratio,newheights:single;
path,dir2:string;
aendern: boolean;
begin
Jpeg:=TJpegImage.Create;
try
path := extractfilepath(dir);
dir2 := extractfilename(dir);
if (path = ‚‘) then
dir := edit1.text + ‚/‘ + dir2;
jpeg.LoadFromFile(dir);
bmp:=TBitmap.Create;
jpegratio := jpeg.width/jpeg.height;
aendern := true;
try
If jpeg.width>jpeg.Height then //Breitformat
begin
bmp.width:=round(height * jpegratio);
bmp.height:=height;
if jpeg.height = height then aendern := false;
end
else
begin //Hochformat
bmp.width:=round(width * jpegratio);
bmp.Height:=width;
if jpeg.height = width then aendern := false;
end;
application.ProcessMessages;
if aendern then
begin
bmp.canvas.StretchDraw(Rect(0,0,bmp.width,bmp.height),jpeg);
jpeg.compressionquality := compression1;
jpeg.assign(bmp);
end;
finally
bmp.free;
end;
jpeg.SavetoFile(savename);
finally
jpeg.free;
end;
end;
//====================================================================
unit resample;
// -----------------------------------------------------------------------------
// Project: bitmap resampler
// Module: resample
// Description: Interpolated Bitmap Resampling using filters.
// Version: 01.02
// Release: 3
// Date: 15-MAR-1998
// Target: Win32, Delphi 2 & 3
// Author(s): anme: Anders Melander, [email protected]
// Copyright © 1997,98 by Anders Melander
// Formatting: 2 space indent, 8 space tabs, 80 columns.
// -----------------------------------------------------------------------------
// This software is copyrighted as noted above. It may be freely copied,
// modified, and redistributed, provided that the copyright notice(s) is
// preserved on all copies.
//
// There is no warranty or other guarantee of fitness for this software,
// it is provided solely „as is“. Bug reports or fixes may be sent
// to the author, who may or may not act on them as he desires.
//
// You may not include this software in a program or other software product
// without supplying the source, or without informing the end-user that the
// source is available for no extra charge.
//
// If you modify this software, you should include a notice in the „Revision
// history“ section giving the name of the person performing the modification,
// the date of modification, and the reason for such modification.
// -----------------------------------------------------------------------------
// Here’s some additional copyrights for you:
//
// From filter.c:
// The authors and the publisher hold no copyright restrictions
// on any of these files; this source code is public domain, and
// is freely available to the entire computer graphics community
// for study, use, and modification. We do request that the
// comment at the top of each file, identifying the original
// author and its original publication in the book Graphics
// Gems, be retained in all programs that use these files.
//
// -----------------------------------------------------------------------------
// Revision history:
//
// 0100 110997 anme - Adapted from fzoom v0.20 by Dale Schumacher.
//
// 0101 110198 anme - Added Lanczos3 and Mitchell filters.
// - Fixed range bug.
// Min value was not checked on conversion from Single to
// byte.
// - Numerous optimizations.
// - Added TImage stretch on form resize.
// - Added support for Delphi 2 via TCanvas.Pixels.
// - Renamed module from stretch to resample.
// - Moved demo code to separate module.
//
// 0102 150398 anme - Fixed a problem that caused all pixels to be shifted
// 1/2 pixel down and to the right (in source
// coordinates). Thanks to David Ullrich for the
// solution.
// -----------------------------------------------------------------------------
// Credits:
// The algorithms and methods used in this library are based on the article
// „General Filtered Image Rescaling“ by Dale Schumacher which appeared in the
// book Graphics Gems III, published by Academic Press, Inc.
//
// The edge offset problem was fixed by:
// * David Ullrich
// -----------------------------------------------------------------------------
// To do (in rough order of priority):
// * Implement Dale Schumacher’s „Optimized Bitmap Scaling Routines“.
// * Fix BoxFilter.
// * Optimize to use integer math instead of floating point where possible.
// -----------------------------------------------------------------------------
interface
// If USE_SCANLINE is defined, Stretch will use the TBitmap.Scanline property
// instead of TBitmap.Canvas.Pixels to access the bitmap pixels.
// Use of the Scanline property is 20 to 50 times faster than the Pixels
// property!
{$DEFINE USE_SCANLINE}
uses
SysUtils, Classes, Graphics;
type
// Type of a filter for use with Stretch()
TFilterProc = function(Value: Single): Single;
// Sample filters for use with Stretch()
function SplineFilter(Value: Single): Single;
function BellFilter(Value: Single): Single;
function TriangleFilter(Value: Single): Single;
function BoxFilter(Value: Single): Single;
function HermiteFilter(Value: Single): Single;
function Lanczos3Filter(Value: Single): Single;
function MitchellFilter(Value: Single): Single;
// Interpolator
// Src: Source bitmap
// Dst: Destination bitmap
// filter: Weight calculation filter
// fwidth: Relative sample radius
procedure Stretch(Src, Dst: TBitmap; filter: TFilterProc; fwidth: single);
// -----------------------------------------------------------------------------
//
// List of Filters
//
// -----------------------------------------------------------------------------
const
ResampleFilters: array[0…6] of record
Name: string; // Filter name
Filter: TFilterProc;// Filter implementation
Width: Single; // Suggested sampling width/radius
end = (
(Name: ‚Box‘; Filter: BoxFilter; Width: 0.5),
(Name: ‚Triangle‘; Filter: TriangleFilter; Width: 1.0),
(Name: ‚Hermite‘; Filter: HermiteFilter; Width: 1.0),
(Name: ‚Bell‘; Filter: BellFilter; Width: 1.5),
(Name: ‚B-Spline‘; Filter: SplineFilter; Width: 2.0),
(Name: ‚Lanczos3‘; Filter: Lanczos3Filter; Width: 3.0),
(Name: ‚Mitchell‘; Filter: MitchellFilter; Width: 2.0)
);
implementation
uses
math;
// -----------------------------------------------------------------------------
//
// Filter functions
//
// -----------------------------------------------------------------------------
// Hermite filter
function HermiteFilter(Value: Single): Single;
begin
// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 -0.5) and (Value 0.0) then
begin
Value := Value * Pi;
Result := sin(Value) / Value
end else
Result := 1.0;
end;
begin
if (Value = SrcWidth) then
n := SrcWidth - j + SrcWidth - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end else
// Horizontal super-sampling
// Scales from smaller to bigger width
begin
for i := 0 to DstWidth-1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
center := i / xscale;
// Original code:
// left := ceil(center - fwidth);
// right := floor(center + fwidth);
left := floor(center - fwidth);
right := ceil(center + fwidth);
for j := left to right do
begin
weight := filter(center - j);
if (weight = 0.0) then
continue;
if (j = SrcWidth) then
n := SrcWidth - j + SrcWidth - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end;
// ----------------------------------------------------
// Apply filter to sample horizontally from Src to Work
// ----------------------------------------------------
for k := 0 to SrcHeight-1 do
begin
{$IFDEF USE_SCANLINE}
SourceLine := Src.ScanLine[k];
DestPixel := Work.ScanLine[k];
{$ENDIF}
for i := 0 to DstWidth-1 do
begin
rgb.r := 0.0;
rgb.g := 0.0;
rgb.b := 0.0;
for j := 0 to contrib^[i].n-1 do
begin
{$IFDEF USE_SCANLINE}
color := SourceLine^[contrib^[i].p^[j].pixel];
{$ELSE}
color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]);
{$ENDIF}
weight := contrib^[i].p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
if (rgb.r > 255.0) then
color.r := 255
else if (rgb.r 255.0) then
color.g := 255
else if (rgb.g 255.0) then
color.b := 255
else if (rgb.b = SrcHeight) then
n := SrcHeight - j + SrcHeight - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end
end else
// Vertical super-sampling
// Scales from smaller to bigger height
begin
for i := 0 to DstHeight-1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
center := i / yscale;
// Original code:
// left := ceil(center - fwidth);
// right := floor(center + fwidth);
left := floor(center - fwidth);
right := ceil(center + fwidth);
for j := left to right do
begin
weight := filter(center - j);
if (weight = 0.0) then
continue;
if (j = SrcHeight) then
n := SrcHeight - j + SrcHeight - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end;
// --------------------------------------------------
// Apply filter to sample vertically from Work to Dst
// --------------------------------------------------
{$IFDEF USE_SCANLINE}
SourceLine := Work.ScanLine[0];
Delta := integer(Work.ScanLine[1]) - integer(SourceLine);
DestLine := Dst.ScanLine[0];
DestDelta := integer(Dst.ScanLine[1]) - integer(DestLine);
{$ENDIF}
for k := 0 to DstWidth-1 do
begin
{$IFDEF USE_SCANLINE}
DestPixel := pointer(DestLine);
{$ENDIF}
for i := 0 to DstHeight-1 do
begin
rgb.r := 0;
rgb.g := 0;
rgb.b := 0;
// weight := 0.0;
for j := 0 to contrib^[i].n-1 do
begin
{$IFDEF USE_SCANLINE}
color := PColorRGB(integer(SourceLine)+contrib^[i].p^[j].pixel*Delta)^;
{$ELSE}
color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]);
{$ENDIF}
weight := contrib^[i].p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
if (rgb.r > 255.0) then
color.r := 255
else if (rgb.r 255.0) then
color.g := 255
else if (rgb.g 255.0) then
color.b := 255
else if (rgb.b