Newsgroup: it.comp.lang.delphi
Titolo: [d5] creare una DLL per EXCEL 2003-2007

ciao a tutti, ho trovato un esempio su delphi3000 in cui si crea una DLL da 
aggiungere tramite i componenti aggiuntivi di Excel (e quindi 
automaticamente dentro excel mi trovo una nuova funzione che in questo caso 
si chiama GetCDF() )... il sistema ho visto funziona e addirittura io ho 
provato anche a far apparire una semplice form... ora per� mi domando... 
come posso fare a leggere dalla form i valori delle celle?
Vorrei far in modo che quando da excel clicco un tasto macro appositamente 
aggiunto alla barra comandi, questo apra una form e in base a determinate 
funzioni scelte sulla form vengano evidenziati o modificate le celle del 
foglio, ho provato ad usare anche questo:
 try
  vMSExcel:= GetActiveOleObject ('Excel.Application');
  label1.caption:='EXCEL GIA'' APERTO';
 except
  label1.caption:='EXCEL NON APERTO';
 end;
per� da dentro la dll sembra che non venga riconosciuto il foglio...
sotto allego il codice della dll
Simone
------------------------------------------------------------------
{$A+,B-,C+,D+,E-,F-,G+,H-,I+,J+,K-,L+,M-,N+,O-
,P+,Q+,R-,S-,T-,U-,V+,W+,X+,Y-,Z1}
library cdfcalc;
uses
  SysUtils,
  windows,
  dialogs,
  forms,
  Classes,
  Math,  Controls,
  unFormProva in 'unFormProva.pas' {Form1};
// XLREF structure
  type xlref = packed record
     rwFirst : smallint;
     rwLast : smallint;
     colFirst : byte;
     colLast : byte;
  end;
  // Returns a range of selection
  XlRangeRecord = packed record
     Count : word; // should always be $1
     Sref : xlref;
  end;
  xlmref= packed record
        count : word;
        RefTbl : array[0..1000] of XlRef;
  end;
  lpxloper = ^XLOPER;
  lpxloperArray = ^XLArray;
  lpxlmref = ^xlmref;
  TVal = packed Record
           Case Byte of
           1: (num : Double); // xltypeNum
           2: (str : ^ShortString); // xltypeStr
           3: (bool : Word); // xltypeBool
           4: (err : Word); // xltypeErr
           5: (w : Integer); // xltypeInt
           6: (sref : packed record
                 Count : word;
                 ref : Xlref;
               end);
           8: (_array : packed Record // xltypeMulti
                         lparray: lpxloperArray;
                         rows: WORD;
                         columns: WORD;
                       End);
           9: (mref : packed record // xltyperef
                         lpmref : lpxlmref;
                         idsheet : integer;
                       End);
          End; // tval
  XLOPER = packed Record
             val : TVal;
             xltype : WORD;
             dummy:array[0..5] of byte; // filler
           End;
xlarray=array[0..1000] of xloper;
lpxlarray=^xlarray;
txloper = class // Simple xloper support class
  private
    fxloper : xloper;
    fActualStr : ShortString;
    function Getlpxloper:lpxloper;
  public
    constructor Create;
    Destructor Destroy;override;
    Constructor Create_Str(NewStr : ShortString);
    procedure SetStr(NewStr : ShortString);
    procedure SetNum(NewNumber : Integer);
    procedure SetInt(NewNumber : Integer);
    procedure SetErr;
    property thelpxloper : lpxloper read Getlpxloper;
end;
// Excel
function Excel4v(xlfn:word;operRes:lpxloper;count:integer;opers:array of 
lpxloper):integer;
stdcall;external 'xlcall32.dll';
// XLMREF structure Describes multiple rectangular references.
const
 xltypeNum = $0001;
 xltypeStr = $0002;
 xltypeBool = $0004;
 xltypeRef = $0008;
 xltypeErr = $0010;
 xltypeFlow = $0020;
 xltypeMulti = $0040;
 xltypeMissing = $0080;
 xltypeNil = $0100;
 xltypeSRef = $0400;
 xltypeInt = $0800;
 xlbitXLFree = $1000;
 xlbitDLLFree = $4000;
 xltypeBigData =xltypeStr or xltypeInt;
