[fpc-pascal] picture preview

Andrew Haines andrewd207 at aol.com
Wed Nov 9 00:32:46 CET 2016


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
-------------- next part --------------
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.



More information about the fpc-pascal mailing list