terça-feira, 12 de maio de 2009

Crie seu próprio Object Inspector!


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 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 qualqier outra propriedade.


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



faça o download no meu skydrive clicando aqui:

Nenhum comentário:

Postar um comentário

Postagens populares

Marcadores

delphi (60) C# (31) poo (21) Lazarus (19) Site aos Pedaços (15) sql (13) Reflexões (10) .Net (9) Humor (9) javascript (9) ASp.Net (8) api (8) Básico (6) Programação (6) ms sql server (5) Web (4) banco de dados (4) HTML (3) PHP (3) Python (3) design patterns (3) jQuery (3) livros (3) metaprogramação (3) Ajax (2) Debug (2) Dicas Básicas Windows (2) Pascal (2) games (2) linguagem (2) música (2) singleton (2) tecnologia (2) Anime (1) Api do Windows (1) Assembly (1) Eventos (1) Experts (1) GNU (1) Inglês (1) JSON (1) SO (1) datas (1) developers (1) dicas (1) easter egg (1) firebird (1) interfaces (1) introspecção (1) memo (1) oracle (1) reflexão (1)