gfortranからWin32/64 APIを利用する方法について

更新日付 2019年11月20日


目次


1.gfortranについて
2.gfortranのインストール
3.Win32/64 API
4.関連コマンド
5.簡単なウィンドウを表示する
6.書籍の紹介

1.gfortran について

Windows で利用できる無料の Fortran の第一選択肢は gfortran でしょう。gfortran は GNU Fortran の略で,GNUコンパイラ群の一つです。 Fortran 水準の Fortran2003 及び Fortran2008 の一部を実装しています。
 gfortran の Windows 版は 32bitOS 用と 64bitOS 用が用意されています。 32bit 用では約3ギガバイトのメモリまでしか利用できません。64bit 用は3ギガバイトを超えるメモリーが配列として利用できるため,実装されているメモリを十分に活用したプログラムを作成できます。(Windows のエディションによって使用できる最大メモリサイズは異なります。)

2.gfortran のインストール

(1) gfortran のダウンロードは以下のサイトから可能です。

 
https://sourceforge.net/projects/mingw-w64/files/?source=navbar

(2) サイトに入ったら「MinGW-w64-for 32 and 64 bit Windows」というタイトルの下ほどに,

   Download Latest Version
  mingw-w64-v7.0.0.zip(15.1MB)

という項目があり,クリックすると以前はインストーラーがダウンロードされました。
現在は,ページの中程に移動し,
  MinGW-W64 Online Installer という項目の,
MinGW-W64-install.exe
をクリックするとインストーラーがダウンロードされます。
インストーラを起動し,使用しているOSに対応した gfortran をインストールします。
Settings の画面が出たら,64 bit モードをインストールする場合は,Architecture の項目でx86_64 を選択します。
gfortran と一緒に gcc やその他のコマンドやライブラリもインストールされます。

3.Win32/64 API

Win32/64 API とは,PCのOSの一つである Windows 用のアプリケーション・プログラム開発用のインタフェースライブラリで Microsoft が無料で提供しています。
 Win32 API と Win64 API の違いは,32bit版 Windows で使用するか,64bit版 Windows で使用するかの違いで機能的な違いはありません。gfortran をインストールすると対応する API も同時にインストールされます。しかし,多くの解説記事は 32bit版を基に書かれています。
 アドレスを表現するのに,32bit版では 32bit(4byte)であるのに対し,64bit版では 64bit(8byte)で表します。この点で両者のプログラム作成に於いては配慮が必要になります。
 また,通常 fortran では関数名を大文字と小文字を区別しませんが,Win32/64 API で引用する関数名(正確には,bind(C)属性の name= 節で指定する呼び出し関数名)は大文字と小文字を区別して利用します。これを間違えると関数が未定義になってしまいます。

4.関連コマンド

gfortranをインストールすると,GCCと一緒に関連するコマンドがインストールされます。これらのコマンドは,後々 Windows プログラミングをするときに必要になります。

(1) ARコマンド
ライブラリ等をアーカイブ形式のファイルにしたり,編集する場合に用いる。


ar r libmylib.a sub1.o sub2.o

(2) NMコマンド
アーカイブファイルに含まれているシンボル(関数名等)を一覧表示する。


nm -C libgdi32.a

(3) WINDRESコマンド
リソースファイルをコンパイルする。


windres menu.rc menu.o

(4) GDBコマンド
-g オプションを付けてコンパイルしたプログラムのデバッグを行う。


gfortran test.f90 -g
gdb a.exe
(gdb) r
(gdb) q

5.簡単なウィンドウを表示する

gfortran から Win32/64 API を用いて簡単なウィンドウを表示してみます。

本稿では,Windows7 のクラシックスタイルでウィンドウを開いています。Windows10 とは表示形式が異なります。

図5.1 簡単なウィンドウ

(1) プログラムの例

!*********************************************************************
!  Win01.f90   use Win32/64 API with gfortran.
!              2017.06.17  Y.Akatsuka
!*********************************************************************
! Define constants & structures
module win32_types
   use ISO_C_BINDING
   implicit NONE
    integer, parameter :: CS_VREDRAW   =  Z'00000001'
    integer, parameter :: CS_HREDRAW   =  Z'00000002'
    integer, parameter :: CW_USEDEFAULT = Z'80000000'
    integer, parameter :: SW_SHOWNORMAL = 1
    integer, parameter :: WM_CREATE    =  Z'00000001'
    integer, parameter :: WM_DESTROY   =  Z'00000002'
    integer, parameter :: WM_PAINT     =  Z'0000000F'
    integer, parameter :: WM_COMMAND   =  Z'00000111'
    integer, parameter :: IDC_ARROW    =  Z'00007F00'
    integer, parameter :: IDI_APPLICATION=Z'00007F00'
    integer, parameter :: COLOR_WINDOW =  5
    integer, parameter :: HANDLE       =  4
    integer, parameter :: WHITE_BRUSH  =  0
    integer, parameter :: BLACK_BRUSH  =  4
    integer, parameter :: WS_OVERLAPPEDWINDOW = Z'00CF0000'
    integer, parameter :: DT_LEFT      =  0
