View Issue Details

IDProjectCategoryView StatusLast Update
0021755LazarusLCLpublic2017-04-09 16:27
ReporterDavid JenkinsAssigned ToJuha Manninen 
PrioritynormalSeverityfeatureReproducibilityN/A
Status resolvedResolutionfixed 
Product Version0.9.30.5 (SVN)Product Build 
Target VersionFixed in Version 
Summary0021755: Animated custom mouse cursors in TCarbonCursor
DescriptionWe'd like to add support for animated custom mouse cursors to TCarbonCursor.

The suggested implementation exposes Create32BitAlphaBitmap helper in order to allow creating the TCarbonCursor methods without having to add extra another method to the Carbon LCLIntf unit.

Patches with suggested implementation attached
TagsNo tags attached.
Fixed in Revisionr54590
LazTarget-
WidgetsetCarbon
Attached Files
  • carbongdiobjects.pp.patch (6,136 bytes)
    --- /Users/djenkins/laz-changes/14807/carbongdiobjects.pp	2012-04-11 17:11:26.000000000 
    +++ /Users/djenkins/laz-changes/14807/carbongdiobjects.pp.ss	2012-04-11 17:15:21.000000000 
    @@ -31,7 +31,7 @@
      // carbon bindings
       MacOSAll,
      // LCL
    -  LCLProc, LCLType, GraphType, Graphics, Controls, Forms,
    +  LCLProc, LCLType, GraphType, Graphics, Controls, Forms, ExtCtrls,
      // LCL Carbon
      {$ifdef DebugBitmaps}
       CarbonDebug,
    @@ -363,13 +363,23 @@
         FQDColorCursorHandle: CCrsrHandle;
         FQDHardwareCursorName: String;
         FPixmapHandle: PixmapHandle;
    +    // animated color cursors
    +    FAnimationFrames: array of record
    +      QDColorCursorHandle: CCrsrHandle;
    +      QDHardwareCursorName: String;
    +      PixmapHandle: PixmapHandle;
    +    end;
    +    FAnimationTimer: TTimer;
         procedure CreateThread;
         procedure DestroyThread;
    +    procedure StepQDAnimation(Sender: TObject);
       protected
         procedure CreateHardwareCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
         procedure CreateColorCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
    +    procedure DestroyCursor;
       public
         constructor Create;
    +    constructor CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
         constructor CreateFromInfo(AInfo: PIconInfo);
         constructor CreateThemed(AThemeCursor: ThemeCursor; ADefault: Boolean = False);
         destructor Destroy; override;
    @@ -2152,7 +2162,7 @@
       FPixmapHandle^^.pmTable := nil;
       FPixmapHandle^^.baseAddr := Ptr(ABitmap.Data);
     
    -  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(Self));
    +  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(FPixmapHandle));
       OSError(
         QDRegisterNamedPixMapCursor(FPixmapHandle, nil, AHotSpot, PChar(FQDHardwareCursorName)),
         Self, 'CreateHardwareCursor', 'QDRegisterNamedPixMapCursor');
    @@ -2243,6 +2253,32 @@
       end;
     end;
     
    +
    +{------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.CreateFromInfo
    +  Params:  AInfo - Array of cursor info
    +           ACount - Number of items in array
    +
    +  Creates new cursor from the specified info
    + ------------------------------------------------------------------------------}
    +constructor TCarbonCursor.CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
    +var
    +  i: Integer;
    +begin
    +  FAnimationTimer := TTimer.Create(nil);
    +  FAnimationTimer.Enabled := False;
    +  FAnimationTimer.Interval := 150;//kThemeCursorAnimationDelay;
    +  FAnimationTimer.OnTimer := @StepQDAnimation;
    +  SetLength(FAnimationFrames, ACount);
    +  for i := 0 to ACount - 1 do begin
    +    CreateFromInfo(AInfo);
    +    FAnimationFrames[i].QDColorCursorHandle := FQDColorCursorHandle;
    +    FAnimationFrames[i].QDHardwareCursorName := FQDHardwareCursorName;
    +    FAnimationFrames[i].PixmapHandle := FPixmapHandle;
    +    Inc(AInfo);
    +  end;
    +end;
    +
     {------------------------------------------------------------------------------
       Method:  TCarbonCursor.CreateFromInfo
       Params:  AInfo - Cusrsor info
    @@ -2323,29 +2359,54 @@
         FCursorType := cctTheme;
     end;
     
    +
     {------------------------------------------------------------------------------
       Method:  TCarbonCursor.Destroy
     
    -  Frees Carbon cursor
    +  Frees QuickDraw cursor
      ------------------------------------------------------------------------------}
    -destructor TCarbonCursor.Destroy;
    +procedure TCarbonCursor.DestroyCursor;
     begin
    -  UnInstall;
    -  
       case CursorType of
         cctQDHardware:
           if FQDHardwareCursorName <> '' then
           begin
             OSError(QDUnregisterNamedPixmapCursor(PChar(FQDHardwareCursorName)),
               Self, SDestroy, 'QDUnregisterNamedPixmapCursor');
    -        
    +
             FPixmapHandle^^.baseAddr := nil;
             DisposePixMap(FPixmapHandle);
           end;
         cctQDColor:
           DisposeCCursor(FQDColorCursorHandle);  // suppose pixmap will be disposed too
       end;
    +end;
    +
    +{------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.Destroy
    +
    +  Frees Carbon cursor
    + ------------------------------------------------------------------------------}
    +destructor TCarbonCursor.Destroy;
    +var
    +  i: Integer;
    +begin
    +  UnInstall;
       
    +  if FAnimationFrames <> nil then
    +  begin
    +    FAnimationTimer.Free;
    +    for i := 0 to Length(FAnimationFrames) - 1 do
    +    begin
    +      FQDColorCursorHandle := FAnimationFrames[i].QDColorCursorHandle;
    +      FQDHardwareCursorName := FAnimationFrames[i].QDHardwareCursorName;
    +      FPixmapHandle := FAnimationFrames[i].PixmapHandle;
    +      DestroyCursor;
    +    end;
    +  end
    +  else
    +    DestroyCursor;
    +
       inherited Destroy;
     end;
     
    @@ -2362,6 +2423,11 @@
         DebugLn('TCarbonCursor.Install type: ', DbgS(Ord(CursorType)));
       {$ENDIF}
       
    +  if FAnimationTimer <> nil then
    +  begin
    +    FAnimationStep := 0;
    +    FAnimationTimer.Enabled := True;
    +  end;
       case CursorType of
         cctQDHardware:
           if FQDHardwareCursorName <> '' then
    @@ -2394,6 +2460,9 @@
       case CursorType of
         cctWait: QDDisplayWaitCursor(False);
         cctAnimated: DestroyThread;
    +    cctQDColor, cctQDHardware:
    +      if FAnimationTimer <> nil then
    +        FAnimationTimer.Enabled := False;
       end;
     end;
     
    @@ -2414,6 +2483,25 @@
         FCursorType := cctTheme;
         SetThemeCursor(FThemeCursor);
       end;
    +end;
    +
    +{------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.StepQDAnimation
    +
    +  Steps Carbon QuickDraw cursor animation
    + ------------------------------------------------------------------------------}
    +procedure TCarbonCursor.StepQDAnimation(Sender: TObject);
    +begin
    +  case CursorType of
    +    cctQDHardware:
    +      with FAnimationFrames[FAnimationStep] do
    +        if QDHardwareCursorName <> '' then
    +          OSError(QDSetNamedPixmapCursor(PChar(QDHardwareCursorName)),
    +            Self, 'StepAnimation', 'QDSetNamedPixmapCursor');
    +    cctQDColor:
    +      SetCCursor(FAnimationFrames[FAnimationStep].QDColorCursorHandle);
    +  end;
    +  FAnimationStep := (FAnimationStep + 1) mod Length(FAnimationFrames);
     end;
     
     {------------------------------------------------------------------------------
    
  • carbonint.pas.patch (340 bytes)
    --- /Users/djenkins/laz-changes/14807/carbonint.pas	2012-04-11 17:16:26.000000000 
    +++ /Users/djenkins/laz-changes/14807/carbonint.pas.ss	2012-04-11 17:17:02.000000000 
    @@ -153,6 +153,8 @@
     var
       CarbonWidgetSet: TCarbonWidgetSet;
     
    +function Create32BitAlphaBitmap(ABitmap, AMask: TCarbonBitmap): TCarbonBitmap;
    +
     implementation
     
     uses
    
    carbonint.pas.patch (340 bytes)
  • svn_patch-21755 (6,696 bytes)
    Index: lcl/interfaces/carbon/carbonint.pas
    ===================================================================
    --- lcl/interfaces/carbon/carbonint.pas	(revision 36681)
    +++ lcl/interfaces/carbon/carbonint.pas	(working copy)
    @@ -153,6 +153,8 @@
     var
       CarbonWidgetSet: TCarbonWidgetSet;
     
    +function Create32BitAlphaBitmap(ABitmap, AMask: TCarbonBitmap): TCarbonBitmap;
    +
     implementation
     
     uses
    Index: lcl/interfaces/carbon/carbongdiobjects.pp
    ===================================================================
    --- lcl/interfaces/carbon/carbongdiobjects.pp	(revision 36681)
    +++ lcl/interfaces/carbon/carbongdiobjects.pp	(working copy)
    @@ -31,7 +31,7 @@
      // carbon bindings
       MacOSAll,
      // LCL
    -  LCLProc, LCLType, GraphType, Graphics, Controls, Forms,
    +  LCLProc, LCLType, GraphType, Graphics, Controls, Forms, ExtCtrls,
      // LCL Carbon
      {$ifdef DebugBitmaps}
       CarbonDebug,
    @@ -363,13 +363,23 @@
         FQDColorCursorHandle: CCrsrHandle;
         FQDHardwareCursorName: String;
         FPixmapHandle: PixmapHandle;
    +    // animated color cursors
    +    FAnimationFrames: array of record
    +      QDColorCursorHandle: CCrsrHandle;
    +      QDHardwareCursorName: String;
    +      PixmapHandle: PixmapHandle;
    +    end;
    +    FAnimationTimer: TTimer;
         procedure CreateThread;
         procedure DestroyThread;
    +    procedure StepQDAnimation(Sender: TObject);
       protected
         procedure CreateHardwareCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
         procedure CreateColorCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
    +    procedure DestroyCursor;
       public
         constructor Create;
    +    constructor CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
         constructor CreateFromInfo(AInfo: PIconInfo);
         constructor CreateThemed(AThemeCursor: ThemeCursor; ADefault: Boolean = False);
         destructor Destroy; override;
    @@ -2152,7 +2162,7 @@
       FPixmapHandle^^.pmTable := nil;
       FPixmapHandle^^.baseAddr := Ptr(ABitmap.Data);
     
    -  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(Self));
    +  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(FPixmapHandle));
       OSError(
         QDRegisterNamedPixMapCursor(FPixmapHandle, nil, AHotSpot, PChar(FQDHardwareCursorName)),
         Self, 'CreateHardwareCursor', 'QDRegisterNamedPixMapCursor');
    @@ -2243,6 +2253,32 @@
       end;
     end;
     
    +
    +{------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.CreateFromInfo
    +  Params:  AInfo - Array of cursor info
    +           ACount - Number of items in array
    +
    +  Creates new cursor from the specified info
    + ------------------------------------------------------------------------------}
    +constructor TCarbonCursor.CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
    +var
    +  i: Integer;
    +begin
    +  FAnimationTimer := TTimer.Create(nil);
    +  FAnimationTimer.Enabled := False;
    +  FAnimationTimer.Interval := 150;//kThemeCursorAnimationDelay;
    +  FAnimationTimer.OnTimer := @StepQDAnimation;
    +  SetLength(FAnimationFrames, ACount);
    +  for i := 0 to ACount - 1 do begin
    +    CreateFromInfo(AInfo);
    +    FAnimationFrames[i].QDColorCursorHandle := FQDColorCursorHandle;
    +    FAnimationFrames[i].QDHardwareCursorName := FQDHardwareCursorName;
    +    FAnimationFrames[i].PixmapHandle := FPixmapHandle;
    +    Inc(AInfo);
    +  end;
    +end;
    +
     {------------------------------------------------------------------------------
       Method:  TCarbonCursor.CreateFromInfo
       Params:  AInfo - Cusrsor info
    @@ -2323,29 +2359,54 @@
         FCursorType := cctTheme;
     end;
     
    +
     {------------------------------------------------------------------------------
       Method:  TCarbonCursor.Destroy
     
    -  Frees Carbon cursor
    +  Frees QuickDraw cursor
      ------------------------------------------------------------------------------}
    -destructor TCarbonCursor.Destroy;
    +procedure TCarbonCursor.DestroyCursor;
     begin
    -  UnInstall;
    -  
       case CursorType of
         cctQDHardware:
           if FQDHardwareCursorName <> '' then
           begin
             OSError(QDUnregisterNamedPixmapCursor(PChar(FQDHardwareCursorName)),
               Self, SDestroy, 'QDUnregisterNamedPixmapCursor');
    -        
    +
             FPixmapHandle^^.baseAddr := nil;
             DisposePixMap(FPixmapHandle);
           end;
         cctQDColor:
           DisposeCCursor(FQDColorCursorHandle);  // suppose pixmap will be disposed too
       end;
    +end;
    +
    +{------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.Destroy
    +
    +  Frees Carbon cursor
    + ------------------------------------------------------------------------------}
    +destructor TCarbonCursor.Destroy;
    +var
    +  i: Integer;
    +begin
    +  UnInstall;
       
    +  if FAnimationFrames <> nil then
    +  begin
    +    FAnimationTimer.Free;
    +    for i := 0 to Length(FAnimationFrames) - 1 do
    +    begin
    +      FQDColorCursorHandle := FAnimationFrames[i].QDColorCursorHandle;
    +      FQDHardwareCursorName := FAnimationFrames[i].QDHardwareCursorName;
    +      FPixmapHandle := FAnimationFrames[i].PixmapHandle;
    +      DestroyCursor;
    +    end;
    +  end
    +  else
    +    DestroyCursor;
    +
       inherited Destroy;
     end;
     
    @@ -2362,6 +2423,11 @@
         DebugLn('TCarbonCursor.Install type: ', DbgS(Ord(CursorType)));
       {$ENDIF}
       
    +  if FAnimationTimer <> nil then
    +  begin
    +    FAnimationStep := 0;
    +    FAnimationTimer.Enabled := True;
    +  end;
       case CursorType of
         cctQDHardware:
           if FQDHardwareCursorName <> '' then
    @@ -2394,6 +2460,9 @@
       case CursorType of
         cctWait: QDDisplayWaitCursor(False);
         cctAnimated: DestroyThread;
    +    cctQDColor, cctQDHardware:
    +      if FAnimationTimer <> nil then
    +        FAnimationTimer.Enabled := False;
       end;
     end;
     
    @@ -2417,6 +2486,25 @@
     end;
     
     {------------------------------------------------------------------------------
    +  Method:  TCarbonCursor.StepQDAnimation
    +
    +  Steps Carbon QuickDraw cursor animation
    + ------------------------------------------------------------------------------}
    +procedure TCarbonCursor.StepQDAnimation(Sender: TObject);
    +begin
    +  case CursorType of
    +    cctQDHardware:
    +      with FAnimationFrames[FAnimationStep] do
    +        if QDHardwareCursorName <> '' then
    +          OSError(QDSetNamedPixmapCursor(PChar(QDHardwareCursorName)),
    +            Self, 'StepAnimation', 'QDSetNamedPixmapCursor');
    +    cctQDColor:
    +      SetCCursor(FAnimationFrames[FAnimationStep].QDColorCursorHandle);
    +  end;
    +  FAnimationStep := (FAnimationStep + 1) mod Length(FAnimationFrames);
    +end;
    +
    +{------------------------------------------------------------------------------
       Method:  TCarbonCursor.HardwareCursorsSupported
       Returns: If hardware cursors are supported
      ------------------------------------------------------------------------------}
    
    svn_patch-21755 (6,696 bytes)

Activities

2012-04-13 21:52

 

carbongdiobjects.pp.patch (6,136 bytes)
--- /Users/djenkins/laz-changes/14807/carbongdiobjects.pp	2012-04-11 17:11:26.000000000 
+++ /Users/djenkins/laz-changes/14807/carbongdiobjects.pp.ss	2012-04-11 17:15:21.000000000 
@@ -31,7 +31,7 @@
  // carbon bindings
   MacOSAll,
  // LCL
-  LCLProc, LCLType, GraphType, Graphics, Controls, Forms,
+  LCLProc, LCLType, GraphType, Graphics, Controls, Forms, ExtCtrls,
  // LCL Carbon
  {$ifdef DebugBitmaps}
   CarbonDebug,
@@ -363,13 +363,23 @@
     FQDColorCursorHandle: CCrsrHandle;
     FQDHardwareCursorName: String;
     FPixmapHandle: PixmapHandle;
+    // animated color cursors
+    FAnimationFrames: array of record
+      QDColorCursorHandle: CCrsrHandle;
+      QDHardwareCursorName: String;
+      PixmapHandle: PixmapHandle;
+    end;
+    FAnimationTimer: TTimer;
     procedure CreateThread;
     procedure DestroyThread;
+    procedure StepQDAnimation(Sender: TObject);
   protected
     procedure CreateHardwareCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
     procedure CreateColorCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
+    procedure DestroyCursor;
   public
     constructor Create;
+    constructor CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
     constructor CreateFromInfo(AInfo: PIconInfo);
     constructor CreateThemed(AThemeCursor: ThemeCursor; ADefault: Boolean = False);
     destructor Destroy; override;
@@ -2152,7 +2162,7 @@
   FPixmapHandle^^.pmTable := nil;
   FPixmapHandle^^.baseAddr := Ptr(ABitmap.Data);
 
-  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(Self));
+  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(FPixmapHandle));
   OSError(
     QDRegisterNamedPixMapCursor(FPixmapHandle, nil, AHotSpot, PChar(FQDHardwareCursorName)),
     Self, 'CreateHardwareCursor', 'QDRegisterNamedPixMapCursor');
