Ver Mensaje Individual
  #11  
Antiguo 17-03-2010
Avatar de José Luis Garcí
[José Luis Garcí] José Luis Garcí is offline
Miembro Premium
 
Registrado: may 2003
Ubicación: Las Palmas de G.C.
Posts: 1.372
Reputación: 23
José Luis Garcí Va camino a la fama
Aquí esta recien salido del horno, pongo el código completo, espero os guste y quedo a la espera de las correciones que hagais

Código 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 http://www.chami.com/tips/delphi/112596D.html  ---------------------[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 http://www.clubdelphi.com/foros/show...nt+twincontrol
                   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 http://www.clubdelphi.com/foros/show...nt+twincontrol
                   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 http://www.clubdelphi.com/foros/show...nt+twincontrol
                  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.

Espero que este al nivel adecuado y este lo suficientemente dosumentado.
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"

Última edición por José Luis Garcí fecha: 17-03-2010 a las 15:45:23. Razón: Correción en el componente
Responder Con Cita