Antes de mais nada, é bom dizer que esse não é um Object Inspector para ser usado em Design - Time, mas sim para ser usado em runtime. Ou seja, não foi usado nada de OTA. O objetivo principal desse Object Inspector é permitir que o usuário modifique propriedades dos componentes do seu programa ao gosto dele e salvar isso no banco de dados.
Nada impede de você usar OTA e transformá-lo em um Object Inspector turbinado para design. Outro objetivo interessante seria listar os nomes dos métodos da form que são eventos, para que o evento de um componente possa ser trocado por outro, dando ao usuário final até uma certa liberdade de "Programação".
Com essa técnica você pode criar em seu aplicativo um gerador de telas/cadastros do usuário, disponibilizando uma paleta de componentes, como a do Delphi, e um object inspector para listar e modificar as propriedades, que podem ser armazenadas em XML ou banco de dados.
Esse Object Inspector está longe de ser completo, obviamente, mas espero que ele sirva de base para quem desejar criar uma IDE de configuração para o usuário, igual ao editor do RAVE.
Em primeiro lugar, note a unit TypInfo: ela é muito útil mesmo. Repare também nos métodos: GetPropList, GetPropInfo, GetMethodProp, IsPublishedProp e o método MethodName da classe TObject.
Atualmente temos manipuladores de cores, fontes e strings ou inteiros. Ainda falta construir manipuladores de sets, enums, objetos e eventos. mas já dá para ter um vislumbre do que é possível fazer com ele. Teste com um componente de cada vez: primeiro com um edit de uma form de teste.
Abra-o conforme o exemplo em anexo, mude a cor desse edit, salve o XML dele, feche o programa, abra o mesmo edit e carregue o XML dele. Verá que a cor do edit mudou. O mesmo dá pra fazer com qualquer outra propriedade.
<div class="code">
<pre class="brush: delphi">unit uFrmVtrPropertyInspector;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, typinfo, StdCtrls, DB, DBClient, Grids, DBGrids, ComCtrls;
type
TfrmVtrPropertyInspector = class(TForm)
cdsProps: TClientDataSet;
dsProps: TDataSource;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
dbgProps: TDBGrid;
TabSheet3: TTabSheet;
Memo1: TMemo;
dbgEvts: TDBGrid;
cdsEvts: TClientDataSet;
dsevts: TDataSource;
cbObjetos: TComboBox;
TabSheet4: TTabSheet;
mInfo: TMemo;
btSalvar: TButton;
btCarregar: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cbObjetosChange(Sender: TObject);
procedure dbgPropsEditButtonClick(Sender: TObject);
procedure btSalvarClick(Sender: TObject);
procedure btCarregarClick(Sender: TObject);
private
FObjeto: TObject;
//esse campo armazena o owner do componente a ser analisado
FOwnerObjetos: Tcomponent;
//adiciona um registro de propriedade no cds
procedure AdicionaPropriedade(iPropIdx: integer; sPropNome: string;
sPropValor: string; sPropTipo: string);
//adiciona um registro de evento no cds
procedure AdicionaEvento(iPropIdx: integer; mMetodo: TMethod; PropInfo:
PPropInfo; obj: Tobject);
//seta a propriedade de um componente
procedure SetaPropriedade(obj: Tobject; sProp: string; vValor: variant;
Objeto: TObject = nil);
function GetOwnerObjetos: TComponent;
public
procedure SetOwnerObjetos(aOwner: TComponent);
procedure SetaObjetoAlvo(aNome: string);
procedure PegaPropriedades(obj: Tobject);
procedure SetaPropriedades(obj: TObject);
property OwnerObjetos: TComponent read GetOwnerObjetos write SetOwnerObjetos;
procedure EditaPropriedades;
end;
const
STR_INDICE = 'Indice';
STR_PROPRIEDADE = 'Propriedade';
STR_VALOR = 'Valor';
STR_TIPO = 'Tipo';
STR_CODIGO = 'Codigo';
STR_DADOS = 'Dados';
STR_COMPONENTE = 'ONDE';
implementation
{$R *.dfm}
{ TForm1 }
procedure TfrmVtrPropertyInspector.PegaPropriedades(obj: Tobject);
var
lista: PPropList;
i: integer;
iNumProps: integer;
sNomeProp: string;
mMetodo: TMethod;
pPropriedade: PPropInfo;
begin
FObjeto := obj;
cdsProps.EmptyDataSet;
iNumProps := GetPropList(obj, lista);
if (obj is TComponent) then
begin
SetOwnerObjetos((obj as TComponent).Owner);
self.Caption := 'Vitor Rubio''s Property Inspector' +
' ---> ' + (obj as TComponent).Name + ' Possui ' +
inttostr(iNumProps)+ ' Propriedades:';
SetaObjetoAlvo((obj as TComponent).Name);
end
else
self.Caption := 'Vitor Rubio''s Property Inspector' +
' ---> ' + obj.ClassName + ' Possui ' +
inttostr(iNumProps)+ ' Propriedades:';
for i:= low(lista^) to iNumProps-1 do
try
sNomeProp := '';
if (lista^[i] <> nil) then
begin
sNomeProp := lista^[i].Name;
pPropriedade := GetPropInfo(obj, sNomeProp);
if (pPropriedade.PropType^.Kind = tkMethod) then
begin
mMetodo := GetMethodProp(obj, sNomeProp);
AdicionaEvento(i, mMetodo, pPropriedade, obj);
end
else
AdicionaPropriedade(i, sNomeProp, string(GetPropValue(obj, sNomeProp)),
lista^[i].PropType^^.Name);
end;
except
if sNomeProp = '' then
sNomeProp := 'Erro';
AdicionaPropriedade(i, sNomeProp, 'Erro', '');
end;
end;
procedure TfrmVtrPropertyInspector.AdicionaPropriedade(iPropIdx: integer; sPropNome: string;
sPropValor: string; sPropTipo: string);
begin
cdsProps.Insert;
cdsProps.FieldByName(STR_INDICE).AsInteger := iPropIdx;
cdsProps.FieldByName(STR_PROPRIEDADE).AsString := sPropNome;
cdsProps.FieldByName(STR_VALOR).AsString := sPropValor;
cdsProps.FieldByName(STR_TIPO).AsString := sPropTipo;
cdsProps.Post;
end;
procedure TfrmVtrPropertyInspector.FormCreate(Sender: TObject);
var
ColProps, Colevts: integer;
begin
//propriedades
with cdsProps.FieldDefs.AddFieldDef do
begin
Name := STR_INDICE;
DataType := ftInteger;
end;
with cdsProps.FieldDefs.AddFieldDef do
begin
Name := STR_TIPO;
DataType := ftString;
end;
with cdsProps.FieldDefs.AddFieldDef do
begin
Name := STR_PROPRIEDADE;
DataType := ftString;
end;
with cdsProps.FieldDefs.AddFieldDef do
begin
Name := STR_VALOR;
DataType := ftString;
Size := 255;
end;
with cdsProps.IndexDefs.AddIndexDef do
begin
Fields := STR_INDICE;
end;
cdsProps.IndexFieldNames := STR_INDICE;
cdsProps.CreateDataSet;
cdsProps.Open;
for ColProps := 0 to dbgProps.Columns.Count-1 do
begin
if dbgProps.Columns[ColProps].Title.Caption = 'Valor' then
dbgProps.Columns[ColProps].ButtonStyle := cbsEllipsis;
end;
//fim propriedades
//eventos
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_INDICE;
DataType := ftInteger;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_TIPO;
DataType := ftString;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_PROPRIEDADE;
DataType := ftString;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_CODIGO;
DataType := ftString;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_DADOS;
DataType := ftString;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_COMPONENTE;
DataType := ftString;
end;
with cdsEvts.FieldDefs.AddFieldDef do
begin
Name := STR_VALOR;
DataType := ftString;
end;
with cdsEvts.IndexDefs.AddIndexDef do
begin
Fields := STR_INDICE;
end;
cdsEvts.IndexFieldNames := STR_INDICE;
cdsEvts.CreateDataSet;
cdsEvts.Open;
//fim eventos
end;
procedure TfrmVtrPropertyInspector.SetaPropriedades(obj: TObject);
begin
cdsProps.First;
while not cdsProps.Eof do
try
try
SetaPropriedade(obj, cdsProps.fieldbyname(STR_PROPRIEDADE).AsString,
cdsProps.fieldbyname(STR_VALOR).AsVariant);
except
end;
finally
cdsProps.Next;
end;
end;
procedure TfrmVtrPropertyInspector.AdicionaEvento(iPropIdx: integer;
mMetodo: TMethod; PropInfo: PPropInfo; obj: Tobject);
begin
cdsEvts.Insert;
cdsEvts.FieldByName(STR_INDICE).AsInteger := iPropIdx;
cdsEvts.FieldByName(STR_PROPRIEDADE).AsString := PropInfo.Name;
if mMetodo.Data <> nil then
cdsEvts.FieldByName(STR_COMPONENTE).AsString :=
TComponent(mMetodo.Data).Name;
if mMetodo.Code <> nil then
cdsEvts.FieldByName(STR_VALOR).AsString :=
FOwnerObjetos.MethodName(mMetodo.Code);
cdsEvts.FieldByName(STR_CODIGO).AsString :=
IntToHex(Integer(GetMethodProp(obj, PropInfo.Name).Code), 10);
cdsEvts.FieldByName(STR_DADOS).AsString :=
IntToHex(Integer(GetMethodProp(obj, PropInfo.Name).Data), 10);
cdsEvts.FieldByName(STR_TIPO).AsString := PropInfo.PropType^.Name;
cdsEvts.Post;
end;
procedure TfrmVtrPropertyInspector.SetaPropriedade(obj: Tobject;
sProp: string; vValor: variant; Objeto: TObject);
var
PropInfo: PPropInfo;
TypeData: PTypeData;
DynArray: Pointer;
Instance: TObject;
PropName: string;
Value: Variant;
function RangedValue(const AMin, AMax: Int64): Int64;
begin
Result := Trunc(Value);
if (Result < AMin) or (Result > AMax) then
raise Exception.Create('Valor fora da faixa permitida');
end;
begin
Instance:= obj;
PropName:= sProp;
Value:= vValor;
// get the prop info
PropInfo := GetPropInfo(Instance, PropName);
if PropInfo = nil then
raise Exception.Create('Propriedade não encontrada: ' + sProp)
else
begin
TypeData := GetTypeData(PropInfo^.PropType^);
// set the right type
case PropInfo.PropType^^.Kind of
tkInteger, tkChar, tkWChar:
if TypeData^.MinValue < TypeData^.MaxValue then
SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
TypeData^.MaxValue))
else
// Unsigned type
SetOrdProp(Instance, PropInfo,
RangedValue(LongWord(TypeData^.MinValue),
LongWord(TypeData^.MaxValue)));
tkEnumeration:
if VarType(Value) = varString then
SetEnumProp(Instance, PropInfo, VarToStr(Value))
else if VarType(Value) = varBoolean then
// Need to map variant boolean values -1,0 to 1,0
SetOrdProp(Instance, PropInfo, Abs(Trunc(Value)))
else
SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
TypeData^.MaxValue));
tkSet:
if VarType(Value) = varInteger then
SetOrdProp(Instance, PropInfo, Value)
else
SetSetProp(Instance, PropInfo, VarToStr(Value));
tkFloat:
SetFloatProp(Instance, PropInfo, Value);
tkString, tkLString:
SetStrProp(Instance, PropInfo, VarToStr(Value));
tkWString:
SetWideStrProp(Instance, PropInfo, VarToWideStr(Value));
tkVariant:
SetVariantProp(Instance, PropInfo, Value);
tkInt64:
SetInt64Prop(Instance, PropInfo, RangedValue(TypeData^.MinInt64Value,
TypeData^.MaxInt64Value));
tkDynArray:
begin
DynArrayFromVariant(DynArray, Value, PropInfo^.PropType^);
SetOrdProp(Instance, PropInfo, Integer(DynArray));
end;
tkClass:
begin
//if Objeto <> nil then
// SetObjectProp(Instance, PropInfo, Objeto);
//SetOrdProp(Instance, PropInfo, vValor);
{cdsProps.FieldByName(STR_VALOR).AsString :=
string(GetPropValue(obj,
cdsProps.FieldByName(STR_PROPRIEDADE).AsString)); }
end;
else
raise Exception.Create('Tipo invalido de propriedade.');
end;
end;
end;
procedure TfrmVtrPropertyInspector.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Release;
end;
procedure TfrmVtrPropertyInspector.SetOwnerObjetos(aOwner: TComponent);
var
i: integer;
TipData: PTypeData;
begin
FOwnerObjetos := aOwner;
TipData := GetTypeData(FOwnerObjetos.ClassInfo);
mInfo.Lines.Add('Classe: ' + TipData.ClassType.ClassName);
mInfo.Lines.Add('Classe Pai: ' + TipData.ParentInfo^.Name);
mInfo.Lines.Add('Nº de propriedades: ' + inttostr(TipData.PropCount));
mInfo.Lines.Add('Nome da Unit: ' + TipData.UnitName);
for i := 0 to aOwner.ComponentCount -1 do
begin
cbObjetos.AddItem(aOwner.Components[i].Name, aOwner.Components[i]);
end;
end;
procedure TfrmVtrPropertyInspector.cbObjetosChange(Sender: TObject);
begin
PegaPropriedades(cbObjetos.Items.Objects[cbObjetos.ItemIndex]);
end;
procedure TfrmVtrPropertyInspector.SetaObjetoAlvo(aNome: string);
begin
cbObjetos.ItemIndex := cbObjetos.Items.IndexOf(aNome);
end;
procedure TfrmVtrPropertyInspector.EditaPropriedades;
var
sNomePropriedade: string;
sValor: variant;
oObjeto: TObject;
PropInfo: PPropInfo;
oObjetinho: Tobject;
begin
cdsProps.Edit;
sValor := cdsProps.FieldByName(STR_VALOR).AsVariant;
sNomePropriedade := cdsProps.FieldByName(STR_PROPRIEDADE).AsString;
oObjeto := FObjeto;
PropInfo := GetPropInfo(oObjeto, sNomePropriedade);
if (cdsProps.FieldByName(STR_TIPO).AsString = 'TFont') then
begin
with TFontDialog.Create(nil) do
try
Font := TFont(integer(sValor));
if Execute then
begin
sValor := integer(Font);
SetaPropriedade(oObjeto,
sNomePropriedade,
sValor);
end;
finally
free;
end;
end
else
if (cdsProps.FieldByName(STR_TIPO).AsString = 'TColor') then
begin
with TColorDialog.Create(nil) do
try
Color := Tcolor(sValor);
if Execute then
begin
sValor := integer(Color);
SetaPropriedade(oObjeto,
sNomePropriedade,
sValor);
end;
finally
free;
end;
end
else
if (PropInfo.PropType^.Kind = tkClass) then
begin
with TfrmVtrPropertyInspector.Create(nil) do
try
oObjetinho := GetObjectProp(oObjeto, sNomePropriedade);
if oObjetinho <> nil then
begin
PegaPropriedades(oObjetinho);
ShowModal;
end;
finally
free;
end;
end
else
begin
SetaPropriedade(oObjeto,
sNomePropriedade,
sValor);
ShowMessage('Propriedade: ' + sNomePropriedade + ' Alterada para: ' + VarToStr(sValor));
end;
cdsProps.FieldByName(STR_VALOR).AsVariant := sValor;
cdsProps.Post;
end;
procedure TfrmVtrPropertyInspector.dbgPropsEditButtonClick(
Sender: TObject);
begin
EditaPropriedades;
end;
function TfrmVtrPropertyInspector.GetOwnerObjetos: TComponent;
begin
Result := FOwnerObjetos;
end;
procedure TfrmVtrPropertyInspector.btSalvarClick(Sender: TObject);
begin
with TSaveDialog.Create(nil) do
try
if Execute then
cdsProps.SaveToFile(FileName, dfXMLUTF8);
finally
Free;
end;
end;
procedure TfrmVtrPropertyInspector.btCarregarClick(Sender: TObject);
begin
with TOpenDialog.Create(nil)do
try
if Execute then
begin
cdsProps.EmptyDataSet;
cdsProps.LoadFromFile(FileName);
cdsProps.First;
while not cdsProps.Eof do
try
try
SetaPropriedade(
FOwnerObjetos.FindComponent(cbObjetos.Text),
cdsProps.fieldbyname(STR_PROPRIEDADE).AsString,
cdsProps.fieldbyname(STR_VALOR).AsString
);
except
//on e:Exception do
//begin
// ShowMessage(e.Message);
//end;
end;
finally
cdsProps.Next;
end;
end;
finally
Free;
end;
end;
end.
Abaixo temos o código da form que chama o inspector:
unit uFrmTeste;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, TypInfo, DB, DBClient;
type
TfrmTeste = class(TForm)
edTeste: TEdit;
btPegar: TButton;
btEvt1: TButton;
btEvt2: TButton;
Label1: TLabel;
Label2: TLabel;
PopupMenu1: TPopupMenu;
Popupdetestedestecomponente1: TMenuItem;
PopupMenu2: TPopupMenu;
Outropopup1: TMenuItem;
ComboBox1: TComboBox;
procedure btEvt1Click(Sender: TObject);
procedure btEvt2Click(Sender: TObject);
procedure btPegarClick(Sender: TObject);
procedure edTesteClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmTeste: TfrmTeste;
implementation
uses uFrmVtrPropertyInspector;
{$R *.dfm}
procedure TfrmTeste.btEvt1Click(Sender: TObject);
begin
ShowMessage('Eu sou o evento disparado pelo botão 1');
end;
procedure TfrmTeste.btEvt2Click(Sender: TObject);
begin
ShowMessage('Eu sou o evento disparado pelo botão 2');
end;
procedure TfrmTeste.btPegarClick(Sender: TObject);
begin
with TfrmVtrPropertyInspector.Create(nil) do
try
try
PegaPropriedades(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
Showmodal;
except
end;
finally
release;
end;
end;
procedure TfrmTeste.edTesteClick(Sender: TObject);
begin
(Sender as tedit).Clear;
end;
procedure TfrmTeste.FormCreate(Sender: TObject);
var i: integer;
begin
for i := 0 to ComponentCount-1 do
ComboBox1.Items.AddObject(Self.Components[i].Name, Self.Components[i]);
ComboBox1.ItemIndex := 0;
end;
end.