@@ -2243,6 +2253,32 @@
   end;
 end;
 
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonCursor.CreateFromInfo
+  Params:  AInfo - Array of cursor info
+           ACount - Number of items in array
+
+  Creates new cursor from the specified info
+ ------------------------------------------------------------------------------}
+constructor TCarbonCursor.CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
+var
+  i: Integer;
+begin
+  FAnimationTimer := TTimer.Create(nil);
+  FAnimationTimer.Enabled := False;
+  FAnimationTimer.Interval := 150;//kThemeCursorAnimationDelay;
+  FAnimationTimer.OnTimer := @StepQDAnimation;
+  SetLength(FAnimationFrames, ACount);
+  for i := 0 to ACount - 1 do begin
+    CreateFromInfo(AInfo);
+    FAnimationFrames[i].QDColorCursorHandle := FQDColorCursorHandle;
+    FAnimationFrames[i].QDHardwareCursorName := FQDHardwareCursorName;
+    FAnimationFrames[i].PixmapHandle := FPixmapHandle;
+    Inc(AInfo);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonCursor.CreateFromInfo
   Params:  AInfo - Cusrsor info
@@ -2323,29 +2359,54 @@
     FCursorType := cctTheme;
 end;
 
+
 {------------------------------------------------------------------------------
   Method:  TCarbonCursor.Destroy
 
-  Frees Carbon cursor
+  Frees QuickDraw cursor
  ------------------------------------------------------------------------------}
