[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