fcl-image

{$mode objfpc}{$h+}
    program demo;
     
    uses classes, sysutils,
         FPImage, FPCanvas, FPImgCanv,
         FPWritePNG;
     
    var canvas : TFPCustomCanvas;
        image : TFPCustomImage;
        writer : TFPCustomImageWriter;
    begin
      { Create an image 100x100 pixels}
      image := TFPMemoryImage.Create (100,100);
      
      { Attach the image to the canvas }
      Canvas := TFPImageCanvas.Create (image);
      
      { Create the writer }
      Writer := TFPWriterPNG.Create;
      
      { Save to file }
      image.SaveToFile ('DrawTest.png', writer);
      
      { Clean up! }
      Canvas.Free;
      image.Free;
      writer.Free;
    end.

{$mode objfpc}{$h+}
    program demo;
     
    uses classes, sysutils,
         FPImage, FPCanvas, FPImgCanv,
         FPWritePNG;
     
    var canvas : TFPcustomCanvas;
        image : TFPCustomImage;
        writer : TFPCustomImageWriter;
        { 
          Colors range from 0 to 65535 in each primary color. 
          They can also show as hexadecimal:
          $FFFF = 65535, $0000 = 0 
        }
        passionRed: TFPColor = (Red: 65535; Green: 0; Blue: 0; Alpha: 65535);
    begin
      image := TFPMemoryImage.Create (100,100);
      Canvas := TFPImageCanvas.Create (image);
      Writer := TFPWriterPNG.Create;
    
      { Set the pen styles }
      with canvas do
      begin
        pen.mode    := pmCopy;
        pen.style   := psSolid;
        pen.width   := 1;
        pen.FPColor := passionRed;
      end;
    
      { Draw a circle }
      canvas.Ellipse (10,10, 90,90);
      
      { Save to file }
      image.SaveToFile ('DrawTest.png', writer);
      
      { Clean up! }
      Canvas.Free;
      image.Free;
      writer.Free;
    end.

program alphablend;
    uses
      FPImage, FPImgCanv, FPCanvas, FPWritePNG;
    var
      img: TFPMemoryImage;
      canvas: TFPImageCanvas;
    begin
      img := TFPMemoryImage.Create(200, 200);
      canvas := TFPImageCanvas.Create(img);
      try
        canvas.DrawingMode := dmAlphaBlend;  // This activates the alpha-blend mode
    
        // Background
        canvas.Pen.Style := psClear;
        canvas.Brush.FPColor := colWhite;
        canvas.FillRect(0, 0, img.Width, img.Height);
    
        // Yellow opaque rectangle
        canvas.Brush.FPColor := FPColor($FFFF, $FFFF, 0);
        canvas.Rectangle(10, 10, 190, 100);
    
        // Overlapping semi-transparent red circle
        canvas.Brush.FPColor := FPColor($FFFF, 0, 0, $4000);
        canvas.Ellipse(60, 60, 140, 140);
    
        // Overlapping semi-transparent blue circle
        canvas.Brush.FPColor := FPColor(0, 0, $FFFF, $8000);
        canvas.Ellipse(0, 100, 100, 200);
    
        // Save to image file
        img.SaveToFile('alphablend.png');
      finally
        canvas.Free;
        img.Free;
      end;
    end.

program FillTest;
    uses
      FPImage, FPCanvas, FPPixlCanv, FPImgCanv, FPWritePNG;
    const
      BRUSH_PATTERN: TBrushPattern = (
        $FF00FF00, $FF00FF00, $FF00FF00, $FF00FF00,
        $FF00FF00, $FF00FF00, $FF00FF00, $FF00FF00,
        $00FF00FF, $00FF00FF, $00FF00FF, $00FF00FF,
        $00FF00FF, $00FF00FF, $00FF00FF, $00FF00FF,
        $FF00FF00, $FF00FF00, $FF00FF00, $FF00FF00,
        $FF00FF00, $FF00FF00, $FF00FF00, $FF00FF00,
        $00FF00FF, $00FF00FF, $00FF00FF, $00FF00FF,
        $00FF00FF, $00FF00FF, $00FF00FF, $00FF00FF
      );
    var
      image: TFPMemoryImage;
      canvas: TFPImageCanvas;
      writer: TFPCustomImageWriter;
    begin
      image := TFPMemoryImage.Create(100, 100);
      try
        canvas := TFPImageCanvas.Create(image);
        try
          // Prepare the brush for the shape interior
          canvas.Brush.Style := bsPattern;
          canvas.Brush.FPColor := colBlue;
          canvas.Brush.Pattern := BRUSH_PATTERN;
    
          // Prepare the pen for the shape border
          canvas.Pen.Style := psSolid;
          canvas.Pen.Width := 3;
          canvas.Pen.FPColor := colDkBlue;
    
          // Fill shape
          canvas.Rectangle(10, 10, 90, 90);
    
          // Save to file
          writer := TFPWriterPNG.Create;
          try
            // Activate alpha channel in saved image
            TFPWriterPNG(writer).UseAlpha := true;
            image.SaveToFile('rectangle.png', writer);
          finally
            writer.Free;
          end;
    
        finally
          canvas.Free;
        end;
    
      finally
        image.Free;
      end;
    end.

