[Lazarus] TImage does not load png file

Junior lazarus.linux at gmail.com
Wed Aug 28 08:44:07 CEST 2013


Lazarus 1.1 r42508M FPC 2.6.2 i386-linux-gtk 2

see image down....


Em 28-08-2013 01:49, Edilson Vieira escreveu:
> 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.
>
>
>
> --
> _______________________________________________
> Lazarus mailing list
> Lazarus at lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20130828/8250e29d/attachment-0003.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: lazarus.png
Type: image/png
Size: 16606 bytes
Desc: not available
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20130828/8250e29d/attachment-0003.png>


More information about the Lazarus mailing list