sábado, 5 de setembro de 2009

Mudando a cor dos componentes ao serem focalizados

Uses
Typinfo

function AchaComponente(Nome: string; F: TForm): TComponent;
var
i: integer;
C: TComponent;
begin
Result := nil;
// Converte nome para maiúscula
Nome := UpperCase(Nome);
// Varre o formulário à procura do componente
for i := 0 to F.ComponentCount - 1 do
begin
C := F.Components[i];
// O nome está correto?
if UpperCase(C.Name) = Nome then
begin
// Retorna o componente
Result := C;
// Sai do loop
exit;
end;
end;
end;

// Atibui propriedade ao componente, dado seu valor como string
procedure AtribuiProp(Comp: TComponent; Const PropName: string; Val: string);
var
PInfo: PPropInfo;
begin
// Pega informações de tipo da propriedade
PInfo := GetPropInfo(Comp.ClassInfo, PropName);
// Achou?
if PInfo <> nil then
begin
// Trata conforme o tipo
case PInfo^.Proptype^.Kind of
tkInteger: SetOrdProp(Comp, PInfo, StrToInt(Val));
tkChar, tkWChar: SetOrdProp(Comp, PInfo, ord(Val[1]));
tkEnumeration: SetOrdProp(Comp, PInfo, GetEnumValue(PInfo^.PropType^, Val));
tkFloat: SetFloatProp(Comp, PInfo, StrToFloat(Val));
tkString, tkLString, tkWString: SetStrProp(Comp, PInfo, Val);
tkVariant: SetVariantProp(Comp, PInfo, Val);
tkInt64: SetInt64Prop(Comp, PInfo, StrToInt64(Val));
else
ShowMessage('Este tipo não é suportado por este programa');
end;
end
else
ShowMessage('Propriedade não achada');
end;

// Lê valor da propriedade do componente
function LeProp(Comp: TComponent; Const PropName: string): string;
var
PInfo: PPropInfo;
begin
Result := '';
// Pega informações de tipo da propriedade
PInfo := GetPropInfo(Comp.ClassInfo, PropName);
// Achou?
if PInfo <> nil then
begin
// Trata conforme o tipo
case PInfo^.Proptype^.Kind of
tkInteger: Result := IntToStr(GetOrdProp(Comp, PInfo));
tkChar, tkWChar: Result := char(GetOrdProp(Comp, PInfo));
tkEnumeration: Result := GetEnumName(PInfo^.PropType^, GetOrdProp(Comp, PInfo));
tkFloat: Result := FloatToStr(GetFloatProp(Comp, PInfo));
tkString, tkLString, tkWString: Result := GetStrProp(Comp, PInfo);
tkVariant: GetVariantProp(Comp, PInfo);
tkInt64: Result := IntToStr(GetInt64Prop(Comp, PInfo));
else
ShowMessage('Este tipo não é suportado por este programa');
end;
end
else
ShowMessage('Propriedade não achada');
end;

procedure TForm1.ColorControl(Sender: TObject);
var
Cor: TColor;
I: integer;
begin
With Screen.ActiveForm do
begin
for I:= 0 to ComponentCount -1 do
begin
if Components[I] is TCustomEdit then
begin
if (Components[I] as TCustomEdit).Focused then
Cor := clRed
else
Cor := clWindow;
AtribuiProp(Components[I], 'Color', IntToStr(Cor));
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := ColorControl;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Screen.OnActiveControlChange := nil;
end;

Nenhum comentário:

Postar um comentário