Ver Mensaje Individual
  #16  
Antiguo 20-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
Pues nada aquí esta el código como queda

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 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.

y el enlace del Ftp archivo ScreenColorCenter.zip
__________________
Un saludo desde Canarias, "El abuelo Cebolleta"
Responder Con Cita