// Error codes Used for val.err field of XLOPER structure
 xlerrNull =0;
 xlerrDiv0 =7;
 xlerrValue =15;
 xlerrRef =23;
 xlerrName =29;
 xlerrNum =36;
 xlerrNA =42;
// Return codes
 xlretSuccess =0; // success
 xlretAbort =1; // macro halted
 xlretInvXlfn =2; // invalid function number
 xlretInvCount =4; // invalid number of arguments
 xlretInvXloper =8; // invalid OPER structure
 xlretStackOvfl =16; // stack overflow
 xlretFailed =32; // command failed
 xlretUncalced =64; // uncalced cell
// Function number bits
 xlCommand = $8000;
 xlSpecial = $4000;
 xlIntl = $2000;
 xlPrompt = $1000;
// Special function numbers
 xlFree =(0 or xlspecial);
 xlStack =(1 or xlspecial);
 xlCoerce =(2 or xlspecial);
 xlSet =(3 or xlspecial);
 xlSheetId =(4 or xlspecial);
 xlSheetNm =(5 or xlspecial);
 xlAbort =(6 or xlspecial);
 xlGetInst =(7 or xlspecial);
 xlGetHwnd =(8 or xlspecial);
 xlGetName =(9 or xlspecial);
 xlEnableXLMsgs =(10 or xlspecial);
 xlDisableXLMsgs =(11 or xlspecial);
 xlDefineBinaryName =(12 or xlspecial);
 xlGetBinaryName =(13 or xlspecial);
// User defined functions, needed for calling Excel functions
  xlfCaller=89;
  xlfRegister=149;
  xlfUnregister=201;
//
  DLLversion:shortstring='CDF Calc V1.02';
  AddInCategory='CDF Calculator';
  const zlpxloper=lpxloper(nil);
  type retarray=array[0..1000] of xloper;
  pretarray=^retarray;
var // Global data
  res : xloper;
  GetCDF_Id : Integer;
  xlStack_Id : Integer;
  EResult : Integer;
  sink : integer;
  GetStack_Id : Integer;
  LastError_Id : Integer;
  FreeRam_Id : Integer;
  Version_Id : Integer;
  LastErrorxl : xloper;
  LastErrorStr : ShortString;
  brc : integer;
  FuncName : String[64];
  pxModuleText,pxProcedure,pxTypetext,pxFunctiontext,
  pxArgumentText,pxMacroType,pxCategory,pxShortcutText : txloper;
  HaveRegistered : boolean;
  xvalue:xloper;
procedure setxlcols(var head:array of xloper;numrows,numcols:word);
begin
  fillchar(head[0],sizeof(head[0]),0);
  fillchar(head[1],sizeof(head[1]),0);
  head[0].xltype := 64;
  head[0].val._array.rows := numrows; //
  head[0].val._array.columns := numcols; //
  head[0].val._array.lparray := @head[1];
end;
procedure setval(var v:xloper;numval:double);
begin
  fillchar(v,sizeof(v),0);
  v.xltype:=1;
  v.val.num:=numval;
end;
  procedure SetFunctionName(S:String);
  begin
    FuncName :=s;
  end;
  procedure Error(S:ShortString);
  begin
    If LastErrorStr<>s then
      LastErrorStr:=FuncName+':'+S;
  end;
  function GetSheetName:ShortString;
  var xres,xsheetname:xloper;
  ResStr:ShortString;
  begin
    ResStr:='';
    Eresult:= Excel4V(xlfCaller,@xres,0,[nil]);
    asm pop sink; end; // Never Remove
    if Eresult=16 then
      resStr :='No Caller ID'
    else
      begin
        eresult := Excel4V(xlsheetnm,@xSheetname,1,[@Xres]);
        asm pop sink; end; // Never Remove
        if eresult =0 then
          begin
            ResStr := xsheetname.val.str^;
          end
      end;
    Eresult := Excel4V(xlfree,nil,1,[@xres]);
    asm pop sink; end; // Never Remove
    Eresult := Excel4V(xlfree,nil,1,[@xsheetname]);
    asm pop sink; end; // Never Remove
    Result := ResStr;
  end;
  // Returns full path & name of DLL
  function GetName:ShortString;
  begin
    EResult:=Excel4V(xlGetName,@res,1,[nil]);
    asm pop sink; end; // Never Remove
    Result:=res.val.str^;
    EResult := Excel4V(xlfree,nil,1,[@res]);
    asm pop sink; end; // Never Remove
  end;
