Detectado javascript desactivado

Tienes el javascript desactivado en este momento. Muchas funciones podrían no funcionar. Por favor reactiva el javascript para obtener una funcionalidad completa.

Aqui os dejo un nuevo Componente no visual

Comenzado por Desart , mar 17 2010 08:06

Por favor identifícate para responder

9 respuestas en este tema

#1 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 17 marzo 2010 - 08:06

Aqui os dejo un nuevo componente, para el uso general de aplicaciones cambiandonos color, font y haciendo zoom en el foco al entrar y retornando al salir. nos permite excluir componentes mediante la propiedad Tag, etc.

este es el componente (Dejo el código completo)

delphi

//////////////////////////////////////////////////////////////
//Este componente parte de uno del compañero PBorges36 y  Grandel
//Que gentilmente compartienron con nuestra comunidad en nuestro
//Valiosicimo ClubDelphi
//
//Fundamental es tambien la participacion en la idea y el
//planteameiento del compañero Neftali
//
// 21/03/2009   JLGT  Verdion 1.0
//Este componente es Freeware y se puede modificar y alterar
//Siempre y cuando se distribuya libremente las modificaciones
//Se ue se puede acortar el código, pero prefiero
//dejarlo de esta manera para poder comprenderlo mejor
///////////////////////////////////////////////////////////////
 
///////////////////////////////////////////////////////////////
//Para su uso se recomienda activar  en el primer active de la aplicación
//y desactivarlo al cerrarse la aplicación para evitar errores
//tener en cuenta que el componente afecta a windows, y por lo tanto a
//otras aplicaciones
///////////////////////////////////////////////////////////////
 
 
unit ScreenColorFontZoomCenter;
 
interface
 
uses
  Windows, ExtCtrls, Messages,SysUtils, Classes, Graphics,
  StdCtrls, ComCtrls, Controls, Forms, TypInfo, Dialogs ;
 
type
  TVZoomVal = 1..4;
  TCenterScreenColorFontZoom = class(TComponent)
  private
    { Private declarations }
    FActive: Boolean;                          //Activa el uso del componente  NO OLVIDAR DESACTIVAR AL CERRA EL FORM
    FTag: integer;                             //Da una proiedad tag al componente
    FColorActive: Boolean;                     //Activa el uso del color altener/perder el foco
    FColorConFoco: TColor;                     //Color de entrada en el foco
    FColorSinFoco: TColor;                     //Color de Salida del Foco
    FPierdeFoco, FTieneFoco: TWinControl;      // a partir de WinControl pueden recibir el foco
    FForm: Boolean;                            //Para usar el proceso en el form o no
    FColorForm: TColor;                        //Establecer el color de fondo del Fom si se activa FFForm al perder el foco
    FTagValorAdmit: Integer;                   //Leera el valor del Tag permitido para apñllicar los efectos por defecto 0 si
                                               //se establece en un componente el tag <> 0 (o valor establecido) no afectaria este componente
    FZoomActive: Boolean;                      //Activa el uso de Zoom en el componente
    FZoomVal: TVZoomVal;                       //Desactiva el Uso de Zoom en el compoenete
    FFontActive :boolean;                      //Aciva el uso de fuentes
    FFontProg: Boolean;                        //USar fuente por defecto en el componente al salir
    FFontFocus: Tfont;                         //Fuente cuando se tiene el foco
    FFontNoFocus: Tfont;                       //Fuente cuando se pierde el foco
    FPanel: Boolean;                           //Afectar a PAneles o no
    FOnFocusChange: TNotifyEvent;              //Evento al Cambiarse el foco
    procedure ScreenActiveControlChange(Sender: TObject);
 //   procedure SetColorActive(value: boolean);
