(仮称)十進BASICで自作DLLを使う

PascalやC,C++などを利用して自作したDLLも使える。
その場合の要点は,公開する関数にstdcall(C++では,__stdcall)を指定すること。

Delphiと互換性を持つPascal開発環境FPC+Lazarusをダウンロードする。
Lazarus Windows 32bit
Windows版十進BASICで使うDLLを作るのが目的であれば,必ず32ビット版Lazarusを使うこと。

Delphi自体に関するリファレンスのリスト
Pascal・Delphi入門:オンライン学習ページ
Pascalシミュレータを初めて使うとき,IEのセキュリティの設定がカスタムの場合は,「未署名のActiveXのダウンロード」の設定を一時的に「ダイアログを表示する」に変更する。
Delphi入門

<Memo>
PascalとBASICの類似点:Pascalは,大文字と小文字を同一視する(文字列定数を除く)。
PascalとBASICが異なる点:Pascalでは改行は空白と同じ意味しか持たない。代わりに文と文の区切りとしてセミコロンが書かれる。

DelphiでDLLを作る

<Note>以下の記述はDelphi6に基づきます。最新版のDelphiでは異なる点があるかも知れません。

Delphiでは,program 〜 end.の代わりに,library 〜 end. でDLLを作れる。

BASICから呼び出す関数(手続きも可)にはstdcallを指示し,それらの名前をexportsに書く。
BASICから使うときには,関数(手続き)の名前は,大文字と小文字の違いが識別される。
exportsに書いた名前と関数(手続き)の頭書きに書いた名前の文字の大小が違っていてもDLLの翻訳はできるが,BASICから使うときの名前は最初に出現する名前。

関数の場合,結果の型は,実数型,文字列型以外で,内部表現が8ビット,16ビット,または,32ビットであるもの。ただし,8ビット,または,16ビットのときは,BASICの側で上位ビットを切り捨てる処理が必要。
引数は原則として値引数にする。引数にできるのは,実数型,文字列型以外で,内部表現が8ビット,16ビット,または32ビットであるもの。ただし,ポインタを引数にする代わりに変数引数にすることもできる。
文字列をDelphiに渡すとき,Delphiの関数(手続き)ではPCharで受ける。
Pointerを扱う場合,BASICにはポインタ型がないので,数値変数を用いて値を保持する。
DLLの内部でのみ利用する関数・手続きには上述の制限はない。

 2数の和,差を求める関数

1.次の内容をメモ帳で作成し,Sample.dprというファイル名で保存する。

library Sample;

function add(a,b:integer): integer; stdcall;
begin
   add:=a+b
end;

function sub(a,b:integer): integer; stdcall;
begin
   sub:=a-b
end;

exports add, sub;

end.

2.Delphiのファイルメニューの「プロジェクトを開く」でSample.dprを読み込み,プロジェクトメニューの「Sampleをコンパイル」を実行するとSample.dllができる。

(コマンドプロンプト(MS-DOSプロンプト)で,Sample.dprを保存したディレクトリに移動して
dcc32 Sample.dpr
を実行してもよい)

3.BASICのプログラムでは,次のようにして利用する。
(プログラムをDLLがあるのと同じフォルダに保存してから実行してください。)

100 FUNCTION ADD(a,b)
110    ASSIGN "Sample.dll","add"
120 END FUNCTION
130 
140 FUNCTION SUB(a,b)
150    ASSIGN "Sample.dll","sub"
160 END FUNCTION
170  
180 PRINT ADD(5,-4),SUB(4,7)
190 END

補足
引数はプログラムに書かれた順に対応付けられる。仮引数名とは無関係。だから,双方のプログラムで仮引数名が異なっていてもよい。
Delphiの関数名とBASICのASSIGN文に書く関数名は,大文字と小文字の違いまで含めて一致させる。

ビット演算

Visual BASICのAND,OR,NOT,XOR,IMP,EQVに相当するビット演算。
AND, OR, NOTはPascalの予約語なので,Delphiのプログラムでは,関数名をANDop,ORop,NOTopなどとする。