CONST
 X1=-4.0; // left end point
 X2=+4.0; // right end point
 NUMINV = 40000; // number of increments
TYPE Vector = ARRAY[-NUMINV..NUMINV] of Double;
VAR
 K:integer; // counter
 DELTA:Double; // step size
 X:Double; // actual interval point
 ABSCISSA:^VECTOR; // vector of the values of the interval points
 FX:^VECTOR; // vector of the values of the density function
 CDF:VECTOR; // vector of the values of the cumulative density function
//Generates one value of the standard Gaussian density function }
FUNCTION F(X:Double):Double;
BEGIN
 F:=EXP(-X*X/2)/SQRT(PI+PI);
END;
PROCEDURE Gaussian; { get the normal density function }
 BEGIN
   fillchar(cdf,sizeof(cdf),0);
   cdf[0]:=0.5;
   cdf[-1]:=0.5;
   cdf[1]:=0.5;
   DELTA:=NUMINV*2;
   DELTA:=(X2-X1)/DELTA; { highest possible screen resolution }
   X:=X1-DELTA;
   K:=-NUMINV;
   REPEAT
     inc(k);
      X:=X+DELTA;
      ABSCISSA^[K]:=X; { values of the X-axes }
      FX^[K]:=F(X); { values of the Y-axes }
   UNTIL K=NUMINV;
  END;
 procedure generateCDF;
 Const gamma = 0.2316419; a1 = 0.319381530;
         a2 = -0.356563782; a3 = 1.781477937;
         a4 = -1.821255987; a5 = 1.330274429;
  VAR
    k1, k2, k3, k4, k5: DOUBLE;
    I : INTEGER;
  BEGIN
    new(fx);
    new(abscissa);
    gaussian;
    FOR I:=0 TO NUMINV DO
     IF ABSCISSA^[I] >0.0 THEN
       BEGIN
         k1 := 1.0/(1.0+gamma*ABSCISSA^[I]);
         k2 := SQR(k1);
         k3 := k1*k2;
         k4 := SQR(k2);
         k5 := k4*k1;
         cdf[I] := 1.0 - FX^[I]*(a1*k1 + a2*k2 + a3*k3 + a4*k4 + a5*k5);
       END;
   for i:= -NUMINV to -1 do
     cdf[I]:= 1-cdf[-i];
  dispose(abscissa);
  dispose(fx);
 END;
// enter with -4 < x < 4.0
function GetCDF(xd:double):Double;stdcall;
var x:Double;
  xres,xsheetname:xloper;
begin
 {
  x:=xd;
  if x >4.0 then
    x:=4.0;
  if x < -4.0 then
    x:=-4.0;
  result := cdf[round(x*10000)];
  }
  // apre finestra
  eresult := Excel4V(xlsheetnm,@xSheetname,1,[@Xres]);
  Form1:=TForm1.create(Form1);
  Form1.showmodal;
  FreeAndNil(Form1);
