学术讨论！进者有分

我们现在的系统也是用f1book做报表的，具体的思路是这样的：
1.用excel画好报表格式，然后通过程序读入并保存到数据库。
2.报表的定义实际就是用f1book把excel画好的表格取出，然后逐个定义
3.定义的条件都保存在数据库中，需要生成的时候在取出并求值，最好通过f1book显示或者导出保存到excel中
下面贴上在用dll代码
能者看看怎么样实现在f1book1公式里面输入doubl(1)
得到返回的值library addin;
{$Hints Off}
{$WARNINGS off}

///////////////////////////////////////////////////////////////
//                                                           //
//  This Unit is Test The Addin func of F1 6.1               //
//                                                           //
//  E-Mail:      [email protected]                           //
//
//                                                           //
// Copyright (C) 1999 by talent corp.  All rights reserved.  //
//                                                           //
///////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////
// REGEDIT4
// [HKEY_LOCAL_MACHINE\SOFTWARE\Tidestone Technologies\Formula One\AddIns\0]
// "Path"="C:\\TEMP\\TestAddinDll.dll"
// "Name"="Demo Add-In"
// "Description"="Delphi 5 Add-In Demo)"
// "Active"=hex:01
//////////////////////////////////////////////////////////////
uses
  windows,
  sysutils,
  comobj;// Error codes for Formula One
const
  F1_E_NULL    = $8004000; // #NULL!
  F1_E_DIVZERO = $80040002; // #DIV/0!
  F1_E_VALUE  =  $80040003; // #VALUE!
  F1_E_REF   =  $80040004; // #REF!
  F1_E_NAME   =  $80040005; // #NAME?
  F1_E_NUM   =  $80040006; // #NUM!
  F1_E_NA    =  $80040007; // #N/A

// The following variant types may be passed to an add-in function as
// arguments from Formula One 6.1:
//
//  VT_EMPTY,VT_R8,VT_BSTR,VT_BOOL,VT_ERROR,VT_UNKNOWN  (see notes below)
//
// For compatibility with future versions of Formula One,
// an add-in function should fail "gracefully" if it encounters
// an unexpected variant type.  The recommended approach is for the
// add-in function to return an error of type E_F1_VALUE.
// The add-in function may first attempt to convert the value to
// a useable type if desired.
//
// When the argument type is VT_UNKNOWN, the add-in function should call
// QueryInterface to obtain an interface implemented by
// Formula One's formula evaluator.  At this time, the only interfaces
// implemented are IF1DispAddInArray and IF1DispAddInArrayEx.
// The interfaces are briefly explained here:
//
// IF1DispAddInArray
//           Query for this interface if you want to support only one-
//                  or two-dimensional arrays or area references.
//
// IF1DispAddInArrayEx
//           Query for this interface if you want to support unions or
//                  three-dimensional area references.This interface
//                  also provides all the functionality of IF1DispAddInArray.
//
// These interfaces are implemented by Formula One 6.1 to pass area
// references (also known as range references) to the add-in function.
// Note that Formula One 6.1 does not support arrays at this time.
// While there are currently no plans to support arrays in the Formula One
// ActiveX, you can be assured that if such support is added in the future,
// these same interfaces will allow you to handle array arguments.
//
// If the add-in function fails to obtain a suitable interface through
// QueryInterface, it should return the error code F1_E_VALUE.

// The following variant types may be returned to Formula One 6.1 by an add-in
// function:
//  VT_EMPTY,VT_R8,VT_BSTR,VT_BOOL,VT_ERROR
//
// Any other type will be evaulated by Formula One as a #VALUE! error.

//  IF1DispAddInArrayEx = interface(IDispatch)
//    function  Get_Areas: Integer; safecall;
//    function  Get_Rows(nArea: Integer): Integer; safecall;
//    function  Get_Cols(nArea: Integer): Integer; safecall;
//    function  GetArrayType: F1AddInArrayTypeConstants; safecall;
//    function  GetValue(nArea: Integer; nRow: Integer; nCol: Integer): OleVariant; safecall;

//     // Use these functions to iterate through non-empty cells.
//    function  IterStart: WordBool; safecall;
//    function  IterNext: WordBool; safecall;
//    function  IterGetValue: OleVariant; safecall;

//    function  IterGetValueEx(out pArea: Integer; out pRow: Integer; out pCol: Integer): OleVariant; safecall;
//    property Areas: Integer read Get_Areas;
                            // number of areas in union, or number of sheets in 3d reference
//    property Rows[nArea: Integer]: Integer read Get_Rows; // number of rows in area
//    property Cols[nArea: Integer]: Integer read Get_Cols; // number of columns in area
//  end;

