[Lazarus] TImage does not load png file

Edilson Vieira vieira.edilson at gmail.com
Wed Aug 28 06:49:20 CEST 2013


Hi guys!

I did a very simple program to see what happens with colors between TColor
and TFPColor.

The program has just one main form that shows four panels and a TImage
object, generates a png image file containing four rectangles with the
'same' color as the panels and load that file to the TImage object with
LoadFromFile method.
When I tried to load the file (png) generated, the image appears black.
However, the image file is generated correctly because I can open it with
other viewers like Explorer, Paint and IrfanViewer.
Even at design time I can load other png image files normally but not this
one generated by this program.

Am I doing something wrong? Maybe a bug?

And, why r. g. b colors are inverted on TColor objects?

If someone has some free time to see the code and give me a hint I would
apreciate a lot!

I am using Lazarus 1.0.10 and FPC 2.6.2, Win 7 32 bits

The program is small so the source folows, contents of .pas, .lfm and .lpr:

unit rgbmain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  FPimage,
  FPImgCanv,
  FPWritePNG;

type

  { TForm1 }

  TForm1 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure GenerateImage(aWidth, aHeight: integer);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

const
  FileGenerated = 'rgb.png';

  // TColors used on screen panels
  clLtYellow: TColor = ($FFFF40);
  clLtYellowR: TColor = ($FF0000);
  clLtYellowG: TColor = ($00FF00);
  clLtYellowB: TColor = ($000040);

  // TFPColors used on FileGenerated
  colLtYellow: TFPColor = (Red: $FFFF; Green: $FFFF; Blue: $4000;
    Alpha: alphaOpaque);
  colLtYellowR: TFPColor = (Red: $FFFF; Green: $0000; Blue: $0000;
    Alpha: alphaOpaque);
  colLtYellowG: TFPColor = (Red: $0000; Green: $FFFF; Blue: $0000;
    Alpha: alphaOpaque);
  colLtYellowB: TFPColor = (Red: $0000; Green: $0000; Blue: $4000;
    Alpha: alphaOpaque);

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.Color := clLtYellowR;
  Panel1.Caption := 'R: $FF; G: $00; B: $00';
  Panel2.Color := clLtYellowG;
  Panel2.Caption := 'R: $00; G: $FF; B: $00';
  Panel3.Color := clLtYellowB;
  Panel3.Caption := 'R: $00; G: $00; B: $40';
  Panel4.Color:= clLtYellow;
  Panel4.Caption := 'R: $FF; G: $FF; B: $40';
  GenerateImage(image1.Width, image1.Height);
  image1.Picture.LoadFromFile(FileGenerated);
end;

procedure TForm1.GenerateImage(aWidth, aHeight: integer);
var
  Img: TFPMemoryImage;
  Writer: TFPWriterPNG;
  ms: TMemoryStream;
  ImgCanvas: TFPImageCanvas;
  fs: TFileStream;
begin
  Img := nil;
  ImgCanvas := nil;
  Writer := nil;
  ms := nil;
  fs := nil;
  try
    Img := TFPMemoryImage.Create(aWidth, aHeight);
    //Img.UsePalette := False;
    ImgCanvas := TFPImageCanvas.Create(Img);
    // Red
    ImgCanvas.Pen.FPColor := colLtYellowR;
    ImgCanvas.Brush.FPColor := colLtYellowR;
    ImgCanvas.Rectangle(0, 0, aWidth div 3, aHeight div 2);
    // Green
    ImgCanvas.Pen.FPColor := colLtYellowG;
    ImgCanvas.Brush.FPColor := colLtYellowG;
    ImgCanvas.Rectangle(aWidth div 3, 0, (aWidth div 3)*2, aHeight div 2);
    // Blue
    ImgCanvas.Pen.FPColor := colLtYellowB;
    ImgCanvas.Brush.FPColor := colLtYellowB;
    ImgCanvas.Rectangle((aWidth div 3)*2, 0, aWidth, aHeight div 2);
    // RGB
    ImgCanvas.Pen.FPColor := colLtYellow;
    ImgCanvas.Brush.FPColor := colLtYellow;
    ImgCanvas.Rectangle(0, aHeight div 2, aWidth, aHeight);

    // 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;
    fs := TFileStream.Create(FileGenerated, fmCreate);
    fs.CopyFrom(ms, ms.Size);
  finally
    ms.Free;
    Writer.Free;
    ImgCanvas.Free;
    Img.Free;
    fs.Free;
  end;
end;

end.

object Form1: TForm1
  Left = 325
  Height = 277
  Top = 145
  Width = 492
  Caption = 'RGB'
  ClientHeight = 277
  ClientWidth = 492
  OnCreate = FormCreate
  LCLVersion = '1.0.10.0'
  object Panel1: TPanel
    Left = 8
    Height = 50
    Top = 8
    Width = 150
    Caption = 'R'
    TabOrder = 0
  end
  object Panel2: TPanel
    Left = 168
    Height = 50
    Top = 8
    Width = 150
    Caption = 'G'
    TabOrder = 1
  end
  object Panel3: TPanel
    Left = 336
    Height = 50
    Top = 8
    Width = 150
    Caption = 'B'
    Font.Color = clWhite
    ParentFont = False
    TabOrder = 2
  end
  object Panel4: TPanel
    Left = 8
    Height = 50
    Top = 64
    Width = 478
    Caption = 'RGB'
    TabOrder = 3
  end
  object Image1: TImage
    Left = 8
    Height = 138
    Top = 128
    Width = 480
    Stretch = True
  end
end

program rgb;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, rgbmain
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource := True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20130828/6bc6955e/attachment-0002.html>


More information about the Lazarus mailing list