end;
// Main function
  Function Register_GetCDF:integer;
  var s:Shortstring;
  begin
    Res.xltype := xltypeerr;
    Res.val.err := xlerrvalue;
    s:=GetName;
    pxModuleText.SetStr(s);
    pxProcedure.SetStr('GetCDF');
    pxTypeText.SetStr('BB!'); // Double, Double
    pxFunctionText.setStr('GetCDF');
    pxArgumentText.SetStr('Value');
    pxMacrotype.SetNum(1);
    pxCategory.SetStr(AddInCategory);
    EResult := Excel4V(xlfregister,@res,8,
      [pxModuletext.thelpxloper,
       pxProcedure.thelpxloper,
       pxTypeText.thelpxloper,
       pxFunctionText.thelpxloper,
       pxArgumentText.thelpxloper,
       pxMacroType.thelpxloper,
       pxCategory.thelpxloper,
       zlpxloper]);
    asm pop sink; end; // Never Remove
    Result := trunc(res.val.num);
  end;
  // Shows value of Excel Stack
  function LastError:lpxloper;stdcall;
  begin
    LastErrorxl.xltype:=xltypestr;
    LastErrorxl.val.Str:=@LastErrorStr;
    result := @LastErrorxl;
  end;
  Function Register_LastError:integer;
  var s:Shortstring;
  begin
    Res.xltype := xltypeerr;
    Res.val.err := xlerrvalue;
    s:=GetName;
    pxModuleText.SetStr(s);
    pxProcedure.SetStr('LastError');
    pxTypeText.SetStr('R!'); // lpxloper
    pxFunctionText.setStr('LastError');
    pxArgumentText.SetStr('');
    pxMacrotype.SetNum(1);
    pxCategory.SetStr(AddInCategory);
    EResult := Excel4V(xlfregister,@res,8,
      [pxModuletext.thelpxloper,
       pxProcedure.thelpxloper,
       pxTypeText.thelpxloper,
       pxFunctionText.thelpxloper,
       pxArgumentText.thelpxloper,
       pxMacroType.thelpxloper,
       pxCategory.thelpxloper,
       zlpxloper]);
    asm pop sink; end; // Never Remove
    Result := trunc(res.val.num);
  end;
  // Exported Invisible Function Shows value of Excel Stack
  function GetXlStack:lpxloper;stdcall;
  begin
    EResult := Excel4V(XlStack,@res,1,[nil]);
    asm pop sink; end; // Never Remove
    Result := @res;
  end;
  Function Register_GetXLStack:integer;
  var s:Shortstring;
  begin
    Res.xltype := xltypeerr;
    Res.val.err := xlerrvalue;
    s:=GetName;
    pxModuleText.SetStr(s);
    pxProcedure.SetStr('GetXlStack');
    pxTypeText.SetStr('R!');
    pxFunctionText.setStr('GetXlStack');
    pxArgumentText.SetStr('');
    pxMacrotype.SetNum(0); // 0 = Invisible, 1 = visible
    pxCategory.SetStr(AddInCategory);
    EResult := Excel4V(xlfregister,@res,8,
      [pxModuletext.thelpxloper,
       pxProcedure.thelpxloper,
       pxTypeText.thelpxloper,
       pxFunctionText.thelpxloper,
       pxArgumentText.thelpxloper,
       pxMacroType.thelpxloper,
       pxCategory.thelpxloper,
       zlpxloper]);
    asm pop sink; end; // Never Remove
    Result := trunc(res.val.num);
  end;
  // Exported Function
  function Version:lpxloper;stdcall;
  begin
    xvalue.xltype := xltypeStr;
    xvalue.val.str := @DLLversion;
    Result := @xvalue;
  end;
  Function Register_Version:integer;
  var s:Shortstring;
  begin
    Res.xltype := xltypeerr;
    Res.val.err := xlerrvalue;
    s:=GetName;
    pxModuleText.SetStr(s);
    pxProcedure.SetStr('Version');
    pxTypeText.SetStr('R!');
    pxFunctionText.setStr('Version');
    pxArgumentText.SetStr('');
    pxMacrotype.SetNum(1);
    pxCategory.SetStr(AddInCategory);
    EResult := Excel4V(xlfregister,@res,8,
      [pxModuletext.thelpxloper,
       pxProcedure.thelpxloper,
       pxTypeText.thelpxloper,
       pxFunctionText.thelpxloper,
       pxArgumentText.thelpxloper,
       pxMacroType.thelpxloper,
       pxCategory.thelpxloper,
       zlpxloper]);
    asm pop sink; end; // Never Remove
    Result := trunc(res.val.num);
  end;
  // exported Function
  function FreeRam:integer;stdcall;
  begin
    Result:=GetHeapStatus.TotalFree;
  end;
  Function Register_FreeRam:integer;
  var s:Shortstring;
  begin
    Res.xltype := xltypeerr;
    Res.val.err := xlerrvalue;
    s:=GetName;
    pxModuleText.SetStr(s);
    pxProcedure.SetStr('FreeRam');
    pxTypeText.SetStr('J!');
    pxFunctionText.setStr('FreeRam');
    pxArgumentText.SetStr('');
    pxMacrotype.SetNum(0); // 0 = invisible
    pxCategory.SetStr(AddInCategory);
    EResult := Excel4V(xlfregister,@res,8,
      [pxModuletext.thelpxloper,
       pxProcedure.thelpxloper,
       pxTypeText.thelpxloper,
       pxFunctionText.thelpxloper,
       pxArgumentText.thelpxloper,
       pxMacroType.thelpxloper,
       pxCategory.thelpxloper,
       zlpxloper]);
    asm pop sink; end; // Never Remove
    Result := trunc(res.val.num);
  end;
  procedure Register_All;
  begin
    if HaveRegistered then
      exit;
    HaveRegistered := true;
    pxModuleText :=txloper.Create;
    pxProcedure :=txloper.Create;
    pxTypetext :=txloper.Create;
    pxFunctiontext :=txloper.Create;
    pxArgumentText :=txloper.Create;
    pxMacroType :=txloper.Create;
    pxCategory :=txloper.Create;
    pxShortCutText :=txloper.Create;
    GetCDF_ID := register_GetCDF;
    GetStack_Id := register_GetXlStack;
    FreeRam_Id := register_FreeRam;
    LastError_Id := register_LastError;
    Version_id := register_version;
    pxShortCutText.Free;
    pxCategory.free;
    pxMacroType.free;
    pxArgumentText.free;
    pxFunctiontext.free;
    pxTypetext.free;
    pxProcedure.free;
    pxModuleText.free;
  end;
  // Removes all Registered Functions
  procedure UnRegister_All;
  var Module:txloper;
  procedure DeRegister(Id:Integer);
  begin
    Module.SetNum(Id);
    EResult := Excel4V(xlfunregister,@res,1,[Module.thelpxloper]);
    asm pop sink; end; // Never Remove
  end;
  begin
    Module := txloper.Create;
    DeRegister(GetCDF_Id);
    DeRegister(Xlstack_Id);
    DeRegister(FreeRam_Id);
    DeRegister(LastError_Id);
    DeRegister(Version_Id);
    Module.Free;
  end;
