Is this a bug ? draw to image.picture.bitmap

[jimbill]

Hello Everyone,

I cant speak very well.
Lazarus is very good tool.
Congratulations to the developers. And so forth

I would like to announce an error.

I have a Image1:TImage.
And I load a picture: Image1.Picture.LoadFromFile(filename); // png image

I'd like to draw to the Image1 some lines (path) which is a permanent.
(so when I move the window to outside of the screen and back the lines should stay on Image1)

 I set: Image1.Picture.Bitmap.Canvas.Pen.Color:=clBlue;

 and draw: Image1.Picture.Bitmap.Canvas.Line(x,y,x2,y2);

 
 I'd like to draw a path with Blue and after another with red. but it's draw just the first path
 and with white not with blue... nowhere the second path.

If I try this with empty bitmap without any loaded image its work perfectly.
It draw the two path to the screen with correct colours.
 
Any help welcome .

Thanks,

windows 7/32 bit
lazarus 1.4.2  i386-win32-win32/win64

[derek.john.evans]

I'm guessing the png is 32bit. ie: Includes a transparent channel. As far as I know, the standard TCanvas functions don't support a alpha channel, and if they did, it might be platform dependent.

To get rid of the alpha channel, use something like this to load pictures into 24bit bitmaps:

Code: Pascal  [Select][+][-]

1. procedure BitmapLoadFromFile(const ABitmap: TBitmap; const AFileName: TFileName; const ABackground: TColor);
2. var
3.   LPicture: TPicture;
4. begin
5.   LPicture := TPicture.Create;
6.   try
7.     LPicture.LoadFromFile(AFileName);
8.     ABitmap.PixelFormat := pf24bit;
9.     ABitmap.SetSize(LPicture.Width, LPicture.Height);
10.     ABitmap.Canvas.Brush.Color := ABackground;
11.     ABitmap.Canvas.FillRect(0, 0, ABitmap.Width, ABitmap.Height);
12.     ABitmap.Canvas.Draw(0, 0, LPicture.Bitmap);
13.   finally
14.     FreeAndNil(LPicture);
15.   end;
16. end;
17.  

But, then you will loose your alpha channel, which would be ok if you never intended to support them. If you are just drawing a path on a PNG, you can use a separate transparent (color keyed) TBitmap for the path layer:

Code: Pascal  [Select][+][-]

1.   FBitmap := TBitmap.Create;
2.   FBitmap.SetSize(FPicture.Width, FPicture.Height);
3.   FBitmap.Transparent:=True;
4.   FBitmap.TransparentColor := clLime;
5.   FBitmap.Canvas.Brush.Color := FBitmap.TransparentColor;
6.   FBitmap.Canvas.FillRect(0, 0, FBitmap.Width, FBitmap.Height);
7.   FBitmap.Canvas.Pen.Color := clBlue;
8.   FBitmap.Canvas.Line(0, 0, 100, 100);
9.   FBitmap.Canvas.Pen.Color := clRed;
10.   FBitmap.Canvas.Line(0, 0, 80, 80);  
11.  
12.   // Draw the two layers to the TForm
13.   Canvas.Draw(0, 0, FPicture.Bitmap);
14.   Canvas.Draw(0, 0, FBitmap);  
15.  

Other than that, if you want to modify a 32bit image, you may have to look into BGRABitmap

[taazz]

png is not a bitmap. Upon load the image does not automatically convert it to bitmap for you it is kept as png in memory try using the image1.picture.graphic.canvas instead.

[derek.john.evans]

png is not a bitmap. Upon load the image does not automatically convert it to bitmap for you it is kept as png in memory try using the image1.picture.graphic.canvas instead.

Mmmm. There is no TPicture.Graphic.Canvas. TPicture.Graphic is the encoded image. When you call TPicture.Bitmap, the graphic is decoded to a TBitmap. The internal graphic is then replaced with the decoded TBitmap.

Either way. TCanvas drawing to a 32bit bitmap has alway caused me problems.

[derek.john.evans]

For anyone thats interested, here is a TPicture derived class which allows 32bit images to be edited using TCanvas methods: (Needs testing, but the concept works)

Code: Pascal  [Select][+][-]

