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

Pascal/Delphi Source File | 1996-09-15 | 5.8 KB | 252 lines

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

{* Simple Form & Unit to handle variables belonging to expressions *}
{* Uses the Handle property and DLL level calls                    *}
unit Vardlg;
interface
uses
  FBCalc,
  WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  StdCtrls, ExtCtrls, Grids;

type
  TVariablesDlg = class(TForm)
    OKBtn: TBitBtn;
    CancelBtn: TBitBtn;
    Bevel1: TBevel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ValueEdit: TEdit;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    SpeedButton1: TSpeedButton;
    procedure FormActivate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; Col, Row: Longint;
      var CanSelect: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    varnames : TStringList;
    fHandle : HEXPR;
    Procedure Fillgrid;
    Function  VariableCount : integer;
    Procedure SetHandle( theHandle : HEXPR );
  public
    { Public declarations }
    Property   Handle : HEXPR read fHandle write setHandle;
  end;

var
  VariablesDlg: TVariablesDlg;

  Procedure ManageVariables(handle : HEXPR);

implementation
uses Sysutils,newVarfm;

{$R *.DFM}

 Procedure ManageVariables(handle : HEXPR);
 var varfm : TVariablesDlg;
 begin
   Application.CreateForm(TVariablesDlg,VarFm);
   varfm.Handle := Handle;
   varfm.ShowModal;
   varfm.Free;
 end;


 Function TypeToChar(vtype : longint):char;
 begin
   result := '?';
   case vtype of
      vtInteger : result := 'I';
      vtFloat   : result := 'F';
      vtString  : result := 'S';
      vtBoolean : result := 'B';
      vtDate    : result := 'D';
      vtChar    : result := 'C';
   end;
 end;


 Function CharToDataType(vt : char):datatypes;
 begin
   result := vtNone;
   case vt of
     'I' : result := vtInteger;
     'F' : result := vtFloat;
     'S' : result := vtString;
     'B' : result := vtBoolean;
     'D' : result := vtDate;
     'C' : result := vtChar;
   end;
 end;


 Procedure DisplayError( ErrTxt : PChar );
 begin
   Application.MessageBox(ErrTxt,'Error',MB_OK or MB_ICONHAND);
 end;


 Function EvaluateInfix(handle : HEXPR;s : String;var good : boolean):string;far;
 var res    : integer;
     outbuf : array[0..256] of char;
     respch : PChar;

 begin
   Result := '';
   Good   := False;
   if (s = '') then
   begin
     result := 'Invalid Expression!';
     exit;
   end;
   s := s + #0;
   res := FBSetExpression(handle,@s[1]);
   respCh := @outbuf;
 if res = EXPR_SUCCESS then
   begin
     res := FBEvaluate(Handle,respch,sizeof(outbuf));
     if res = EXPR_SUCCESS then
        Result := strpas(respch);
   end;
   if res = EXPR_SUCCESS then
      good := true
    else
      begin
        FBGetErrorString(res,respch,sizeof(outbuf)-1);
        DisplayError(respch);
      end;
end;




Procedure TVariablesDlg.SetHandle( theHandle : HEXPR );
begin
  fHandle := theHandle;
  FillGrid;
end;

procedure TVariablesDlg.FormActivate(Sender: TObject);
begin
  FillGrid;
end;

Function  TVariablesDlg.VariableCount : integer;
begin
  result := FBGetVariableCount(fHandle);
end;


Procedure TvariablesDlg.FillGrid;
var i,cnt : integer;
    v      : TValueRec;
    nom    : string[55];
    vname  : pchar;
    varcnt : integer;
    buf    : array[0..75] of char;
    list   : TStringList;
    typ    : longint;

begin
  StringGrid1.Cells[0,0] := '#';
  StringGrid1.Cells[1,0] := 'NAME';
  StringGrid1.Cells[2,0] := 'TYPE';
  Cnt    := 0;
  varcnt := VariableCount;
  if varcnt < 1 then exit;
  StringGrid1.Rowcount := varcnt + 1;
  vname := @buf;
  List := TStringList.Create;
  TRY
    For i := 0 to VarCnt-1 do
    begin
      FBPeekVariable(fHandle,i,vname,sizeof(buf)-1,v);
      typ := v.vtype;
      List.AddObject(strpas(vname), pointer(typ) );
    end;
    List.Sorted := True;
    With stringGrid1 do
    For i := 0 to list.count-1 do
    begin
      FBPeekVariable(fHandle,i,vname,sizeof(buf)-1,v);
      inc(cnt);
      Cells[0,cnt] := inttostr(cnt);
      Cells[1,cnt] := List.Strings[i];
      Cells[2,cnt] := TypeToChar( longint(List.Objects[i]) );
     { type }
    end;
  FINALLY
    List.Free;
  END;
  StringGrid1.Invalidate;
  StringGrid1.Refresh;
 end;

procedure TVariablesDlg.BitBtn1Click(Sender: TObject);
begin
  if NEWVARFM.AddNewVariable(fHandle) then
     FillGrid;
end;

procedure TVariablesDlg.StringGrid1SelectCell(Sender: TObject; Col,
  Row: Longint; var CanSelect: Boolean);
var vname  : string[60];
    _value : array[0..256] of char;
    val    : pchar;
    v      : TValueRec;

begin
  if col <> 1 then exit;
  vname := StringGrid1.Cells[1,Row]+#0;
  val   := @_value;
  if FBGetVarAsString(fHandle,@vname[1],val,sizeof(_Value)) = EXPR_SUCCESS then
  begin
     ValueEdit.Text := Strpas(val);
  end;
end;


procedure TVariablesDlg.SpeedButton1Click(Sender: TObject);
var t       : string;
    v       : TValueRec;
    good    : boolean;
    typech  : String[1];
    typ     : datatypes;
    vname   : string[45];
    tmp     : string;

begin
  if (StringGrid1.row = 0) or (VariableCount < 1) then exit;
  t := valueEdit.Text;
  if T = '' then
  begin
     DisplayError('No value specified');
     exit;
  end;
(*  v := EvaluateInfix(t,good);
  if not good then exit; *)
  with stringGrid1 do
  begin
    typech := Cells[2,Row];
    vname  := Cells[1,Row];
  end;
  fillchar(v,sizeof(v),0);
  typ := CharToDatatype(typech[1]);
  tmp := valueEdit.Text;
  if typ = vtString then
      tmp := '"'+tmp+'"';
  tmp := Vname + ' := '+ tmp;
  t := EvaluateInfix(fhandle,tmp,Good);
 { FillGrid; }
end;

end.