-destructor TCarbonCursor.Destroy;
+procedure TCarbonCursor.DestroyCursor;
 begin
-  UnInstall;
-  
   case CursorType of
     cctQDHardware:
       if FQDHardwareCursorName <> '' then
       begin
         OSError(QDUnregisterNamedPixmapCursor(PChar(FQDHardwareCursorName)),
           Self, SDestroy, 'QDUnregisterNamedPixmapCursor');
-        
+
         FPixmapHandle^^.baseAddr := nil;
         DisposePixMap(FPixmapHandle);
       end;
     cctQDColor:
       DisposeCCursor(FQDColorCursorHandle);  // suppose pixmap will be disposed too
   end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonCursor.Destroy
+
+  Frees Carbon cursor
+ ------------------------------------------------------------------------------}
+destructor TCarbonCursor.Destroy;
+var
+  i: Integer;
+begin
+  UnInstall;
   
+  if FAnimationFrames <> nil then
+  begin
+    FAnimationTimer.Free;
+    for i := 0 to Length(FAnimationFrames) - 1 do
+    begin
+      FQDColorCursorHandle := FAnimationFrames[i].QDColorCursorHandle;
+      FQDHardwareCursorName := FAnimationFrames[i].QDHardwareCursorName;
+      FPixmapHandle := FAnimationFrames[i].PixmapHandle;
+      DestroyCursor;
+    end;
+  end
+  else
+    DestroyCursor;
+
   inherited Destroy;
 end;
 
