tntactnlist.pas

TNT Components Source

procedure TntAction_SetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Value: WideString);
begin
  if Supports(Action, ITntAction) then
    with FindActionHelper(Action) do
      SetHint(Value)
  else
    Action.Hint := Value;
end;

function TntAction_GetHint(Action: TCustomAction{TNT-ALLOW TCustomAction}): WideString;
begin
  if Supports(Action, ITntAction) then
    with FindActionHelper(Action) do
      Result := GetHint
  else
    Result := Action.Hint;
end;

function TntAction_GetNewHint(Action: TCustomAction{TNT-ALLOW TCustomAction}; const Default: WideString): WideString;
begin
  Result := Default;
  if Supports(Action, ITntAction) then
    with FindActionHelper(Action) do
      if SettingNewHint then
        Result := FHint;
end;

procedure TntAction_AfterInherited_Assign(Action: TCustomAction{TNT-ALLOW TCustomAction}; Source: TPersistent);
begin
  with Action do begin
    if (Source is TCustomAction{TNT-ALLOW TCustomAction}) then begin
      Caption := TntAction_GetCaption(Source as TCustomAction{TNT-ALLOW TCustomAction});
      Hint := TntAction_GetHint(Source as TCustomAction{TNT-ALLOW TCustomAction});
    end else if (Source is TControl) then begin
      Caption := TntControl_GetText(Source as TControl);
      Hint := TntControl_GetHint(Source as TControl);
    end;
  end;
end;

// -- TControl helper routines

function TntControl_GetActionLinkClass(Control: TControl; InheritedLinkClass: TControlActionLinkClass): TControlActionLinkClass;
begin
  if Control is TCustomListView{TNT-ALLOW TCustomListView} then
    Result := TTntListViewActionLink
  else if Control is TComboBoxEx then
    Result := TTntComboBoxExActionLink
  else if Control is TSpeedButton{TNT-ALLOW TSpeedButton} then
    Result := TTntSpeedButtonActionLink
  {$IFDEF COMPILER_10_UP}
  else if Control is TBitBtn{TNT-ALLOW TBitBtn} then
    Result := TTntBitBtnActionLink
  {$ENDIF}
  else if Control is TToolButton{TNT-ALLOW TToolButton} then
    Result := TTntToolButtonActionLink
  else if Control is TButtonControl then
    Result := TTntButtonActionLink
  else if Control is TWinControl then
    Result := TTntWinControlActionLink
  else
    Result := TTntControlActionLink;

  Assert(Result.ClassParent = InheritedLinkClass);
end;