// This interface is implemented for the following kinds of arguments:
//
//     Array:     =WHAT({1,2,3;4,5,6;7,8,9})  <-- *not supported* by
//                                                    Formula One 6.1
//     2d Area:   =WHAT(A1:C3)
//     3d Area:   =WHAT(Sheet1:Sheet3!A1:A3)
//     Union:     =WHAT((A1:C3,A4:C6))
//
// If the argument is an Array or a 2d Area, the Areas property always
// return 1.  Arrays are not supported by Formula One 6.1.
//
// If the argument is a 3d Area, all areas are the same shape.
//
// If the argument is a Union, the shape of the areas may differ.
//    IF1DispAddInArray = interface(IDispatch)
//    function  Get_Rows: Integer; safecall;
//    function  Get_Cols: Integer; safecall;
//    function  GetArrayType: F1AddInArrayTypeConstants; safecall;
//    function  GetValue(nRow: Integer; nCol: Integer): OleVariant; safecall;
//    function  IterStart: WordBool; safecall;
//    function  IterNext: WordBool; safecall;
//    function  IterGetValue: OleVariant; safecall;
//    function  IterGetValueEx(out pRow: Integer; out pCol: Integer): OleVariant; safecall;
//    property Rows: Integer read Get_Rows;
//    property Cols: Integer read Get_Cols;
//  end;

// This interface is implemented for the following kinds of arguments:
//
//     Array:     =WHAT({1,2,3;4,5,6;7,8,9})  <-- *not supported* by
  //                                                    Formula One 6.1
  //     2d Area:   =WHAT(A1:C3)const

IID_IF1DispAddInArray:   TGUID = '{8B803700-DAE4-11d2-A622-00A0C933C408}';
IID_IF1DispAddInArrayEx: TGUID = '{8B803701-DAE4-11d2-A622-00A0C933C408}';

const
  F1ADDIN_ARRAY  = 0; // Not implemented in Formula One 6.1
  F1ADDIN_AREA   = 1;
  F1ADDIN_AREA3D = 2;
  F1ADDIN_REGION = 3;

  F1AddIn2dArea = $00000001;
  F1AddIn3dArea = $00000002;
  F1AddInRegion = $00000003;

type
  TOleVariantArray=array[0..1024] of OleVariant;
  pOleVariantArray=^TOleVariantArray;

  TF1ADDIN_FUNCTION=function(var pResult:OleVariant;nReserved:Integer;nArgs:Integer;Args:pOleVariantArray):HRESULT stdcall;
  pF1ADDIN_FUNCTION=^TF1ADDIN_FUNCTION;
  TF1AddInRegisterFunctionProc=function(pwszName:LPWSTR;nReserved:Integer;pFunction:pF1ADDIN_FUNCTION;nArgs:Integer):HRESULT      stdcall;
  TF1AddInRegisterInfoProc=function(pwszName,pwszDescription:LPWSTR;nReserved1:integer;nReserved2:integer):HRESULT      stdcall;
var
  TVV:TF1ADDIN_FUNCTION=nil;
  dou1:TF1ADDIN_FUNCTION=nil;

function MakeErrorResult(var pResult:OleVariant;hrEval:LongWord= S_OK):HRESULT;
begin
  if hrEval<>S_OK then
  begin
    VarClear(pResult);
   TvarData(pResult).VType:= varError;
   TvarData(pResult).VError:=hrEval;
   end;
   result:=S_OK;
end;function VariableValue(var pResult:OleVariant;
                      resv:integer;
                      nArgs:integer;
                      pArgs:pOleVariantArray):HRESULT;stdcall;
begin
  if assigned(TVV) then
     Result:=TVV(pResult,resv,nArgs,pArgs)
  else
     Result:=MakeErrorResult(pResult, F1_E_VALUE);
end;

procedure InitTVV(p:pF1ADDIN_FUNCTION);stdcall;
begin
  @TVV:=P;
end;                          function F1AddInInit(RegisterInfoProc: TF1ADDINREGISTERINFOPROC;
                        RegisterFunctionProc: TF1ADDINREGISTERFUNCTIONPROC;
                        nReserved1: Integer;
                        nReserved2: Integer): HRESULT  stdcall;
var
hr:HRESULT;
begin
hr := RegisterFunctionProc('TVV',0,@VariableValue,1);
hr := RegisterFunctionProc('dou',0,@dou,1);
if (SUCCEEDED(hr)) then
  hr := RegisterInfoProc('报表系统同F1Book V6.1接口',
                          '报表系统',
                          0,0);
result:=hr;
end;function dou(i:integer):Integer;
begin
  Result:=4*i;
end;exports
  F1AddInInit name 'F1AddInInit',
  InitTVV     name 'InitTVV',
  dou       name 'dou';
beginend.
function dou(i:integer):Integer;
begin
  Result:=4*i;
end;

调试易

学术讨论！进者有分

解决方案 »