@@ -2362,6 +2423,11 @@
     DebugLn('TCarbonCursor.Install type: ', DbgS(Ord(CursorType)));
   {$ENDIF}
   
+  if FAnimationTimer <> nil then
+  begin
+    FAnimationStep := 0;
+    FAnimationTimer.Enabled := True;
+  end;
   case CursorType of
     cctQDHardware:
       if FQDHardwareCursorName <> '' then
@@ -2394,6 +2460,9 @@
   case CursorType of
     cctWait: QDDisplayWaitCursor(False);
     cctAnimated: DestroyThread;
+    cctQDColor, cctQDHardware:
+      if FAnimationTimer <> nil then
+        FAnimationTimer.Enabled := False;
   end;
 end;
 
@@ -2414,6 +2483,25 @@
     FCursorType := cctTheme;
     SetThemeCursor(FThemeCursor);
   end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonCursor.StepQDAnimation
+
+  Steps Carbon QuickDraw cursor animation
+ ------------------------------------------------------------------------------}
+procedure TCarbonCursor.StepQDAnimation(Sender: TObject);
+begin
+  case CursorType of
+    cctQDHardware:
+      with FAnimationFrames[FAnimationStep] do
+        if QDHardwareCursorName <> '' then
+          OSError(QDSetNamedPixmapCursor(PChar(QDHardwareCursorName)),
+            Self, 'StepAnimation', 'QDSetNamedPixmapCursor');
+    cctQDColor:
+      SetCCursor(FAnimationFrames[FAnimationStep].QDColorCursorHandle);
+  end;
+  FAnimationStep := (FAnimationStep + 1) mod Length(FAnimationFrames);
 end;
 
 {------------------------------------------------------------------------------

2012-04-13 21:53

 

carbonint.pas.patch (340 bytes)
--- /Users/djenkins/laz-changes/14807/carbonint.pas	2012-04-11 17:16:26.000000000 
+++ /Users/djenkins/laz-changes/14807/carbonint.pas.ss	2012-04-11 17:17:02.000000000 
@@ -153,6 +153,8 @@
 var
   CarbonWidgetSet: TCarbonWidgetSet;
 
+function Create32BitAlphaBitmap(ABitmap, AMask: TCarbonBitmap): TCarbonBitmap;
+
 implementation
 
 uses
carbonint.pas.patch (340 bytes)

2012-04-19 17:45

 

svn_patch-21755 (6,696 bytes)
Index: lcl/interfaces/carbon/carbonint.pas
===================================================================
--- lcl/interfaces/carbon/carbonint.pas	(revision 36681)
+++ lcl/interfaces/carbon/carbonint.pas	(working copy)
@@ -153,6 +153,8 @@
 var
   CarbonWidgetSet: TCarbonWidgetSet;
 
+function Create32BitAlphaBitmap(ABitmap, AMask: TCarbonBitmap): TCarbonBitmap;
+
 implementation
 
 uses
Index: lcl/interfaces/carbon/carbongdiobjects.pp
===================================================================
--- lcl/interfaces/carbon/carbongdiobjects.pp	(revision 36681)
+++ lcl/interfaces/carbon/carbongdiobjects.pp	(working copy)
@@ -31,7 +31,7 @@
  // carbon bindings
   MacOSAll,
  // LCL
-  LCLProc, LCLType, GraphType, Graphics, Controls, Forms,
+  LCLProc, LCLType, GraphType, Graphics, Controls, Forms, ExtCtrls,
  // LCL Carbon
  {$ifdef DebugBitmaps}
   CarbonDebug,
@@ -363,13 +363,23 @@
     FQDColorCursorHandle: CCrsrHandle;
     FQDHardwareCursorName: String;
     FPixmapHandle: PixmapHandle;
+    // animated color cursors
+    FAnimationFrames: array of record
+      QDColorCursorHandle: CCrsrHandle;
+      QDHardwareCursorName: String;
+      PixmapHandle: PixmapHandle;
+    end;
+    FAnimationTimer: TTimer;
     procedure CreateThread;
     procedure DestroyThread;
+    procedure StepQDAnimation(Sender: TObject);
   protected
     procedure CreateHardwareCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
     procedure CreateColorCursor(ABitmap: TCarbonBitmap; AHotSpot: Point);
+    procedure DestroyCursor;
   public
     constructor Create;
+    constructor CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
     constructor CreateFromInfo(AInfo: PIconInfo);
     constructor CreateThemed(AThemeCursor: ThemeCursor; ADefault: Boolean = False);
     destructor Destroy; override;
@@ -2152,7 +2162,7 @@
   FPixmapHandle^^.pmTable := nil;
   FPixmapHandle^^.baseAddr := Ptr(ABitmap.Data);
 
-  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(Self));
+  FQDHardwareCursorName := Application.Title + LazarusCursorInfix + IntToStr(Integer(FPixmapHandle));
   OSError(
     QDRegisterNamedPixMapCursor(FPixmapHandle, nil, AHotSpot, PChar(FQDHardwareCursorName)),
     Self, 'CreateHardwareCursor', 'QDRegisterNamedPixMapCursor');
