Saber si un control tiene asignado OnEnter

[cesarsoftware]

Hola compis.

He hecho la tipica funcion para resaltar los controles de entrada (TEdit, TmaskEdit, etc). Todo funciona bién.
Este es el código

Código Delphi [-]
procedure TFormProveedorFactura.FormCreate(Sender: TObject);
begin
  ControlesResaltados();
end;

procedure TFormProveedorFactura.ControlesResaltados();
var
  i: word;
begin
  for i := 0 to FormProveedorFactura.ComponentCount - 1 do
  begin
    if FormProveedorFactura.Components[i] is TWinControl then
    begin
      TFormProveedorFactura(Components[i]).OnEnter := ControlEnter;
      TFormProveedorFactura(Components[i]).OnExit := ControlExit;
    end;
  end;
end;

procedure TFormProveedorFactura.ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clLime;
end;

procedure TFormProveedorFactura.ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

El tema es que algunos controles ya tienen las funciones onenter y onexit activadas, asi que las sustituyo.
Lo que no acierto es ha averiguar si el control ya tiene asignados los enventos para no incluirlos en esta funcion, y que sean esa funciones las que gestionen su entrada y salida algo si como

Código Delphi [-]
procedure TFormProveedorFactura.FechaVencimientoExit(Sender: TObject);
begin
  FechaVencimiento.Visible := False;
  TimerVencimientos.Enabled := False;
  ControlExit(Sender);
end;

procedure TFormProveedorFactura.ControlesResaltados();
var
  i: word;
begin
  for i := 0 to FormProveedorFactura.ComponentCount - 1 do
  begin
    if FormProveedorFactura.Components[i] is TWinControl then
    begin
      if TFormProveedorFactura(Components[i]).OnEnter = nil then
        TFormProveedorFactura(Components[i]).OnEnter := ControlEnter;
      if TFormProveedorFactura(Components[i]).OnExit = nil then
        TFormProveedorFactura(Components[i]).OnExit := ControlExit;
    end;
  end;
end;

Si no, despues de activar la funcion tengo re reescribir el codigo a cada control que tenga un onenter o un onextit
FechaVencimiento.onExit := FechaVencimientoExit

A ver si sabeis como hacerlo (y me lo contais, .)
Thanks

[ecfisa]

Hola.

Proba de este modo:

Código Delphi [-]
uses  TypInfo;
...
function MethodAssigned(aObject: TObject; const MethodName: string): Boolean;
var
  Method: TMethod;
begin
  Method:= GetMethodProp(aObject, MethodName);
  Result:= (Method.Code <> nil)and(Method.Data <> nil);
end;
...

// Un ejemplo de uso:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to ComponentCount-1 do
    if Components[i] is TEdit then
      if MethodAssigned(Components[i],'OnEnter') then
        ShowMessage(Components[i].Name+' :OnEnter asignado')
      else
        ShowMessage(Components[i].Name+' :OnEnter no asignado')
end;

Saludos.

[dec]

Hola,

No sé si me estoy perdiendo algo, pero, ¿qué pasa si se usa la función "Assigned"? Tal que así:

Código Delphi [-]
  if Assigned( TFormProveedorFactura( Components[ i ] ).OnEnter ) then
    ShowMessage( 'OnEnter is assigned' )
  else
    ShowMessage( 'OnEnter is NOT assigned' );

[roman]

Empezado por dec

Hola,

No sé si me estoy perdiendo algo, pero, ¿qué pasa si se usa la función "Assigned"?

Pasa que funciona

// Saludos

[[Chris]]

Haciendo una combinación del código de ecfisa y Dec:

Código Delphi [-]
procedure probar();
var
    I: Integer;
begin
    for I := 0 to Self.ComponentCount - 1 do
    begin
        if Self.Components[i].inheritsFrom(TCustomEdit)
            if Assigned(TEdit(Self.Components[i]).OnEnter)
                ShowMessage('OnEnter Asignado!');
    end;
end;

La línea "Self.Components[i].inheritsFrom(TCustomEdit)" es más adecuada a tu caso (tienes varios clases de editores). Además, sino me equivoco funcionará con TMemo's.

Saludos.

[cesarsoftware]

Bueno, bueno...sin pelearse

Muchas gracias a todos, lo mas "sencillo" y con menos código es el metodo de dec. Ya solo falta que se pueda acceder a la clase del formulario (self) y asi esa rutina se puede incorporar a biblioteca y no tener que ponerla en cada formulario. Es decir sustituir TFormProveedorFactura por Self.
¿que, sabeis hacerlo?

