Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Saber si un control tiene asignado OnEnter (https://www.clubdelphi.com/foros/showthread.php?t=79167)

cesarsoftware 13-06-2012 12:52:58
Saber si un control tiene asignado OnEnter
 
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 13-06-2012 14:28:19
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 13-06-2012 14:38:36
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 13-06-2012 15:06:27
Cita:
Empezado por dec (Mensaje 434970)
Hola,

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

// Saludos

Chris 13-06-2012 16:18:42
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 13-06-2012 17:07:16
Bueno, bueno...sin pelearse :D

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?:p

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 13-06-2012 22:22:16
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 14-06-2012 10:56:37
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 14-06-2012 13:28:31
Cita:
Empezado por cesarsoftware (Mensaje 435050)
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 15-06-2012 04:09:17
Cita:
Empezado por cesarsoftware (Mensaje 435050)
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 15-06-2012 10:56:41
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:D
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 15-06-2012 11:25:07
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 15-06-2012 11:25:35
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 15-06-2012 11:41:06
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 15-06-2012 12:00:25
La verdad es que ni lo probé, lo puse aquí directamente

ozsWizzard 15-06-2012 12:14:49
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 15-06-2012 12:39:34
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.:cool:

ozsWizzard 15-06-2012 13:02:25
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 :D:cool:


La franja horaria es GMT +2. Ahora son las 16:38:56.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi