paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 12:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL carbon: fixed using mask for TBitBtn and TMenuItem glyph

Browse Source 
git-svn-id: trunk@13830 -
This commit is contained in:
tombo 2008-01-22 13:18:39 +00:00
parent 88d822c376
commit 79b247b5dd
3 changed files with 58 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/interfaces/carbon/carbonbuttons.pp
View File

@ -402,15 +402,12 @@ end;
procedure TCarbonBitBtn.SetGlyph(const AGlyph: TBitmap);
var
ContentInfo: ControlButtonContentInfo;
FreeImage: Boolean;
BitBtn: TCustomBitBtn;
R: TRect;
begin
ContentInfo.contentType := kControlContentCGImageRef;
FreeImage := False;
ContentInfo.imageRef := nil;
if AGlyph <> nil then
begin
if TObject(AGlyph.Handle) is TCarbonBitmap then
@ -418,13 +415,14 @@ begin
BitBtn := LCLObject as TCustomBitBtn;
if BitBtn.NumGlyphs <= 1 then
ContentInfo.imageRef := TCarbonBitmap(AGlyph.Handle).CGImage
ContentInfo.imageRef :=
TCarbonBitmap(AGlyph.Handle).CreateMaskedImage(TCarbonBitmap(AGlyph.MaskHandle))
else
begin
// TODO: consider button style (down, disabled)
R := Classes.Rect(0, 0, AGlyph.Width div BitBtn.NumGlyphs, AGlyph.Height);
ContentInfo.imageRef := TCarbonBitmap(AGlyph.Handle).CreateSubImage(R);
FreeImage := True;
ContentInfo.imageRef :=
TCarbonBitmap(AGlyph.Handle).CreateMaskedImage(TCarbonBitmap(AGlyph.MaskHandle), R);
end;
end;
end;
@ -433,7 +431,7 @@ begin
OSError(SetBevelButtonContentInfo(ControlRef(Widget), @ContentInfo),
Self, 'SetGlyph', 'SetBevelButtonContentInfo');
finally
if FreeImage then CGImageRelease(ContentInfo.imageRef);
CGImageRelease(ContentInfo.imageRef);
end;
end;

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

@ -189,6 +189,8 @@ type
destructor Destroy; override;
procedure Update;
function CreateSubImage(const ARect: TRect): CGImageRef;
function CreateMaskedImage(AMask: TCarbonBitmap): CGImageRef;
function CreateMaskedImage(AMask: TCarbonBitmap; const ARect: TRect): CGImageRef;
public
property BitsPerComponent: Integer read GetBitsPerComponent;
property BytesPerRow: Integer read FBytesPerRow;
@ -1244,11 +1246,42 @@ end;
------------------------------------------------------------------------------}
function TCarbonBitmap.CreateSubImage(const ARect: TRect): CGImageRef;
begin
if CGImage = nil
then Result := nil
if CGImage = nil then Result := nil
else Result := CGImageCreateWithImageInRect(CGImage, RectToCGRect(ARect));
end;
{------------------------------------------------------------------------------
Method: TCarbonBitmap.CreateMaskedImage
Returns: New image ref to masked image data
------------------------------------------------------------------------------}
function TCarbonBitmap.CreateMaskedImage(AMask: TCarbonBitmap): CGImageRef;
begin
Result := CreateMaskedImage(AMask, Classes.Rect(0, 0, Width, Height));
end;
{------------------------------------------------------------------------------
Method: TCarbonBitmap.CreateMaskedImage
Returns: New image ref to portion of masked image data according to the rect
------------------------------------------------------------------------------}
function TCarbonBitmap.CreateMaskedImage(AMask: TCarbonBitmap;
const ARect: TRect): CGImageRef;
var
CGSubImage: CGImageRef;
begin
Result := nil;
if CGImage = nil then Exit;
if (AMask <> nil) and (AMask.CGImage <> nil) then
begin
CGSubImage := CreateSubImage(ARect);
try
Result := CGImageCreateWithMask(CGSubImage, AMask.CGImage);
finally
CGImageRelease(CGSubImage);
end;
end
else
Result := CreateSubImage(ARect);
end;
{ TCarbonCursor }

25
lcl/interfaces/carbon/carbonmenus.pp
View File

@ -477,6 +477,7 @@ procedure TCarbonMenu.SetBitmap(const ABitmap: TBitmap);
var
IconType: Byte;
AHandle: FPCMacOSAll.Handle;
CGImage: CGImageRef;
const
SName = 'SetBitmap';
begin
@ -487,23 +488,31 @@ begin
if FParentMenu = nil then Exit;
AHandle := nil;
CGImage := nil;
if ABitmap <> nil then
begin
if not CheckBitmap(ABitmap.Handle, SName) then Exit;
IconType := kMenuCGImageRefType;
AHandle := Pointer(TCarbonBitmap(ABitmap.Handle).CGImage);
CGImage :=
TCarbonBitmap(ABitmap.Handle).CreateMaskedImage(TCarbonBitmap(ABitmap.MaskHandle));
AHandle := Pointer(CGImage);
end;
if AHandle = nil then IconType := kMenuNoIcon;
{$IFDEF VerboseMenu}
DebugLn('TCarbonMenu.SetBitmap IconType: ' + DbgS(IconType) + ' AIcon: ' + DbgS(AHandle));
{$ENDIF}
if OSError(
SetMenuItemIconHandle(FParentMenu.Menu, GetIndex + 1, IconType, AHandle),
Self, SName, 'SetMenuItemIconHandle') then Exit;
try
{$IFDEF VerboseMenu}
DebugLn('TCarbonMenu.SetBitmap IconType: ' + DbgS(IconType) + ' AIcon: ' + DbgS(AHandle));
{$ENDIF}
if OSError(
SetMenuItemIconHandle(FParentMenu.Menu, GetIndex + 1, IconType, AHandle),
Self, SName, 'SetMenuItemIconHandle') then Exit;
finally
if CGImage <> nil then
CGImageRelease(CGImage);
end;
end;
{------------------------------------------------------------------------------