Graphics32 Resampler

[Manfred Polak]

Moin!

Hat hier jemand Erfahrung mit Graphics32 unter Delphi 10.2? Ich hatte
schon Schwierigkeiten, das überhaupt zu installieren (das lag an zwei
blöden Schreibfehlern in einer dpk-Datei), aber am Ende ging es doch.

Ich hab das für ein Programm installiert, das Ljapunow-Diagramme
erzeugt, wobei mehrere Threads gleichzeitig am Bild werkeln. Mit
TBitmap, das ich vorher dafür verwendet hatte, ging das so halbwegs,
aber TImage32 bzw. das darin enthaltene TBitmap32 aus Graphics32
ist threadsicher, da geht das deutlich besser. Soweit funktioniert das
alles so, wie ich es mir vorgestellt hatte.

Nun wollte ich als Zugabe einige der zahlreichen in Graphics32 enthal-
tenen Filter bzw. Resampler testen, um nach Sichtung der Ergebnisse
einen oder zwei davon dauerhaft im Programm zu belassen. Aber
nichts davon hat bei mir funktioniert. Hier mal ein Beispiel:

| procedure Form1.CubicSample;
| var CubicSampler: TKernelResampler;
| Rasterizer: TRegularRasterizer;
| begin
| Rasterizer := TRegularRasterizer.Create;
| CubicSampler := TKernelResampler.Create(Image32.Bitmap);
| CubicSampler.Kernel := TCubicKernel.Create;
| Rasterizer.Sampler := CubicSampler;
| Rasterizer.Rasterize(Image32.Bitmap);
| end;

Wenn ich das so auf das Bild loslasse, tut sich darin zwar etwas, der
Rasterizer legt also los, doch als Ergebnis erhalte ich nur ein komplett
schwarzes Bild. So auch mit Lanczos, Gauss und Linear statt Cubic
getestet, selbes Ergebnis. Auch mit TProgressiveRasterizer statt
TRegularRasterizer sowie mit Rasterize() oder TRenderThread.Create()
statt Rasterizer.Rasterize() getestet - immer wird alles schwarz.

Und noch schlimmer war es mit TSuperSampler, da legt nicht mal der
Rasterizer los, sondern es tut sich entweder gar nichts, oder es gibt
einen Stack Overflow. Jedenfalls habe ich es damit nicht geschafft,
am Image32.Bitmap überhaupt irgendeine Veränderung herbeizuführen.

Die zahlreichen Beispielprogramme in Graphics32 sind keine große
Hilfe für mich. Erstens sind zumindest die zwei oder drei, die sich mit
den Resamplern befassen, übermäßig kompliziert, so dass man (oder
zumindest ich) kaum erkennt, wie man das nun am einfachsten macht.
Zweitens kompilieren die bei mir überhaupt nicht. Jedenfalls die ersten
drei, die ich versucht habe, dann hab ich's aufgegeben.

Weiß jemand, was ich da falsch mache, und hat einen Code-Schnipsel,
der unter 10.2 funktioniert?


Manfred

[Achim Kalwa]

Hallo Manfred,

hab Deine Frage heute erst gelesen...

Post by Manfred Polak
Hat hier jemand Erfahrung mit Graphics32 unter Delphi 10.2? Ich hatte

Welche Delphi-Version hattest Du denn zuvor im Einsatz?

Post by Manfred Polak
schon Schwierigkeiten, das überhaupt zu installieren (das lag an zwei
blöden Schreibfehlern in einer dpk-Datei), aber am Ende ging es doch.

Schreib' mal einen Download-Link; ich würde mir das gerne mal ansehen.
Hilfreich wäre auch ein komplettes Beispiel-Programm.

Achim

[Manfred Polak]

Post by Achim Kalwa
hab Deine Frage heute erst gelesen...

Nicht mehr viel los hier ...

Post by Achim Kalwa

Post by Manfred Polak
Hat hier jemand Erfahrung mit Graphics32 unter Delphi 10.2? Ich hatte

Welche Delphi-Version hattest Du denn zuvor im Einsatz?

Ich hab das Paket erst für mein fragliches Programm heruntergeladen
und installiert, also nur mit 10.2 benutzt. Die aktuelle stabile Version
von Graphics32 ist schon Jahre alt, also für eine frühere Version von
Delphi geschrieben, aber ich weiß jetzt nicht, welche. Es gab aber
2017 ein paar Patches, die es für 10.2 fit machen sollten. Für die
Installation unter 10.2 ist das Verzeichnis ...\Source\Packages\RX2
zuständig. In einer der beiden dpk-Dateien darin waren die beiden
erwähnten Rechtschreibfehler ("rrequires" statt "requires" und noch
irgendwas). Ich weiß nicht, ob das inzwischen gefixt wurde.

