計算型のコンポーネントを作ったら。。。

条件が成立するまでWaitと計算を繰り返すコンポーネントを作ったら、止まらなくなりました。

いや、いずれ条件が成り立てば止まるんですが、途中で止めたくても止まらなくなってしまいました。

具体的にどうなるかというと。。。

計算が全く進まない状態。条件の成立を待ちをしているので、これはこれで正常な状態。

でも途中で止めたくなって「Abort」ボタンをクリックすると。。。。

これが、本格的に問題があるようなメッセージになってしまう。とほほっ。。。

これはなんか格好が悪い

これって、Windowsのイベント処理の問題というか、コンポーネントが計算に夢中になって処理を返さないのが原因。VBなんかでも計算型のプログラムを書くと陥りやすいパターンです。VBにはDoEvents()っていう便利な関数が用意されているので、適当なタイミング、一般的には時間の掛かりそうなループの途中で呼んであげれば簡単に解決できます。

しかし、今回はFORTRAN。そんな便利な関数はない。というか、言語仕様にそんな機能があったら変だ。

だが、そこはIntel FORTRANのこと、なんか用意してそうだと思ったら、やっぱりありました。Win32 APIを直接呼び出しているサンプルが！

ということで、DoEvents()もどきのサブルーチンに仕立ててみました。

こいつを適宜呼び出すことで無事に解決。

! 呼出し側   

! 計算の途中でイベントの処理を流す   

Call DoEvents() !Windowsイベントを処理する

!-----------------------------------------------------------
! イベント処理   
!-----------------------------------------------------------
SUBROUTINE DoEvents()
use IFWINTY
use USER32
use IFLOGM
logical lNotQuit, lret
integer iret
TYPE (T_MSG) mesg
lNotQuit = .TRUE.
do while (lNotQuit .AND. (PeekMessage(mesg, 0, 0, 0, PM_NOREMOVE) /= 0))
  lNotQuit = GetMessage(mesg, NULL, 0, 0)
    if (lNotQuit) then
      if (DLGISDLGMESSAGE(mesg) .EQV. .FALSE.) then
         lret = TranslateMessage(mesg)
         iret = DispatchMessage(mesg)
      end if
    end if
end do
END SUBROUTINE DoEvents

Tweet

Pocket