@@ -2243,6 +2253,32 @@
   end;
 end;
 
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonCursor.CreateFromInfo
+  Params:  AInfo - Array of cursor info
+           ACount - Number of items in array
+
+  Creates new cursor from the specified info
+ ------------------------------------------------------------------------------}
+constructor TCarbonCursor.CreateAnimatedFromInfo(AInfo: PIconInfo; ACount: Integer);
+var
+  i: Integer;
+begin
+  FAnimationTimer := TTimer.Create(nil);
+  FAnimationTimer.Enabled := False;
+  FAnimationTimer.Interval := 150;//kThemeCursorAnimationDelay;
+  FAnimationTimer.OnTimer := @StepQDAnimation;
+  SetLength(FAnimationFrames, ACount);
+  for i := 0 to ACount - 1 do begin
+    CreateFromInfo(AInfo);
+    FAnimationFrames[i].QDColorCursorHandle := FQDColorCursorHandle;
+    FAnimationFrames[i].QDHardwareCursorName := FQDHardwareCursorName;
+    FAnimationFrames[i].PixmapHandle := FPixmapHandle;
+    Inc(AInfo);
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method:  TCarbonCursor.CreateFromInfo
   Params:  AInfo - Cusrsor info
@@ -2323,29 +2359,54 @@
     FCursorType := cctTheme;
 end;
 
