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 = '|Bold'; csfsItalic = '|Italic'; csfsUnderline = '|Underline'; csfsStrikeout = '|Strikeout'; // // 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( ',', sFont ); Name := Copy( sFont, 2, p-3 ); Delete( sFont, 1, p ); // get font size p := Pos( ',', sFont ); Size := StrToInt( Copy( sFont, 2, p-2 ) ); Delete( sFont, 1, p ); // get font style p := Pos( ',', sFont ); sStyle := '|' + 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 := ''; 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 ( '|' = sStyle[ 1 ] ) )then begin sStyle := Copy( sStyle, 2, Length( sStyle ) - 1 ); end; Result := Format( '"%s", %d, [%s], [%s]', [ 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 = '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', [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,'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; end.
Si necesitais más información decirmelo y como siempre espero vuestros comentarios y tirones de oreja.