Código Delphi [-]
procedure TFormProveedorFactura.FormCreate(Sender: TObject);
begin
  FormBuscar := TFormBuscar.Create(Self);
  ControlesResaltados();
end;

procedure TFormProveedorFactura.FechaVencimientoExit(Sender: TObject);
begin
  FechaVencimiento.Visible := False;
  TimerVencimientos.Enabled := False;
  ControlExit(Sender);
end;

procedure TFormProveedorFactura.ControlesResaltados();
var
  i: word;
begin
  for i := 0 to Self.ComponentCount - 1 do
  begin
    if Self.Components[i] is TWinControl then
    begin
      if Assigned(TFormProveedorFactura(Components[ i ]).OnEnter ) = False then
        TFormProveedorFactura(Components[i]).OnEnter := ControlEnter;
      if Assigned(TFormProveedorFactura(Components[ i ]).OnExit ) = False then
        TFormProveedorFactura(Components[i]).OnExit := ControlExit;
    end;
  end;
end;
 
procedure TFormProveedorFactura.ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clYellow;
end;
 
procedure TFormProveedorFactura.ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

[ecfisa]

Hola.

Del modo que te sugerí, no tendrías ningún problema.

Ejemplo:

Código Delphi [-]
unit Unit2;

interface

  function MethodAssigned(aObject: TObject; const MethodName: string): Boolean;

implementation

uses  TypInfo;

function MethodAssigned(aObject: TObject; const MethodName: string): Boolean;
var
  Method: TMethod;
begin
  Method:= GetMethodProp(aObject, MethodName);
  Result:= (Method.Code <> nil)and(Method.Data <> nil);
end;
end.

Código Delphi [-]
uses Unit2;
...
var
  i: Integer;
begin
  for i:= 0 to ComponentCount-1 do
    if MethodAssigned(Components[i],'OnEnter') then // u OnExit, OnClick, OnKeyDown, ect.
      ShowMessage(Components[i].Name+' tiene el método asignado');
  ...

Y detectará si el método cuyo nombre enviamos está activo en cualquier componente.

Saludos.

[cesarsoftware]

Gracias ecfisa

Si que detecta el metodo, sin hacer referencia al formulario, lo que falta es que la asignacion tambien sea anonima

Código Delphi [-]
     if MethodAssigned(Components[i], 'OnExit') = False then
        TFormProveedorFactura(Components[i]).OnExit := ControlExit;

Todavia hay que hacer referencia a "TFormProveedorFactura" para asignarle el nuevo evento, ¿como podriamos hacerlo con Self o como parametro?

Thanks

[ozsWizzard]

Empezado por cesarsoftware

Gracias ecfisa

Si que detecta el metodo, sin hacer referencia al formulario, lo que falta es que la asignacion tambien sea anonima

Código Delphi [-]
     if MethodAssigned(Components[i], 'OnExit') = False then
        TFormProveedorFactura(Components[i]).OnExit := ControlExit;

Todavia hay que hacer referencia a "TFormProveedorFactura" para asignarle el nuevo evento, ¿como podriamos hacerlo con Self o como parametro?

Thanks

Si lo que quieres es asignar ControlExit al componente, creo que te sobraría con

Código Delphi [-]
...
var
   Obj: TWinControl;
begin
     if MethodAssigned(Components[i], 'OnExit') = False then
     begin
         Obj := (Components[i] as TWinControl)
         Obj.OnExit := ControlExit;
     end;
...

Si el problema es que es el bucle el que hace:

Código Delphi [-]
     for i := 0 to TFormProveedorFactura.ComponentCount -1 do
     begin
     ...
     end;

Siempre puedes ponerle al procedimiento un "AOwner: TComopnent" y recorrer ese. Es decir:

Código Delphi [-]
unit Unit2;

interface

  function MethodAssigned(aObject: TObject; const MethodName: string): Boolean;
  
  procedure ControlEnter(Sender: TObject);
  procedure ControlExit(Sender: TObject);
  procedure ControlesResaltados(AOwner: TComponent);
  

implementation

uses  TypInfo;

function MethodAssigned(aObject: TObject; const MethodName: string): Boolean;
var
  Method: TMethod;
begin
  Method:= GetMethodProp(aObject, MethodName);
  Result:= (Method.Code <> nil)and(Method.Data <> nil);
end;

procedure ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clYellow;
end;
 
procedure ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

procedure ControlesResaltados(AOwner: TComponent);
var
  i: word;
  Obj: TWinControl; 