+
 {------------------------------------------------------------------------------
   Method:  TCarbonCursor.Destroy
 
-  Frees Carbon cursor
+  Frees QuickDraw cursor
  ------------------------------------------------------------------------------}
-destructor TCarbonCursor.Destroy;
+procedure TCarbonCursor.DestroyCursor;
 begin
-  UnInstall;
-  
   case CursorType of
     cctQDHardware:
       if FQDHardwareCursorName <> '' then
       begin
         OSError(QDUnregisterNamedPixmapCursor(PChar(FQDHardwareCursorName)),
           Self, SDestroy, 'QDUnregisterNamedPixmapCursor');
-        
+
         FPixmapHandle^^.baseAddr := nil;
         DisposePixMap(FPixmapHandle);
       end;
     cctQDColor:
       DisposeCCursor(FQDColorCursorHandle);  // suppose pixmap will be disposed too
   end;
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonCursor.Destroy
+
+  Frees Carbon cursor
+ ------------------------------------------------------------------------------}
+destructor TCarbonCursor.Destroy;
+var
+  i: Integer;
+begin
+  UnInstall;
   
+  if FAnimationFrames <> nil then
+  begin
+    FAnimationTimer.Free;
+    for i := 0 to Length(FAnimationFrames) - 1 do
+    begin
+      FQDColorCursorHandle := FAnimationFrames[i].QDColorCursorHandle;
+      FQDHardwareCursorName := FAnimationFrames[i].QDHardwareCursorName;
+      FPixmapHandle := FAnimationFrames[i].PixmapHandle;
+      DestroyCursor;
+    end;
+  end
+  else
+    DestroyCursor;
+
   inherited Destroy;
 end;
 