library bitOp;

function ANDop(a,b:integer):integer;stdcall;
begin
   result:=a and b
end;

function ORop(a,b:integer):integer;stdcall;
begin
   result:=a or b
end;

function NOTop(a:integer):integer;stdcall;
begin
   result:=not a
end;

function XORop(a,b:integer):integer;stdcall;
begin
   result:=a xor b
end;

function IMPop(a,b:integer):integer;stdcall;
begin
    result:=not a or b 
end;
   
function EQVop(a,b:integer):integer;stdcall;
begin
    result:=not (a xor b)
end;

exports ANDop, ORop, NOTop, XORop, IMPop, EQVop;

end.

BASICでの使い方
NOTはFull BASICの予約語なので,関数名をBitInvにした。

DECLARE EXTERNAL FUNCTION AND,OR,XOR,IMP,EQV,BitInv
LET a=BVAL("1010",2)
LET b=BVAL("11",2)
PRINT AND(a,b),OR(a,b),XOR(a,b),IMP(a,b),EQV(a,b)
PRINT BitInv(a),BitInv(b)
END
EXTERNAL FUNCTION AND(a,b)
ASSIGN "BitOp.dll","ANDop"
END FUNCTION
EXTERNAL FUNCTION OR(a,b)
ASSIGN "BitOp.dll","ORop"
END FUNCTION
EXTERNAL FUNCTION XOR(a,b)
ASSIGN "BitOp.dll","XORop"
END FUNCTION
EXTERNAL FUNCTION IMP(a,b)
ASSIGN "BitOp.dll","IMPop"
END FUNCTION
EXTERNAL FUNCTION EQV(a,b)
ASSIGN "BitOp.dll","EQVop"
END FUNCTION
EXTERNAL FUNCTION BitInv(a)
ASSIGN "BitOp.dll","NOTop"
END FUNCTION

ビット配列

BASICでビット配列が使えるようにする。複数の配列を用いることもできる。
完成品のダウンロード BITARRAY.LZH

DLLに独自のメモリ管理を追加し,メモリの解放を怠ったとしてもDLLを利用するプログラムの実行が終わればアドレス空間が解放されるようにしておく。
以下の内容をHEAPMEM.PASとして保存

unit HeapMem;

interface
uses Windows;
var
   HHeap:THandle;

implementation

initialization
  HHeap:=HeapCreate(0,0,0);

finalization
  HeapDestroy(HHeap);

end.
次に,次の内容をBitArray.dprとして保存して dcc32 BitArray.dpr で,(またはDelphi IDEから)コンパイルする。
Intel x86にビット列を扱う命令があるので,それを利用してビット列を操作する関数・手続きを定義している。
library BitArray;

uses
  Windows,
  HeapMem in 'HEAPMEM.PAS';

function MemSize(s:integer):integer;
begin
   result:=(s shr 5) shl 2;
   if (s and 31) <>0 then inc(result,4)
end;

const
  HEAP_ZERO_MEMORY = $00000008;
function GetArray(s:integer):pointer;stdcall;
begin
   Result:=HeapAlloc(HHeap,HEAP_ZERO_MEMORY,MemSize(s));
end;

procedure FreeArray(p:pointer); stdcall;
begin
  HeapFree(HHeap,0,p)
end;

function Test(p:pointer; i:integer):integer;stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   bt  [edx],eax
   mov eax,0
   rcl eax,1
   mov result,eax
  end;
end;

procedure SetBit(p:pointer; i:integer);stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   bts [edx],eax
  end;
end;

procedure ResetBit(p:pointer; i:integer);stdcall;
begin
  asm
   mov eax,i
   mov edx,p
   btr [edx],eax
  end;
end;

exports GetArray,FreeArray,Test,SetBit,ResetBit ;