1. unit PictureEx;
2.  
3. {$MODE DELPHI}
4.  
5. interface
6.  
7. uses
8.   Graphics, SysUtils;
9.  
10. type
11.   TPictureEx = class(TPicture)
12.   strict private
13.     FUpdateCount: Integer;
14.     FBuffer: TBitmap;
15.   public
16.     constructor Create;
17.     destructor Destroy; override;
18.     function BeginUpdate: TCanvas;
19.     procedure EndUpdate;
20.   end;
21.  
22. implementation
23.  
24. constructor TPictureEx.Create;
25. begin
26.   inherited Create;
27.   FBuffer := TBitmap.Create;
28.   FBuffer.PixelFormat := pf24bit;
29. end;
30.  
31. destructor TPictureEx.Destroy;
32. begin
33.   FreeAndNil(FBuffer);
34.   inherited Destroy;
35. end;
36.  
37. function TPictureEx.BeginUpdate: TCanvas;
38. begin
39.   if (FUpdateCount = 0) and (Bitmap.PixelFormat = pf32bit) then begin
40.     FBuffer.Transparent := True;
41.     FBuffer.TransparentColor := $FF00FF;
42.     FBuffer.SetSize(Width, Height);
43.     FBuffer.Canvas.Brush.Color := FBuffer.TransparentColor;
44.     FBuffer.Canvas.FillRect(0, 0, Width, Height);
45.     Result := FBuffer.Canvas;
46.   end else begin
47.     Result := Bitmap.Canvas;
48.   end;
49.   Inc(FUpdateCount);
50. end;
51.  
52. procedure TPictureEx.EndUpdate;
53. var
54.   LCount: Integer;
55.   LSrc, LDst: PByte;
56. begin
57.   Dec(FUpdateCount);
58.   if (FUpdateCount = 0) and (Bitmap.PixelFormat = pf32bit) then begin
59.     FBuffer.BeginUpdate;
60.     try
61.       LSrc := FBuffer.RawImage.Data;
62.       LDst := Bitmap.RawImage.Data;
63.       for LCount := 1 to FBuffer.RawImage.DataSize div 3 do begin
64.         if (LSrc[0] <> $FF) or (LSrc[1] <> $00) or (LSrc[0] <> $FF) then begin
65.           LDst[0] := LSrc[0];
66.           LDst[1] := LSrc[1];
67.           LDst[2] := LSrc[2];
68.           LDst[3] := $FF;
69.         end;
70.         LSrc += 3;
71.         LDst += 4;
72.       end;
73.     finally
74.       FBuffer.EndUpdate;
75.     end;
76.   end;
77. end;
78.  
79. end.
80.  

As a test, I loaded a PNG image, drew a bunch of random coloured lines, then saved. The output PNG had the original alpha + lines.

Code: Pascal  [Select][+][-]

1.   LPicture := TPictureEx.Create;
2.   LPicture.LoadFromFile('test.png');
3.   with LPicture.BeginUpdate do begin
4.     try
5.       for LIndex := 1 to 1000 do begin
6.         Pen.Color := Random($FFFFFF);
7.         Line(Random(LPicture.Width), Random(LPicture.Height), Random(LPicture.Width), Random(LPicture.Height));
8.       end;
9.     finally
10.       LPicture.EndUpdate;
11.     end;
12.   end;
13.   LPicture.SaveToFile('test2.png');  
14.  

Unsure what it could be used for, but it might be helpful to someone.

[jimbill]

Thanks for your help

The problem was the alpha channel Its working now perfectly with 24bit. In this way:

...

 TForm1 = class(TForm)
    Image1: TImage; // Component Palette: additional: TImage

...

// load picture
procedure TForm1.MenuItem4load pictureClick(Sender: TObject);
var
LPicture: TPicture;
begin
  if OpenDialog1.Execute then
   begin
      filename := OpenDialog1.Filename;
      LPicture := TPicture.Create;
      try
         LPicture.LoadFromFile(filename);
         Image1.Picture.Bitmap.PixelFormat := pf24bit;
         Image1.Picture.Bitmap.SetSize(LPicture.Width, LPicture.Height);
         Image1.Picture.Bitmap.Canvas.Draw(0, 0, LPicture.Bitmap);
      finally
         FreeAndNil(LPicture);
      end;   
...

// And I draw path to picture in this way and its staying there permanent

   Image1.Canvas.Pen.Color:= clRed;
        Image1.Canvas.Pen.Width:=5;
        Image1.Canvas.Font.Size:=10;

        Image1.Canvas.Line(x,y,x2,y2);



What is the best solution to remove the path from picture? Now I am reloading the original pic.
Is there any other way quicker? ex. with layers?

" you can use a separate transparent (color keyed) TBitmap for the path layer:"