uses
      FPImage, FPCanvas, FPImgCanv;
    
    type
      TGradientDir = (gdHorizontal, gdVertical);
    
    procedure GradientFill(Canvas: TFPCustomCanvas; ARect: TRect; AStartColor, AEndColor: TFPColor; ADirection: TGradientDir);
    
      function InterpolateColor(x, xmax: Integer): TFPColor;
      var
        factor1, factor2: Single;
      begin
        factor2 := x / xmax;
        factor1 := 1.0 - factor2;
        Result.Red := trunc(AStartColor.Red * factor1 + AEndColor.Red * factor2);
        Result.Green := trunc(AStartColor.Green * factor1 + AEndColor.Green * factor2);
        Result.Blue := trunc(AStartColor.Blue * factor1 + AEndColor.Blue * factor2);
        Result.Alpha := trunc(AStartColor.Alpha * factor1 + AEndColor.Alpha * factor2);
      end;
    
    var
      x, y, max: Integer;
      color: TFPColor;
    begin
      if ADirection = gdHorizontal then
      begin
        max := ARect.Right - ARect.Left;
        for x := ARect.Left to ARect.Right do
        begin
          color := InterpolateColor(x - ARect.Left, max);
          for y := ARect.Top to ARect.Bottom do
            Canvas.DrawPixel(x, y, color);
        end;
      end else
      begin
        max := ARect.Bottom - ARect.Top + 1;
        for y := ARect.Top to ARect.Bottom do
        begin
          color := InterpolateColor(y - ARect.Top, max);
          for x := ARect.Left to ARect.Right do
            Canvas.DrawPixel(x, y, color);
        end;
      end;
    end;

program alphablend;
    uses
      FPImage, FPImgCanv, FPCanvas, FPWritePNG;
    var
      img: TFPMemoryImage;
      canvas: TFPImageCanvas;
    begin
      img := TFPMemoryImage.Create(200, 200);
      canvas := TFPImageCanvas.Create(img);
      try
        canvas.DrawingMode := dmAlphaBlend;  // This activates the alpha-blend mode
    
        // Background
        canvas.Pen.Style := psClear;
        canvas.Brush.FPColor := colWhite;
        canvas.FillRect(0, 0, img.Width, img.Height);
    
        // Yellow opaque rectangle
        canvas.Brush.FPColor := FPColor($FFFF, $FFFF, 0);
        canvas.Rectangle(10, 10, 190, 100);
    
        // Overlapping semi-transparent red circle
        canvas.Brush.FPColor := FPColor($FFFF, 0, 0, $4000);
        canvas.Ellipse(60, 60, 140, 140);
    
        // Overlapping semi-transparent blue circle
        canvas.Brush.FPColor := FPColor(0, 0, $FFFF, $8000);
        canvas.Ellipse(0, 100, 100, 200);
    
        img.SaveToFile('alphablend.png');
      finally
        canvas.Free;
        img.Free;
      end;
    end.

