Шаг 232.
Создание в среде Delphi DLL для ее использования в макросах Excel

    На этом шаге мы рассмотрим алгоритм создания DLL.

    В качестве примера создадим DLL, состоящую из двух функций, одна из которых содержит диалоговое окно выбора даты (она будет возвращать дату). Другая функция будет просто преобразовывать значение аргумента, заданного в формате денежной единицы, и возвращать его в виде текстовой строки. Весь проект будет состоять из

    Проект динамической библиотеки экспортируемых функций. 

library LibForOf;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  MyLib in 'MyLib.pas';

{$R *.res}
exports
  GetDateDialog,
  GetSumInWords;
begin
end.

    Текст файла проекта содержит имя библиотеки, список используемых модулей и список экспортируемых функций. Модуль MYLIB.PAS содержит исходные тексты экспортируемых функций. Обратим внимание на то, что при описании функций используется соглашение о вызове stdcall, позволяющее компилировать библиотеку так, чтобы она была совместима для использования в программных модулях документов Excel.

    Исходный текст модуля MYLIB.PAS. 

unit MyLib;

interface
uses Variants;

  function GetDateDialog:variant;stdcall;
  function GetSumInWords(cur:currency; var stroka:string):boolean; stdcall;

implementation
  uses Windows,SysUtils,Forms,Controls,DateDlg;
  var j:LongInt;

function GetDateDialog:variant;
begin
  Application.CreateForm(TDateDlg, DatDlg);
  if DatDlg.ShowModal=mrOk then
     GetDateDialog:=DatDlg.MonthCalendar1.Date
  else GetDateDialog:=null;
  DatDlg.Free;
end;

function currtostrSS(str:shortstring;zpz:word):shortstring;
begin
  if pos(DecimalSeparator,str)>0 then
    str:=copy(str+'00000',1, pos(DecimalSeparator, str)+zpz)
  else str:=str+DecimalSeparator+copy('00000',1, zpz);
  currtostrSS:=str;
end;

function Del_sstr(ss:shortstring;var str:shortstring):boolean;
  var a:word;
begin
  Del_sstr:=false; a:=pos(ss,str);
  if pos(ss,str)=0 then exit;
  delete(str,a,length(ss));
  Del_sstr:=True;
end;

function Get_strok_num(var ss1,ss2:shortstring; razd:char;nn_raz:byte):byte;
const
 src_1:array[0..20] of string[15]=('', 'один', 'два',
   'три','четыре','пять','шесть','семь', 'восемь', 'девять', 'десять',
   'одиннадцать', 'двенадцать','тринадцать',
   'четырнадцать', 'пятнадцать', 'шестнадцать',
   'семнадцать', 'восемнадцать','девятнадцать','двадцать');
src_1_1:array[0..20] of string[15] = ('', 'одна','две',
   'три','четыре','пять', 'шесть', 'семь', 'восемь','девять',
   'десять','одиннадцать', 'двенадцать','тринадцать',
   'четырнадцать', 'пятнадцать','шестнадцать','семнадцать',
   'восемнадцать','девятнадцать','двадцать');
src_2:array[0..9] of string[15] = ('','десять','двадцать',
   'тридцать','сорок','пятьдесят','шестьдесят', 'семьдесят',
   'восемьдесят','девяносто');
src_3:array[0..9] of string[15] = ('', 'сто','двести',
   'триста','четыреста','пятьсот','шестьсот', 'семьсот',
   'восемьсот','девятьсот');
src_4:array[0..4] of string[15]=('','тысяча','миллион',
   'миллиард','триллион');
src_5:array[0..4] of string[15]=('','тысячи','миллиона',
   'миллиарда','триллиона');
src_6:array[0..4] of string[15]=('','тысяч','миллионов',
   'миллиардов','триллионов');
rub:array[0..2] of string[10]=('рубль','рубля','рублей');
kop:array[0..2] of string[10]=('копейка','копейки','копеек');
  var cc1,cc2:string[20];
  a,b:byte;
  razrad: array[1..5,1..3] of byte;