end.
BASICのプログラムでは次のように利用する。
REM エラトステネスの篩 
DECLARE EXTERNAL FUNCTION GetArray, Test
DECLARE EXTERNAL SUB FreeArray, setbit
LET Nmax=10000
LET p=GetArray(Nmax)
IF p<>0 THEN 
   FOR i=2 TO Nmax-1
      IF Test(p,i)=0 THEN
         PRINT i
         FOR  j=i^2 TO Nmax-1 STEP i
            CALL SetBit(p,j)
         NEXT j 
      END IF
   NEXT i
   CALL FreeArray(p)
END IF
END
 
EXTERNAL FUNCTION GetArray(s)
! (s+1)ビットのメモリを確保し,ゼロで埋める。
! 結果は,メモリのアドレス。0のときは失敗。
FUNCTION GetArray_sub(s)
   ASSIGN "BitArray.DLL","GetArray"
END FUNCTION
IF 0<=s AND s<2^32 THEN
   LET GetArray=getArray_sub(s)
ELSE 
   LET GetArray=0
END if
END FUNCTION
 
EXTERNAL SUB FreeArray(p)
! メモリを返却する。pはGetArrayで得た値
ASSIGN "BitArray.DLL","FreeArray"
END SUB 
 
EXTERNAL FUNCTION Test(p,i)
! i番目のビットを取得する。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "Test"
END FUNCTION

EXTERNAL SUB SetBit(p,i)
! i番目のビットを1にする。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "SetBit"
END SUB
 
EXTERNAL SUB ResetBit(p,i)
! i番目のビットを0にする。pはGetArrayで得た値
ASSIGN "BitArray.DLL", "ResetBit"
END SUB
Test,SetBit,ResetBitで指定できるiの値は,GetArrayに指定した数をsとして,0〜sである。
また,実際にGetArrayに指定できるsの値の上限は,Windows XPでの実験結果では,1983381248で,これは2^30を超えるが,2^31よりは小さい 。
<注意>Test,SetBit,resetBitは範囲外の数を指定したときの安全策を講じていない。

直接メモリー操作

次のDLLは,文字列変数を用いずに,メモリーを直接操作する関数・手続きを用意する。

library memory;

uses
  Windows,
  HeapMem in 'HEAPMEM.PAS';

function GetMem(s:integer):pointer;stdcall;
begin
   Result:=HeapAlloc(HHeap,0,s);
end;

procedure FreeMem(p:pointer); stdcall;
begin
  HeapFree(HHeap,0,p)
end;

type
   PByte=^byte;
   PWord=^word;
   PInteger=^integer;

function Peek(p:PByte):integer;stdcall;
begin
   result:=p^
end;

function Peek2(p:PWord):integer;stdcall;
begin
   result:=p^
end;

function Peek4(p:PInteger):integer;stdcall;
begin
   result:=p^
end;

procedure Poke(p:PByte; i:byte);stdcall;
begin
  p^:=i
end;

procedure Poke2(p:PWord; i:word);stdcall;
begin
  p^:=i
end;

procedure Poke4(p:PInteger; i:integer);stdcall;
begin
  p^:=i
end;

procedure MoveM(p,q:Pointer; n:integer);stdcall;
begin
  move(p^,q^,n)
end;


exports GetMem,FreeMem,peek,Peek2,Peek4,Poke,Poke2,Poke4,MoveM ;

end.
使い方はこちら

Delphiで出力窓を作る

これを土台にして拡張していけば,好みの出力ウィンドウが作れる。

ソースファイルのダウンロードSAMPLE1.LZH

(1) Delphiの「新規作成」で「フォーム」を選ぶ。
(2) フォームにメモ・コントロールを貼り付ける。
次の(3),(4)は飛ばして(5)に進んでもよい。
(3) オブジェクト・インスペクタを利用して,memo1のAlignプロパティをalClientに変更する。
(4) 同じく,memo1のlinesプロパティをクリックして,「文字列リストの設定」を開いて,入力されている文字列“memo1”を消す。
(5) 適当なフォルダにUnit1.pasという名前で保存する。
(6) メモ帳でUnit1.pasを開き,最終行( end. の行)の直前に次の4行を追加して上書き保存する。

