Fórum crie seu proprio object inspector #370381
12/05/2009
0
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 usuario modifique propriedades dos componentes do seu programa ao gosto dele e salvar isso no banco de dados. Nada impede de você usar OTA e transforma-lo em um Object Inspector turbinado para design.
Outro objetivo interessante seria listar os nomes dos metodos da form que são eventos, para que o evento de um componente possa ser trocado por outro, dando ao usuario 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, onde você disponibiliza uma paleta de componentes como a do delphi e um object inspector para listar e modificar as propriedades. As propriedades 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 usuario, igual ao editor do RAVE.
Em primeiro lugar, note a unit TypInfo. Ela é muito util 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 é possivel fazer com ele.
Teste com um componente de cada vez, primeiro com um ediit 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 qualqier outra propriedade.
//codigo da form principal do object inspector
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
//ainda falta implementar
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.
[b:55e8a5aa00]Abaixo o código da form que chama o inspector: [/b:55e8a5aa00]
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.
faça o download no meu skydrive [url]http://cid-a3e4fd1c20f4d546.skydrive.live.com/self.aspx/.Public/VtrObjectInspector.zip[/url]:
Vitor Rubio
Curtir tópico
+ 0Posts
12/05/2009
.lg.
Da pra ser usado em diversas aplicações. Pra mim que gerencio o meu servidor de tibia e minhas aplicações... um Object Inspector seria bem viável.
Muito bom.
Gostei + 0
12/05/2009
Vitor Rubio
basta você criar todas as suas classes com propriedades published, e ativando o methodinfo ou fazendo com que sejam dscendentes de TPersistent.
Aí você pode criar um metodo que aceita como parametro um objeto de uma classe criada por você. Esse método é responsavel por criar uma tabela no banco de dados com o nome da classe caso não existir (se existir ele pula essa parte) e já cadastrar um registro. Cada campo da tabela seria uma propriedade do seu objeto, e os valores gravados nessa tabela, no seu insert ou update, seriam os valores das propriedades.
Gostei + 0
14/05/2009
Marco Salles
dois assuntos interresantes que vc colocou
este apesar de não ser novo ( o Ghinter ja postou algo resumido em
RTTI) em uma edição do Clube delphi
e o assunto :
http://forum.devmedia.com.br/viewtopic.php?p=328239&highlight=#328239
Sugiro vc entrar em contato com o Adriano e colocar de forma mais
didática , mais ampla , com um espaçoa maior , em Uma edição da
Revista. Creio que eles estão um pouco carentes
Gostei + 0
14/05/2009
Vitor Rubio
Na verdade eu estou postando essas dicas por 2 motivos: compartilhar alguns Code Snippets úteis e também treinar a minha didática, que não é muito objetiva nem sucinta. Por isso estou aberto a sugestões.
Alem do forum da devmedia estou publicando em outros foruns e no meu blog pessoal tambem.
Agora, quanto a publicar o artigo na revista, como eu poderia fazer isso? Nunca achei que fosse fácil, também não entendo muito como funcionam essas coisas.
Gostei + 0
14/05/2009
Marco Salles
aqui ser resumido e temos que engolir etapas , deixemos de colocar
adendos e refrencias , comentar , enfim , resumir ao máximo
O Adriano é um cara de muito bom relacionamento e sempre prestativo
Ele atualmente é o Editor da Revista. E com certeza a materia sobre
Interfaces , RTTI , POO , desperta muito interresse por parte da
comunidade . Ele certamente acolhera o seu conteudo e tenho certeza
ganhará a Revista , e os leitores ... Espero que vcs cheguem a um Acordo
Gostei + 0
14/05/2009
Vitor Rubio
Eu tinha escrito isso anteriormente de uma outra forma, bem mais passo a passo, colocando inclusive meus proprios erros no processo e como corrigi-los, mas ficou enorme demais :shock:
por isso resumi. Mas valeu pela sugestão. Como posso contatar o Adriano? Aqui pelo forum mesmo?
Gostei + 0
14/05/2009
Marco Salles
ele ainda ´espero que não´ virou Papa
sempre muito disposto e simpatico : ´Veio´ como ele diz
Tem o Blog Dele
http://delphitodelphi.blogspot.com/
o Proprio site do Devmeia tem a opção de contacta-lo
e tb pelo emai dele
asrsantos@gmail.com
Bem , espero ver tão cedo o Artigo publicado com mais riquezas que o
espaço ira te proporcionar
Gostei + 0
Clique aqui para fazer login e interagir na Comunidade :)