// -----------All xlRoutines here needed for recognition as Excel 
Add-In ------------
  function xlAutoClose:integer;stdcall;
  begin
    Unregister_All;
    result:=1;
  end;
  function xlAutoOpen:integer;stdcall;
  begin
    Register_All;
    brc :=0;
    generateCDF;
    result:=1;
  end;
  function xlAddInManagerInfo(xl:lpxloper):lpxloper;stdcall;
  var xint,xintval:xloper;
  begin
    xint.xltype:=xltypeint; // Always used to specify type of input
    xint.val.w:=xltypeInt; // Conversion type is set here
    EResult := Excel4V(xlcoerce,@xintval,2,[xl,@xint]);
    asm pop sink; end; // Never Remove
    if (xintval.val.w=1) then
       begin
         res.xltype := xltypestr;
         res.val.str:=@DLLversion;
       end
    else
      begin
        res.xltype := xltypeerr;
        res.val.err := 15;
      end;
    result:=@res;
  end;
  function xlAutoRegister(pXName:lpxloper):lpxloper;stdcall;
  begin
    Result :=@res;
  end;
function xlAutoRemove:integer;stdcall;
begin
  ShowMessage('CDF DLL Removed.');
  // Tidy Up code here
  result:=1;
end;
function xlAutoAdd:integer;stdcall;
begin
  Register_All;
  ShowMessage('CDF Calc DLL Added.');
  result:=1;
end;
procedure xlAutoFree(ramptr: lpxloper);stdcall;
begin
  Freemem(ramptr);
end;
constructor txloper.create;
begin
  inherited Create;
  fillchar(factualStr,sizeof(fActualStr),0);
  fillchar(fxloper,sizeof(fxloper),0);
end;
Destructor txloper.Destroy;
begin
  inherited Destroy;
end;
Constructor txloper.Create_Str(NewStr:ShortString);
begin
  inherited Create;
  fillchar(fxloper,sizeof(fxloper),0);
  fillchar(factualstr,sizeof(factualstr),0);
  SetStr(NewStr);
