[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