program fontdraw;
    
    {$mode objfpc}{$H+}
    
    uses
      Classes, SysUtils, FPimage, FPImgCanv, FTFont, FPWritePNG, FPCanvas;
    
    procedure TestFPImgFont;
    var
      Img: TFPMemoryImage;
      Writer: TFPWriterPNG;
      ms: TMemoryStream;
      ImgCanvas: TFPImageCanvas;
      AFont: TFreeTypeFont;
    begin
      Img:=nil;
      ImgCanvas:=nil;
      Writer:=nil;
      ms:=nil;
      AFont:=nil;
      try
        // initialize free type font manager
        FTFont.InitEngine;
        FontMgr.SearchPath:='/usr/share/fonts/truetype/ttf-dejavu/';  // not needed on Windows
        AFont:=TFreeTypeFont.Create;
    
        // create an image of width 200, height 100
        Img:=TFPMemoryImage.Create(200,100);
        Img.UsePalette:=false;
        // create the canvas with the drawing operations
        ImgCanvas:=TFPImageCanvas.Create(Img);
    
        // paint white background
        ImgCanvas.Brush.FPColor:=colWhite;
        ImgCanvas.Brush.Style:=bsSolid;
        ImgCanvas.Rectangle(0,0,Img.Width-1,Img.Height-1);
    
        // paint text
        ImgCanvas.Font:=AFont;
        ImgCanvas.Font.Name:='DejaVuSans';
        ImgCanvas.Font.Size:=20;
        ImgCanvas.TextOut(10,30,'Test');
    
        // write image as png to memory stream
        Writer:=TFPWriterPNG.create;
        ms:=TMemoryStream.Create;
        writer.ImageWrite(ms,Img);
        // write memory stream to file
        ms.Position:=0;
        ms.SaveToFile('testfont.png');
      finally
        AFont.Free;
        ms.Free;
        Writer.Free;
        ImgCanvas.Free;
        Img.Free;
      end;
    end;
    
    begin
      TestFPImgFont;
    end.

uses
      fpreadgif, fpimage;
    
    var
      image: TFPCustomImage;
      reader: TFPCustomImageReader;
    begin
      Image := TFPMemoryImage.Create(10, 10);
      Reader := TFPReaderGIF.Create;
      Image.LoadFromFile(AFileName, Reader);
      // ...

uses
      fpreadgif, fpimage, fpwritebmp;
    
    var
      image: TFPCustomImage;
      reader: TFPCustomImageReader;
      writer: TFPCustomImageWriter;
    begin
      Image := TFPMemoryImage.Create(10, 10);
      Reader := TFPReaderGIF.Create;
      Writer := TFPWriterBMP.Create;
    
      Image.LoadFromFile(AFileName, Reader);
      Image.SaveToFile(ADestFileName, Writer);
      //...

program project1;
    uses
      FPImage, FPCanvas, FPImgCanv, FPReadJPEG, FPWriteJPEG;
    const
      FILE_NAME = 'cheetah.jpg';
      MAX_SIZE = 512;
    var
      srcImg, destImg: TFPMemoryImage;
      canvas: TFPImageCanvas;
      scaleFactor: Double;
    begin
      // Create and load the source image
      srcImg := TFPMemoryImage.Create(0, 0);
      srcImg.LoadFromFile(FILE_NAME);
    
      // Calculate the image scaling factor
      if srcImg.Width > srcImg.Height then
        scaleFactor := MAX_SIZE / srcImg.Width
      else
        scaleFactor := MAX_SIZE / srcImg.Height;
    
      // Create the destination image in the requested size
      destimg := TFPMemoryImage.Create(round(srcImg.Width*scaleFactor), round(srcImg.Height*scaleFactor));
    
      // Create a canvas for the destination image ...
      canvas := TFPImageCanvas.Create(destImg);
    
      // ... and an interpolation
      canvas.Interpolation := TFPBaseInterpolation.Create;
    
      // Use the interpolation to stretch the source image to the new size
      canvas.StretchDraw(0, 0, destImg.Width, destImg.Height, srcImg);
    
      // Save destination image to file
      destImg.SaveToFile('resized.jpg');
    
      // Clean up
      canvas.Interpolation.Free;
      canvas.Free;
      destImg.Free;
      srcImg.Free;
    end.

uses
      Types, Math, FPImage, GraphMath;
    
    function CreateRotatedImage(AImage: TFPMemoryImage; Angle: Double): TFPMemoryImage; // Angle is in radians
    var
      R: TRect;
      x, y: Integer;
      C, P: TPoint;
      delta: TPoint;
    begin
      // Calculate bounds of the rotated image
      R := RotateRect(AImage.Width, AImage.Height, Angle);
      OffsetRect(R, -R.Left, -R.Top);
    
      // Calculate center of rotated image
      C := Point((R.Left + R.Right) div 2, (R.Top + R.Bottom) div 2);
    
      // Create the resulting image.
      Result := TFPMemoryImage.Create(R.Right - R.Left, R.Bottom - R.Top);
    
      // Correction needed to center the rotated pixels
      delta := Point((AImage.Width - Result.Width) div 2, (AImage.Height - Result.Height) div 2);
    
      // Iterate over all pixels in the result image and look up the corresponding
      // pixels in the unrotated image. Pixels in the rotated image which are outside
      // the unrotated image are set to be transparent.
      for y := 0 to Result.Height-1 do
        for x := 0 to Result.Width-1 do
        begin
          P := RotatePoint(Point(x, y) - C, -Angle) + C;
          P := P + delta;
          if (P.X >= 0) and (P.Y >= 0) and (P.X < AImage.Width) and (P.Y < AImage.Height) then
            Result.Colors[x, y] := AImage.Colors[P.X, P.Y]
          else
            Result.Colors[x, y] := colTransparent;
        end;
    end;

