home *** CD-ROM | disk | FTP | other *** search
- { FormulaBuilder }
- { YGB Software, Inc. }
- { Copyright 1995 Clayton Collie }
- { All rights reserved }
-
- { EIS Demo using callbacks. Note that for the sake of brevity, }
- { Database variables are not handled }
- unit Eiscbkfm;
- interface
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- StdCtrls, Forms, DBCtrls, DB, DBGrids,
- SSheet,FBCOMP,FBDBCOMP,FBCALC,
- Grids,DBTables, ExtCtrls, Buttons;
-
- type
- { since SetFieldCallbacks is a protected member of TDSExpression, we }
- { simply declare a dummy descendant to be able to get at the protected }
- { parts of TDSExpression }
- TNewExpression = Class(TDSExpression)
- end;
-
- TForm2 = class(TForm)
- DBGrid1: TDBGrid;
- DBNavigator: TDBNavigator;
- Panel1: TPanel;
- DataSource1: TDataSource;
- Panel2: TPanel;
- Table1: TTable;
- Panel3: TPanel;
- SSheetGrid: TStringGrid;
- GroupBox1: TGroupBox;
- ResultPanel: TPanel;
- FormulaEdit: TEdit;
- BitBtn1: TBitBtn;
- SpeedButton1: TSpeedButton;
- procedure FormCreate(Sender: TObject);
- procedure SSheetGridGetEditText(Sender: TObject; ACol, ARow: Longint;
- var Value: OpenString);
- procedure SSheetGridSetEditText(Sender: TObject; ACol, ARow: Longint;
- const Value: String);
- procedure FormDestroy(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- private
- { private declarations }
- Sheet : TSpreadSheet;
- public
- { public declarations }
- Expression : TNewExpression;
- end;
-
- var
- Form2: TForm2;
-
- implementation
- {$R *.DFM}
-
- {
- The syntax for "spreadsheet" cell access in [RnCn] where n is an integer,
- for example :
-
- "[R1C1] * [R2C2] - [R5C2]"
- }
-
-
- Function SheetFindVarCBK(vname : pchar;
- var vtype : byte;
- var vardata : longint;
- CBKData : longint):integer; export;
-
- var r,c : word;
- theSheet : TSpreadSheet;
- begin
- result := EXPR_SUCCESS;
- if not ParseCellname(strpas(vname),r,c) then
- begin
- vtype := vtNONE;
- exit;
- end;
- theSheet := TSpreadSheet( CBKData ); { Cast CBKData back into spreadsheet }
- { check to see if r and c are within range. If not, return an error }
- if (r > MAXROWS) or (c > MAXCOLS) then
- begin
- Result := EXPR_RANGE_ERROR;
- Exit;
- end;
- { in our spreadsheet, all values are floats }
- vtype := vtFLOAT;
- { typecast vardata to a pointer to our actual value. This speeds }
- { up variable access when the value of the cell needs to be retrieved. }
- { see GetVariable function }
- vardata := longint( @theSheet.sheetData[r,c] );
- end; {}
-
-
- function SheetGetVarCBK(vname : pchar;
- var Value : TValueRec;
- vardata : longint;
- CBKData : longint) :integer; export;
-
- var theSheet : TSpreadSheet absolute CBKData;
- begin
- result := EXPR_SUCCESS;
- { we could retrieve the value this way :
-
- ParseCellName(varname,r,c);
- value.vFloat := TheSheet.SheetData[r,c];
-
- but since we set vardata to point directly to the data, all we need to
- do is typecast and dereference the vardata parameter (see above). This
- is a bit faster, since we skip the ParseCellName function call.
- }
- value.vFloat := PDouble(VarData)^;
- { no errors occurred so we dont have to set errcode. Its value is
- EXPR_SUCCESS on entry }
- end; { getVariable }
-
-
-
- Function SheetSetVarCBK(vname : pchar;
- value : TValueRec;
- vardata : longint;
- CBKData : longint):integer; export;
- begin
- { we could set the value this way :
-
- ParseCellName(varname,r,c);
- TheSheet.SheetData[r,c] := value.vFloat;
-
- but since we set vardata to point directly to the data, all we need to
- do is typecast and dereference the vardata parameter (see above). This
- is a bit faster, since we skip the ParseCellName function call.
- }
- PDouble(VarData)^ := value.vFloat;
- { no errors occurred so we dont have to set errcode. Its value is
- EXPR_SUCCESS on entry }
- end; { setVariable }
-
-
-
-
-
- procedure TForm2.FormCreate(Sender: TObject);
- var r, c : integer;
- tmpstr : String[15];
- begin
- Table1.Open;
- Sheet := TSpreadSheet.Create;
- Expression := TNewExpression.Create(Self);
- { Note the last parameter passed to SetFieldCallbacks. This is the value that }
- { is passed to the CBKData parameter of the callback functions. We use this }
- { fact to pass our instance of the spreadsheet to the callback functions }
- Expression.SetVariableCallbacks(SheetFindVarCBK,
- SheetGetVarCBK,
- SheetSetVarCBK,
- longint(Sheet));
- Expression.Dataset := Table1;
- Expression.UseEvents := True;
- for r := 0 to MAXROWS do
- for c := 0 to MAXCOLS do
- begin
- if (r + c = 0) then continue;
- if (r = 0) then
- begin
- tmpStr := 'C'+IntToStr(c);
- SSheetGrid.Cells[c,r] := tmpstr;
- end
- else
- if (c = 0) then
- begin
- tmpStr := 'R'+IntToStr(r);
- SSheetGrid.Cells[c,r] := tmpstr;
- end
- else
- begin
- tmpstr := FloatToStrF(Sheet.SheetData[r,c],ffCurrency,10,2);
- SSheetGrid.Cells[c,r] := tmpstr;
- end;
- end;
- end;
-
-
- procedure TForm2.SSheetGridGetEditText(Sender: TObject; ACol,
- ARow: Longint; var Value: OpenString);
- begin
- Value := FloatToStrF(Sheet.SheetData[ARow,Acol],ffCurrency,10,2);
- end;
-
- procedure TForm2.SSheetGridSetEditText(Sender: TObject; ACol,
- ARow: Longint; const Value: String);
- var temp : double;
- begin
- Try
- Sheet.SheetData[ARow,ACol] := StrToFloat(value);
- except
- {}
- end;
- end;
-
- procedure TForm2.FormDestroy(Sender: TObject);
- begin
- Expression.Free;
- end;
-
- procedure TForm2.SpeedButton1Click(Sender: TObject);
- var stringExpr : String;
- begin
- StringExpr := FormulaEdit.Text;
- if StringExpr <> '' then
- begin
- Expression.Formula := StringExpr;
- if Expression.Status <> EXPR_SUCCESS then
- begin
- MessageBeep( MB_ICONHAND );
- ResultPanel.Caption := Expression.StatusText;
- end
- else
- ResultPanel.Caption := Expression.AsString;
- end;
- end;
-
- end.
-