begin
  for i := 0 to AOwner.ComponentCount - 1 do
  begin
    if AOwner.Components[i] is TWinControl then
    begin
      Obj := (AOwner.Components[i] as TWinControl);
      if not MethodAssigned(Obj, 'OnEnter') then       
        Obj.OnEnter := ControlEnter;
      if not MethodAssigned(Obj, 'OnExit') then
        Obj.OnExit := ControlExit;
    end;
  end;
end;

[ecfisa]

Empezado por cesarsoftware

Gracias ecfisa
Si que detecta el metodo, sin hacer referencia al formulario, lo que falta es que la asignacion tambien sea anonima

Código Delphi [-]
     if MethodAssigned(Components[i], 'OnExit') = False then
        TFormProveedorFactura(Components[i]).OnExit := ControlExit;

Todavia hay que hacer referencia a "TFormProveedorFactura" para asignarle el nuevo evento, ¿como podriamos hacerlo con Self o como parametro?

Thanks

Hola Cesar.

Fijate si te sirve de este modo:

Código Delphi [-]
unit Unit2;

interface

uses
  SysUtils, Classes;

procedure AssignMethod(aComponent: TComponent; const MethodName: string; aEvent: TNotifyEvent);

implementation

uses  TypInfo;

procedure AssignMethod(aComponent: TComponent; const MethodName: string; aEvent: TNotifyEvent);
var
  PInfo: PPropInfo;
  Method: TMethod;
  PEvent: ^TNotifyEvent;
begin
  PInfo:= GetPropInfo(aComponent.ClassInfo, MethodName);
  if (PInfo <> nil)and(PInfo^.PropType^.Kind = tkMethod) then
  begin
    Method:= GetMethodProp(aComponent, MethodName);
    if not Assigned(Method.Code) then
    begin
      PEvent:= @Method.Code;
      PEvent^:= aEvent;
      Method.Data:= aComponent.GetParentComponent;
      SetMethodProp(aComponent, PInfo, Method);
    end;
  end;
end;
end.

Ejemplo de uso:

Código Delphi [-]
procedure TForm1.ControlClick(Sender: TObject);
begin
  ShowMessage('Click sobre '+TComponent(Sender).Name);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to ComponentCount-1 do
    if Components[i].Name <> 'Button1' then //  para no asignarlo a Button1...
      AssignMethod(Components[i], 'OnClick', ControlClick);
end;

Saludos.

[cesarsoftware]

Gracias, gracias

Al final es una combinacion de los metodos de ecfisa y y ozswizzard.

En esta procedure se produce el error
[DCC Error] UnitProveedorFactura.pas(1099): E2362 Cannot access protected symbol TWinControl.OnEnter
[DCC Error] UnitProveedorFactura.pas(1099): E2035 Not enough actual parameters

en las lineas
Obj.OnEnter := ControlEnter;
Obj.OnExit := ControlExit;

Código Delphi [-]
procedure TFormProveedorFactura.ControlesResaltados(AOwner: TComponent);
var
  i: word;
  Obj: TWinControl;
begin
  for i := 0 to AOwner.ComponentCount - 1 do
  begin
    if AOwner.Components[i] is TWinControl then
    begin
      Obj := (AOwner.Components[i] as TWinControl);
      if not MethodAssigned(Obj, 'OnEnter') then
        Obj.OnEnter := ControlEnter;
      if not MethodAssigned(Obj, 'OnExit') then
        Obj.OnExit := ControlExit;
    end;
  end;
end;

asi que de momento el mejor resultado es

Código Delphi [-]
type TFormProveedorFactura = class(TForm)
    procedure ControlesResaltados(AOwner: TComponent);
    procedure ControlEnter(Sender: TObject);
    procedure ControlExit(Sender: TObject);
end;

procedure TFormProveedorFactura.FormActivate(Sender: TObject);
begin
  if activate = True then
    Exit;
  activate := True;
  ControlesResaltados(Self);
  IniciaGrillas;
  VaciaCampos;
end;

procedure TFormProveedorFactura.ControlesResaltados(AOwner: TComponent);
var
  i: word;
  Obj: TWinControl;
begin
  for i := 0 to AOwner.ComponentCount - 1 do
  begin
    if AOwner.Components[i] is TWinControl then
    begin
      Obj := (AOwner.Components[i] as TWinControl);
      if not MethodAssigned(Obj, 'OnEnter') then
        AssignMethod(AOwner.Components[i], 'OnEnter', ControlEnter);
      if not MethodAssigned(Obj, 'OnExit') then
        AssignMethod(AOwner.Components[i], 'OnExit', ControlExit);
    end;
  end;