@@ -2362,6 +2423,11 @@
     DebugLn('TCarbonCursor.Install type: ', DbgS(Ord(CursorType)));
   {$ENDIF}
   
+  if FAnimationTimer <> nil then
+  begin
+    FAnimationStep := 0;
+    FAnimationTimer.Enabled := True;
+  end;
   case CursorType of
     cctQDHardware:
       if FQDHardwareCursorName <> '' then
@@ -2394,6 +2460,9 @@
   case CursorType of
     cctWait: QDDisplayWaitCursor(False);
     cctAnimated: DestroyThread;
+    cctQDColor, cctQDHardware:
+      if FAnimationTimer <> nil then
+        FAnimationTimer.Enabled := False;
   end;
 end;
 
@@ -2417,6 +2486,25 @@
 end;
 
 {------------------------------------------------------------------------------
+  Method:  TCarbonCursor.StepQDAnimation
+
+  Steps Carbon QuickDraw cursor animation
+ ------------------------------------------------------------------------------}
+procedure TCarbonCursor.StepQDAnimation(Sender: TObject);
+begin
+  case CursorType of
+    cctQDHardware:
+      with FAnimationFrames[FAnimationStep] do
+        if QDHardwareCursorName <> '' then
+          OSError(QDSetNamedPixmapCursor(PChar(QDHardwareCursorName)),
+            Self, 'StepAnimation', 'QDSetNamedPixmapCursor');
+    cctQDColor:
+      SetCCursor(FAnimationFrames[FAnimationStep].QDColorCursorHandle);
+  end;
+  FAnimationStep := (FAnimationStep + 1) mod Length(FAnimationFrames);
+end;
+
+{------------------------------------------------------------------------------
   Method:  TCarbonCursor.HardwareCursorsSupported
   Returns: If hardware cursors are supported
  ------------------------------------------------------------------------------}