program PaletteBMP;
    
    {$mode objfpc}{$H+}
    
    uses
      classes, fpcanvas, fpimage, fpimgcanv, fpwritebmp;
    
    var
      img: TFPMemoryImage;
      cnv: TFPImageCanvas;
      writer: TFPCustomimageWriter;
    begin
      img := TFPMemoryImage.Create(100, 100);
      try
        img.UsePalette := true;      // IMPORTANT!
        // colBlack is always available at index 0.
        img.Palette.Add(colYellow);  // Index 1
        img.Palette.Add(colBlue);    // Index 2
        img.Palette.Add(colGreen);   // Index 3
    
        cnv := TFPImageCanvas.Create(img);
        try
          cnv.Brush.FPColor := colYellow;
          cnv.Rectangle(10, 10, 45, 45);
    
          cnv.Brush.FPColor := colBlue;
          cnv.Rectangle(55, 10, 90, 45);
    
          cnv.Brush.FPColor := img.Palette[3];
          cnv.Rectangle(10, 55, 45, 90);
    
          cnv.Brush.FPColor := colWhite;  // not yet in palette
          cnv.Rectangle(55, 55, 90, 90);
        finally
          cnv.Free;
        end;
    
        writer := TFPWriterBMP.Create;
        TFPWriterBMP(writer).BitsPerPixel := 8;
        try
          img.SaveToFile('test-8bpp.bmp', writer);
        finally
          writer.Free;
        end;
      finally
        img.Free;
      end;
    end.

uses
      fpimage, fpimgcanv, fpreadbmp, fpwritebmp, fpquantizer, fpditherer;
    
    procedure ReduceColors(SourceFile, TargetFile:String; BitsPerPixel: Integer);
    var
      sourceImg, targetImg: TFPMemoryImage;
      reader: TFPReaderBMP;
      writer: TFPWriterBMP;
      quantizer: TFPMedianCutQuantizer = nil;
      palette: TFPPalette = nil;
      ditherer: TFPFloydSteinbergDitherer = nil;
    begin
      if FileExists(SourceFile) then begin
        sourceImg := TFPMemoryImage.Create(0,0);
        targetImg := TFPMemoryImage.Create(0,0);
        reader := TFPReaderBMP.Create;
        writer := TFPWriterBMP.Create;
        try
          sourceImg.LoadFromFile(SourceFile);
          quantizer  := TFPMedianCutQuantizer.Create;
          quantizer.ColorNumber := 1 shl BitsPerPixel;
          quantizer.Add(sourceImg);
          palette := quantizer.Quantize;
          ditherer := TFPFloydSteinbergDitherer.Create(palette);
          ditherer.Dither(sourceImg, targetImg);
          writer.BitsPerPixel := BitsPerPixel;
          targetImg.SaveToFile(TargetFile, writer);
        finally
          ditherer.Free;
          palette.Free;
          quantizer.Free;
          writer.Free;
          reader.Free;
          targetImg.Free;
          sourceImg.Free;
        end;
      end;
    end;

uses
      SysUtils,
      fpimage, fpimgcanv, fpreadbmp, fpwritebmp, fpditherer;
    
    procedure BlackAndWhite(SourceFile, TargetFile:String);
    var
      sourceImg, targetImg: TFPMemoryImage;
      reader: TFPReaderBMP;
      writer: TFPWriterBMP;
      palette: TFPPalette = nil;
      ditherer: TFPFloydSteinbergDitherer = nil;
    begin
      sourceImg := TFPMemoryImage.Create(0,0);
      targetImg := TFPMemoryImage.Create(0,0);
      reader := TFPReaderBMP.Create;
      writer := TFPWriterBMP.Create;
      try
        sourceImg.LoadFromFile(SourceFile);
        palette := TFPPalette.Create(2);
        palette.Add(colBlack);
        palette.Add(colWhite);
        ditherer := TFPFloydSteinbergDitherer.Create(palette);
        ditherer.Dither(sourceImg, targetImg);
        writer.BitsPerPixel := 1;
        targetImg.SaveToFile(TargetFile, writer);
      finally
        ditherer.Free;
        palette.Free;
        writer.Free;
        reader.Free;
        targetImg.Free;
        sourceImg.Free;
      end;
    end;