initialization
  Form1:=TForm1.Create(nil);
finalization
  Form1.Free
これによってDLLのロード,アンロードでフォームの初期化と解放が行われるようになる。(ここがポイント)

(7) メモ帳で次の内容を作成し,Sample1.dprという名前で保存する。

library Sample1;

uses
  Unit1 in 'Unit1.pas';

procedure Show; stdcall;
begin
   Form1.Show
end;

procedure Hide; stdcall;
begin
   Form1.Hide
end;

procedure TextOut(p:PChar);stdcall;
begin
   Form1.Memo1.Lines.Append(p)
end;

exports Show,Hide,TextOut;

end.

(8)Delphiのファイルメニューの「プロジェクトを開く」でSample1.dprを読み込み,プロジェクトメニューの「Sample1をコンパイル」を実行する。

(9)BASICプログラムでは,次のようにして利用する。

SUB Show
   ASSIGN "Sample1.dll", "Show"
END SUB

SUB Hide
   ASSIGN "Sample1.dll", "Hide"
END SUB

SUB TextOut(s$)
   ASSIGN "Sample1.dll", "TextOut"
END SUB

CALL Show
WAIT DELAY 1
CALL TextOut("Hello")
WAIT DELAY 1
CALL TextOut("Good Bye")
WAIT DELAY 1
CALL Hide
END

複数(任意個)の出力窓

上の例ではDLLのロード,アンロードでフォームの生成と解放を行うが,使えるウィンドウは1個に限る。 上の(6)の工程を省略し,フォームの生成と解放もBASICのプログラムから行うようにすれば,任意個のウィンドウが出せる。
以下の内容をSample2.dprとして保存し,コンパイルする。
library Sample2;

uses
  Unit1 in 'Unit1.pas';

function NewWindow:TForm1;stdcall;
begin
   NewWindow:=TForm1.create(nil)
end;

procedure CloseWindow(Form0:TForm1);stdcall;
begin
   Form0.free
end;

procedure Show(Form0:TForm1);stdcall;
begin
   Form0.Show
end;

procedure Hide(Form0:TForm1);stdcall;
begin
   Form0.Hide
end;

procedure Move(x,y:integer; Form0:TForm1);stdcall;
begin
   Form0.Left:=Form0.Left + x;
   Form0.Top:=Form0.Top + y
end;

procedure TextOut(p:PChar; Form0:TForm1);stdcall;
begin
   Form0.Memo1.Lines.Append(p)
end;

exports NewWindow,CloseWindow,Show,Hide,Move,TextOut;

end.
なお,Unit1.pasでは,
var
Form1: TForm1;
の2行は不要なので,削除しておいたほうがよい。(削除しておかないと,Form1を書いたときにエラーにならないのでバグの要因になる)

TForm型を含め,Delphiのオブジェクト型の変数の実体は32ビットポインタだから,BASICでこれを数値として保持して使用することができる。
具体的には,次のようにする。