procedure TntControl_BeforeInherited_ActionChange(Control: TControl; Sender: TObject; CheckDefaults: Boolean);
begin
  if (Sender is TCustomAction{TNT-ALLOW TCustomAction}) and Supports(Sender, ITntAction) then begin
    if not CheckDefaults or (TntControl_GetText(Control) = '') or (TntControl_GetText(Control) = Control.Name) then
      TntControl_SetText(Control, TntAction_GetCaption(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
    if not CheckDefaults or (TntControl_GetHint(Control) = '') then
      TntControl_SetHint(Control, TntAction_GetHint(TCustomAction{TNT-ALLOW TCustomAction}(Sender)));
  end;
end;

// -- TControlActionLink helper routines

function TntActionLink_IsCaptionLinked(InheritedIsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
begin
  Result := InheritedIsCaptionLinked
    and (TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetText(FClient));
end;

function TntActionLink_IsHintLinked(InheritedIsHintLinked: Boolean; Action: TBasicAction; FClient: TControl): Boolean;
begin
  Result := InheritedIsHintLinked
        and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = TntControl_GetHint(FClient));
end;

procedure TntActionLink_SetCaption(IsCaptionLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
begin
  if IsCaptionLinked then
    TntControl_SetText(FClient, TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
end;

procedure TntActionLink_SetHint(IsHintLinked: Boolean; Action: TBasicAction; FClient: TControl; const Value: string{TNT-ALLOW string});
begin
  if IsHintLinked then
    TntControl_SetHint(FClient, TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value));
end;

//---------------------------------------------------------------------------------------------
//                              ACTIONS
//---------------------------------------------------------------------------------------------

{ TTntCustomAction }

procedure TTntCustomAction.Assign(Source: TPersistent);
begin
  inherited;
  TntAction_AfterInherited_Assign(Self, Source);
end;

procedure TTntCustomAction.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntCustomAction.GetCaption: WideString;
begin
  Result := TntAction_GetCaption(Self);
end;

procedure TTntCustomAction.SetCaption(const Value: WideString);
begin
  TntAction_SetCaption(Self, Value);
end;

function TTntCustomAction.GetHint: WideString;
begin
  Result := TntAction_GetHint(Self);
end;

procedure TTntCustomAction.SetHint(const Value: WideString);
begin
  TntAction_SetHint(Self, Value);
end;

{ TTntAction }

procedure TTntAction.Assign(Source: TPersistent);
begin
  inherited;
  TntAction_AfterInherited_Assign(Self, Source);
end;

procedure TTntAction.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntAction.GetCaption: WideString;
begin
  Result := TntAction_GetCaption(Self);
end;

procedure TTntAction.SetCaption(const Value: WideString);
begin
  TntAction_SetCaption(Self, Value);
end;

function TTntAction.GetHint: WideString;
begin
  Result := TntAction_GetHint(Self);
end;

procedure TTntAction.SetHint(const Value: WideString);
begin
  TntAction_SetHint(Self, Value);
end;

//---------------------------------------------------------------------------------------------
//                             MENU ACTION LINK
//---------------------------------------------------------------------------------------------

{ TTntMenuActionLink }

function TTntMenuActionLink.IsCaptionLinked: Boolean;
begin
  Result := inherited IsCaptionLinked
    and WideSameCaption(TntAction_GetCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}), (FClient as TTntMenuItem).Caption);
end;

function TTntMenuActionLink.IsHintLinked: Boolean;
begin
  Result := inherited IsHintLinked
        and (TntAction_GetHint(Action as TCustomAction{TNT-ALLOW TCustomAction}) = (FClient as TTntMenuItem).Hint);
end;

procedure TTntMenuActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  if IsCaptionLinked then
    (FClient as TTntMenuItem).Caption := TntAction_GetNewCaption(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
end;

procedure TTntMenuActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  if IsHintLinked then
    (FClient as TTntMenuItem).Hint := TntAction_GetNewHint(Action as TCustomAction{TNT-ALLOW TCustomAction}, Value);
end;

//---------------------------------------------------------------------------------------------
//                             CONTROL ACTION LINKS
//---------------------------------------------------------------------------------------------

{ TTntListViewActionLink }

function TTntListViewActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntListViewActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntListViewActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntListViewActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{ TTntComboBoxExActionLink }

function TTntComboBoxExActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntComboBoxExActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntComboBoxExActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntComboBoxExActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{ TTntSpeedButtonActionLink }

function TTntSpeedButtonActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntSpeedButtonActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntSpeedButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntSpeedButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{$IFDEF COMPILER_10_UP}
// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.

function TTntSpeedButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
end;

procedure TTntSpeedButtonActionLink.SetImageIndex(Value: Integer);
begin
  ; // taken from TActionLink.IsImageIndexLinked
end;
{$ENDIF}

{$IFDEF COMPILER_10_UP}
{ TTntBitBtnActionLink }

function TTntBitBtnActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntBitBtnActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntBitBtnActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntBitBtnActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{$IFDEF COMPILER_10_UP}
// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.

function TTntBitBtnActionLink.IsImageIndexLinked: Boolean;
begin
  Result := Action is TCustomAction{TNT-ALLOW TCustomAction}; // taken from TActionLink.IsImageIndexLinked
end;

procedure TTntBitBtnActionLink.SetImageIndex(Value: Integer);
begin
  ; // taken from TActionLink.IsImageIndexLinked
end;
{$ENDIF}

{$ENDIF}

{ TTntToolButtonActionLink }

function TTntToolButtonActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntToolButtonActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntToolButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntToolButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{ TTntButtonActionLink }

function TTntButtonActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntButtonActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntButtonActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntButtonActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{ TTntWinControlActionLink }

function TTntWinControlActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntWinControlActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntWinControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntWinControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

{ TTntControlActionLink }

function TTntControlActionLink.IsCaptionLinked: Boolean;
begin
  Result := TntActionLink_IsCaptionLinked(inherited IsCaptionLinked, Action, FClient);
end;

function TTntControlActionLink.IsHintLinked: Boolean;
begin
  Result := TntActionLink_IsHintLinked(inherited IsHintLinked, Action, FClient);
end;

procedure TTntControlActionLink.SetCaption(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetCaption(IsCaptionLinked, Action, FClient, Value);
end;

procedure TTntControlActionLink.SetHint(const Value: string{TNT-ALLOW string});
begin
  TntActionLink_SetHint(IsHintLinked, Action, FClient, Value);
end;

end.