'■■■■■■■■■■■■■■■
'■ このソースコードは
'■ ActiveBasic 2.62
'■ でコンパイルできます。

Dim A As WORD
Dim B As WORD
Dim i As Long
Dim recode As Long
Dim C(256) As Byte	'■大きい時は増やす
Dim x As WORD
Dim y As WORD
Dim tmp As Byte
Dim w As WORD
Dim h As WORD
Dim BPC As WORD
Dim bit(8) As Byte
bit(0)=1;
bit(1)=2;
bit(2)=4;
bit(3)=8;
bit(4)=16;
bit(5)=32;
bit(6)=64;
bit(7)=128;

cls 3

w=12
h=12

Print "フォント名"
Input fontName$
if fontName$="" then fontName$="MS 明朝"
Print "幅(px)"
Input w
Print "高(px)"
Input h

cls 3

BPC=h*w\8

Open "font.dat" As 2
Field #2, ((255-64+1)*(h*w\8)) , As FILE$
recode=1

For B=129 to 252
if(B=133) then B=135
if(B=160) then B=224
if(B=239) then B=250
if(B=235) then B=237

For A=64 to 255
'print A,B
out$=Chr$(B)+Chr$(A)
'  Line (0,0)-(h,w),0,Bf
  TextOut 0,0, out$,7,0,h,w\2,fontName$
  for x=0 to w-1
  for y=0 to h-1
'    tmp=Point(x,y)
'    PSet(x,y),tmp+7
    if Point(x,y) then
      i=(x*h+y)\8
      C(i)=C(i)+bit((x*h+y) Mod 8)
    end if
  next y
  next x
  for i=0 to BPC-1
    FILE$=FILE$+Chr$(C(i))
    C(i)=0
  next i

Next A
Put #2, recode
recode=recode+1
FILE$=""
Next B
Close #2
TextOut 0,0, "完了",7,0,h,w\2,fontName$