100 FUNCTION NewWindow
110    ASSIGN "Sample2.dll","NewWindow"
120 END FUNCTION
130 SUB CloseWindow(n)
140    ASSIGN "Sample2.dll","CloseWindow"
150 END SUB
160 SUB Show(n)
170    ASSIGN "Sample2.dll", "Show"
180 END SUB
190 SUB Hide(n)
200    ASSIGN "Sample2.dll", "Hide"
210 END SUB
220 SUB move(x,y,n)
230    ASSIGN "Sample2.dll","Move"
240 END sub
250 SUB TextOut(s$,n)
260    ASSIGN "Sample2.dll", "TextOut"
270 END SUB
280 LET a=NewWindow
290 LET b=NewWindow
300 LET c=NewWindow
310 CALL show(a)
320 WAIT DELAY 1
330 CALL TextOut("Hello",a)
340 WAIT DELAY 1
350 CALL move (-20,20,b)
360 CALL show(b)
370 WAIT DELAY 1
380 CALL TextOut("Bonjour",b)
390 WAIT DELAY 1
400 CALL move(-40,40,c)
410 CALL show(c)
420 WAIT DELAY 1
430 CALL TextOut("こんちには",c)
440 WAIT DELAY 1
450 CALL hide(c)
460 WAIT DELAY 1
470 CALL hide(b)
480 WAIT DELAY 1
490 CALL hide(a)
500 CALL CloseWindow(c)
510 CALL CloseWindow(b)
520 CALL CloseWindow(a)
530 END
<機能拡張のためのヒント>
フォームに対する操作は,Delphi VCLのTForm型のプロパティとメソッドから選べる。
簡単に使えそうなプロパティとして,Caption,Width,Heightがある。
メモ・コントロールに対する操作は,delphi VCLのTMemo型のプロパティとメソッドから選べる。
プロパティは,プログラム実行中に変更する必要がなければ,オブジェクト インスペクタを用いて設計時に設定しておくのが簡単。反対に,プログラム実行中に変えたいものは,上のサンプルプログラムのように,exportするために,関数・手続きを定義して利用する。

メモ・コントロールのテキスト本体はLinesプロパティにある。LinesはTStrings型であるので,Linesに対する操作はLinesのTStrings型のプロパティあるいはメソッドに対する操作になる。たとえば,
procedure TextOut(p:PChar; Form0:TForm1);stdcall;
begin
Form0.Memo1.Lines.Append(p)
end;

では,Unit1.pasで定義されたTForm1型の変数Form0のTMemo型の項目Meme1のTStrings型のプロパティLinesのメソッドAppendを呼び出している。

文字の装飾

メモ・コントロールは個々の文字に対して色を付けたりフォントを変えたりすることはできないが,RichEditコントロールに変えれば,それが可能になる。RichEditコントロールは,SelAttributesプロパティを変更して文字を出力すれば,文字の装飾ができる。SelAttributesは,TTextAttributes型で,Color,Size,Name,Styleなどのプロパティを持っている。

ソースファイルのダウンロードSAMPLE3.LZH

(1) Delphiの「新規作成」で「フォーム」を選ぶ。
(2) フォームにRichEditコントロールを貼り付ける。RichEditコントロールは,Delphiの設計画面では,Win32タブの下にある。
(3) オブジェクト・インスペクタを利用して,RichEdit1のAlignプロパティをalClientに変更する。
(4) 同じく,RichEdit1のlinesプロパティをクリックして,「文字列リストの設定」を開いて,入力されている文字列“RichEdit1”を消す。
(5) 適当なフォルダにUnit3.pasという名前で保存する。
(6) メモ帳でUnit3.pasを開き,最終行( end. の行)の直前に次の4行を追加して上書き保存する。

initialization
  Form1:=TForm1.Create(nil);
finalization
  Form1.Free

(7) メモ帳で次の内容を作成し,Sample3.dprという名前で保存する。
TColor型,TFontStyle型,TFontPitch型の宣言がGraphicsユニットにあるため,uses節にGraphicsを追加する。
library Sample3;

uses
  Graphics,                 
  Unit3 in 'Unit3.pas';

procedure Show;stdcall;
begin
   Form1.Show
end;

procedure Hide;stdcall;
begin
   Form1.Hide
end;

procedure TextOut(p:PChar);stdcall;
begin
   Form1.RichEdit1.Lines.Append(p)
end;

procedure SetTextColor(c:TColor);stdcall;
begin
   Form1.RichEdit1.SelAttributes.Color:=c
end;
 
procedure SetTextStyle(s:TFontStyles);stdcall;
begin
   Form1.RichEdit1.SelAttributes.Style:=s
end;

procedure SetTextPitch(p:TFontPitch);stdcall;
begin
   Form1.RichEdit1.SelAttributes.Pitch:=p
end;
 
procedure SetFontName(p:PChar);stdcall;
begin
   Form1.RichEdit1.SelAttributes.Name:=p
end;
 