end;

procedure TFormProveedorFactura.ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clSkyBlue;
end;

procedure TFormProveedorFactura.ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

Asi que este pequeño codigo se puede trasportar al resto de formularios y con solo cambiar el formulario propietario ya esta y no se toca mas código.
Las rutinas para comprobar metodos y asignarlos ya estan en la bliblioteca general de funciones (Gracias de nuevo).
Digo esto por que si lo saco de type TForm, se queja de la siguiente linea

[DCC Error] UnitProveedorFactura.pas(1099): E2009 Incompatible types: 'method pointer and regular procedure'
en
AssignMethod(AOwner.Components[i], 'OnEnter', ControlEnter);

osea, la buena seria esta para que no hubiera que tocar nada de codigo, pero no se resolver el problema 'method pointer and regular procedure'

Código Delphi [-]
procedure ControlesResaltados(AOwner: TComponent);
var
  i: word;
  Obj: TWinControl;
begin
  for i := 0 to AOwner.ComponentCount - 1 do
  begin
    if AOwner.Components[i] is TWinControl then
    begin
      Obj := (AOwner.Components[i] as TWinControl);
      if not MethodAssigned(Obj, 'OnEnter') then
        AssignMethod(AOwner.Components[i], 'OnEnter', ControlEnter);
      if not MethodAssigned(Obj, 'OnExit') then
        AssignMethod(AOwner.Components[i], 'OnExit', ControlExit);
    end;
  end;
end;

procedure ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clSkyBlue;
end;

procedure ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

Saludos

[cesarsoftware]

Perdona que siga, pero me he dado cuenta que se puede hacer mas sencillo si pertenecen a la clase del formulario

Código Delphi [-]
procedure TFormProveedorFactura.ControlesResaltados();
var
  i: word;
begin
  for i := 0 to Self.ComponentCount - 1 do
  begin
    if Self.Components[i] is TWinControl then
    begin
      if MethodAssigned(Self.Components[i],'OnEnter') = False then
        AssignMethod(Self.Components[i], 'OnEnter', Self.ControlEnter);
      if MethodAssigned(Self.Components[i],'OnExit') = False then
        AssignMethod(Self.Components[i], 'OnExit', Self.ControlExit);
    end;
  end;
end;

procedure TFormProveedorFactura.ControlEnter(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clSkyBlue;
end;

procedure TFormProveedorFactura.ControlExit(Sender: TObject);
begin
  TWinControl(Sender).Brush.Color := clWindow;
end;

Ya solo falta sacarlo del formulario y que este (Self) sea un parametro

Sigo, a ver si lo consigo

[ozsWizzard]

Es que yo lo hice para que lo pusieras en una unidad externa al formulario, así sólo tienes que poner en el uses de cada formulario (o hacer un formulario padre del cual hereden todos) y ya está.

Pensé, además, que era lógico que para llamar a "ControlesResaltados" había que pasarle el formulario,

Bueno, me alegro de que te haya funcionado.

[cesarsoftware]

Hola ozaWizzard.

pero no te da error
Obj.OnEnter := ControlEnter;

[DCC Error] Metodos.pas(47): E2362 Cannot access protected symbol TWinControl.OnEnter

Uso Delphi 10,si no la verdad que lo ideal es que sea una unidad y la llamemos en el uses.

¿Que version usas?

[ozsWizzard]

La verdad es que ni lo probé, lo puse aquí directamente

[ozsWizzard]

Pero vamos, que lo del "as Tipo" lo puedes hacer a un nivel que te permita modificarle el OnEnter o el OnExit, aunque si así funciona, pues mejor

Yo es que asigno el método OnExit a unos TEdit y unos TMemo, por lo tanto, en lugar de TWinControl usaba TCustomEdit y si funciona.

[cesarsoftware]

Yo he probado con TLabeledEdit y tambien me dice
[DCC Error] Metodos.pas(70): E2009 Incompatible types: 'method pointer and regular procedure'

Asi que me quedo como estoy, ya le hemos dedicado unas horas y tampoco es que se nos vaya la vida en ello.

Muchas Gracias Compi. Una cervecitas, pago Yo.

[ozsWizzard]

No, sí está claro, en la pregunta del principio lo pone, saber si el componente tiene ese propiedad, yo he tirado por la calle de en medio...

Acepto la cerveza