Pues nada aquí esta el código como queda
Código Delphi
[-]
unit ScreenColorCenter;
interface
uses
Windows, ExtCtrls, Messages,SysUtils, Classes, Graphics,
StdCtrls, ComCtrls, Controls, Forms, TypInfo, Dialogs ;
type
TCenterScreenColor = class(TComponent)
private
FActive: Boolean; FColorActive: Boolean; FColorConFoco: TColor; FColorSinFoco: TColor; FTagValorAdmit: Integer; FForm: Boolean; FEdit_DBEdit:Boolean; FMEmo_DbMEmo:Boolean; FComboBox_DBCombobox: Boolean; FOther: Boolean; FTag: integer; FPierdeFoco, FTieneFoco: TWinControl; FOnFocusChange: TNotifyEvent;
procedure ScreenActiveControlChange(Sender: TObject);
procedure SetColorConFoco(const Value: TColor);
procedure SetColorSinFoco(const Value: TColor);
protected
public
Procedure AplicarColor(Color: string; Componente: TWinControl);
procedure AdmitComponent(Component:TWinControl);
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
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; procedure Register;
implementation
function ExistProp(Instance: TObject; const PropName: string):Boolean;
var
PropInfo: PPropInfo;
begin
PropInfo := GetPropInfo(Instance, PropName);
Result := not (PropInfo = nil);
end;
function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
var
PInfo: PPropInfo;
Begin
PInfo := GetPropInfo(AObj.ClassInfo, PropName);
Result := PInfo <> nil;
if (Result) then
begin
if (PInfo^.Proptype^.Kind = tkString) or (PInfo^.Proptype^.Kind = tkLString) then
begin
SetStrProp(AObj, PInfo, Value);
end
else
if (PInfo^.Proptype^.Kind = tkInteger) then
begin
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
Result := False;
end;
end;
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
Screen.OnActiveControlChange := nil;
inherited;
end;
procedure TCenterScreenColor.ScreenActiveControlChange(Sender: TObject);
var FontNAme,FontColor:string;
begin
FPierdeFoco := FTieneFoco;
FTieneFoco := Screen.ActiveControl;
VarCompAdm:=1; VarPrivPassComponent:=True;
if FActive=True then
begin
if FPierdeFoco <> nil then 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;
VarCompUsage:=0; end;
end;
end;
if FTieneFoco <> nil then 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; end;
end;
end;
end else FTag := 0;
end else
begin
if (VarCompUsage=1) then 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; end;
FTag:=0;
end;
if Assigned(FOnFocusChange) then FOnFocusChange(Self); end;
Procedure TCenterScreenColor.AplicarColor(Color :String; Componente: TWinControl);
begin
try
if ExistProp(Componente,'Color') then SetPropAsString(Componente,'Color',Color);
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