On 11/08/2016 01:51 PM, Marc Santhoff wrote:
Hi,
if I want load a bitmap picture for extracting a small preview of it,
what component or library would be best?
My goal is to use pascal only without any external lirbraries if
possible. Second goal is to keep the program small, ideally avoiding to
link lcl controls in.
Bitmap picture may be anything commen, JPEG, PNG, GIF, BMP, etc.
TIA,
Marc
Hi I attached a small program I just wrote that resizes an image and
saves it to a file. I didn't test it but it compiles. It uses just the
png reader/writer components but there are several units for different
image formats.
FPReadPNG, FPWritePNG
FPReadBMP, FPWriteBMP etc.
Regards,
Andrew Haines
program imageresize;
{$mode objfpc}
uses
Classes, FPimage, FPImgCanv, FPCanvas, FPReadPNG, FPWritePNG;
function ResizeImage(ASrcImage: TFPCustomImage; ANewWidth, ANewHeight:
Integer): TFPCustomImage;
var
Canvas: TFPImageCanvas;
begin
Result := TFPMemoryImage.Create(ANewWidth, ANewHeight);
Canvas := TFPImageCanvas.Create(Result);
Canvas.StretchDraw(0,0, ANewWidth, ANewHeight, ASrcImage);
Canvas.Free;
end;
function ReadImage(AFileName: String) : TFPCustomImage;
var
Stream: TMemoryStream;
Reader: TFPReaderPNG;
begin
Result := nil;
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(AFileName);
Stream.Seek(0, soBeginning);
// I assume png for this example
Reader := TFPReaderPNG.Create;
Result := Reader.ImageRead(Stream, nil);
finally
Stream.Free;
Reader.Free;
end;
end;
procedure SaveImage(AImage: TFPCustomImage; AFileName: String);
var
Writer: TFPWriterPNG;
F: TFileStream;
begin
F := TFileStream.Create(AFileName, fmCreate or fmOpenReadWrite);
try
Writer := TFPWriterPNG.Create;
Writer.ImageWrite(F, AImage);
finally
Writer.Free;
F.Free;
end;
end;
var
OrigImage,
NewImage: TFPCustomImage;
begin
if ParamCount < 2 then
begin
WriteLn('usage:');
WriteLn(' imageresize input.png output.png');
end;
OrigImage := ReadImage(ParamStr(1));
NewImage := ResizeImage(OrigImage, 50, 50);
SaveImage(NewImage, ParamStr(2));
OrigImage.Free;
NewImage.Free;
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