function preob(ccc:shortstring;kod:byte):shortstring;
type mema=array[0..100] of byte;
var
  eee:shortstring;
  a,b:byte;
  mem: ^mema;
begin
  for a:=1 to length(ccc) do
    if ((ord(ccc[a])<48)or(ord(ccc[a])>57)) then
      begin
        preob:='0'; exit;
      end;
  fillchar(razrad,sizeof(razrad),48);
  mem:=@razrad;
  for a:=1 to length(ccc) do
   mem[a-1+sizeof(razrad)-length(ccc)]:=ord(ccc[a]);
  eee:='';
  for b:=1 to 5 do
  begin
    for a:=1 to 3 do
    begin
       if (a=1)and(razrad[b,a]>48) then
         eee:=eee+' '+src_3[razrad[b,a]-48];
       if razrad[b,2]>49 then
       begin
         if (a=2)and(razrad[b,a]>48) then
           eee:=eee+' '+ src_2[razrad[b,a]-48];
           if b<>4 then
             if (a=3)and(razrad[b,a]>48)and(kod=1) then
               eee:=eee+ ' '+src_1[razrad[b,a]-48];
           if (a=3)and(razrad[b,a]>48)and(kod=2) then
             eee:=eee+' '+ src_1_1[razrad[b,a]-48];
           if b=4 then if (a=3)and(razrad[b,a]>48) then
             eee:=eee+' '+ src_1_1[razrad[b,a]-48];
       end;
       if razrad[b,2]=48 then
       begin
         if (a=2)and(razrad[b,a]>48)  then
           eee:=eee+' '+ src_2[razrad [b, a]-48];
         if b<>4 then
           if (a=3)and(razrad[b,a]>48)and(kod=1) then
             eee:=eee+' '+src_1[razrad[b,a]-48];
           if (a=3)and(razrad[b,a]>48)and(kod=2) then
             eee:=eee+' '+src_1_1[razrad[b,a]-48];
           if b=4 then
             if (a=3)and(razrad[b,a]>48) then
               eee:=eee+' '+ src_1_1[razrad[b,a]-48];
       end;
       if (razrad[b,2]=49)and(a=2) then
         begin
           eee:=eee+' ' +src_1[(razrad[b,2]-48)*10+(razrad[b,3]-48)];
         end;
    end;
    if razrad[b,2]=48 then
    begin
     if razrad[b,3]=49 then eee:=eee+' '+src_4[5-b];
     if ((razrad[b,3]>49)and(razrad[b,3]<53)) then eee:=eee+' '+src_5[5-b];
     if (razrad[b,3]>52)then eee:=eee+' '+src_6[5-b];
    end;
    if (razrad[b,2]=49) then
    begin
      if (razrad[b,3]>=48)then eee:=eee+' '+src_6[5-b];
    end;
    if (razrad[b,2]=48)and(razrad[b,3]=48) then
    begin
      if razrad[b,1]>48 then eee:=eee+' '+src_6[5-b];
    end;
    if razrad[b,2]>49 then
    begin
      if (razrad[b,3]=49)then eee:=eee+' '+src_4[5-b];
      if ((razrad[b,3]>49)and(razrad[b,3]<53)) then eee:=eee+' '+src_5[5-b];
      if (razrad[b,3]>52)then eee:=eee+' '+src_6[5-b];
      if (razrad[b,3]=48)then eee:=eee+' '+src_6[5-b];
    end;
  end;
preob:=eee;
end;

begin
  Get_strok_num:=0;
  if (pos(razd, ss1)>0) and (length(ss1)-pos(razd,ss1)>nn_raz) then
    ss1:=copy(ss1,1,pos(razd,ss1)+nn_raz);
  if pos(razd, ss1)>0 then
    ss1:=ss1+copy('000000',1,nn_raz-(length(ss1)-pos(razd,ss1)));
    if pos(razd,ss1)>0 then
    begin
      cc1:=copy(ss1,1,pos(razd,ss1)-1);
      cc2:=copy(ss1,pos(razd,ss1)+1,length(ss1)-pos(razd,ss1));
    end
  else
    begin
      cc1:=ss1;
      cc2:='';
    end;
  if length(cc1)>15 then
  begin
    Get_strok_num:=2; exit;
  end;
  if length(cc2)>15 then
  begin
    Get_strok_num:=3; exit;
  end;
  ss1:=preob(cc1,1);
  ss2:=preob(cc2,2);