svn_patch-21755 (6,696 bytes)

Alexey Tor.

2017-04-08 18:46

reporter   ~0099516

Last edited: 2017-04-08 18:48

View 2 revisions

Diff can apply to today trunk. IDE compiles ok then, app works ok.

//MacOS dont have usual options to change cursors. so i cannot test animation. https://features.en.softonic.com/5-ways-to-customize-your-cursor-on-mac

Juha Manninen

2017-04-09 16:27

developer   ~0099523

Applied, thanks.
After some testing period this can be merged to fixes_1_8 branch.

Issue History

Date Modified Username Field Change
2012-04-13 21:52 David Jenkins New Issue
2012-04-13 21:52 David Jenkins File Added: carbongdiobjects.pp.patch
2012-04-13 21:52 David Jenkins Widgetset => Carbon
2012-04-13 21:53 David Jenkins File Added: carbonint.pas.patch
2012-04-19 17:45 David Jenkins File Added: svn_patch-21755
2017-04-08 18:46 Alexey Tor. Note Added: 0099516
2017-04-08 18:48 Alexey Tor. Note Edited: 0099516 View Revisions
2017-04-08 20:10 Juha Manninen Assigned To => Juha Manninen
2017-04-08 20:10 Juha Manninen Status new => assigned
2017-04-09 16:27 Juha Manninen Fixed in Revision => r54590
2017-04-09 16:27 Juha Manninen LazTarget => -
2017-04-09 16:27 Juha Manninen Note Added: 0099523
2017-04-09 16:27 Juha Manninen Status assigned => resolved
2017-04-09 16:27 Juha Manninen Resolution open => fixed