Pārlūkot izejas kodu

* Some delphi compatibility methods/types for actions

(cherry picked from commit a88dd9197fb367378a4d395235456f9019caa684)
Michaël Van Canneyt 1 gadu atpakaļ
vecāks
revīzija
0d7e93d87b

+ 1 - 0
packages/rtl-objpas/src/inc/system.uitypes.pp

@@ -25,6 +25,7 @@ Type
     PColorRef   = ^TColorRef;
     TAlphaColor = Cardinal;
     PAlphaColor = ^TAlphaColor;
+    TImageIndex = type Integer;
 
     TColorRec = record
                  class operator := (AColor : TColor): TColorRec; inline;

+ 34 - 0
rtl/objpas/classes/action.inc

@@ -140,6 +140,11 @@ begin
    Result := False;
 end;
 
+function TBasicAction.Suspended: Boolean;
+begin
+  Result:=False;
+end;
+
 
 procedure TBasicAction.SetOnExecute(Value: TNotifyEvent);
 var
@@ -155,6 +160,25 @@ begin
   end;
 end;
 
+function TBasicAction.ClientCount: Integer;
+begin
+  Result:=FClients.Count;
+end;
+
+function TBasicAction.GetClient(Idx: Integer): TObject;
+begin
+  Result:=TObject(FClients[Idx]);
+end;
+
+procedure TBasicAction.SetActionComponent(AValue: TComponent);
+begin
+  if FActionComponent=AValue then Exit;
+  if Assigned(FActionComponent) then
+     FActionComponent.RemoveFreeNotification(Self);
+  FActionComponent:=AValue;
+  if Assigned(FActionComponent) then
+     FActionComponent.FreeNotification(Self);
+end;
 
 procedure TBasicAction.Change;
 begin
@@ -162,6 +186,16 @@ begin
     FOnChange(Self);
 end;
 
+procedure TBasicAction.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation<>OpRemove) then
+    exit;
+  if (AComponent=FActionComponent) then
+    FActionComponent:=nil;
+end;
+
 
 procedure TBasicAction.RegisterChanges(Value: TBasicActionLink);
 begin

+ 8 - 1
rtl/objpas/classes/classesh.inc

@@ -116,6 +116,7 @@ type
 { Standard events }
 
   TNotifyEvent = procedure(Sender: TObject) of object;
+  THintEvent = procedure(var HintStr: string; var CanShow: Boolean) of object;
   THelpEvent = function (Command: Word; Data: Longint;
     var CallHelp: Boolean): Boolean of object;
   TGetStrProc = procedure(const S: string) of object;
@@ -2024,11 +2025,15 @@ type
     FOnChange: TNotifyEvent;
     FOnExecute: TNotifyEvent;
     FOnUpdate: TNotifyEvent;
+    procedure SetActionComponent(AValue: TComponent);
   protected
     FClients: TFpList;
     procedure Change; virtual;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure SetOnExecute(Value: TNotifyEvent); virtual;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    Function ClientCount : Integer;
+    Function GetClient(Idx : Integer) : TObject;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -2039,10 +2044,12 @@ type
     procedure RegisterChanges(Value: TBasicActionLink);
     procedure UnRegisterChanges(Value: TBasicActionLink);
     function Update: Boolean; virtual;
-    property ActionComponent: TComponent read FActionComponent write FActionComponent;
+    function Suspended: Boolean; virtual;
+    property ActionComponent: TComponent read FActionComponent write SetActionComponent;
     property OnExecute: TNotifyEvent read FOnExecute write SetOnExecute;
     property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
   end;
+  TActionEvent = procedure(Action: TBasicAction; var Handled: Boolean) of object;
 
 { TBasicAction class reference type }