Post by Achim Kalwa
Schreib' mal einen Download-Link; ich würde mir das gerne mal ansehen.
Hilfreich wäre auch ein komplettes Beispiel-Programm.

https://github.com/graphics32

Wie im ersten Artikel schon angedeutet, sind da viele Beispielprogramme
dabei. Für mich relevant sind v.a. \Examples\General\Mandelbrot,
\Examples\Resampling\Resamplers und \Examples\Resampling\NestedSampling.
Aber ich komme mit denen nicht so recht klar.


Manfred

[Enrico Hillmann]

Post by Manfred Polak
Hat hier jemand Erfahrung mit Graphics32 unter Delphi 10.2?

Das nicht, aber zumindest läuft es hier in einem älteren Projekt
mit Delphi 7. Da sich in Graphics32 allerdings wenig geändert hat,
sollte das keinen Unterschied machen.

Post by Manfred Polak
Nun wollte ich als Zugabe einige der zahlreichen in Graphics32 enthal-
tenen Filter bzw. Resampler testen, um nach Sichtung der Ergebnisse
einen oder zwei davon dauerhaft im Programm zu belassen. Aber
| procedure Form1.CubicSample;
| var CubicSampler: TKernelResampler;
| Rasterizer: TRegularRasterizer;
| begin
| Rasterizer := TRegularRasterizer.Create;
| CubicSampler := TKernelResampler.Create(Image32.Bitmap);
| CubicSampler.Kernel := TCubicKernel.Create;
| Rasterizer.Sampler := CubicSampler;
| Rasterizer.Rasterize(Image32.Bitmap);
| end;
Weiß jemand, was ich da falsch mache, und hat einen Code-Schnipsel,
der unter 10.2 funktioniert?

Soweit ich mich recht erinnere, kannst die Operationen nicht auf dem
Quell- Bild ausführen, sondern musst das in ein neues Bitmap ausgeben.
Ich habe Graphics32 dazu verwendet, von Bildern Thumbnails zu erstellen
(JPEG laden, verkleinern/Resampling mit Lanzcos-Filter, danach
schärfen, zum Schluß nach JPEG konvertieren und speichern).

Ich kippe die ganze Unit hier einfach mal ab, vielleicht kannst Du Dir
das ein oder andere entnehmen.

Gruß
Enrico


unit ImageResizer;

interface

uses
Classes, Graphics, GR32, GR32_Image, GR32_Resamplers, jpeg,
GR32_OrdinalMaps, GR32_Rasterizers;

type
TImageResizer = class(TObject)
private
bmpResample: TBitmap32;
bmpSharpen: TBitmap32;
bmpDest: TBitmap32;
bmpSave: TBitmap;
destFile: TJPEGImage;
Rasterizer: TRasterizer;
Convolver: TConvolver;
FDestSizeY: Integer;
FDestSizeX: Integer;
lstErrors: TStringList;
function CalcNewImageRect(Width, Height: Integer): TPoint;
public
constructor Create(DestSizeX, DestSizeY: Integer);
destructor Destroy; override;
function Resize(srcFilename, destFilename: string): Boolean;
procedure GetErrors(dest: TStrings);
procedure SetSize(X, Y: Integer);
end;

implementation

uses
SysUtils, Math;

{ TImageResizer }

constructor TImageResizer.Create(DestSizeX, DestSizeY: Integer);
var tmpResampler: TKernelResampler;
begin
inherited Create;
lstErrors:=TStringList.Create;
FDestSizeX:=DestSizeX;
FDestSizeY:=DestSizeY;
bmpResample:=TBitmap32.Create;
tmpResampler:=TKernelResampler.Create(bmpResample);
tmpResampler.Kernel:=TLanczosKernel.Create;
bmpDest:=TBitmap32.Create;
bmpDest.SetSize(DestSizeX, DestSizeY);
bmpSharpen:=TBitmap32.Create;
bmpSharpen.SetSize(DestSizeX, DestSizeY);
TNearestResampler.Create(bmpSharpen);
bmpSharpen.Resampler.PixelAccessMode:=pamTransparentEdge;
Rasterizer:=TRegularRasterizer.Create;
Convolver:=TConvolver.Create(bmpSharpen.Resampler);
Convolver.CenterX:=1;
Convolver.CenterY:=1;
Convolver.Kernel.SetSize(3,3);
Convolver.Kernel[0, 0]:=Round(-0.2*256);
Convolver.Kernel[0, 2]:=Convolver.Kernel[0, 0];
Convolver.Kernel[2, 0]:=Convolver.Kernel[0, 0];
Convolver.Kernel[2, 2]:=Convolver.Kernel[0, 0];
Convolver.Kernel[1, 1]:=Round(1.8*256);
Rasterizer.Sampler:=Convolver;

