home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / filtrfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  7.3 KB  |  285 lines
  1. {*                               *}
  2. {* FormulaBuilder 1.0            *}
  3. {* YGB Software, Inc.            *}
  4. {* Copyight 1995, Clayton Collie *}
  5. {* All Rights Reserved           *}
  6. {*                               *}
  7.  
  8. {* This unit defines a form TFilterFm which permits the *}
  9. {* user to visually build an expression based on a BDE  *}
  10. {* dataset                                              *}
  11.  
  12. {$F+}
  13. unit Filtrfrm;
  14. interface
  15. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  16.      StdCtrls, ExtCtrls,Sysutils,DB,
  17.      fbcomp,fbdbcomp,
  18.      fbcalc;
  19.  
  20. type
  21.   Datatypeset = Set of Datatypes;
  22.  
  23.  
  24.  
  25.   TFilterFm = class(TForm)
  26.     CancelBtn: TBitBtn;
  27.     HelpBtn: TBitBtn;
  28.     Bevel1: TBevel;
  29.     FieldListbox: TListBox;
  30.     OperatorListbox: TListBox;
  31.     FunctionListbox: TListBox;
  32.     ExpressionMemo: TMemo;
  33.     Bevel2: TBevel;
  34.     Label1: TLabel;
  35.     Label2: TLabel;
  36.     Label3: TLabel;
  37.     Label4: TLabel;
  38.     GroupBtn: TBitBtn;
  39.     BitBtn1: TBitBtn;
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure FieldListboxClick(Sender: TObject);
  42.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  43.     procedure OperatorListboxClick(Sender: TObject);
  44.     procedure FunctionListboxDblClick(Sender: TObject);
  45.     procedure GroupBtnClick(Sender: TObject);
  46.     procedure FormActivate(Sender: TObject);
  47.     procedure ExpressionMemoMouseUp(Sender: TObject; Button: TMouseButton;
  48.       Shift: TShiftState; X, Y: Integer);
  49.   private
  50.     { Private declarations }
  51.     fDataset    : TDataset;
  52.     fExpression : TCustomDSExpression;
  53.     fValidTypes : Datatypeset;
  54.     Procedure LoadFieldListbox;
  55.     Procedure setExpression(const s : string);
  56.     Function  getDataset : TDataset;
  57.     Procedure SetDataset(const db : TDataset);
  58.     Function  Evaluate(var vtype : datatypes;var res : integer) : String;
  59.   public
  60.     { Public declarations }
  61.     Property Dataset  : TDataset read getDataset write SetDataset;
  62.   end;
  63.  
  64. var
  65.   FilterFm: TFilterFm;
  66.  
  67.  
  68. {* Build an expression based on a BDE dataset. The expression type *}
  69. {* must be in the set ValidTypes                                   *}
  70. {* the extra Dataset parameter is a workaround for the fact that   *}
  71. {* TCustomDSExpression does not expose its Dataset property        *}
  72.  
  73. Function BuildDSExpression(const theTitle    : string;
  74.                            const ValidTypes  : DataTypeSet;
  75.                                  theExpr     : TCustomDSExpression;
  76.                                  theDataset  : TDataset):boolean;
  77.  
  78.  
  79. implementation
  80. uses fbmisc,dialogs;
  81. {$R *.DFM}
  82. {$F+}
  83.  
  84.  
  85. Function BuildDSExpression(const theTitle    : string;
  86.                            const ValidTypes  : DataTypeSet;
  87.                                  theExpr     : TCustomDSExpression;
  88.                                  theDataset  : TDataset):boolean;
  89. Var Form1    : TFilterFm;
  90.     origExpr : pchar;
  91.     oldUsex  : boolean;
  92.     wasEmpty : boolean;
  93.  
  94. begin
  95.   Application.CreateForm(TFilterFm,Form1);
  96.   origExpr := TheExpr.StrFormula;
  97.   OldUseX  := theExpr.UseExceptions;
  98.   TheExpr.UseExceptions := False;
  99.   WasEmpty := (OrigExpr = NIL);
  100.   TRY
  101.     with form1 do
  102.     begin
  103.       fExpression          := theExpr;
  104.       Dataset              := theDataset;
  105.       ExpressionMemo.Lines := TheExpr.Lines;
  106.       fValidTypes          := ValidTypes;
  107.       Caption              := theTitle;
  108.       result := False;
  109.       if ShowModal = mrOk then
  110.          Result := true
  111.      else
  112.        begin
  113.          Result := False;
  114.          if wasEmpty then TheExpr.Clear;
  115.        end;
  116.     end;
  117.   FINALLY
  118.     StrDispose(OrigExpr);
  119.     Form1.Free;
  120.   END;
  121.   theExpr.UseExceptions := OldUsex
  122. end;
  123.  
  124.  
  125.  
  126. Function TFilterFm.Evaluate(var vtype : datatypes;var res : integer) : String;
  127. begin
  128.   fExpression.Lines := ExpressionMemo.Lines;
  129.   res := FExpression.Status;
  130.   if res = EXPR_SUCCESS then
  131.   begin
  132.      result := FExpression.AsString;
  133.      vtype  := FExpression.ReturnType;
  134.   end;
  135. end; {}
  136.  
  137.  
  138. Procedure TFilterFm.setExpression(const s : string);
  139. begin
  140.   if fExpression.Formula = s then exit;
  141.   fExpression.Formula := s;
  142.   expressionMemo.Text := s;
  143. end;
  144.  
  145.  
  146. Function  TFilterFm.getDataset : TDataset;
  147. begin
  148.   result := fDataset;
  149. end;
  150.  
  151. Procedure TFilterFm.SetDataset(const db : TDataset);
  152. begin
  153.   if FieldListBox.items.Count > 0 then
  154.      FieldListbox.Clear;
  155.   if Assigned(db) then
  156.   begin
  157.     fDataset := db;
  158.     fDataset.GetFieldNames(FieldListbox.Items);
  159.   end;
  160. {  LoadFieldListbox; }
  161. end;
  162.  
  163.  
  164. (*
  165. procedure TDBExprBuilder.GroupButtonClick(Sender: TObject);
  166. var txt : string;
  167. begin
  168.    txt := ExpressionMemo.SelText;
  169.    if txt <> '' then
  170.    ExpressionMemo.Seltext := '(' + txt + ')';
  171. end;
  172. *)
  173.  
  174. Procedure TFilterFm.LoadFieldListBox;
  175. begin
  176.   if (fDataset = NIL) then exit;
  177.   fDataset.GetFieldNames(FieldListbox.Items);
  178. end;
  179.  
  180.  
  181.  
  182. procedure TFilterFm.FormCreate(Sender: TObject);
  183. var thelist : TStringList;
  184. begin
  185.  thelist := getFunctionPrototypes(false);
  186.  if Assigned(theList) then
  187.  begin
  188.    FunctionListBox.Items.AddStrings(thelist);
  189.    thelist.free;
  190.  end;
  191.  { Dispose of global object }
  192. end;
  193.  
  194. procedure TFilterFm.FieldListboxClick(Sender: TObject);
  195. var
  196.    tblname,fldname : string[50];
  197.    indx            : integer;
  198.  
  199. begin
  200.   indx := FieldListBox.ItemIndex;
  201.   if indx = -1 then exit;
  202.   FldName := FieldListBox.Items[Indx];
  203.   ExpressionMemo.SelText := fldname;
  204. end;
  205.  
  206.  
  207. procedure TFilterFm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  208. begin
  209.   if (modalResult = mrCancel) then canclose := true
  210. else
  211.   if (ModalResult = mrOk) then
  212.   begin
  213.     fExpression.Lines := ExpressionMemo.Lines;
  214.     if (fExpression.status <> EXPR_SUCCESS) then
  215.     begin
  216.       canClose := False;
  217.       MessageDlg(fExpression.StatusText,mtError,[mbOK],0);
  218.     end
  219.    else
  220.     begin
  221.       Canclose := (fExpression.ReturnType in fValidTypes);
  222.       if not CanClose then
  223.       begin
  224.         MessageBeep(mb_iconHand);
  225.         MessageDlg(FBCALC.getTypenames(fValidTypes)+' expression expected.', mtInformation,[mbOk],0);
  226.       end;
  227.     end;
  228.   end;
  229. end;    {}
  230.  
  231.  
  232. procedure TFilterFm.OperatorListboxClick(Sender: TObject);
  233. var
  234.    op   : string[10];
  235.    indx : integer;
  236.  
  237. begin
  238.   indx := OperatorListBox.ItemIndex;
  239.   if indx = -1 then exit;
  240.   Op := OperatorListBox.Items[Indx];
  241.   ExpressionMemo.SelText := ' ' + Op + ' ';
  242. end;
  243.  
  244. procedure TFilterFm.FunctionListboxDblClick(Sender: TObject);
  245. var fnName : string;
  246.     sel    : string;
  247.     indx   : integer;
  248.     p      : byte;
  249.  
  250. begin
  251.  indx := FunctionListBox.ItemIndex;
  252.   if indx = -1 then exit;
  253.   FnName := FunctionListBox.Items[Indx];
  254.   p := Pos('(',fnName);
  255.   if p > 0 then
  256.      fnName := Copy(fnName,1,p-1);
  257.   fnName := fnName + '( ';
  258.   sel := ExpressionMemo.SelText;
  259.   if sel <> '' then
  260.      ExpressionMemo.SelText := fnName + Sel + ' )'
  261.    else
  262.      ExpressionMemo.SelText := fnName+' )';
  263. end;
  264.  
  265. procedure TFilterFm.GroupBtnClick(Sender: TObject);
  266. var txt : string;
  267. begin
  268.    txt := ExpressionMemo.SelText;
  269.    if txt <> '' then
  270.    ExpressionMemo.Seltext := '(' + txt + ')';
  271. end;
  272.  
  273. procedure TFilterFm.FormActivate(Sender: TObject);
  274. begin
  275.   GroupBtn.Enabled := False;
  276. end;
  277.  
  278. procedure TFilterFm.ExpressionMemoMouseUp(Sender: TObject;
  279.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  280. begin
  281.   GroupBtn.Enabled := ExpressionMemo.SelText <> '';
  282. end;
  283.  
  284. end.
  285.