paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 13:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, carbon fix canvas.pixels, issue #23112, #26275

Browse Source 
git-svn-id: trunk@45346 -
This commit is contained in:
jesus 2014-06-05 06:25:33 +00:00
parent d8609cf93a
commit 208579db61
2 changed files with 21 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/interfaces/carbon/carboncanvas.pp
View File

@ -1843,15 +1843,16 @@ begin
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;
{------------------------------------------------------------------------------

18
lcl/interfaces/carbon/carbonobject.inc
View File

@ -906,6 +906,7 @@ var Width, Height: Integer;
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 @@ begin
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;