//    procedure SetTagValorAdmit(value: integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    //Cambiar propiedad color y añadir Zoom, zoomval y font
    //{ORIGINAL}  Procedure AplicarColor(Color: TColor; Componente: TWinControl);
    Procedure AplicarColor(Color: string; Componente: TWinControl);
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
 
  published
    { Published declarations }
    property Active: boolean             read FActive          write FActive         default False;
    property Tag: integer                read FTag             write FTag;
    property ColorConFoco: TColor        read FColorConFoco    write FColorConFoco;
    property ColorSinFoco: TColor        read FColorSinFoco    write FColorSinFoco;
    property ColorActive: boolean        read FColorActive     write FColorActive    default True;
    property Form: boolean               read FForm            write FForm           default False;
    property TagValorAdmit: integer      read FTagValorAdmit   write FTagValorAdmit  default 0;
    property ZoomActive: Boolean         read FZoomActive      write FZoomActive     default False;
    property ZoomVal: TVZoomVal          read FZoomVal         write FZoomVal        default 1;
    property FontActive: Boolean         read FFontActive      write FFontActive     default False;
    property FontProg: Boolean           read FFontProg        write FFontProg       default False;
    property PAnel: Boolean              read FPanel           write FPanel          default False;
    property FontFocus: TFont            read FFontFocus       write FFontFocus;
    property FontNoFocus: TFont          read FFontNoFocus     write FFontNoFocus;
    property OnFocusChange: TNotifyEvent read FOnFocusChange   write FOnFocusChange;
  end;
 
var VarCompUsage: Integer;
procedure Register;
 
 
implementation
 
//Bajado de [url]http://www.chami.com/tips/delphi/112596D.html[/url]  ---------------------[1]
 
//El Codigo bajo las siguientes lineas no se termino usando en el componenete, pero me parecio
//Interesante mantenerlo para posibles futuros usos.
const
  csfsBold      = &#39;|Bold&#39;;
  csfsItalic    = &#39;|Italic&#39;;
  csfsUnderline = &#39;|Underline&#39;;
  csfsStrikeout = &#39;|Strikeout&#39;;
//
// Expected format:
//   "Arial", 9, [Bold], [clRed]
//
 
//Pasamos de String a font
procedure StringToFont(   sFont : string; Font : TFont );
var
  p      : integer;
  sStyle : string;
