Delphi Programmer's Power Pack/Delphi Volume 1.iso/e_to_l/fbuilder/delphi/demos/rttifm.pas

Pascal/Delphi Source File | 1996-09-15 | 5.9 KB | 220 lines

{ FormulaBuilder                }
{ YGB Software, Inc.            }
{ Copyright 1995 Clayton Collie }
{ All rights reserved           }

{* RTTI Demo Form. Demonstrates the use of the TRTTIExpression class *}

unit Rttifm;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, Outline, StdCtrls, Buttons, ExtCtrls,FBRTComp, DB,
  DBGrids, DBTables,FB_Rtti;

type
  TRTTIDemoForm = class(TForm)
    olObjects: TOutline;
    BitBtn1: TBitBtn;
    CustomerTable: TTable;
    dbgCompany: TDBGrid;
    CustomerSource: TDataSource;
    CustomerTableCustNo: TFloatField;
    CustomerTableCompany: TStringField;
    CustomerTableAddr1: TStringField;
    CustomerTableAddr2: TStringField;
    CustomerTableCity: TStringField;
    CustomerTableState: TStringField;
    CustomerTableZip: TStringField;
    CustomerTableCountry: TStringField;
    CustomerTablePhone: TStringField;
    CustomerTableFAX: TStringField;
    CustomerTableTaxRate: TFloatField;
    CustomerTableContact: TStringField;
    CustomerTableLastInvoiceDate: TDateTimeField;
    gbxProperty: TGroupBox;
    PropNamePanel: TPanel;
    TypenamePanel: TPanel;
    PropValuePanel: TPanel;
    PropvalueEdit: TEdit;
    btnChangeProp: TSpeedButton;
    gbxExpression: TGroupBox;
    moRTTIExpression: TMemo;
    TestButton: TBitBtn;
    gbxResult: TGroupBox;
    edResult: TEdit;
    lblObjects: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure TestButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure olObjectsClick(Sender: TObject);
    procedure BtnChangePropClick(Sender: TObject);
    procedure olObjectsDblClick(Sender: TObject);
  private
    { Private declarations }
    Expr : TRTTIExpression;
    Function GetCurrentProp  : TInstanceProperty;
    Function GetCurrPropPath : String;
    Procedure LoadPropertyList;
  public
    { Public declarations }
    Procedure TestExpr;
  end;

var
  RTTIDemoForm: TRTTIDemoForm;

Procedure ShowRTTIDemo;

implementation
uses fbcalc,typinfo;
{$R *.DFM}


Procedure ShowRTTIDemo;
var dlg : TRTTIDemoForm;
begin
  dlg := TRTTIDemoForm.Create(Application);
  TRY
    Dlg.ShowModal;
  FINALLY
    Dlg.Free;
  END;
end;


Function RemoveSpaces(const s : String):string;
var i : integer;
begin
  result := '';
  for i := 1 to length(s) do begin
      if not(s[i] in [#32,#160]) then
         result := result + s[i];
  end;
end;

procedure TRTTIDemoForm.FormCreate(Sender: TObject);
begin
  Application.Name := 'App';
  Name      := 'RTTIForm';
  Expr      := TRTTIExpression.Create(Self);
  Expr.Root := Application;
  LoadPropertyList;
end;


Procedure TRTTIDemoForm.LoadPropertyList;
var lines : TStringList;
begin
  olObjects.BeginUpdate;
  lines := TStringList.Create;
  { The following operation takes a bit of time, so change cursor to }
  { hourglass                                                        }
  Cursor := crHourGlass;
  TRY
    GetComponentProperties({Self}Application,tkProperties {+ tkMethods},Lines,0);
  FINALLY
    Cursor := crDefault;
  END;
  olObjects.Lines.Assign(lines);
  lines.free;
  olObjects.EndUpdate;
end;

Procedure TRTTIDemoForm.TestExpr;
var i : integer;
    res : string;
begin
  Expr.Status  := EXPR_SUCCESS;
  Expr.Lines   := moRTTIExpression.Lines;
  if Expr.Status <> EXPR_SUCCESS then
     edResult.Text := ' Error : '+Expr.StatusText
    else
     edResult.Text := Expr.AsString;
 end;

procedure TRTTIDemoForm.TestButtonClick(Sender: TObject);
begin
  TestExpr;
end;

procedure TRTTIDemoForm.FormDestroy(Sender: TObject);
begin
 { Kill the data collected by the GetComponentProperties call }
  FreePropertyData(olObjects.Lines);
end;

Function TRTTIDemoForm.GetCurrentProp : TInstanceProperty;
var node : TOutlineNode;
begin
  node := olObjects.Items[olObjects.SelectedItem];
  result := TInstanceProperty(node.data);
end;


{* Display the current instance property, along with its *}
{* Type and current value, which is editable             *}
procedure TRTTIDemoForm.olObjectsClick(Sender: TObject);
var node : TOutLineNode;
    prop : TInstanceProperty;
    tempstr : string;
begin
  node := olObjects.Items[olObjects.SelectedItem];
  prop := TInstanceProperty(node.Data);
  PropNamePanel.Caption  := ' '+GetCurrPropPath;
  if Assigned(prop) then
  begin
    TypenamePanel.Caption  := prop.Typename;
    PropValueEdit.Text     := prop.AsString;
    PropValueEdit.Enabled  := True;
  end
 else
  begin
    TypenamePanel.Caption := '';
    PropValueEdit.Text    := '';
    PropValueEdit.Enabled := False;
  end;
end;


{* Change the value of a property based on user input. If successful *}
{* it will have the expected runtime effect as defined by the object *}
{* designer                                                          *}
procedure TRTTIDemoForm.BtnChangePropClick(Sender: TObject);
var prop : TInstanceProperty;
begin
  prop := getCurrentProp;
  if Assigned(prop) then
  begin
    { Setting an object's property is this easy !}
    Prop.AsString := PropValueEdit.Text;
  end;
end;

{* Returns the "Dot-notated" path of the current property *}
{* Note that the Root object's name is implicit, so it is *}
{* removed from the path                                  *}
Function TRTTIDemoForm.getCurrPropPath : string;
var node : TOutlineNode;
    p    : integer;
begin
  node := olObjects.Items[olObjects.SelectedItem];
  result := RemoveSpaces(node.fullpath);
  p := pos('.',result);
  if (p > 0) then
     system.delete(result,1,p);
end;


{* Put the current property in the expression edit Window *}

procedure TRTTIDemoForm.olObjectsDblClick(Sender: TObject);
var prop : TInstanceProperty;
begin
  prop := getCurrentProp;
  if assigned(prop) and (Prop.Kind <> tkClass) then
     moRTTIExpression.SelText := '['+ GetCurrPropPath+']';
end;

end.