paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-07 02:18:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

carbon : added pixel format RGBA

Browse Source 
git-svn-id: trunk@22112 -
This commit is contained in:
mattias 2009-10-12 11:53:44 +00:00
parent 532a45aca2
commit 61806eef87
3 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/interfaces/carbon/carbongdiobjects.pp
View File

@ -243,7 +243,8 @@ type
cbtMono, // mask or mono bitmap cbtMono, // mask or mono bitmap
cbtGray, // grayscale bitmap cbtGray, // grayscale bitmap
cbtRGB, // color bitmap 8-8-8 R-G-B cbtRGB, // color bitmap 8-8-8 R-G-B
cbtARGB, // color bitmap with alpha channel 8-8-8-8 A-R-G-B cbtARGB, // color bitmap with alpha channel first 8-8-8-8 A-R-G-B
cbtRGBA, // color bitmap with alpha channel last 8-8-8-8 R-G-B-A
cbtBGR, // color bitmap 8-8-8 B-G-R (windows compatible) cbtBGR, // color bitmap 8-8-8 B-G-R (windows compatible)
cbtBGRA // color bitmap with alpha channel 8-8-8-8 B-G-R-A (windows compatible) cbtBGRA // color bitmap with alpha channel 8-8-8-8 B-G-R-A (windows compatible)
); );
@ -406,6 +407,7 @@ const
{cbtGray} kCGImageAlphaNone, {cbtGray} kCGImageAlphaNone,
{cbtRGB} kCGImageAlphaNoneSkipFirst, {cbtRGB} kCGImageAlphaNoneSkipFirst,
{cbtARGB} kCGImageAlphaFirst, {cbtARGB} kCGImageAlphaFirst,
{cbtRGBA} kCGImageAlphaLast,
{cbtBGR} kCGImageAlphaNoneSkipFirst or kCGBitmapByteOrder32Little, {cbtBGR} kCGImageAlphaNoneSkipFirst or kCGBitmapByteOrder32Little,
{cbtBGRA} kCGImageAlphaFirst or kCGBitmapByteOrder32Little {cbtBGRA} kCGImageAlphaFirst or kCGBitmapByteOrder32Little
); );
@ -1787,6 +1789,7 @@ begin
cbtRGB, cbtRGB,
cbtBGR: Result := FDepth div 3; cbtBGR: Result := FDepth div 3;
cbtARGB, cbtARGB,
cbtRGBA,
cbtBGRA: Result := FDepth shr 2; cbtBGRA: Result := FDepth shr 2;
else else
Result := 0; Result := 0;

8
lcl/interfaces/carbon/carbonlclintf.inc
View File

@ -431,10 +431,10 @@ var
bmpType: TCarbonBitmapType; bmpType: TCarbonBitmapType;
begin begin
Result := RawImage_DescriptionToBitmapType(ADesc, bmpType); Result := RawImage_DescriptionToBitmapType(ADesc, bmpType);
if not Result then begin
if not Result then debugln(['TCarbonWidgetSet.RawImage_CreateBitmaps TODO Depth=',ADesc.Depth,' alphaprec=',ADesc.AlphaPrec,' byteorder=',ord(ADesc.ByteOrder),' alpha=',ADesc.AlphaShift,' red=',ADesc.RedShift,' green=',adesc.GreenShift,' blue=',adesc.BlueShift]);
Exit; exit;
end;
ABitmap := HBITMAP(TCarbonBitmap.Create(ADesc.Width, ADesc.Height, ADesc.Depth, ADesc.BitsPerPixel, ALIGNMAP[ADesc.LineEnd], bmpType, ARawImage.Data)); ABitmap := HBITMAP(TCarbonBitmap.Create(ADesc.Width, ADesc.Height, ADesc.Depth, ADesc.BitsPerPixel, ALIGNMAP[ADesc.LineEnd], bmpType, ARawImage.Data));
if ASkipMask or (ADesc.MaskBitsPerPixel = 0) if ASkipMask or (ADesc.MaskBitsPerPixel = 0)

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

@ -741,6 +741,12 @@ begin
and (ADesc.BlueShift = 0 ) and (ADesc.BlueShift = 0 )
then bmpType := cbtARGB then bmpType := cbtARGB
else else
if (ADesc.AlphaShift = 0)
and (ADesc.RedShift = 24)
and (ADesc.GreenShift = 16 )
and (ADesc.BlueShift = 8 )
then bmpType := cbtRGBA
else
if (ADesc.AlphaShift = 0 ) if (ADesc.AlphaShift = 0 )
and (ADesc.RedShift = 8 ) and (ADesc.RedShift = 8 )
and (ADesc.GreenShift = 16) and (ADesc.GreenShift = 16)
@ -760,6 +766,12 @@ begin
and (ADesc.GreenShift = 16) and (ADesc.GreenShift = 16)
and (ADesc.BlueShift = 24) and (ADesc.BlueShift = 24)
then bmpType := cbtARGB then bmpType := cbtARGB
else
if (ADesc.AlphaShift = 24 )
and (ADesc.RedShift = 0 )
and (ADesc.GreenShift = 8)
and (ADesc.BlueShift = 16)
then bmpType := cbtRGBA
else Exit; else Exit;
end; end;
end end