View Issue Details

IDProjectCategoryView StatusLast Update
0023112LazarusLCLpublic2014-06-05 08:26
ReportershiraishiAssigned ToJesus Reyes 
PrioritynormalSeveritymajorReproducibilityalways
Status resolvedResolutionfixed 
PlatformMac (intel)OSOS-XOS Version10.6.8
Product Version1.0.2Product Build 
Target Version1.4Fixed in Version1.3 (SVN) 
Summary0023112: Reading Pixels property of TBitMap raises FPImageException
DescriptionThe following code raises an FPImageException Invalid Size on Lazarus 1.0 or 1.0.2 on Mac(Intel).
  c:=bitmap1.Canvas.Pixels[2,2];
Lazarus 0.9.30.4 Mac Carbon or Lazarus 1.0.2 Windows do not cause such an error.

The whole code of the unit is as follows.

unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Buttons, StdCtrls;
type
  { TForm1 }
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Label1: TLabel;
    PaintBox1: TPaintBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    bitmap1:TBitmap;
    public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    bitmap1:=TBitmap.Create;
    bitmap1.Width:=PaintBox1.Width;
    bitmap1.Height:=PaintBox1.Height;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bitmap1.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
    PaintBox1.Canvas.Draw(0,0,BitMap1);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  c:integer;
begin
    bitmap1.Canvas.Pixels[2,2]:=clred;
    c:=bitmap1.Canvas.Pixels[2,2];
    Label1.Caption:=IntToStr(c and $FFFFFF);
    repaint;
end;


end.
                                  