uses
      fpimage, fpreadjpeg, fpwritejpeg, math;
    
    procedure GammaCorrection(const ASrcFile, ADestFile: String; AGamma: Double);
    var
      img: TFPMemoryImage;
      reader: TFPCustomImageReader;
      writer: TFPCustomImageWriter;
      i, j: Integer;
      clr: TFPColor;
    begin
      Assert(AGamma <> 0.0);
    
      img := TFPMemoryImage.Create(0, 0);
      try
        reader := TFPReaderJpeg.Create;
        try
          img.LoadFromFile(ASrcFile, reader);
        finally
          reader.Free;
        end;
    
        for j := 0 to img.Height - 1 do
          for i := 0 to img.Width - 1 do
          begin
            clr := img.Colors[i, j];
            clr.Red := round(((clr.Red / 65535)**AGamma)*65535);
            clr.Green := round(((clr.Green / 65535)**AGamma)*65535);
            clr.Blue := round(((clr.Blue / 65535)**AGamma)*65535);
            img.Colors[i, j] := clr;
          end;
    
        writer := TFPWriterJpeg.Create;
        try
          img.SaveToFile(ADestFile, writer);
        finally
          writer.Free;
        end;
      finally
        img.Free;
      end;
    end;

program qrcode_as_imagefile;
    uses
      fpqrcodegen, fpimgqrcode, fpWritePng;
    const
      TEXT_STRING = 'This is a qrcode generated by fpc.';
      FILE_NAME = 'qrcode.png';
    var
      qrcode: TImageQRCodeGenerator;
    begin
      qrcode := TImageQRCodeGenerator.Create;
      try
        qrcode.PixelSize := 4;
        qrcode.Border := 8;
        qrcode.ErrorCorrectionLevel := EccHigh;
        qrcode.Generate(TEXT_STRING);
        qrcode.SaveToFile(FILE_NAME);
      finally
        qrcode.Free;
      end;
    end.

program code25_as_image_file;
    uses
      Types, fpImage, fpBarCode, fpImgBarCode, fpWritePng;
    const
      HEIGHT = 60;
      NUMERIC_TEXT = '0123456789';
      ENCODING = be2of5Industrial;
      UNIT_WIDTH = 2;
      WEIGHT = 4;
      FILE_NAME = 'barcode.png';
    var
      barcode: TFPDrawBarcode;
      width: Integer;
    begin
      barcode := TFPDrawBarcode.Create;
      try
        barcode.Encoding := ENCODING;
        barcode.UnitWidth := UNIT_WIDTH;
        barcode.Weight := WEIGHT;
        barcode.Text := NUMERIC_TEXT;
        width := barcode.CalcWidth;
        barcode.Rect := Rect(0, 0, width, HEIGHT);
        barcode.Image := TFPCompactImgGray8Bit.Create(barcode.Rect.Width, barcode.Rect.Height);
        try
          if barcode.Draw then
          begin
            barcode.Image.SaveToFile(FILE_NAME);
            WriteLn('Saved to file ', FILE_NAME);
          end else
            WriteLn('Error generating barcode.');
        finally
          barcode.Image.Free;
        end;
      finally
        barcode.Free;
      end;
    end.

Size := TFPReaderJPEG.ImageSize(stream);

uses
      [...] fpImage, fpReadJpeg, fpReadBMP, fpReadPNG, fpReadGIF, fpReadPCX, fpReadTIFF, fpReadTGA;
     
    function GetImageSize(const AFileName: String; out ASize: TPoint): Boolean;
    var
      stream: TStream;
      readerClass: TFPCustomImageReaderClass;
    begin
      Result := false;
      ASize := Point(-1, -1);
      stream := TFileStream.Create(AFileName, fmOpenRead);
      try
        readerClass := TFPCustomImage.FindReaderFromStream(stream);
        if readerClass <> nil then
        begin
          ASize := readerClass.ImageSize(stream);
          Result := true;
        end;
      finally
        stream.Free;
      end;
    end;