begin
  with Font do
  begin
    // get font name
    p    := Pos( &#39;,&#39;, sFont );
    Name := Copy( sFont, 2, p-3 );
    Delete( sFont, 1, p );
        // get font size
    p    := Pos( &#39;,&#39;, sFont );
    Size := StrToInt( Copy( sFont, 2, p-2 ) );
    Delete( sFont, 1, p );
        // get font style
    p      := Pos( &#39;,&#39;, sFont );
    sStyle :=  &#39;|&#39; + Copy( sFont, 3, p-4 );
    Delete( sFont, 1, p );
        // get font color
    Color :=  StringToColor( Copy( sFont, 3, Length( sFont ) - 3 ) );
        // convert str font style to
    // font style
    Style := [];
    if( Pos( csfsBold, sStyle ) > 0 )then Style := Style + [ fsBold ];
    if( Pos( csfsItalic, sStyle ) > 0 )then  Style := Style + [ fsItalic ];
    if( Pos( csfsUnderline, sStyle ) > 0 )then  Style := Style + [ fsUnderline ];
    if( Pos( csfsStrikeout,  sStyle ) > 0 )then  Style := Style + [ fsStrikeout ];
  end;
end;
 
//
// Output format:
//   "Aril", 9, [Bold|Italic], [clAqua]
//
 
//PAsamos de font a String
function FontToString( Font : TFont ) : string;
var
  sStyle : string;
begin
  with Font do
  begin
    // convert font style to string
    sStyle := &#39;&#39;;
    if( fsBold in Style )then  sStyle := sStyle + csfsBold;
    if( fsItalic in Style )then sStyle := sStyle + csfsItalic;
    if( fsUnderline in Style )then sStyle := sStyle + csfsUnderline;
    if( fsStrikeout in Style )then  sStyle := sStyle + csfsStrikeout;
    if( ( Length( sStyle ) > 0 ) and ( &#39;|&#39; = sStyle[ 1 ] ) )then
    begin
      sStyle := Copy( sStyle, 2, Length( sStyle ) - 1 );
    end;
    Result := Format( &#39;"%s", %d, [%s], [%s]&#39;,  [ Name,  Size,  sStyle, ColorToString( Color ) ] );
  end;
end;
//------------------------------------------------------------------------------[1]
//USO DEL RTTI------------------------------------------------------------------[2]
  //·······················································································
  // Comprueba si existe una propiedad con ese nombre
  function ExistProp(Instance: TObject; const PropName: string):Boolean;
  var
    PropInfo: PPropInfo;
  begin
    // Busca la propiedad y deviuelve la estructura nil
    PropInfo := GetPropInfo(Instance, PropName);
    Result := not (PropInfo = nil);
      end;
 
  //·······················································································
  // Cambia el valor de la propiedad
  function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
  var
    PInfo: PPropInfo;
  Begin
    // Intentamos acceder (con un puntero) a la info. de la propiedad
    PInfo := GetPropInfo(AObj.ClassInfo, PropName);
    Result := PInfo <> nil;
 
    // Se ha obtenido la información...
    if (Result) then
    begin
      // Se ha encontrado la propiedad con éste nombre; Chequear el tipo...
      if (PInfo^.Proptype^.Kind = tkString) or (PInfo^.Proptype^.Kind = tkLString) then
      begin
        // Asignar el valor de tipo String
        SetStrProp(AObj, PInfo, Value);
      end else
      if (PInfo^.Proptype^.Kind = tkInteger) then
      begin
         // Asignar el valor...
         if (PInfo^.PropType^.Name = &#39;TColor&#39;) then
         begin
               SetOrdProp(AObj, PInfo, StringToColor(Value));
         end else
         begin
            SetOrdProp(AObj, PInfo, StrToInt(Value));
         end;
      end else
      begin
               Result := False;
               MessageDlg(&#39;&#39;&#39;La propiedad &#39;&#39; + PropName + &#39;&#39; no es de tipo String (o un tipo implementado)&#39;, mtWarning, [mbOK], 0);
       end;
    end  else
    begin
      // No se ha encontrado la propiedad con ese nombre
      Result := False;
    end;
  end;
//FIN USO DEL RTTI--------------------------------------------------------------[2]
 
procedure Register;
begin
  RegisterComponents(&#39;Samples&#39;, [TCenterScreenColorFontZoom]);
end;
 
constructor TCenterScreenColorFontZoom.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Screen.OnActiveControlChange := ScreenActiveControlChange;
  FColorConFoco := clSkyBlue;
  FColorSinFoco := clWindow;
  FColorActive:= True;
  FTagValorAdmit:=0;
  FForm :=False;
  FActive:=False;
  FZoomActive:= False;
  FZoomVal:=1;
  FFontActive:=False;
  FFontProg:=False;
  FFontFocus:=TFont.Create;
  FFontNoFocus:=TFont.Create;
  FPanel:=False;
  VarCompUsage:=0;
end;
 
destructor TCenterScreenColorFontZoom.Destroy;
begin
  Screen.OnActiveControlChange := nil;
  FFontNoFocus.Free();
  FFontFocus.Free();
  inherited;
end;
 
procedure TCenterScreenColorFontZoom.ScreenActiveControlChange(Sender: TObject);
begin
  FPierdeFoco := FTieneFoco;
  FTieneFoco  := Screen.ActiveControl;
  //Sólo si esta activo el componente
  if FActive=True then
  begin
    //Si el control activo no es un TFOM y ademas la propiedad FForm no sea false
    if not ((Screen.ActiveControl.ClassType = TForm) and (FForm=False)) then
    begin
      //Si el valor del tag del control es igual al de la propiedad FtagValoradmit
      if FPierdeFoco <> nil then   //PAra el Componente que pierde el Foco
      begin
           if FPierdeFoco.Tag=FTagValorAdmit then
           begin
            if not ((FPierdeFoco.ClassType=TPanel) and (FPanel=False)) then
            begin
               //Si esta activo el color
               if FColorActive=true then   Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
               if FZoomActive = true then
               begin      //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
                   TEdit(FPierdeFoco).Font.Size:=(Tedit(FPierdeFoco).Font.Size div Fzoomval);
                   FPierdeFoco.Width:=(FPierdeFoco.Width div FZoomVal);
                end;
               if FFontActive=true then TEdit(FPierdeFoco).font:=FFontNoFocus;
            end;
             VarCompUsage:=0; //Decimos que no hay un componente activado
           end;
      end;
 
      if FTieneFoco <> nil then   //Para el componente que adquiere el foco
      begin
           if FTieneFoco.Tag=FTagValorAdmit then
           begin
               if not ((FTieneFoco.ClassType=TPanel) and (FPanel=False)) then
               begin
                 if FColorActive=true then self.AplicarColor(ColorToString(FColorconFoco), FTieneFoco);
                 if FFontActive=true then
                 begin
                   //Si activamos FFontProg cuando pierda el fco volvera a la que estipulemos anteriormente
                   //En caso contrario devolvera el Font establecido en FontNoFocus
                   if FFontProg=true then FFontNoFocus:=TEdit(FTieneFoco).Font;
                   TEdit(FTieneFoco).Font:=FFontFocus;
                 end;
                if FZoomActive = true then
                begin   //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
                   TEdit(FTieneFoco).Font.Size:=(Tedit(FTieneFoco).Font.Size * Fzoomval);
                   FTieneFoco.Width:=(FTieneFoco.Width * FZoomVal);
                   FTieneFoco.BringToFront;
                end;
                FTag := self.Tag;
                VarCompUsage:=1; //Decimos que hay un componente activado
              end;
           end;
      end else   FTag := 0;
    end;
  end else
  begin
      if (VarCompUsage=1) then  //Comprobamos si hay algún componente activo con anterioridad
      begin
        if FPierdeFoco.Tag=FTagValorAdmit then
        begin
          if not ((FPierdeFoco.ClassType=TPanel) and (FPanel=False)) then
          begin
            if FColorActive=true then   Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
            if FZoomActive = true then
            begin      //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
                  TEdit(FPierdeFoco).Font.Size:=(Tedit(FPierdeFoco).Font.Size div Fzoomval);
                  FPierdeFoco.Width:=(FPierdeFoco.Width div FZoomVal);
            end;
            if FFontActive=true then TEdit(FPierdeFoco).font:=FFontNoFocus;
          end;
        end;
        VarCompUsage:=0;    //Decimos que no hay componentes activos
      end;
      FTag:=0;
  end;
 
  if Assigned(FOnFocusChange) then FOnFocusChange(Self);
end;
 
Procedure TCenterScreenColorFontZoom.AplicarColor(Color :String; Componente: TWinControl);
begin
  try
    if ExistProp(Componente,&#39;Color&#39;) then SetPropAsString(Componente,&#39;Color&#39;,Color);
// ORIGINAL -------------------------------------------------------------------------------
//    if (Componente is TCustomEdit)     then (Componente as TEdit).Color := Color;
//    if (Componente is TDateTimePicker) then (Componente as TDateTimePicker).Color:= Color;
//    if (Componente is TCustomMemo)     then (Componente as TMemo).Color:= Color;
//    if (Componente is TCustomComboBox) then (Componente as TComboBox).Color:= Color;
//
//    (Componente as TWinControl).Repaint;
//------------------------------------------------------------------------------------------
  except
  end;
end;
end.

Si necesitais más información decirmelo y como siempre espero vuestros comentarios y tirones de oreja.

0

Volver arriba

#2 enecumene

Webmaster

Administrador
7.419 mensajes

LocationRepública Dominicana

Escrito 17 marzo 2010 - 08:59

Muchas gracias por el aporte Desart, muy agradecido estamos, fuera bueno colocar un Screen del componente es acción, digo, es una idea pues. De nuevo, Muchas gracias (y)

.

0

Volver arriba

#3 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 17 marzo 2010 - 11:07

Vueno el componente funciona pero cuando pueda intentare mejorar cosas que no me gusta que haga, como darme un error si entro en el editor de propiedades del font, tener que poner a ciertos componentes que no queria que afectara un tag no valido, etc., así mismo intentare utilizar el agrupamiento de propiedades. etc, pero no se cuando me pondré con el.

Gracia Enecume, para que te hagas una ida, es como cambiar el color de un edit en el OnEnter y restaurarlo en el OnExit, pero claro no es lo único, también permite cambiar el Font, y para mi lo más importante, después de trabajar durante años con minusvalidos de todos los tipos, el zoom, lo que hace al entrar en un componente, multiplica por el valor que tenga la propiedad ZoomVal quer admite entre 1 y 4 y aumenta y al recibir el foco aumenta el Width del componente por este valor, así como el size del Font del componente, dividiendolo, por este valor al perder el foco. Aparte de esto, permite otras cosas, pero poniéndolo en la unidad inicial, afectara a todo el programa, Realmente afecta a windows y todas sus aplicaciones (o debería), es una de las cosas que quiero corregir más adelante, afecta a más componentes de lo que yo pensé inicialmente, y claro esto me obliga a palntear, poner un conjunto de propiedades que active su uso sobre unos componentes a voluntad evitando otros según su clase.

Espero este más o menos claro, Repito hay que corregirlo, pero funciona y con unas pocas mejoras, nos puede ahorrar bastante código.

P.D. Es muy importante activar el componente una vez iniciada la aplicación y desactivarlo una vez se ejecute el close de l form primcipal o del Tapplication.

0

Volver arriba

#4 andres1569

Advanced Member

Miembro Platino
431 mensajes

Escrito 17 marzo 2010 - 12:13

Hola Desart, aunque aún no lo he probado me ha llamado la funcionalidad del zoom, nunca he visto un programa que amplíe el control que recibe el foco. Cuando pueda le echaré un vistazo.

En cuanto al error con las propiedades TFont con el Object Inspector, en la declaración de dichas propiedades, en la sentencia write no debe acceder directamente a la variable interna, sino llamar a un método SetFont que a su vez asigne el contenido a dichas variables. Te pongo un ejemplo:

delphi

property FontFocus: TFont read FFontFocus write SetFontFocus;
 
 
( ... )
 
procedure TCenterScreenColorFontZoom.SetFontFocus(Value: TFont);
begin 
  FFontFocus.Assign(Value);
end;

En cuanto a lo que comentas de que debe desactivarse al cerrar el formulario principal, ¿no podría ser esto automático, realizándose en el destructor Destroy del mismo componente?

Saludos

0

Volver arriba

#5 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 17 marzo 2010 - 02:19

Hola Andres1569, gracias por tu aporte y te prometo que en cuanto tenga tiempo lo implementare, en cuanto a lo del Destroy, tendré que estudiarlo, por que como la mayoría sabe mi fuerte era clipper y en delphi aún me pierdo y la verdad me suena a chino mandarín, pero no te preocupes, es lo normal que en delphi que me empiece sonando a chino mandarín, pase por sueco para terminar por chapurrear español y digo chapurrear, por que como autodidacta, no me atrevería a decir que lo hablo medianamente bien (Me refiero a Delphi)...

0

Volver arriba

#6 pcicom

Advanced Member

Miembro Platino
267 mensajes

LocationMéxico

Escrito 17 marzo 2010 - 04:26

Y como se USA..!!!

0

Volver arriba

#7 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 18 marzo 2010 - 07:29

Hola pcicom
Lo sueltas en el form principal
pones el active en true al ejecutar tu aplicacion, y false al cerrarla
si quieres que colore al tener el foco y al perderlo, pones color active en true
Si quieres Zoom lo mismo y elijes un valor entre 1 y 4 Ojo 1 = normal, no varia
Si quieres funetes diferentes lo mismo, pero en cada apartado elijes otras opciones , como colores, fuentes o valor del zoom
y listo.

0

Volver arriba

#8 pcicom

Advanced Member

Miembro Platino
267 mensajes

LocationMéxico

Escrito 18 marzo 2010 - 08:25

Creo que este es un COMPONENTE muy pero muy UTIL... que debe de tachar en la clasificacion de IMPRRESINDIBLE..
aunque de momento no me sea de utilizad esta GENIAL...

Saludos y GRACIAS por la APORTACION..

0

Volver arriba

#9 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 20 marzo 2010 - 03:51

:cry:Lamento comunicar que las partes de Font y zoom no son irreglamentables en este componente, después de días intentando mejorarlo, me topo con los siguientes problemas insalvable, por lo menos par mi, Ocurre que si seleccionamos por ejemplo un botón, se pierde el foco, pero ese no es el problema, este ocurre cuando, ponemos enable en false, donde estaba activo anteriormente el componente, sin haber podido salir del foco, o cuando ejecutamos un SetFocus, el componente no logra registrar, este cambio. De Todas maneras, reescribiré el componente, para que quede completo, con el control de diferentes componentes, etc.

0

Volver arriba

#10 Desart

Advanced Member

Miembro Platino
715 mensajes

LocationEspaña

Escrito 20 marzo 2010 - 04:36

Bueno este es el código como queda.

delphi

//////////////////////////////////////////////////////////////
//Este componente parte de uno del compañero PBorges36 y  Grandel
//Que gentilmente compartienron con nuestra comunidad en nuestro
//Valiosicimo ClubDelphi
//
//Fundamental es tambien la participacion en la idea y el
//planteameiento del compañero Neftali
//
// 21/03/2009   JLGT  Verdion 1.0
//Este componente es Freeware y se puede modificar y alterar
//Siempre y cuando se distribuya libremente las modificaciones
//Se ue se puede acortar el código, pero prefiero
//dejarlo de esta manera para poder comprenderlo mejor
///////////////////////////////////////////////////////////////
 
///////////////////////////////////////////////////////////////
//Para su uso se recomienda activar  en el primer active de la aplicación
//y desactivarlo al cerrarse la aplicación para evitar errores
//tener en cuenta que el componente afecta a windows, y por lo tanto a
//otras aplicaciones
///////////////////////////////////////////////////////////////
 
 
unit ScreenColorCenter;
 
interface
 
uses
  Windows, ExtCtrls, Messages,SysUtils, Classes, Graphics,
  StdCtrls, ComCtrls, Controls, Forms, TypInfo, Dialogs ;
// Math, Forms;
 
type
  TCenterScreenColor = class(TComponent)
  private
    { Private declarations }
    FActive: Boolean;                          //Activa el uso del componente  NO OLVIDAR DESACTIVAR AL CERRA EL FORM
    FColorActive: Boolean;                     //Activa el uso del color altener/perder el foco
    FColorConFoco: TColor;                     //Color de entrada en el foco
    FColorSinFoco: TColor;                     //Color de Salida del Foco
    FTagValorAdmit: Integer;                   //Leera el valor del Tag permitido para apñllicar los efectos por defecto 0 si
                                               //se establece en un componente el tag <> 0 (o valor establecido) no afectaria este componente
    FForm: Boolean;                            //Para usar el proceso en el form o no
    FEdit_DBEdit:Boolean;                      //Afecta a edits y dbedits
    FMEmo_DbMEmo:Boolean;                      //Afecta a Memos y dbmemos
    FComboBox_DBCombobox: Boolean;             //Afecta a Combocbox y dbcombobox
    FOther: Boolean;                           //Afecta a l resto de los componentes
                                               //Ojo other puede darnos efectos no deseados
    FTag: integer;                             //Da una proiedad tag al componente
    FPierdeFoco, FTieneFoco: TWinControl;      // a partir de WinControl pueden recibir el foco
    FOnFocusChange: TNotifyEvent;              //Evento al Cambiarse el foco
 
    procedure ScreenActiveControlChange(Sender: TObject);
    procedure SetColorConFoco(const Value: TColor);
    procedure SetColorSinFoco(const Value: TColor);
 
  protected
    { Protected declarations }
 
  public
    { Public declarations }
    //Cambiar propiedad color y añadir Zoom, zoomval y font
    //{ORIGINAL}  Procedure AplicarColor(Color: TColor; Componente: TWinControl);
    Procedure AplicarColor(Color: string; Componente: TWinControl);
    procedure AdmitComponent(Component:TWinControl);
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
 
  published
    { Published declarations }
    property Active: boolean               read FActive              write FActive              default False;
    property ColorActive: boolean          read FColorActive         write FColorActive         default True;
    property ColorConFoco: TColor          read FColorConFoco        write SetColorConFoco;
    property ColorSinFoco: TColor          read FColorSinFoco        write SetColorSinFoco;
    property TagValorAdmit: integer        read FTagValorAdmit       write FTagValorAdmit       default 0;
    property Form: boolean                 read FForm                write FForm                default False;
    property Edit_DBEdit: boolean          read FEdit_DBEdit         write FEdit_DBEdit         default True;
    property MEmo_DbMEmo: boolean          read FMEmo_DbMEmo         write FMEmo_DbMEmo         default True;
    property ComboBox_DBCombobox: boolean  read FComboBox_DBCombobox write FComboBox_DBCombobox default True;
    property Other: Boolean                read FOther               write FOther               default False;
    property Tag: integer                  read FTag                 write FTag;
    property OnFocusChange: TNotifyEvent   read FOnFocusChange       write FOnFocusChange;
  end;
 
var VarCompUsage,VarCompAdm: Integer;
    VarPrivPassComponent: Boolean;             //Esta variable nos permitira saber si usar los efectos en el componente
procedure Register;
 
implementation
 
//USO DEL RTTI------------------------------------------------------------------[2]
  //·······················································································
  // Comprueba si existe una propiedad con ese nombre
  function ExistProp(Instance: TObject; const PropName: string):Boolean;
  var
    PropInfo: PPropInfo;
  begin
    // Busca la propiedad y deviuelve la estructura nil
    PropInfo := GetPropInfo(Instance, PropName);
    Result := not (PropInfo = nil);
  end;
 
  //·······················································································
  // Cambia el valor de la propiedad
  function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
  var
    PInfo: PPropInfo;
  Begin
    // Intentamos acceder (con un puntero) a la info. de la propiedad
    PInfo := GetPropInfo(AObj.ClassInfo, PropName);
    Result := PInfo <> nil;
 
    // Se ha obtenido la información...
    if (Result) then
    begin
      // Se ha encontrado la propiedad con éste nombre; Chequear el tipo...
      if (PInfo^.Proptype^.Kind = tkString) or (PInfo^.Proptype^.Kind = tkLString) then
      begin
        // Asignar el valor de tipo String
        SetStrProp(AObj, PInfo, Value);
      end
      else
      if (PInfo^.Proptype^.Kind = tkInteger) then
      begin
         // Asignar el valor...
         if (PInfo^.PropType^.Name = 'TColor') then
         begin
               SetOrdProp(AObj, PInfo, StringToColor(Value));
         end else
         begin
            SetOrdProp(AObj, PInfo, StrToInt(Value));
         end;
      end
      else
      begin
               Result := False;
               MessageDlg('''La propiedad '' + PropName + '' no es de tipo String (o un tipo implementado)', mtWarning, [mbOK], 0);
       end;
    end  else
    begin
      // No se ha encontrado la propiedad con ese nombre
      Result := False;
    end;
  end;
//FIN USO DEL RTTI--------------------------------------------------------------[2]
 
procedure Register;
begin
  RegisterComponents('Samples', [TCenterScreenColor]);
end;
 
constructor TCenterScreenColor.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Screen.OnActiveControlChange := ScreenActiveControlChange;
  FColorConFoco := clSkyBlue;
  FColorSinFoco := clWindow;
  FColorActive:= True;
  FTagValorAdmit:=0;
  FForm :=False;
  FActive:=False;
  FEdit_DBEdit:=True;
  FMEmo_DbMEmo:=True;
  FComboBox_DBCombobox:=True;
  FOther:=False;
  VarCompUsage:=0;
end;
 
destructor TCenterScreenColor.Destroy;
begin
//  FActive:=False;     //Nueva linea que se desactive aútomaticamente es la idea
  Screen.OnActiveControlChange := nil;
  inherited;
end;
 
 
procedure TCenterScreenColor.ScreenActiveControlChange(Sender: TObject);
//-------------------------------------------------------------------------------
// Aquie es donde se desarrolla todo el proseso del componente
//-------------------------------------------------------------------------------
var FontNAme,FontColor:string;
begin
  FPierdeFoco := FTieneFoco;
  FTieneFoco  := Screen.ActiveControl;
  VarCompAdm:=1;         //Nos permite decir si activamos o no el componente comprobando previamente la case y su permiso
  VarPrivPassComponent:=True;
  //Sólo si esta activo el componente
  if FActive=True then
  begin
     //Si el valor del tag del control es igual al de la propiedad FtagValoradmit
      if FPierdeFoco <> nil then   //PAra el Componente que pierde el Foco
      begin
           if VarCompAdm=1 then
           begin
             if FPierdeFoco.Tag=FTagValorAdmit then
             begin
                Self.AdmitComponent(FPierdeFoco);
                if VarPrivPassComponent=true then
                begin
                   //Si esta activo el color
                   if FColorActive=true then   Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
                end;
               VarCompUsage:=0; //Decimos que no hay un componente activado
             end;
           end;
      end;
 
      if FTieneFoco <> nil then   //Para el componente que adquiere el foco
      begin
           if VarCompAdm=1 then
           begin
             if FTieneFoco.Tag=FTagValorAdmit then
             begin
                 Self.AdmitComponent(FTieneFoco);
                 if VarPrivPassComponent=true then
                 begin
                     if FColorActive=true then self.AplicarColor(ColorToString(FColorconFoco), FTieneFoco);
                    FTag := self.Tag;
                    VarCompUsage:=1; //Decimos que hay un componente activado
                 end;
             end;
           end;
      end else   FTag := 0;
  end else
  begin
      if (VarCompUsage=1) then  //Comprobamos si hay algún componente activo con anterioridad
      begin
        if VarCompAdm=1 then
        begin
          if FPierdeFoco.Tag=FTagValorAdmit then
          begin
            Self.AdmitComponent(FPierdeFoco);
            if VarPrivPassComponent=True then
            begin
              if FColorActive=true then   Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
            end;
          end;
        end;
        VarCompUsage:=0;    //Decimos que no hay componentes activos
      end;
      FTag:=0;
  end;
  if Assigned(FOnFocusChange) then FOnFocusChange(Self);       //Ejcuta el evento
end;
 
Procedure TCenterScreenColor.AplicarColor(Color :String; Componente: TWinControl);
begin
  try
    if ExistProp(Componente,'Color') then SetPropAsString(Componente,'Color',Color);
// ORIGINAL -------------------------------------------------------------------------------
//    if (Componente is TCustomEdit)     then (Componente as TEdit).Color := Color;
//    if (Componente is TDateTimePicker) then (Componente as TDateTimePicker).Color:= Color;
//    if (Componente is TCustomMemo)     then (Componente as TMemo).Color:= Color;
//    if (Componente is TCustomComboBox) then (Componente as TComboBox).Color:= Color;
//    (Componente as TWinControl).Repaint;
//------------------------------------------------------------------------------------------
  except
  end;
end;
procedure TCenterScreenColor.SetColorConFoco(const Value: TColor);
begin
  if (FColorConFoco <> value) then FColorConFoco:= value;
end;
procedure TCenterScreenColor.SetColorSinFoco(const Value: TColor);
begin
  if (FColorSinFoco <> value) then FColorSinFoco:= value;
end;
procedure TCenterScreenColor.AdmitComponent(Component:TWinControl);
begin
     if (Component is TCustomForm) then
     if Component.ClassType=Tform then
     begin
         if FForm=true then VarPrivPassComponent:=True
                       else VarPrivPassComponent:=False;
     end else
     begin
        if ((Component is TCustomEdit) or (Component is TDateTimePicker))then
        begin
           if FEdit_DBEdit=true then VarPrivPassComponent:=True
           else VarPrivPassComponent:=False;
        end else
        begin
           if (Component is TCustomMemo) then
           begin
              if FMEmo_DbMEmo=true then VarPrivPassComponent:=True
                                   else VarPrivPassComponent:=False;
           end else
           begin
              if (Component is TCustomComboBox) then
              begin
                  if FComboBox_DBCombobox=true then VarPrivPassComponent:=True
                                               else VarPrivPassComponent:=False;
              end else
              begin
                 if FOther=true then VarPrivPassComponent:=True
                                else VarPrivPassComponent:=False;
              end;
           end;
        end;
     end;
end;
end.