!
   type, bind(C) :: WNDCLASSEX_T
      integer(C_INT)      cbSize
      integer(C_INT)      style
      type(C_FUNPTR)      lpfnWndProc
      integer(C_INT)      cbClsExtra
      integer(C_INT)      cbWndExtra
      integer(C_INTPTR_T) hInstance
      integer(C_INTPTR_T) hIcon
      integer(C_INTPTR_T) hCursor
      integer(C_INTPTR_T) hbrBackground
      type(C_PTR)         lpszMenuName
      type(C_PTR)         lpszClassName
      integer(C_INTPTR_T) hIconSm
   end type WNDCLASSEX_T
!
   type, bind(C) :: POINT_T
      integer(C_LONG) x
      integer(C_LONG) y
   end type POINT_T
!
   type, bind(C) :: MSG_T
      integer(C_INTPTR_T) hwnd
      integer(C_INT)      message
      integer(C_INTPTR_T) wParam
      integer(C_INTPTR_T) lParam
      integer(C_LONG)     time
      type(POINT_T)       pt
   end type MSG_T
!
   type, bind(C) :: RECT_T
      integer(C_LONG) left
      integer(C_LONG) top
      integer(C_LONG) right
      integer(C_LONG) bottom
   end type RECT_T
!
   type, bind(C) :: PAINTSTRUCT_T
      integer(C_INTPTR_T) hdc
      integer(C_INT)      fErase
      type(RECT_T)        rcPaint
      integer(C_INT)      fRestore
      integer(C_INT)      fIncUpdate
      integer(C_INT8_T)   rgbReserved(32)
   end type PAINTSTRUCT_T
!
end module win32_types

!********************************************************************
!     Define function interfaces.
!********************************************************************
module win32
   implicit none
   interface
!
   function DefWindowProc(hwnd,Msg,wParam,lParam) &
            bind(C,name='DefWindowProcA')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: DefWindowProc
   integer(C_INT) DefWindowProc
   integer(C_INTPTR_T), value :: hwnd,wParam,lParam
   integer(C_INT), value :: Msg
   end function DefWindowProc
!
   function LoadIcon(hInstance,lpIconName) bind(C,name='LoadIconA')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: LoadIcon
   integer(C_INTPTR_T) LoadIcon
   integer(C_INTPTR_T), value :: hInstance
!  character(kind=C_CHAR) lpIconName(*)
   integer(C_INT), value :: lpIconName      ! alternate parameter
   end function LoadIcon
!
   function LoadCursor(hInstance,lpCursorName) bind(C,name='LoadCursorA')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: LoadCursor
   integer(C_INTPTR_T)  LoadCursor
   integer(C_INTPTR_T), value :: hInstance
!  character(kind=C_CHAR) lpCursorName(*)
   integer(C_INT), value :: lpCursorName    ! alternate parameter
   end function LoadCursor
!
   function CreateWindowEx(dwExStyle,lpClassName,lpWindowName,&
            dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu, &
            hInstance,lpParam) bind(C,name='CreateWindowExA')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: CreateWindowEx
   integer(C_INTPTR_T) CreateWindowEx
   integer(C_INT), value  :: dwExStyle,dwStyle,x,y,nWidth,nHeight
   integer(C_INTPTR_T), value  :: hWndParent,hMenu,hInstance
   character(kind=C_CHAR) :: lpClassName(*),lpWindowName(*)
   type(C_PTR), value :: lpParam
   end function CreateWindowEx
!
   function ShowWindow(hWnd,nCmdShow) bind(C,name='ShowWindow')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: ShowWindow
   integer(C_INT) ShowWindow
   integer(C_INTPTR_T), value :: hWnd
   integer(C_INT), value :: nCmdShow
   end function ShowWindow
!
   function RegisterClassEx(WndClass) bind(C,name='RegisterClassExA')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: RegisterClassEx
   integer(C_SHORT) RegisterClassEx
   type(WNDCLASSEX_T) WndClass
   end function RegisterClassEx