Steps To ReproduceRun project1 and click BitBtn1.
TagsNo tags attached.
Fixed in Revision45346
LazTarget1.4
WidgetsetCarbon
Attached Files
  • project1.zip (2,892 bytes)
  • 23112.diff (2,153 bytes)
    Index: carbonobject.inc
    ===================================================================
    --- carbonobject.inc	(revision 45183)
    +++ carbonobject.inc	(working copy)
    @@ -906,6 +906,7 @@
     	WorkData: PByte = nil;
     	MaskData: PByte = nil;
     	MaskDataSize, WorkDataSize: PtrUInt;
    +	Ptr: PByte;
     
     	function CreateSub(ARect: TRect; ABmp: TCarbonBitMap; BitsPerPixel: Integer; var ImageDataSize: PtrUInt): PByte;
     	var	FullImageData, BytePtr: PByte;
    @@ -969,9 +970,24 @@
     	end;
       end
       else begin
    -	WorkData := CreateSub(R, ABitmap, ARawImage.Description.BitsPerPixel, WorkDataSize);
    +    // TODO: fix CreateSub which is broken at least for one pixel (@ 32bpp)
    +    //       In the mean time, here is a shortcut which should be also
    +    //       faster than CreateSub.
    +    //       Only tested with bitmaps at 32 bits per pixel. See bug #23112
    +    if (Width=1) and (Height=1) and (AMask=nil) then
    +    begin
    +    WorkDataSize := (ARawImage.Description.BitsPerPixel + 7) div 8;
    +    WorkData := System.GetMem(WorkDataSize);
    +    Ptr := ABitmap.Data;
    +    inc(Ptr, ARawImage.Description.BytesPerLine * R.Top);
    +    Inc(Ptr, WorkDataSize * R.Left);
    +    System.Move(Ptr^, WorkData^, WorkDataSize);
    +    end
    +    else begin
    +	  WorkData := CreateSub(R, ABitmap, ARawImage.Description.BitsPerPixel, WorkDataSize);
         if AMask <> nil then
           MaskData := CreateSub(R, AMask, 1, MaskDataSize);
    +    end;
       end;
     
       ARawImage.Description.Width  := Width;
    Index: carboncanvas.pp
    ===================================================================
    --- carboncanvas.pp	(revision 45183)
    +++ carboncanvas.pp	(working copy)
    @@ -1843,15 +1843,16 @@
       
       S := GetSize;
       if (X < 0) or (Y < 0) or (X > S.X - 1) or (Y > S.Y - 1) then Exit;
    -  
    -  R := Classes.Rect(X, Y, 1, 1);
    +
    +  R := Classes.Bounds(X, Y, 1, 1);
       if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
       IntfImage := TLazIntfImage.Create(RawImage, True);
       try
    -    Result := IntfImage.TColors[X, Y];
    +    Result := IntfImage.TColors[0, 0];
       finally
         IntfImage.Free;
       end;
    +
     end;
     
     {------------------------------------------------------------------------------
    
    23112.diff (2,153 bytes)
  • 23112.tar.gz (1,805 bytes)

Relationships

has duplicate 0026275 resolvedJesus Reyes MacOSX: crash in my app because of TLazIntfImage 
related to 0026201 closedZeljan Rikalo TBitmap size differs from TBitmap.Canvas 

Activities

2012-10-12 07:28

 

project1.zip (2,892 bytes)

shiraishi

2012-10-20 10:59

reporter   ~0063313

Stack Trace.

#0 fpc_raiseexception at :0
0000001 ERROR((POINTER) 0xbfffd678) at intfgraphics.pas:3338
0000002 TLAZINTFIMAGE__INTERNALSETSIZE(-1, -1, (TLAZINTFIMAGE) 0x24b7320) at intfgraphics.pas:3342
0000003 TLAZINTFIMAGE__SETSIZE(-1, -1, (TLAZINTFIMAGE) 0x24b7320) at intfgraphics.pas:3351
0000004 FPIMAGE_TFPCUSTOMIMAGE_$__CREATE$LONGINT$LONGINT$$TFPCUSTOMIMAGE at :0
0000005 TLAZINTFIMAGE__CREATE(-1, -1, [], (POINTER) 0x0, (TLAZINTFIMAGE) 0x24b7320) at intfgraphics.pas:3225
0000006 TLAZINTFIMAGE__CREATE({DESCRIPTION = {FORMAT = RICFRGBA, WIDTH = 4294967295, HEIGHT = 4294967295, DEPTH = 24, BITORDER = RIBOREVERSEDBITS, BYTEORDER = RIBOMSBFIRST, LINEORDER = RILOTOPTOBOTTOM, LINEEND = RILEDQWORDBOUNDARY, BITSPERPIXEL = 32, REDPREC = 8, REDSHIFT = 16, GREENPREC = 8, GREENSHIFT = 8, BLUEPREC = 8, BLUESHIFT = 0, ALPHAPREC = 0, ALPHASHIFT = 0, MASKBITSPERPIXEL = 0, MASKSHIFT = 0, MASKLINEEND = RILEBYTEBOUNDARY, MASKBITORDER = RIBOREVERSEDBITS, PALETTECOLORCOUNT = 0, PALETTEBITSPERINDEX = 0, PALETTESHIFT = 0, PALETTELINEEND = RILETIGHT, PALETTEBITORDER = RIBOBITSINORDER, PALETTEBYTEORDER = RIBOLSBFIRST}, DATA = 0x0, DATASIZE = 0, MASK = 0x0, MASKSIZE = 0, PALETTE = 0x0, PALETTESIZE = 0}, true, (POINTER) 0x2d6bd8, (TLAZINTFIMAGE) 0x24b7320) at intfgraphics.pas:3240
0000007 TCARBONBITMAPCONTEXT__GETPIXEL(2, 2, (TCARBONBITMAPCONTEXT) 0x243d320) at carboncanvas.pp:1853
0000008 TCARBONWIDGETSET__DCGETPIXEL(37999392, 2, 2, (TCARBONWIDGETSET) 0x244b020) at carbonobject.inc:1353
0000009 TCANVAS__GETPIXEL(2, 2, (TCANVAS) 0x24b7260) at ./include/canvas.inc:138
0000010 TFORM1__BITBTN1CLICK((^TOBJECT) 0x2069f10, (TFORM1) 0x2069820) at unit1.pas:57
0000011 TCONTROL__CLICK((TCONTROL) 0x2069f10) at ./include/control.inc:2718
0000012 TBUTTONCONTROL__CLICK((TBUTTONCONTROL) 0x2069f10) at ./include/buttoncontrol.inc:56
0000013 TCUSTOMBUTTON__CLICK((TCUSTOMBUTTON) 0x2069f10) at ./include/buttons.inc:175
0000014 TCUSTOMBITBTN__CLICK((TCUSTOMBITBTN) 0x2069f10) at ./include/bitbtn.inc:58
0000015 TBUTTONCONTROL__WMDEFAULTCLICKED({MSG = 66567, WPARAM = 0, LPARAM = 0, RESULT = 0, WPARAMLO = 0, WPARAMHI = 0, LPARAMLO = 0, LPARAMHI = 0, RESULTLO = 0, RESULTHI = 0}, (TBUTTONCONTROL) 0x2069f10) at ./include/buttoncontrol.inc:26
0000016 SYSTEM_TOBJECT_$__DISPATCH$formal at :0
0000017 TWINCONTROL__WNDPROC({MSG = 66567, WPARAM = 0, LPARAM = 0, RESULT = 0, WPARAMLO = 0, WPARAMHI = 0, LPARAMLO = 0, LPARAMHI = 0, RESULTLO = 0, RESULTHI = 0}, (TWINCONTROL) 0x2069f10) at ./include/wincontrol.inc:5322
0000018 DELIVERMESSAGE((^TOBJECT) 0x2069f10, void) at lclmessageglue.pas:117
0000019 SENDSIMPLEMESSAGE((^TCONTROL) 0x2069f10, 66567) at lclmessageglue.pas:148
0000020 LCLSENDCLICKEDMSG((^TCONTROL) 0x2069f10) at lclmessageglue.pas:525
0000021 TCARBONCUSTOMBUTTON__HIT(10, (TCARBONCUSTOMBUTTON) 0x2058620) at carbonbuttons.pp:350
0000022 CARBONCONTROL_HIT((CFSTRINGREF) 0xbfffdfd0, (CFSTRINGREF) 0x171f680, (^TCARBONWIDGET) 0x2058620) at carbonprivatecontrol.inc:45
0000023 DispatchEventToHandlers at :0
0000024 SendEventToEventTargetInternal at :0
0000025 SendEventToEventTarget at :0
0000026 SendControlHit at :0
0000027 HIView::NotifyControlHit at :0
0000028 HIView::ClickInternal at :0
0000029 HIView::ClickSelf at :0
0000030 HIView::EventHandler at :0
0000031 DispatchEventToHandlers at :0
0000032 SendEventToEventTargetInternal at :0
0000033 SendEventToEventTarget at :0
0000034 HIView::Click at :0
0000035 HandleClickAsHIView at :0
0000036 HandleWindowClick at :0
0000037 HandleMouseEvent at :0
0000038 StandardWindowEventHandler at :0
0000039 DispatchEventToHandlers at :0
0000040 SendEventToEventTargetInternal at :0
0000041 SendEventToEventTarget at :0
0000042 ToolboxEventDispatcherHandler at :0
0000043 DispatchEventToHandlers at :0
0000044 SendEventToEventTargetInternal at :0
0000045 SendEventToEventTarget at :0
0000046 TCARBONWIDGETSET__APPPROCESSMESSAGES((TCARBONWIDGETSET) 0x244b020) at carbonobject.inc:620
0000047 TAPPLICATION__HANDLEMESSAGE((TAPPLICATION) 0x2068030) at ./include/application.inc:1274
0000048 TAPPLICATION__RUNLOOP((TAPPLICATION) 0x2068030) at ./include/application.inc:1407
0000049 EVENTLOOPEVENTHANDLER((PLONGINT) 0xbffff4a0, (PLONGINT) 0x220d510, (POINTER) 0x244b020) at carbonobject.inc:179
0000050 DispatchEventToHandlers at :0
0000051 SendEventToEventTargetInternal at :0
0000052 SendEventToEventTargetWithOptions at :0
#53 ToolboxEventDispatcherHandler at :0
#54 DispatchEventToHandlers at :0
0000055 SendEventToEventTargetInternal at :0
0000056 SendEventToEventTarget at :0
0000057 ToolboxEventDispatcher at :0
0000058 RunApplicationEventLoop at :0
0000059 TCARBONWIDGETSET__APPRUN((TAPPLICATIONMAINLOOP) 0x459d0 <TAPPLICATION__RUNLOOP>, (TCARBONWIDGETSET) 0x244b020) at carbonobject.inc:563
0000060 TAPPLICATION__RUN((TAPPLICATION) 0x2068030) at ./include/application.inc:1395

shiraishi

2012-10-20 11:07

reporter   ~0063314

CarbonCanvas.pp lines 1851 to 1853 are as follows.

 R := Classes.Rect(X, Y, 1, 1);
 if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
 IntfImage := TLazIntfImage.Create(RawImage, True);

R was made left 2, right 1, top 2, bottom 1.
RawImage_FromBitmap makes RawImage of negative width and height.
But TLazIntfImage.create handles those negative numbers as unsigned integers,
thus excessive size of memories are required.

Zeljan Rikalo

2012-10-20 17:16

developer   ~0063316

What happens if you add (note X + 1 and Y + 1) at that place ?
 R := Classes.Rect(X, Y, X + 1, Y + 1);
 if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;

shiraishi

2012-10-21 04:42

reporter   ~0063334

CarbonCanvas.pp at Lazarus 0.9.30.4 also has lines 1811 to 1813

 R := Classes.Rect(X, Y, 1, 1);
  if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
  IntfImage := TLazIntfImage.Create(RawImage, True);

These work fine without raising any exception.

shiraishi

2013-03-27 01:20

reporter   ~0066571

This bug still remains in Lazarus 1.0.8 Carbon.

Zeljan Rikalo

2014-05-29 15:18

developer   ~0075296

can you add Bitmap1.Canvas.GetUpdatedHandle([csHandleValid]); before first call to Pixels in BitBtn1Click ?

Jesus Reyes

2014-05-31 17:34

developer  

23112.diff (2,153 bytes)
Index: carbonobject.inc
===================================================================
--- carbonobject.inc	(revision 45183)
+++ carbonobject.inc	(working copy)
@@ -906,6 +906,7 @@
 	WorkData: PByte = nil;
 	MaskData: PByte = nil;
 	MaskDataSize, WorkDataSize: PtrUInt;
+	Ptr: PByte;
 
 	function CreateSub(ARect: TRect; ABmp: TCarbonBitMap; BitsPerPixel: Integer; var ImageDataSize: PtrUInt): PByte;
 	var	FullImageData, BytePtr: PByte;
@@ -969,9 +970,24 @@
 	end;
   end
   else begin
-	WorkData := CreateSub(R, ABitmap, ARawImage.Description.BitsPerPixel, WorkDataSize);
+    // TODO: fix CreateSub which is broken at least for one pixel (@ 32bpp)
+    //       In the mean time, here is a shortcut which should be also
+    //       faster than CreateSub.
+    //       Only tested with bitmaps at 32 bits per pixel. See bug #23112
+    if (Width=1) and (Height=1) and (AMask=nil) then
+    begin
+    WorkDataSize := (ARawImage.Description.BitsPerPixel + 7) div 8;
+    WorkData := System.GetMem(WorkDataSize);
+    Ptr := ABitmap.Data;
+    inc(Ptr, ARawImage.Description.BytesPerLine * R.Top);
+    Inc(Ptr, WorkDataSize * R.Left);
+    System.Move(Ptr^, WorkData^, WorkDataSize);
+    end
+    else begin
+	  WorkData := CreateSub(R, ABitmap, ARawImage.Description.BitsPerPixel, WorkDataSize);
     if AMask <> nil then
       MaskData := CreateSub(R, AMask, 1, MaskDataSize);
+    end;
   end;
 
   ARawImage.Description.Width  := Width;
Index: carboncanvas.pp
===================================================================
--- carboncanvas.pp	(revision 45183)
+++ carboncanvas.pp	(working copy)
@@ -1843,15 +1843,16 @@
   
   S := GetSize;
   if (X < 0) or (Y < 0) or (X > S.X - 1) or (Y > S.Y - 1) then Exit;
-  
-  R := Classes.Rect(X, Y, 1, 1);
+
+  R := Classes.Bounds(X, Y, 1, 1);
   if not RawImage_FromBitmap(RawImage, HBITMAP(Bitmap), 0, @R) then Exit;
   IntfImage := TLazIntfImage.Create(RawImage, True);
   try
-    Result := IntfImage.TColors[X, Y];
+    Result := IntfImage.TColors[0, 0];
   finally
     IntfImage.Free;
   end;
+
 end;
 
 {------------------------------------------------------------------------------
23112.diff (2,153 bytes)

Jesus Reyes

2014-05-31 17:39

developer  

23112.tar.gz (1,805 bytes)

Jesus Reyes

2014-05-31 17:42

developer   ~0075334

Last edited: 2014-05-31 19:02

View 2 revisions

Please try with attached patch. It seems R := Classes.Rect(X, Y, X + 1, Y + 1); is not enough. Attached also a small change in test file just to be sure of what we get is the same pixel color than we set.

Jesus Reyes

2014-06-05 08:26

developer   ~0075483

I applied the patch, please test.

Issue History

Date Modified Username Field Change
2012-10-12 07:28 shiraishi New Issue
2012-10-12 07:28 shiraishi File Added: project1.zip
2012-10-12 07:28 shiraishi Widgetset => Carbon
2012-10-20 10:59 shiraishi Note Added: 0063313
2012-10-20 11:07 shiraishi Note Added: 0063314
2012-10-20 17:16 Zeljan Rikalo LazTarget => -
2012-10-20 17:16 Zeljan Rikalo Note Added: 0063316
2012-10-20 17:16 Zeljan Rikalo Status new => feedback
2012-10-21 04:42 shiraishi Note Added: 0063334
2013-03-27 01:20 shiraishi Note Added: 0066571
2013-03-27 01:20 shiraishi Status feedback => new
2014-05-21 17:35 Juha Manninen Relationship added related to 0026201
2014-05-29 15:18 Zeljan Rikalo Note Added: 0075296
2014-05-31 17:29 Jesus Reyes File Added: 23112.diff
2014-05-31 17:34 Jesus Reyes File Deleted: 23112.diff
2014-05-31 17:34 Jesus Reyes File Added: 23112.diff
2014-05-31 17:39 Jesus Reyes File Added: 23112.tar.gz
2014-05-31 17:42 Jesus Reyes Note Added: 0075334
2014-05-31 19:02 Jesus Reyes Note Edited: 0075334 View Revisions
2014-05-31 21:04 Jesus Reyes Assigned To => Jesus Reyes
2014-05-31 21:04 Jesus Reyes Status new => assigned
2014-06-05 08:26 Jesus Reyes Fixed in Revision => 45346
2014-06-05 08:26 Jesus Reyes LazTarget - => 1.4
2014-06-05 08:26 Jesus Reyes Note Added: 0075483
2014-06-05 08:26 Jesus Reyes Status assigned => resolved
2014-06-05 08:26 Jesus Reyes Fixed in Version => 1.3 (SVN)
2014-06-05 08:26 Jesus Reyes Resolution open => fixed
2014-06-05 08:26 Jesus Reyes Target Version => 1.4
2014-06-05 08:27 Jesus Reyes Relationship added has duplicate 0026275