Ir al contenido


Foto

Aqui os dejo un nuevo Componente no visual


  • Por favor identifícate para responder
9 respuestas en este tema

#1 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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
  1. //////////////////////////////////////////////////////////////
  2. //Este componente parte de uno del compañero PBorges36 y  Grandel
  3. //Que gentilmente compartienron con nuestra comunidad en nuestro
  4. //Valiosicimo ClubDelphi
  5. //
  6. //Fundamental es tambien la participacion en la idea y el
  7. //planteameiento del compañero Neftali
  8. //
  9. // 21/03/2009  JLGT  Verdion 1.0
  10. //Este componente es Freeware y se puede modificar y alterar
  11. //Siempre y cuando se distribuya libremente las modificaciones
  12. //Se ue se puede acortar el código, pero prefiero
  13. //dejarlo de esta manera para poder comprenderlo mejor
  14. ///////////////////////////////////////////////////////////////
  15.  
  16. ///////////////////////////////////////////////////////////////
  17. //Para su uso se recomienda activar  en el primer active de la aplicación
  18. //y desactivarlo al cerrarse la aplicación para evitar errores
  19. //tener en cuenta que el componente afecta a windows, y por lo tanto a
  20. //otras aplicaciones
  21. ///////////////////////////////////////////////////////////////
  22.  
  23.  
  24. unit ScreenColorFontZoomCenter;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, ExtCtrls, Messages,SysUtils, Classes, Graphics,
  30.   StdCtrls, ComCtrls, Controls, Forms, TypInfo, Dialogs ;
  31.  
  32. type
  33.   TVZoomVal = 1..4;
  34.   TCenterScreenColorFontZoom = class(TComponent)
  35.   private
  36.     { Private declarations }
  37.     FActive: Boolean;                          //Activa el uso del componente  NO OLVIDAR DESACTIVAR AL CERRA EL FORM
  38.     FTag: integer;                            //Da una proiedad tag al componente
  39.     FColorActive: Boolean;                    //Activa el uso del color altener/perder el foco
  40.     FColorConFoco: TColor;                    //Color de entrada en el foco
  41.     FColorSinFoco: TColor;                    //Color de Salida del Foco
  42.     FPierdeFoco, FTieneFoco: TWinControl;      // a partir de WinControl pueden recibir el foco
  43.     FForm: Boolean;                            //Para usar el proceso en el form o no
  44.     FColorForm: TColor;                        //Establecer el color de fondo del Fom si se activa FFForm al perder el foco
  45.     FTagValorAdmit: Integer;                  //Leera el valor del Tag permitido para apñllicar los efectos por defecto 0 si
  46.                                               //se establece en un componente el tag <> 0 (o valor establecido) no afectaria este componente
  47.     FZoomActive: Boolean;                      //Activa el uso de Zoom en el componente
  48.     FZoomVal: TVZoomVal;                      //Desactiva el Uso de Zoom en el compoenete
  49.     FFontActive :boolean;                      //Aciva el uso de fuentes
  50.     FFontProg: Boolean;                        //USar fuente por defecto en el componente al salir
  51.     FFontFocus: Tfont;                        //Fuente cuando se tiene el foco
  52.     FFontNoFocus: Tfont;                      //Fuente cuando se pierde el foco
  53.     FPanel: Boolean;                          //Afectar a PAneles o no
  54.     FOnFocusChange: TNotifyEvent;              //Evento al Cambiarse el foco
  55.     procedure ScreenActiveControlChange(Sender: TObject);
  56. //  procedure SetColorActive(value: boolean);
  57. //    procedure SetTagValorAdmit(value: integer);
  58.   protected
  59.     { Protected declarations }
  60.   public
  61.     { Public declarations }
  62.     //Cambiar propiedad color y añadir Zoom, zoomval y font
  63.     //{ORIGINAL}  Procedure AplicarColor(Color: TColor; Componente: TWinControl);
  64.     Procedure AplicarColor(Color: string; Componente: TWinControl);
  65.     constructor Create(AOwner : TComponent); override;
  66.     destructor Destroy; override;
  67.  
  68.   published
  69.     { Published declarations }
  70.     property Active: boolean            read FActive          write FActive        default False;
  71.     property Tag: integer                read FTag            write FTag;
  72.     property ColorConFoco: TColor        read FColorConFoco    write FColorConFoco;
  73.     property ColorSinFoco: TColor        read FColorSinFoco    write FColorSinFoco;
  74.     property ColorActive: boolean        read FColorActive    write FColorActive    default True;
  75.     property Form: boolean              read FForm            write FForm          default False;
  76.     property TagValorAdmit: integer      read FTagValorAdmit  write FTagValorAdmit  default 0;
  77.     property ZoomActive: Boolean        read FZoomActive      write FZoomActive    default False;
  78.     property ZoomVal: TVZoomVal          read FZoomVal        write FZoomVal        default 1;
  79.     property FontActive: Boolean        read FFontActive      write FFontActive    default False;
  80.     property FontProg: Boolean          read FFontProg        write FFontProg      default False;
  81.     property PAnel: Boolean              read FPanel          write FPanel          default False;
  82.     property FontFocus: TFont            read FFontFocus      write FFontFocus;
  83.     property FontNoFocus: TFont          read FFontNoFocus    write FFontNoFocus;
  84.     property OnFocusChange: TNotifyEvent read FOnFocusChange  write FOnFocusChange;
  85.   end;
  86.  
  87. var VarCompUsage: Integer;
  88. procedure Register;
  89.  
  90.  
  91. implementation
  92.  
  93. //Bajado de [url]http://www.chami.com/tips/delphi/112596D.html[/url]  ---------------------[1]
  94.  
  95. //El Codigo bajo las siguientes lineas no se termino usando en el componenete, pero me parecio
  96. //Interesante mantenerlo para posibles futuros usos.
  97. const
  98.   csfsBold      = &#39;|Bold&#39;;
  99.   csfsItalic    = &#39;|Italic&#39;;
  100.   csfsUnderline = &#39;|Underline&#39;;
  101.   csfsStrikeout = &#39;|Strikeout&#39;;
  102. //
  103. // Expected format:
  104. //  "Arial", 9, [Bold], [clRed]
  105. //
  106.  
  107. //Pasamos de String a font
  108. procedure StringToFont(  sFont : string; Font : TFont );
  109. var
  110.   p      : integer;
  111.   sStyle : string;
  112. begin
  113.   with Font do
  114.   begin
  115.     // get font name
  116.     p    := Pos( &#39;,&#39;, sFont );
  117.     Name := Copy( sFont, 2, p-3 );
  118.     Delete( sFont, 1, p );
  119.         // get font size
  120.     p    := Pos( &#39;,&#39;, sFont );
  121.     Size := StrToInt( Copy( sFont, 2, p-2 ) );
  122.     Delete( sFont, 1, p );
  123.         // get font style
  124.     p      := Pos( &#39;,&#39;, sFont );
  125.     sStyle :=  &#39;|&#39; + Copy( sFont, 3, p-4 );
  126.     Delete( sFont, 1, p );
  127.         // get font color
  128.     Color :=  StringToColor( Copy( sFont, 3, Length( sFont ) - 3 ) );
  129.         // convert str font style to
  130.     // font style
  131.     Style := [];
  132.     if( Pos( csfsBold, sStyle ) > 0 )then Style := Style + [ fsBold ];
  133.     if( Pos( csfsItalic, sStyle ) > 0 )then  Style := Style + [ fsItalic ];
  134.     if( Pos( csfsUnderline, sStyle ) > 0 )then  Style := Style + [ fsUnderline ];
  135.     if( Pos( csfsStrikeout,  sStyle ) > 0 )then  Style := Style + [ fsStrikeout ];
  136.   end;
  137. end;
  138.  
  139. //
  140. // Output format:
  141. //  "Aril", 9, [Bold|Italic], [clAqua]
  142. //
  143.  
  144. //PAsamos de font a String
  145. function FontToString( Font : TFont ) : string;
  146. var
  147.   sStyle : string;
  148. begin
  149.   with Font do
  150.   begin
  151.     // convert font style to string
  152.     sStyle := &#39;&#39;;
  153.     if( fsBold in Style )then  sStyle := sStyle + csfsBold;
  154.     if( fsItalic in Style )then sStyle := sStyle + csfsItalic;
  155.     if( fsUnderline in Style )then sStyle := sStyle + csfsUnderline;
  156.     if( fsStrikeout in Style )then  sStyle := sStyle + csfsStrikeout;
  157.     if( ( Length( sStyle ) > 0 ) and ( &#39;|&#39; = sStyle[ 1 ] ) )then
  158.     begin
  159.       sStyle := Copy( sStyle, 2, Length( sStyle ) - 1 );
  160.     end;
  161.     Result := Format( &#39;"%s", %d, [%s], [%s]&#39;,  [ Name,  Size,  sStyle, ColorToString( Color ) ] );
  162.   end;
  163. end;
  164. //------------------------------------------------------------------------------[1]
  165. //USO DEL RTTI------------------------------------------------------------------[2]
  166.   //·······················································································
  167.   // Comprueba si existe una propiedad con ese nombre
  168.   function ExistProp(Instance: TObject; const PropName: string):Boolean;
  169.   var
  170.     PropInfo: PPropInfo;
  171.   begin
  172.     // Busca la propiedad y deviuelve la estructura nil
  173.     PropInfo := GetPropInfo(Instance, PropName);
  174.     Result := not (PropInfo = nil);
  175.       end;
  176.  
  177.   //·······················································································
  178.   // Cambia el valor de la propiedad
  179.   function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
  180.   var
  181.     PInfo: PPropInfo;
  182.   Begin
  183.     // Intentamos acceder (con un puntero) a la info. de la propiedad
  184.     PInfo := GetPropInfo(AObj.ClassInfo, PropName);
  185.     Result := PInfo <> nil;
  186.  
  187.     // Se ha obtenido la información...
  188.     if (Result) then
  189.     begin
  190.       // Se ha encontrado la propiedad con éste nombre; Chequear el tipo...
  191.       if (PInfo^.Proptype^.Kind = tkString) or (PInfo^.Proptype^.Kind = tkLString) then
  192.       begin
  193.         // Asignar el valor de tipo String
  194.         SetStrProp(AObj, PInfo, Value);
  195.       end else
  196.       if (PInfo^.Proptype^.Kind = tkInteger) then
  197.       begin
  198.         // Asignar el valor...
  199.         if (PInfo^.PropType^.Name = &#39;TColor&#39;) then
  200.         begin
  201.               SetOrdProp(AObj, PInfo, StringToColor(Value));
  202.         end else
  203.         begin
  204.             SetOrdProp(AObj, PInfo, StrToInt(Value));
  205.         end;
  206.       end else
  207.       begin
  208.               Result := False;
  209.               MessageDlg(&#39;&#39;&#39;La propiedad &#39;&#39; + PropName + &#39;&#39; no es de tipo String (o un tipo implementado)&#39;, mtWarning, [mbOK], 0);
  210.       end;
  211.     end  else
  212.     begin
  213.       // No se ha encontrado la propiedad con ese nombre
  214.       Result := False;
  215.     end;
  216.   end;
  217. //FIN USO DEL RTTI--------------------------------------------------------------[2]
  218.  
  219. procedure Register;
  220. begin
  221.   RegisterComponents(&#39;Samples&#39;, [TCenterScreenColorFontZoom]);
  222. end;
  223.  
  224. constructor TCenterScreenColorFontZoom.Create(AOwner : TComponent);
  225. begin
  226.   inherited Create(AOwner);
  227.   Screen.OnActiveControlChange := ScreenActiveControlChange;
  228.   FColorConFoco := clSkyBlue;
  229.   FColorSinFoco := clWindow;
  230.   FColorActive:= True;
  231.   FTagValorAdmit:=0;
  232.   FForm :=False;
  233.   FActive:=False;
  234.   FZoomActive:= False;
  235.   FZoomVal:=1;
  236.   FFontActive:=False;
  237.   FFontProg:=False;
  238.   FFontFocus:=TFont.Create;
  239.   FFontNoFocus:=TFont.Create;
  240.   FPanel:=False;
  241.   VarCompUsage:=0;
  242. end;
  243.  
  244. destructor TCenterScreenColorFontZoom.Destroy;
  245. begin
  246.   Screen.OnActiveControlChange := nil;
  247.   FFontNoFocus.Free();
  248.   FFontFocus.Free();
  249.   inherited;
  250. end;
  251.  
  252. procedure TCenterScreenColorFontZoom.ScreenActiveControlChange(Sender: TObject);
  253. begin
  254.   FPierdeFoco := FTieneFoco;
  255.   FTieneFoco  := Screen.ActiveControl;
  256.   //Sólo si esta activo el componente
  257.   if FActive=True then
  258.   begin
  259.     //Si el control activo no es un TFOM y ademas la propiedad FForm no sea false
  260.     if not ((Screen.ActiveControl.ClassType = TForm) and (FForm=False)) then
  261.     begin
  262.       //Si el valor del tag del control es igual al de la propiedad FtagValoradmit
  263.       if FPierdeFoco <> nil then  //PAra el Componente que pierde el Foco
  264.       begin
  265.           if FPierdeFoco.Tag=FTagValorAdmit then
  266.           begin
  267.             if not ((FPierdeFoco.ClassType=TPanel) and (FPanel=False)) then
  268.             begin
  269.               //Si esta activo el color
  270.               if FColorActive=true then  Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
  271.               if FZoomActive = true then
  272.               begin      //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
  273.                   TEdit(FPierdeFoco).Font.Size:=(Tedit(FPierdeFoco).Font.Size div Fzoomval);
  274.                   FPierdeFoco.Width:=(FPierdeFoco.Width div FZoomVal);
  275.                 end;
  276.               if FFontActive=true then TEdit(FPierdeFoco).font:=FFontNoFocus;
  277.             end;
  278.             VarCompUsage:=0; //Decimos que no hay un componente activado
  279.           end;
  280.       end;
  281.  
  282.       if FTieneFoco <> nil then  //Para el componente que adquiere el foco
  283.       begin
  284.           if FTieneFoco.Tag=FTagValorAdmit then
  285.           begin
  286.               if not ((FTieneFoco.ClassType=TPanel) and (FPanel=False)) then
  287.               begin
  288.                 if FColorActive=true then self.AplicarColor(ColorToString(FColorconFoco), FTieneFoco);
  289.                 if FFontActive=true then
  290.                 begin
  291.                   //Si activamos FFontProg cuando pierda el fco volvera a la que estipulemos anteriormente
  292.                   //En caso contrario devolvera el Font establecido en FontNoFocus
  293.                   if FFontProg=true then FFontNoFocus:=TEdit(FTieneFoco).Font;
  294.                   TEdit(FTieneFoco).Font:=FFontFocus;
  295.                 end;
  296.                 if FZoomActive = true then
  297.                 begin  //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
  298.                   TEdit(FTieneFoco).Font.Size:=(Tedit(FTieneFoco).Font.Size * Fzoomval);
  299.                   FTieneFoco.Width:=(FTieneFoco.Width * FZoomVal);
  300.                   FTieneFoco.BringToFront;
  301.                 end;
  302.                 FTag := self.Tag;
  303.                 VarCompUsage:=1; //Decimos que hay un componente activado
  304.               end;
  305.           end;
  306.       end else  FTag := 0;
  307.     end;
  308.   end else
  309.   begin
  310.       if (VarCompUsage=1) then  //Comprobamos si hay algún componente activo con anterioridad
  311.       begin
  312.         if FPierdeFoco.Tag=FTagValorAdmit then
  313.         begin
  314.           if not ((FPierdeFoco.ClassType=TPanel) and (FPanel=False)) then
  315.           begin
  316.             if FColorActive=true then  Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
  317.             if FZoomActive = true then
  318.             begin      //Idea del compañero Jhonny en tema [url]http://www.clubdelphi.com/foros/showthread.php?t=50323&highlight=font+twincontrol[/url]
  319.                   TEdit(FPierdeFoco).Font.Size:=(Tedit(FPierdeFoco).Font.Size div Fzoomval);
  320.                   FPierdeFoco.Width:=(FPierdeFoco.Width div FZoomVal);
  321.             end;
  322.             if FFontActive=true then TEdit(FPierdeFoco).font:=FFontNoFocus;
  323.           end;
  324.         end;
  325.         VarCompUsage:=0;    //Decimos que no hay componentes activos
  326.       end;
  327.       FTag:=0;
  328.   end;
  329.  
  330.   if Assigned(FOnFocusChange) then FOnFocusChange(Self);
  331. end;
  332.  
  333. Procedure TCenterScreenColorFontZoom.AplicarColor(Color :String; Componente: TWinControl);
  334. begin
  335.   try
  336.     if ExistProp(Componente,&#39;Color&#39;) then SetPropAsString(Componente,&#39;Color&#39;,Color);
  337. // ORIGINAL -------------------------------------------------------------------------------
  338. //    if (Componente is TCustomEdit)    then (Componente as TEdit).Color := Color;
  339. //    if (Componente is TDateTimePicker) then (Componente as TDateTimePicker).Color:= Color;
  340. //    if (Componente is TCustomMemo)    then (Componente as TMemo).Color:= Color;
  341. //    if (Componente is TCustomComboBox) then (Componente as TComboBox).Color:= Color;
  342. //
  343. //    (Componente as TWinControl).Repaint;
  344. //------------------------------------------------------------------------------------------
  345.   except
  346.   end;
  347. end;
  348. end.




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

#2 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.409 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

#3 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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

#4 andres1569

andres1569

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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
  1. property FontFocus: TFont read FFontFocus write SetFontFocus;
  2.  
  3.  
  4. ( ... )
  5.  
  6. procedure TCenterScreenColorFontZoom.SetFontFocus(Value: TFont);
  7. begin
  8.   FFontFocus.Assign(Value);
  9. 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

#5 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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

#6 pcicom

pcicom

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 261 mensajes
  • LocationMéxico

Escrito 17 marzo 2010 - 04:26

Y como se USA..!!!

  • 0

#7 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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

#8 pcicom

pcicom

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 261 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

#9 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 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

#10 Desart

Desart

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 715 mensajes
  • LocationEspaña

Escrito 20 marzo 2010 - 04:36

Bueno este es el código como queda.


delphi
  1. //////////////////////////////////////////////////////////////
  2. //Este componente parte de uno del compañero PBorges36 y  Grandel
  3. //Que gentilmente compartienron con nuestra comunidad en nuestro
  4. //Valiosicimo ClubDelphi
  5. //
  6. //Fundamental es tambien la participacion en la idea y el
  7. //planteameiento del compañero Neftali
  8. //
  9. // 21/03/2009  JLGT  Verdion 1.0
  10. //Este componente es Freeware y se puede modificar y alterar
  11. //Siempre y cuando se distribuya libremente las modificaciones
  12. //Se ue se puede acortar el código, pero prefiero
  13. //dejarlo de esta manera para poder comprenderlo mejor
  14. ///////////////////////////////////////////////////////////////
  15.  
  16. ///////////////////////////////////////////////////////////////
  17. //Para su uso se recomienda activar  en el primer active de la aplicación
  18. //y desactivarlo al cerrarse la aplicación para evitar errores
  19. //tener en cuenta que el componente afecta a windows, y por lo tanto a
  20. //otras aplicaciones
  21. ///////////////////////////////////////////////////////////////
  22.  
  23.  
  24. unit ScreenColorCenter;
  25.  
  26. interface
  27.  
  28. uses
  29.   Windows, ExtCtrls, Messages,SysUtils, Classes, Graphics,
  30.   StdCtrls, ComCtrls, Controls, Forms, TypInfo, Dialogs ;
  31. // Math, Forms;
  32.  
  33. type
  34.   TCenterScreenColor = class(TComponent)
  35.   private
  36.     { Private declarations }
  37.     FActive: Boolean;                          //Activa el uso del componente  NO OLVIDAR DESACTIVAR AL CERRA EL FORM
  38.     FColorActive: Boolean;                    //Activa el uso del color altener/perder el foco
  39.     FColorConFoco: TColor;                    //Color de entrada en el foco
  40.     FColorSinFoco: TColor;                    //Color de Salida del Foco
  41.     FTagValorAdmit: Integer;                  //Leera el valor del Tag permitido para apñllicar los efectos por defecto 0 si
  42.                                               //se establece en un componente el tag <> 0 (o valor establecido) no afectaria este componente
  43.     FForm: Boolean;                            //Para usar el proceso en el form o no
  44.     FEdit_DBEdit:Boolean;                      //Afecta a edits y dbedits
  45.     FMEmo_DbMEmo:Boolean;                      //Afecta a Memos y dbmemos
  46.     FComboBox_DBCombobox: Boolean;            //Afecta a Combocbox y dbcombobox
  47.     FOther: Boolean;                          //Afecta a l resto de los componentes
  48.                                               //Ojo other puede darnos efectos no deseados
  49.     FTag: integer;                            //Da una proiedad tag al componente
  50.     FPierdeFoco, FTieneFoco: TWinControl;      // a partir de WinControl pueden recibir el foco
  51.     FOnFocusChange: TNotifyEvent;              //Evento al Cambiarse el foco
  52.  
  53.     procedure ScreenActiveControlChange(Sender: TObject);
  54.     procedure SetColorConFoco(const Value: TColor);
  55.     procedure SetColorSinFoco(const Value: TColor);
  56.  
  57.   protected
  58.     { Protected declarations }
  59.  
  60.   public
  61.     { Public declarations }
  62.     //Cambiar propiedad color y añadir Zoom, zoomval y font
  63.     //{ORIGINAL}  Procedure AplicarColor(Color: TColor; Componente: TWinControl);
  64.     Procedure AplicarColor(Color: string; Componente: TWinControl);
  65.     procedure AdmitComponent(Component:TWinControl);
  66.     constructor Create(AOwner : TComponent); override;
  67.     destructor Destroy; override;
  68.  
  69.   published
  70.     { Published declarations }
  71.     property Active: boolean              read FActive              write FActive              default False;
  72.     property ColorActive: boolean          read FColorActive        write FColorActive        default True;
  73.     property ColorConFoco: TColor          read FColorConFoco        write SetColorConFoco;
  74.     property ColorSinFoco: TColor          read FColorSinFoco        write SetColorSinFoco;
  75.     property TagValorAdmit: integer        read FTagValorAdmit      write FTagValorAdmit      default 0;
  76.     property Form: boolean                read FForm                write FForm                default False;
  77.     property Edit_DBEdit: boolean          read FEdit_DBEdit        write FEdit_DBEdit        default True;
  78.     property MEmo_DbMEmo: boolean          read FMEmo_DbMEmo        write FMEmo_DbMEmo        default True;
  79.     property ComboBox_DBCombobox: boolean  read FComboBox_DBCombobox write FComboBox_DBCombobox default True;
  80.     property Other: Boolean                read FOther              write FOther              default False;
  81.     property Tag: integer                  read FTag                write FTag;
  82.     property OnFocusChange: TNotifyEvent  read FOnFocusChange      write FOnFocusChange;
  83.   end;
  84.  
  85. var VarCompUsage,VarCompAdm: Integer;
  86.     VarPrivPassComponent: Boolean;            //Esta variable nos permitira saber si usar los efectos en el componente
  87. procedure Register;
  88.  
  89. implementation
  90.  
  91. //USO DEL RTTI------------------------------------------------------------------[2]
  92.   //·······················································································
  93.   // Comprueba si existe una propiedad con ese nombre
  94.   function ExistProp(Instance: TObject; const PropName: string):Boolean;
  95.   var
  96.     PropInfo: PPropInfo;
  97.   begin
  98.     // Busca la propiedad y deviuelve la estructura nil
  99.     PropInfo := GetPropInfo(Instance, PropName);
  100.     Result := not (PropInfo = nil);
  101.   end;
  102.  
  103.   //·······················································································
  104.   // Cambia el valor de la propiedad
  105.   function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
  106.   var
  107.     PInfo: PPropInfo;
  108.   Begin
  109.     // Intentamos acceder (con un puntero) a la info. de la propiedad
  110.     PInfo := GetPropInfo(AObj.ClassInfo, PropName);
  111.     Result := PInfo <> nil;
  112.  
  113.     // Se ha obtenido la información...
  114.     if (Result) then
  115.     begin
  116.       // Se ha encontrado la propiedad con éste nombre; Chequear el tipo...
  117.       if (PInfo^.Proptype^.Kind = tkString) or (PInfo^.Proptype^.Kind = tkLString) then
  118.       begin
  119.         // Asignar el valor de tipo String
  120.         SetStrProp(AObj, PInfo, Value);
  121.       end
  122.       else
  123.       if (PInfo^.Proptype^.Kind = tkInteger) then
  124.       begin
  125.         // Asignar el valor...
  126.         if (PInfo^.PropType^.Name = 'TColor') then
  127.         begin
  128.               SetOrdProp(AObj, PInfo, StringToColor(Value));
  129.         end else
  130.         begin
  131.             SetOrdProp(AObj, PInfo, StrToInt(Value));
  132.         end;
  133.       end
  134.       else
  135.       begin
  136.               Result := False;
  137.               MessageDlg('''La propiedad '' + PropName + '' no es de tipo String (o un tipo implementado)', mtWarning, [mbOK], 0);
  138.       end;
  139.     end  else
  140.     begin
  141.       // No se ha encontrado la propiedad con ese nombre
  142.       Result := False;
  143.     end;
  144.   end;
  145. //FIN USO DEL RTTI--------------------------------------------------------------[2]
  146.  
  147. procedure Register;
  148. begin
  149.   RegisterComponents('Samples', [TCenterScreenColor]);
  150. end;
  151.  
  152. constructor TCenterScreenColor.Create(AOwner : TComponent);
  153. begin
  154.   inherited Create(AOwner);
  155.   Screen.OnActiveControlChange := ScreenActiveControlChange;
  156.   FColorConFoco := clSkyBlue;
  157.   FColorSinFoco := clWindow;
  158.   FColorActive:= True;
  159.   FTagValorAdmit:=0;
  160.   FForm :=False;
  161.   FActive:=False;
  162.   FEdit_DBEdit:=True;
  163.   FMEmo_DbMEmo:=True;
  164.   FComboBox_DBCombobox:=True;
  165.   FOther:=False;
  166.   VarCompUsage:=0;
  167. end;
  168.  
  169. destructor TCenterScreenColor.Destroy;
  170. begin
  171. //  FActive:=False;    //Nueva linea que se desactive aútomaticamente es la idea
  172.   Screen.OnActiveControlChange := nil;
  173.   inherited;
  174. end;
  175.  
  176.  
  177. procedure TCenterScreenColor.ScreenActiveControlChange(Sender: TObject);
  178. //-------------------------------------------------------------------------------
  179. // Aquie es donde se desarrolla todo el proseso del componente
  180. //-------------------------------------------------------------------------------
  181. var FontNAme,FontColor:string;
  182. begin
  183.   FPierdeFoco := FTieneFoco;
  184.   FTieneFoco  := Screen.ActiveControl;
  185.   VarCompAdm:=1;        //Nos permite decir si activamos o no el componente comprobando previamente la case y su permiso
  186.   VarPrivPassComponent:=True;
  187.   //Sólo si esta activo el componente
  188.   if FActive=True then
  189.   begin
  190.     //Si el valor del tag del control es igual al de la propiedad FtagValoradmit
  191.       if FPierdeFoco <> nil then  //PAra el Componente que pierde el Foco
  192.       begin
  193.           if VarCompAdm=1 then
  194.           begin
  195.             if FPierdeFoco.Tag=FTagValorAdmit then
  196.             begin
  197.                 Self.AdmitComponent(FPierdeFoco);
  198.                 if VarPrivPassComponent=true then
  199.                 begin
  200.                   //Si esta activo el color
  201.                   if FColorActive=true then  Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
  202.                 end;
  203.               VarCompUsage:=0; //Decimos que no hay un componente activado
  204.             end;
  205.           end;
  206.       end;
  207.  
  208.       if FTieneFoco <> nil then  //Para el componente que adquiere el foco
  209.       begin
  210.           if VarCompAdm=1 then
  211.           begin
  212.             if FTieneFoco.Tag=FTagValorAdmit then
  213.             begin
  214.                 Self.AdmitComponent(FTieneFoco);
  215.                 if VarPrivPassComponent=true then
  216.                 begin
  217.                     if FColorActive=true then self.AplicarColor(ColorToString(FColorconFoco), FTieneFoco);
  218.                     FTag := self.Tag;
  219.                     VarCompUsage:=1; //Decimos que hay un componente activado
  220.                 end;
  221.             end;
  222.           end;
  223.       end else  FTag := 0;
  224.   end else
  225.   begin
  226.       if (VarCompUsage=1) then  //Comprobamos si hay algún componente activo con anterioridad
  227.       begin
  228.         if VarCompAdm=1 then
  229.         begin
  230.           if FPierdeFoco.Tag=FTagValorAdmit then
  231.           begin
  232.             Self.AdmitComponent(FPierdeFoco);
  233.             if VarPrivPassComponent=True then
  234.             begin
  235.               if FColorActive=true then  Self.AplicarColor(ColorToString(FColorSinFoco), FPierdeFoco);
  236.             end;
  237.           end;
  238.         end;
  239.         VarCompUsage:=0;    //Decimos que no hay componentes activos
  240.       end;
  241.       FTag:=0;
  242.   end;
  243.   if Assigned(FOnFocusChange) then FOnFocusChange(Self);      //Ejcuta el evento
  244. end;
  245.  
  246. Procedure TCenterScreenColor.AplicarColor(Color :String; Componente: TWinControl);
  247. begin
  248.   try
  249.     if ExistProp(Componente,'Color') then SetPropAsString(Componente,'Color',Color);
  250. // ORIGINAL -------------------------------------------------------------------------------
  251. //    if (Componente is TCustomEdit)    then (Componente as TEdit).Color := Color;
  252. //    if (Componente is TDateTimePicker) then (Componente as TDateTimePicker).Color:= Color;
  253. //    if (Componente is TCustomMemo)    then (Componente as TMemo).Color:= Color;
  254. //    if (Componente is TCustomComboBox) then (Componente as TComboBox).Color:= Color;
  255. //    (Componente as TWinControl).Repaint;
  256. //------------------------------------------------------------------------------------------
  257.   except
  258.   end;
  259. end;
  260. procedure TCenterScreenColor.SetColorConFoco(const Value: TColor);
  261. begin
  262.   if (FColorConFoco <> value) then FColorConFoco:= value;
  263. end;
  264. procedure TCenterScreenColor.SetColorSinFoco(const Value: TColor);
  265. begin
  266.   if (FColorSinFoco <> value) then FColorSinFoco:= value;
  267. end;
  268. procedure TCenterScreenColor.AdmitComponent(Component:TWinControl);
  269. begin
  270.     if (Component is TCustomForm) then
  271.     if Component.ClassType=Tform then
  272.     begin
  273.         if FForm=true then VarPrivPassComponent:=True
  274.                       else VarPrivPassComponent:=False;
  275.     end else
  276.     begin
  277.         if ((Component is TCustomEdit) or (Component is TDateTimePicker))then
  278.         begin
  279.           if FEdit_DBEdit=true then VarPrivPassComponent:=True
  280.           else VarPrivPassComponent:=False;
  281.         end else
  282.         begin
  283.           if (Component is TCustomMemo) then
  284.           begin
  285.               if FMEmo_DbMEmo=true then VarPrivPassComponent:=True
  286.                                   else VarPrivPassComponent:=False;
  287.           end else
  288.           begin
  289.               if (Component is TCustomComboBox) then
  290.               begin
  291.                   if FComboBox_DBCombobox=true then VarPrivPassComponent:=True
  292.                                               else VarPrivPassComponent:=False;
  293.               end else
  294.               begin
  295.                 if FOther=true then VarPrivPassComponent:=True
  296.                                 else VarPrivPassComponent:=False;
  297.               end;
  298.           end;
  299.         end;
  300.     end;
  301. end;
  302. end.



Y aquí tenéis el zip con el componente

Archivos adjuntos


  • 0