■

拡張子を.exeから.scrに変えた後は、ダブルクリックすれば起動できるようです。

白い四角を１０個づつ表示しては、画面を黒で塗りつぶして、また四角を表示し続けます。

logical(4) function  ScreenSaverConfigureDialog(hDlg ,message ,wParam, lParam)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ScreenSaverConfigureDialog@16' ::ScreenSaverConfigureDialog
integer :: hDlg ,message ,wParam ,lParam
ScreenSaverConfigureDialog = 1
end function ScreenSaverConfigureDialog

logical(4) function  RegisterDialogClasses(hInst)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_RegisterDialogClasses@4' :: RegisterDialogClasses
integer :: hInst
RegisterDialogClasses = 1
end function RegisterDialogClasses

INTEGER(4) FUNCTION ScreenSaverProc(hWnd, uMsg, wParam, lParam)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ScreenSaverProc@16' :: ScreenSaverProc
USE scrnsave
USE ifwina
USE iflogm
IMPLICIT NONE
INTEGER(4), INTENT(IN) :: hWnd, uMsg, wParam, lParam
INTEGER, SAVE :: ID_TIMER = 32767, iwx, iwy, nc = 0
INTEGER :: i, ix, iy
REAL :: x(2)
TYPE (t_RECT) :: rc
TYPE (t_PaintStruct) :: ps
INTEGER(BOOL) :: iret
INTEGER(handle) :: hDC, hBrush
ScreenSaverProc = 0
SELECT CASE (uMsg)
 CASE (WM_CREATE)
  iret = GetClientRect(hWnd, rc)
  iwx = rc%right  - rc%left
  iwy = rc%bottom - rc%top
  iret = SetTimer(hWnd, ID_TIMER, 1000, NULL)
  CALL RANDOM_SEED()
 CASE (WM_TIMER)
  CALL RANDOM_NUMBER(x)
  ix = x(1) * (iwx - 100)
  iy = x(2) * (iwy - 100)
  hDC = GetDC(hWnd)
  IF (nc < 10) THEN 
   nc = nc + 1
   hBrush = CreateSolidBrush(RGB(255, 255, 255)) 
   iret = SelectObject(hDC, hBrush)
   iret = Rectangle(hdc, ix, iy, ix + 100, iy + 100)
   iret = DeleteObject(hBrush)
  ELSE
   nc = 0
   hBrush = CreateSolidBrush(RGB(0, 0, 0)) 
   iret = SelectObject(hDC, hBrush)
   iret = Rectangle(hDC, 0, 0, iwx, iwy)
   iret = DeleteObject(hBrush)
  END IF
  iret = ReleaseDC(hWnd, hDC)
 CASE (WM_DESTROY)
  iret = KillTimer(hWnd, ID_TIMER);
  CALL PostQuitMessage(0)
 CASE DEFAULT
  ScreenSaverProc = DefScreenSaverProc(hWnd, uMsg, wParam, lParam)
END SELECT
RETURN
END FUNCTION ScreenSaverProc

参考図書

いつの間にか３版が出たようです。本屋で見てみます。