exports Show,Hide,TextOut,SetTextColor,SetTextStyle,SetTextPitch,SetFontName;

end.
<Note>
SelAttributesのNameプロパティはTFontName型で,TFontName型は type TFontName = type string; で定義されているが, procedure SetFontNameの仮引数をTFontName型やString型にしてはいけない。
DelphiのString型は特殊な構造を持っているので,BASICから直接操作することができない。
DelphiはPchar文字列をString型の変数に代入すれば,型の変換を自動的に処理してくれる。
なお,Procedure TextOutでも同様に仮引数をPChar型にしている。

(8) Delphi のファイルメニューの「プロジェクトを開く」で読み込んで,プロジェクトメニューの「Sample3をコンパイル」を実行する。
(コマンド・プロンプトで dcc32 Sample3.dpr を実行してもよい。)

(9)BASICのプログラムから呼ぶとき,引数の値は次のように定める。

DelphiのTColor型の実体は32ビット整数なので,BASICからはWindowsの色を直接指定すればよい。

DelphiのTFontPitch型は, TFontPitch = (fpDefault, fpVariable, fpFixed) で定義されている。
この場合,TFontPitch型の実体は,fpDefault=0,fpVariable=1,fpFixed=2である。

Delphiの TFontStyles型は,TFontStyleを基底とする集合型で,
TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
TFontStyles = set of TFontStyle;
で定義されている。Delphiの集合型は,第1の要素から順に,1,2,4,8,・・・の値を持つ。
たとえば,fsBold, fsItalic, fsUnderlineの3つの要素を持つ集合の値は1+2+4=7である。
(つまり,2進数の各ビットが集合の要素であるか否かを表している)

100 SUB Show
110    ASSIGN "Sample3.dll", "Show"
120 END SUB
130 SUB Hide
140    ASSIGN "Sample3.dll", "Hide"
150 END SUB
160 SUB TextOut(s$)
170    ASSIGN "Sample3.dll", "TextOut"
180 END SUB
190 SUB SetTextColor(n)
200    ASSIGN "Sample3.dll", "SetTextColor"
210 END SUB
220 SUB SetTextStyle(n)
230    ASSIGN "Sample3.dll", "SetTextStyle"
240 END SUB
250 SUB SetTextPitch(n)
260    ASSIGN "Sample3.dll", "SetTextPitch"
270 END SUB
280 SUB SetFontName(s$)
290    ASSIGN "Sample3.dll", "SetFontName"
300 END SUB
310 ! TFontPitch
320 LET  fpDefault=0
330 LET  fpVariable=1
340 LET  fpFixed=2
350 ! TFontStyles
360 LET  fsBold=1
370 LET  fsItalic=2
380 LET  fsUnderline=4
390 LET  fsStrikeOut=8
400 CALL Show
410 CALL TextOut("こんにちは")
420 CALL SetTextColor(BVAL("FF0000",16))
430 CALL SetTextStyle(fsBold + fsItalic + fsUnderline) 
440 CALL SetTextPitch(fpVariable)
450 CALL SetFontName("Times New Roman")
460 CALL TextOut("Hello!")
470 WAIT DELAY 3
480 END

文字列を受け取る

文字列をBASICで受け取りたいときは,あらかじめ十分な長さの文字列を代入した文字列変数s$を用意して,引数として渡す。
文字列変数s$は,他の変数に代入したことのあるものでも,他の変数からの値を代入されたものであってもならない。
DLLの関数では,PChar型の変数でそのアドレスを受け取り,実領域を書き換える。
DLLの関数は文字列長を関数値として返すようにする。nをその値とすると,s$(1:n)が目的の文字列である。

次の内容をSample4.pasとして保存してコンパイルする。
library Sample4;

uses
   Math;

function Test(p:PChar; m:integer):integer; stdcall;
var 
   i,n:integer;
   s:string;
begin
   s:='Hello';  
   n:=Min(length(s),m);
   for i:=1 to n do
            p[i-1]:=s[i];
   Test:=n;
end;