!
   function GetStockObject(fnObject) bind(C,name='GetStockObject')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: GetStockObject
   integer(C_INTPTR_T) GetStockObject
   integer(C_INT), value :: fnObject
   end function GetStockObject
!
   function GetMessage(lpMsg,hWnd,wMsgFilterMin,wMsgFilterMax) &
            bind(C,name='GetMessageA')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: GetMessage
   integer(C_INT) GetMessage
   type(MSG_T) lpMsg
   integer(C_INTPTR_T), value :: hWnd
   integer(C_INT), value :: wMsgFilterMin,wMsgFilterMax
   end function GetMessage
!
   function TranslateMessage(lpMsg) bind(C,name='TranslateMessage')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: TranslateMessage
   integer(C_INT) TranslateMessage
   type(MSG_T) lpMsg
   end function TranslateMessage
!
   function DispatchMessage(lpMsg) bind(C,name='DispatchMessageA')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: DispatchMessage
   integer(C_INT) DispatchMessage
   type(MSG_T) lpMsg
   end function DispatchMessage
!
   subroutine PostQuitMessage(nExitCode) bind(C,name='PostQuitMessage')
   use ISO_C_BINDING, only: C_INT
!GCC$ ATTRIBUTES STDCALL :: PostQuitMessage
   integer(C_INT), value :: nExitCode
   end subroutine PostQuitMessage
!
   function BeginPaint(hwnd,lpPaint) bind(C,name='BeginPaint')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: BeginPaint
   integer(C_INTPTR_T) BeginPaint
   integer(C_INTPTR_T), value :: hwnd
   type(PAINTSTRUCT_T) lpPaint
   end function BeginPaint
!
   function EndPaint(hwnd,lpPaint) bind(C,name='EndPaint')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: EndPaint
   integer(C_INT) EndPaint
   integer(C_INTPTR_T), value :: hwnd
   type(PAINTSTRUCT_T) lpPaint
   end function EndPaint
!
   function GetClientRect(hwnd,lpRect) bind(C,name='GetClientRect')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: GetClientRect
   integer(C_INT) GetClientRect
   integer(C_INTPTR_T), value :: hwnd
   type(RECT_T) lpRect
   end function GetClientRect
!
   function DrawTextEx(hdc,lpchText,cchText,lprc,dvDTFormat,lpDTParams) &
            bind(C,name='DrawTextExA')
   use ISO_C_BINDING
   use win32_types
!GCC$ ATTRIBUTES STDCALL :: DrawTextEx
   integer(C_INT) DrawTextEx
   integer(C_INTPTR_T), value :: hdc
   character(kind=C_CHAR) :: lpchText(*)
   integer(C_INT), value :: cchText  !   -1 to calculate the length
   type(RECT_T) lprc
   integer(C_INT), value :: dvDTFormat
   integer(C_INTPTR_T), value :: lpDTParams
   end function DrawTextEx
!
   function SetTextColor(hdc,crColor) bind(C,name='SetTextColor')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: SetTextColor
   integer(C_INT) SetTextColor
   integer(C_INTPTR_T), value :: hdc
   integer(C_INT), value :: crColor
   end function SetTextColor
!
   function SetBkMode(hdc,iBkMode) bind(C,name='SetBkMode')
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: SetBkMode
   integer(C_INT) SetBkMode
   integer(C_INTPTR_T), value :: hdc
   integer(C_INT), value :: iBkMode
   end function SetBkMode
!
   end interface
end module win32

!*********************************************************************
!    MainWndProc
!*********************************************************************
   integer function MainWndProc(hWnd,mesg,wParam,lParam) bind(C)
   use win32_types
   use win32
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: MainWndProc
   integer(C_INTPTR_T), value :: hWnd,wParam,lParam
   integer(C_INT), value :: mesg
   integer(C_INTPTR_T), save  :: hDC
   type(PAINTSTRUCT_T) ps
   type(RECT_T) rect
   character(kind=C_CHAR) msg*(80)
!
   select case (mesg)
   case (WM_CREATE)
   case (WM_DESTROY)
     call PostQuitMessage(0)
   case (WM_PAINT)
     hDC = BeginPaint(hWnd,ps)
     i = GetClientRect(hWnd,rect)
     rect%top = rect%top + 50
     rect%left = rect%left + 50
     i = SetTextColor(hdc,INT(Z'0000FFFF'))  ! yellow
     i = SetBkMode(hdc, 1)                   ! 1:TRANSPARENT
     msg ='Hellow, My name is Y.Akatsuka.'//char(0)
     i = DrawTextEx(hdc,msg,-1,rect,DT_LEFT,0_C_INTPTR_T)
     i = EndPaint(hWnd,ps)
   case (WM_COMMAND)
     select case (IAND(wParam,Z'0000FFFF'))
     case DEFAULT
       MainWndProc = DefWindowProc(hWnd, mesg, wParam, lParam)
       return
     end select
   end select
   MainWndProc = DefWindowProc(hWnd, mesg, wParam, lParam)
 end function MainWndProc