end;

function get_rub_kop(var rub,kop:shortstring):byte;
label 0,1,2;
const
  rb:array[0..2]of string[10]=('рубль','рубля','рублей');
  kp:array[0..2]of string[10]=('копейка','копейки','копеек');
begin
  get_rub_kop:=0;
  try
    if rub='' then
    begin
      rub:= ''; goto 1;
    end;
    if ((StrToInt(rub) mod 100 >4)and(StrToInt(rub)mod 100 <=20)) then
    begin
      rub:=rb[2]; goto 1;
    end;
    if (StrToInt(rub) mod 10>1)and(StrToInt(rub) mod 10<5) then
    begin
      rub:=rb[1]; goto 1;
    end;
    if (StrToInt(rub) mod 10=1) then
    begin
      rub:=rb[0]; goto 1;
    end;
    if ((StrToInt(rub) mod 10>4)and(StrToInt(rub) mod 10<=9))or
          (StrToInt(rub) mod 10=0) then
    begin
      rub:=rb[2]; goto 1;
    end;
1:
  except
    get_rub_kop:=1;
  end;
  try
    if kop='' then
    begin
      kop:=''; goto 2;
    end;
    if ((StrToInt(kop)>4)and(StrToInt(kop) <=20)) then
    begin
      kop:=kp[2]; goto 2;
    end;
    if (StrToInt(kop) mod 10>1)and(StrToInt(kop) mod 10<5) then
    begin
      kop:=kp[1]; goto 2;
    end;
    if (strtoint(kop) mod 10=1) then
    begin
      kop:=kp[0]; goto 2;
    end;
    if ((StrToInt(kop) mod 10>4)and(StrToInt(kop) mod 10<=9))or 
        (StrToInt(kop) mod 10=0) then
    begin
      kop:=kp[2]; goto 2;
    end;
2:
  except
    get_rub_kop:=2;
  end;
end;

Function GetSumInWords(cur:currency; var stroka:string):boolean;
label 1;
var
  ss_r,ss_k,rub,ckop,kop:shortstring;
  str,eee,vux:string;
  a,b:word;
begin
1:
  str:=currtostr(cur);
  if str<>'' then
  begin
    ss_r:=currtostrSS(str,2);
    while Del_sstr(' ',ss_r) do;
    rub:=ss_r;
    kop:='';
    if pos(DecimalSeparator,ss_r)>0 then
    begin
      rub:=copy(ss_r,1,pos(DecimalSeparator,ss_r)-1);
      if length(ss_r)>pos(DecimalSeparator,ss_r) then
         kop:=copy(ss_r,pos(DecimalSeparator,ss_r)+1, 
                 length(ss_r)-pos(DecimalSeparator,ss_r))
      else kop:='';
      ss_r[pos(DecimalSeparator,ss_r)]:=',';
    end;
    ckop:=kop;
    Get_strok_num(ss_r,ss_k,',',2);
    get_rub_kop(rub,kop);
    if ckop<>'' then vux:=ss_r+' '+rub+' '+ckop+' '+kop
    else vux:=ss_r+' '+rub;
    vux:=copy(vux,2,length(vux)-1);
    eee:=vux;
    eee[1]:=chr(ord(eee[1])-32);
    stroka:=eee;
  end;
end;

end.
Текст этой библиотеки можно взять здесь (217,2 Кб).

    После компиляции проекта мы получим файл LIBFOROF.DLL и можем использовать доступные процедуры и функции, которые содержатся в этой библиотеке. Для этого расположим файл библиотеки таким образом, чтобы он был доступен приложению Excel. Это можно сделать, поместив файл LIBFOROF.DLL в одной папке с Excel или в папке, в которой он будет доступен для приложения Excel, например, в папке Windows\System32.

    На следующем шаге мы рассмотрим использование созданной DLL.




Предыдущий шаг Содержание Следующий шаг