exports Test;

end.
<Note>Delphiで,string型文字列sの最初の文字はs[1],PChar文字列pの最初の文字はp[0]。
<Note>Min関数はMathユニットで宣言されている。

BASICプログラムでは次のようにする。
10 FUNCTION TEST(s$,m)
20    ASSIGN "Sample4.dll","Test"
30 END FUNCTION
40 LET m=32
50 LET s$=REPEAT$("#",m)
60 LET n=TEST(s$,m)
70 LET a$=s$(1:n)
80 PRINT a$
90 END

ダイアログ

ダイアログは,ShowModalで実行すると,ダイアログ側でOkボタンをクリックするなりの操作をするまで制御が戻らない。
例として,入力ダイアログを作る。入力候補をあらかじめ入力しておくことができるものにしよう。

ソースファイルのダウンロードSAMPLE5.LZH

(1)Delphiのファイルメニューの新規作成で「その他」を選び,「ダイアログ」タブで「標準ダイアログ」(下にボタンのあるタイプ)を選ぶ。
(2)ダイアログにEditコントロールを貼り付け,Unit5.pasという名前で保存する。
(3)Unit5.pasを表示して,
var
  OKBottomDlg: TOKBottomDlg;
とあるのを確認し,
{$R *.dfm}
 と
end.
の間に

initialization
  OKBottomDlg:=TOKBottomDlg.Create(nil);
finalization
  OKBottomDlg.Free
を追加して,上書き保存。

(4)次の内容をSample5.dprとして保存し,コンパイルする。

library Sample5;

uses
  Controls,
  Math,
  Unit5 in 'Unit5.pas';

function Dialog(s,t:PChar; maxlen:integer):integer;stdcall;
var
   i,n:integer;
begin
   n:=-1;
   OKBottomDlg.Edit1.text:=s;
   if OKBottomDlg.ShowModal = mrOK then
     begin
        n:=Min(maxlen, length(OKBottomDlg.edit1.text) );
        for i:=1 to n do 
                    t[i-1]:=OKBottomDlg.edit1.text[i];
     end;
   Dialog:=n;
end;

exports Dialog;

end.
<Note>mrOK定数はControlsユニットで宣言されている。

(5) BASICのプログラムでは,次のように利用する。
Dialog関数の結果は入力された文字列のバイト数。ただし,Cancelされたときは-1。

OPTION CHARACTER BYTE
FUNCTION Dialog(s$,t$,m)
   ASSIGN "Sample5.dll","Dialog"
END FUNCTION
LET s$="ここを書き換えてください"
LET t$=REPEAT$("#",128)
LET n=Dialog(s$,t$,LEN(t$))
IF n>=0 THEN
   LET s$=t$(1:n)
END IF
PRINT s$
END

実数値を埋め込む

Double型の配列を変数引数として要求するDLLが使えるようにする。
文字列として与えた数値を倍精度浮動小数点数(8バイト)に変換し,8バイトの文字列に埋め込む。
逆の変換も用意する。
8バイトの浮動小数点数の内部形式は,どの言語でも同じ。たいてい,Double型と呼ばれる。

次の内容をBinPack.dprとして保存し,コンパイルする。

library BinPack;

uses
  SysUtils,Math;

function Pack(s:PChar; var x:Double):integer;stdcall;
// 結果が0のときが正常終了
begin
    VAL(s,x,result);
end;

function UnPack(var x:Double; p:PChar; maxlen:integer):integer;stdcall;
var
   i:integer;
   s:string;
begin
   s:=Format('%.18g',[x]);
   result:=Min(length(s),maxlen);
   for i:=1 to result do
           p[i-1]:=s[i];
end;

exports Pack,Unpack;
end.
数値を文字列化するのに用いる関数FormatはSysUtilsユニットで定義されている。
<Note>Pascalの変数引数(varを前置して書かれた引数)で実際に渡されるのは変数のアドレスである。だから,Delphiで変数引数にした変数には,BASICでは(その変数のバイト数に応じた大きさの)文字列変数を指定する。