! *******************************************************************
!     WinMain Function
! *******************************************************************
   integer function WinMain(hInstance, hPrevInstance, lpCmdLine, &
                          nCmdShow) bind(C,name='WinMain')
   use win32_types
   use win32
   use ISO_C_BINDING
!GCC$ ATTRIBUTES STDCALL :: WinMain
   external MainWndProc
   integer(C_INTPTR_T), value :: hInstance,hPrevInstance
   integer(C_INT), value :: nCmdShow
   type(C_PTR), value :: lpCmdLine
   integer(C_INTPTR_T) hWnd
   character(kind=C_CHAR), target :: szAppName*(80)
   type (WNDCLASSEX_T) wc
   type (MSG_T) mesg
!
   szAppName = "Win01"//char(0)
!
   wc%cbSize       = SIZEOF(wc)
   wc%style        = IOR(CS_VREDRAW, CS_HREDRAW)
   wc%lpfnWndProc  = C_FUNLOC(MainWndProc)
   wc%cbClsExtra   = 0
   wc%cbWndExtra   = 0
   wc%hInstance    = hInstance
   wc%hIcon        = LoadIcon(0_C_INTPTR_T, IDI_APPLICATION)
   wc%hCursor      = LoadCursor(0_C_INTPTR_T, IDC_ARROW)
   wc%hbrBackground= GetStockObject(BLACK_BRUSH)
   wc%lpszMenuName = C_NULL_PTR
   wc%lpszClassName= C_LOC(szAppName)
   wc%hIconSm      = LoadIcon(0_C_INTPTR_T, IDI_APPLICATION)
   i = RegisterClassEx(wc)
!
   hWnd = CreateWindowEx(0, szAppName, szAppName, &
           WS_OVERLAPPEDWINDOW,      &
           50, 100,                  & ! x,y
           400,300,                  & ! Width,Height
           0_C_INTPTR_T,             & ! hWndParent
           0_C_INTPTR_T,             & ! hMenu
           hInstance,                & ! hInstance
           C_NULL_PTR)                 ! lpParam
   i = ShowWindow(hWnd, nCmdShow)
!
   do while (GetMessage(mesg, 0_C_INTPTR_T, 0, 0) .NE. 0)
     i = TranslateMessage(mesg)
     i = DispatchMessage(mesg)
   end do
   WinMain = mesg%wParam
   return
   end

(2) プログラムの解説

Win32/64 APIは C のプログラムから引用することが前提に作られています。 gfortran から API を引用するには C のインタフェースに合わせる必要があります。

Intel Visual Fortran や Compaq Visual Fortran には,Win32 API を引用するためのインタフェースが予め用意されています。 C/C++のプログラムでは,windows.h という用意されたヘッダファイルの集合体の中で定義されていますので include するだけで済みます。

インタフェースには関数の呼び出しに関する定義と,API とデータの受け渡しを行う構造体と呼ばれるデータ構造を定義したインタフェースがあります。その他には,APIに与えるパラメータ値に API 固有の名前が定義されています。

因みに,WNDCLASSEX や WM_PAINT は winuser.h というヘッダファイルに,HANDLE は winnt.h に定義されています。gfortran ではヘッダファイルはそのままでは使用できませんので,gfortran 用にインタフェースを記述しなければなりません。

サンプルプログラムでは,始めの部分に値の定義と構造体の定義を列挙しています。それに続いて API を呼び出す関数のインタフェース定義を行っています。API は戻り値を有する関数の形で定義します。本プログラムで引用している部分のみを定義しています。

bind パラメータは C のインタフェースで API を呼び出すときの関数の別名を定義します。関数名の後ろに A が付くのは,文字列を扱う関数が ansi の文字列であることを示します。
use ISO_C_BINDING 文は gfortran に用意されている C 互換の定義を使用していることを宣言しています。integer(C_INT)は,C の互換表記で,integer(4)と同等です。