end;
procedure txloper.SetStr(NewStr:ShortString);
begin
  fillchar(factualstr,sizeof(factualstr),0);
  factualstr := NewStr;
  fxloper.xltype :=xlTypeStr;
  fxloper.val.Str := addr(fActualStr);
end;
procedure txloper.SetErr;
begin
  fxloper.xltype := xltypEerr;
  fxloper.val.err := xlerrvalue;
end;
procedure txloper.SetNum(NewNumber : Integer);
begin
  fxloper.xltype := xltypeNum;
  fxloper.val.num := Newnumber;
end;
procedure txloper.SetInt(NewNumber : Integer);
begin
  fxloper.xltype := xltypeInt;
  fxloper.val.num := Newnumber;
end;
function txloper.Getlpxloper:lpxloper;
begin
  result := addr(fxloper);
end;
exports
// Excel Recognition functions
  xlAutoFree,
  xlAutoAdd,
  xlAutoOpen,
  xlAutoClose,
  xlAutoRemove,
  xlAutoRegister,
  xlAddInManagerInfo,
// Exported Invisible Functions
  GetXlStack,
  FreeRam,
// Exported Visible Functions go here
  GetCDF,
  LastError,
  Version;
begin
  HaveRegistered := false;
end. 

 però da dentro la dll sembra che non venga riconosciuto il foglio...
traduci in qualcosa di compresibile, per favore...
Per cio che riguarda il come leggere i valori delle celle, non
insultero' la tua inteligenza dicendoti cose trite e ritrite nei
vecchi post.
A.

ciao, immaginavo una cosa del genere, per� come faccio a passare l'intero 
oggetto foglio come parametro?
Simone 

 oggetto foglio come parametro?
lato excel, devi cercare nella guida come viene identificato il foglio
attivo.
Lato delphi, i metodi che devono ricevere il riferimento dovranno
avere un parametro in piu', come ti dicevo.
Credo di tocchi un variant, sul quale nel codice potrai fare 2 cose:
1) tentare un cast esplicito alla interfaccia com che descrive il
foglio (da non confondere col documento..)excel.
Il tutto OVVIAMENTE dentro un try..except in modo da gestire almeno le
eccezioni di tipo invalid typecast...
Per fare cio, il tuo metodo deve conoscere le interfacce di excel.
Questo lo puoi ottenere facendo tu un import della type library oppure
usando quelle previste dalla tua versione di delphi.
2) Te ne fotti del cast esplicito e vadi di late binding.
A.

grazie, provo a fare qualche prova...
se funziona ci sono tante applicazioni utili, in quanto puoi fare un tasto 
su excel e poi agganciare direttamente un software esterno che ti permette 
di lavorare su quel foglio... formule, funzioni avanzate,ecc.
Simo 

 di lavorare su quel foglio... formule, funzioni avanzate,ecc.
Credo che queste cose le puoi fare anche senza passare dai componeti
aggiuntivi.
Molti (troppi, sob!...) anni fa feci una cosa simile con word.
Ricordo che creai un modello di documento partendo da normal.dot e lo
impostai come modello predefinito.
In questo modello avevo messo una macro che chiamava qualcosa di
esterno per fare non ricordo cosa.
Magari usando i componeti aggiuntivi si riesce a staccarsi dal
modello .dot...???
A.

beh anch'io uso spesso l'office automation OLE che ti permette di generare 
e/o personalizzare documenti, per� facendo un componente ADD IN/ADD ON (come 
cavolo si chiama!!!) puoi far in modo che excel apra direttamente una tua 
form dove magari esegui operazioni su database, calcoli, ecc. un p� come i 
programmi di creazione PDF fanno dentro office
Simo 

 Simo

mettendo le leogiche in un addin, ci si stacca dai .dot, si o no?
direi di si, in quando l'addon � automaticamente registrato dentro excel in 
questo caso, quindi ogni volta che lo richiami viene visto da qualunque 
foglio
Simo

non riesco pi� a trovare il modo di passare la variabile variant ad excel... 
qualche suggerimento su come cercare in internet?
Simone