使用例はこちら

ActiveXを使う

BASICから直接使うのが難しいOCX,ActiveXは,DelphiでDLLを作成して利用する。

例1 CPUInfo ActiveX OCX を使う。

Delphiで「コンポーネント」−「ActiveXコントロールの取り込み」を選択。
「追加」で CPUInfo.ocx を指定。
「ユニットの作成」をクリックすると,CPUINFOLib_TLBができるので,適当なフォルダに名前を付けて保存する。
「新規作成」−「その他」で「DLL作成ウィザード」を選択。
「プロジェクト」−「プロジェクトに追加」で先ほど保存したCPUINFOLib_TLB.pasを指定する。
Library以下を次のように書き換えて,CPUInfo1.dprとして保存し,コンパイルする。

<Note>関数定義におけるresultは,本来のPascalにはないDelphi独自の拡張で,結果を格納する変数を表す。

library CPUinfo1;

uses
   CPUINFOLib_TLB in 'CPUINFOLib_TLB.pas';

var
   obj:TCPUinfo;

function GetCPUString(p:PChar):integer; stdcall;
var
   i:integer;
   s:string;
begin
   s:=obj.GetCpuString;
   result:=length(s);
   for i:=1 to result do p[i-1]:=s[i]
end;

function GetCPUFamilyID:integer;
begin
  result:=obj.GetCpuFamilyID
end;

exports GetCPUString, GetCPUFamilyID;

begin
   obj:=TCpuInfo.Create(nil);
end.
TCPUInfo型の変数objを宣言し,初期化部(begin〜end.)でオブジェクトを生成している(DLLのロード時に実行される)。
必要な処理は,すべて,このオブジェクト参照で記述すればよい。

BASICのプログラムでは,次のように利用する。

100 OPTION CHARACTER BYTE
110 FUNCTION GetCPUString(s$)
120    ASSIGN "CPUInfo1.dll","GetCPUString"
130 END FUNCTION
140 FUNCTION GetCPUFamilyID
150    ASSIGN "CPUInfo1.dll","GetCPUFamilyID"
160 END FUNCTION 
170 LET  s$=REPEAT$("#" ,255)
180 PRINT s$(1:GetCPUString(s$))
190 PRINT GetCPUFamilyID
200 END

Borland C++でDLLを作る

CやC++でDLLを作成してもよい。
Borland C++ Compiler 5.5 無償ダウンロードサービス

Borland C++では,bcc32のコマンドラインパラメータに -WD を付加するとDLLができる。

C言語で書くとき
以下の内容をSample.cという名前で保存し,コマンドプロンプト(MS-DOSプロンプト)で
bcc32 -WD Sample.c
を実行すると,Sample.dllができる。
BASICでの使い方は,Delphiで作成したSample.dllと同じ。

__declspec(dllexport) int __stdcall add(int a,int b);
__declspec(dllexport) int __stdcall sub(int a,int b);

int __stdcall add(int a, int b)
{
  return a+b;
};

int __stdcall sub(int a, int b)
{
  return a+b;
};

C++で書くとき
以下の内容をSample.cppという名前で保存し,コマンドプロンプト(MS-DOSプロンプト)で
bcc32 -WD Sample.cpp
を実行すると,Sample.dllができる。
BASICでの使い方は,Delphiで作成したSample.dllと同じ。

extern "C"  __declspec(dllexport) int __stdcall add(int a,int b);
extern "C"  __declspec(dllexport) int __stdcall sub(int a,int b);

int __stdcall add(int a, int b)
{
  return a+b;
};

int __stdcall sub(int a, int b)
{
  return a+b;
};
Borland C++は,拡張子でC言語かC++かを識別している。
Borland C++で,extern "C"を書かずにC++のプログラムをコンパイルすると,関数名が@add$qqsii や@sub$qqsiiのように変わってしまう。
反対に,C言語のプログラムにextern "C"を書くとエラーになってコンパイルできない。

戻る inserted by FC2 system