通常 Windows プログラムは,WinMain という関数が最初に実行されます。WinMain は Windows から呼び出される Windows プログラムの標準的に決まっている名前で,メインプログラムに相当します。関数 MainWndProc は,WinMain からウィンドウが作られたときに呼び出される関数で,WinMain 内で呼び出す名前を任意に定義できます。Windows プログラムはイベントドリブン型といって,Windows からメッセージとして送られて来るいろいろなイベントメッセージ(実際には整数値です)を処理するようにプログラムを作成します。MainWndProc ではこれらのメッセージを処理します
ウィンドウ画面にテキストを表示するには,WM_PAINT メッセージを捕らえてテキストを表示する関数を実行します。

WinMain 関数は,ウィンドウを開いて,送られてくるメッセージを捕らえ,MainWndProc 関数にその処理を依頼するためのメッセージ処理ループを記述します。

このプログラムは,32bit 版と 64bit 版のどちらでも動作するように記述しています。詳しい解説は,API の解説本が多数出ていますのでそちらを参照してください。また,筆者も gfortran から Win32/64 API を用いる解説本を執筆しましたので,よろしければ購読をお願いします。

(3) gfortranの起動とプログラムの実行

gfortran の起動は,gfortran をインストールしたディレクトリの mingw-w64.bat をダブルクリックすると,コマンドビューウィンドウが開きます。

図5.2 コマンドビューウィンドウ

gfortran を起動して,例示したプログラム(Win01.f90)をコンパイル/リンクします。
-fno-range-check は,コンパイラに与えるオプションで16進表記で表示されるエラーメッセージを抑止します。
-lgdi32 は,リンカに gdi32 ライブラリを用いることを指示します。gdi32 は Win32/64 API の一部で,描画を行うインタフェースライブラリの名前 [libgdi32.a] です。通常 gfortran と一緒にインストールされています。 コマンドやライブラリが入ったディレクトリの場所は,gfortran が内部的に保持しているようです。もし,gdi を使用している関数が未定義になった場合は,-Lパラメータでディレクトリの Path を設定してください。又は,システム環境変数 LIBRARY_PATH(大文字)にディレクトリの Path を設定し,システムを再起動します。
-mwindows は,プログラムを起動したときに,Windows の独立したプログラムとして起動します。このパラメータを省略すると,起動したウィンドウプログラムが終了するまでコマンドビューは待機状態になります。write(6,*)文が有効になりますので,debug 時にはこのパラメータを省略すると便利です 。Explorer からプログラムを起動((4)を参照)すると,コマンドビュー風の何も入出力できないウィンドウが同時に開きます。
毎回,このようなコマンドを間違いなく入力するのは大変なので Batch ファイルを作成しておくと便利です。(図5.3 参照)

図5.3 コンパイルと実行

コンパイルエラーがなくリンクも正常に終われば,a.exe という実行形式のファイルが作成されます。a.exe 又は a と入力すると,プログラムが実行され Hello,... の文字が表示されたウィンドウが開きます。(図5.3,図5.4 参照)

図5.4 Win01プログラムが開いたウィンドウ

このとき,プログラムは WinMain のメッセージ処理ループを実行しています。ウィンドウの閉じるボタンをクリックすると,WM_DESTROY メッセージが MainWndProc ルーチンに送られ,プログラムが終了します。

(4) Explorer からプログラムを起動する

gfortran でコンパイルして作成したプログラムは,通常は gfortran のコマンドビューから実行します。プログラムを別のディレクトリに移動したりして,Explorer からダブルクリックして起動しようとすると,×××.dll が見つからない旨のエラーになる場合があります。システムの環境変数 Path が設定されていないと起こります。これを回避するには,環境変数の Path に dll が存在するディレクトリを追加します。
コントロールパネルのシステムを起動して,システムの詳細設定をクリックし,システムのプロパティの環境変数(N)を選択します。ユーザー環境変数,又は,システム環境変数の PATH を選択し,編集をクリックします。変数値の入力域に,gfortran をインストールしたディレクトリ内の mingw32\bin をフルパス名で追加します。コマンドビューから Path と入力すると確認することができます。Path が認識されるにはシステムの再起動が必要です。
 gfortran がインストールされていない PC にプログラムを移植する場合には,-static オプションを付けてコンパイルします。

gfortran -static prog.f90 -o prog.exe


6.書籍の紹介



コンピュータ・IT>プログラミング

筆者が執筆した gfortran から Win32/64 API を用いる解説本が amazon から販売されました。

図形表示の基礎から応用までのプログラミングを中心に解説しています。gfortran からWin32/64 API を用いる解説本は唯一だと思います。応用では株価チャートの表示とテクニカル分析について解説しています。また,プリント出力についても詳しく解説していますので,実用上必要十分な解説書となっています。

価格は多くの人に読んでもらいたいので,¥2,200(税込)と安く抑えています。





TOPページに戻る