bmpSave:=TBitmap.Create;
destFile:=TJPEGImage.Create;
destFile.CompressionQuality:=90;
destFile.PixelFormat:=jf24Bit;
end;

destructor TImageResizer.Destroy;
begin
FreeAndNil(bmpResample);
FreeAndNil(bmpDest);
FreeAndNil(bmpSharpen);
FreeAndNil(Rasterizer);
FreeAndNil(Convolver);
FreeAndNil(bmpSave);
FreeAndNil(destFile);
FreeAndNil(lstErrors);
inherited Destroy;
end;

procedure TImageResizer.GetErrors(dest: TStrings);
begin
dest.AddStrings(lstErrors);
end;

function TImageResizer.CalcNewImageRect(Width, Height: Integer): TPoint;
var ratio:Double;
begin
Result.X:=FDestSizeX;
Result.Y:=FDestSizeY;
ratio:=Width/Height;
if Abs(ratio-1.333333)>0.0001 then begin
if (Width>FDestSizeX) or (Height>FDestSizeY) then begin
ratio:=Min(FDestSizeX/Width, FDestSizeY/Height);
Result.X:=Trunc(Width*ratio);
Result.Y:=Trunc(Height*ratio);
end;
end;
end;

function TImageResizer.Resize(srcFilename, destFilename: string):
Boolean; var newSize:TPoint;
deleteError: Boolean;
begin
Result:=False;
lstErrors.Clear;
if FileExists(srcFileName)
and (UpperCase(ExtractFileExt(srcFilename))='.JPG') then begin
try
deleteError:=False;
if FileExists(destFilename) then
deleteError:=not DeleteFile(destFilename);
if deleteError then
lstErrors.Add('Could''nt delete existing thumbnail: '+
ExtractFileName(destFilename))
else begin
bmpResample.SetSize(0,0);
bmpResample.LoadFromFile(srcFilename);
if (bmpResample.Width>0) and (bmpResample.Height>0) then begin
newSize:=CalcNewImageRect(bmpResample.Width,
bmpResample.Height); bmpSharpen.Width:=newSize.X;
bmpSharpen.Height:=newSize.Y;
bmpDest.Width:=newSize.X;
bmpDest.Height:=newSize.Y;
bmpSharpen.Draw(bmpSharpen.BoundsRect,
bmpResample.BoundsRect, bmpResample);
Rasterizer.Rasterize(bmpDest);
if not ForceDirectories(ExtractFilePath(destFileName)) then
lstErrors.Add('Could''nt create dir '+
ExtractFilePath(destFileName));
bmpSave.Assign(bmpDest);
destFile.Assign(bmpSave);
destFile.JPEGNeeded;
destFile.Compress;
destFile.SaveToFile(destFilename);
Result:=True;
end;
end;
except
on E:Exception do begin
lstErrors.Add(e.Message);
Result:=False;
end;
end;
end
end;

procedure TImageResizer.SetSize(X, Y: Integer);
begin
FDestSizeX:=X;
FDestSizeY:=Y;
bmpSharpen.SetSize(X, Y);
bmpDest.SetSize(X, Y);
end;

end.

[Manfred Polak]

Post by Enrico Hillmann
Soweit ich mich recht erinnere, kannst die Operationen nicht auf dem
Quell- Bild ausführen, sondern musst das in ein neues Bitmap ausgeben.
Ich habe Graphics32 dazu verwendet, von Bildern Thumbnails zu erstellen
(JPEG laden, verkleinern/Resampling mit Lanzcos-Filter, danach
schärfen, zum Schluß nach JPEG konvertieren und speichern).
Ich kippe die ganze Unit hier einfach mal ab, vielleicht kannst Du Dir
das ein oder andere entnehmen.

Danke für den Code! Übers Wochenende bin ich erst mal beschäftigt, aber
irgendwann nächste Woche werde ich es mir genauer ansehen.


Manfred