Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Milestone

JohnNichols
Valued Contributor II
433 Views

In 4 months and a fortnight, we will reach an important milestone, 20 years of this forum

The first post

Hi there, the first problem-thread, I bet ;-).

I built a VF6.0 dailog-application for Windows on a WinNT machine. Now I integrated the systemmenu in the dialog (minmize, maximize and close button on the top right corner). Minimizing works, maximizing is intentionally greyed out, but theclosing-button doesnt do anything. I tried to check the manual - found nothing, I tried to check the examples: no result (check "Therm" for example), the clos-button has also no effect.

Can anybody help me? It would be enough to point out, how it works in the "Therm"-example.

Best greetings,

Andre
4 Replies
Ron_Green
Moderator
391 Views

 I was hoping it would be a question on the FREQUENCY statement.  Or a question of support for the compiler on the VMS operating system for a microVAX.

Steve_Lionel
Black Belt Retired Employee
377 Views

This forum is, if you count its DEC/ Compaq ancestors, closer to 25 years old.

As for your problem, I vaguely recall the Therm example but it's not part of the current example set. Have you looked at Whizzy?

JohnNichols
Valued Contributor II
363 Views

I was playing with the KMeans program to further fix some errors and found an old program that use ANSI codes to clear the screen etc.  

I tried them again but no go - then I found this program, I know we have been talking about ansi codes, but this works a treat with IFORT.   LINE 17 is mine the rest is from 

ANSI Method 

PROGRAM WriteAnsi
  IMPLICIT NONE
  CHARACTER CH
       CH=CHAR(27)
  CALL set_ansi

  PRINT "(A)",  &
  
      ACHAR(27) // '[2J'// &
      ACHAR(27) // '[31m' // 'H' //  &
      ACHAR(27) // '[32m' // 'e' //  &
      ACHAR(27) // '[33m' // 'l' //  &
      ACHAR(27) // '[34m' // 'l' //  &
      ACHAR(27) // '[35m' // 'o' //  &      
      ACHAR(27) // '[0m'
      
WRITE(*,'(1X,4A,A23\)')CH,'[5;15H',CH,'[31m','______________________'

CONTAINS
  SUBROUTINE set_ansi
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        DWORD => C_LONG,  &    ! C_INT32_T really, but this is per the docs
        HANDLE => C_INTPTR_T,  &
        BOOL => C_INT

    INTEGER(HANDLE), PARAMETER :: INVALID_HANDLE_VALUE = -1_HANDLE

    INTERFACE
      FUNCTION GetStdHandle(nStdHandle) BIND(C, NAME='GetStdHandle')
        IMPORT :: DWORD
        IMPORT :: HANDLE
        IMPLICIT NONE
        INTEGER(DWORD), INTENT(IN), VALUE :: nStdHandle
        INTEGER(HANDLE) :: GetStdHandle
        !DEC$ ATTRIBUTES STDCALL :: GetStdHandle
        !GCC$ ATTRIBUTES STDCALL :: GetStdHandle
      END FUNCTION GetStdHandle
    END INTERFACE
    INTEGER(DWORD), PARAMETER :: STD_INPUT_HANDLE = -10_DWORD
    INTEGER(DWORD), PARAMETER :: STD_OUTPUT_HANDLE = -11_DWORD
    INTEGER(DWORD), PARAMETER :: STD_ERROR_HANDLE = -12_DWORD

    INTERFACE
      FUNCTION GetConsoleMode(hConsoleHandle, lpMode) BIND(C, NAME='GetConsoleMode')
        IMPORT :: HANDLE
        IMPORT :: DWORD
        IMPORT :: BOOL
        IMPLICIT NONE
        INTEGER(HANDLE), INTENT(IN), VALUE :: hConsoleHandle
        INTEGER(DWORD), INTENT(OUT) :: lpMode
        !DEC$ ATTRIBUTES REFERENCE :: lpMode
        INTEGER(BOOL) :: GetConsoleMode
        !DEC$ ATTRIBUTES STDCALL :: GetConsoleMode
        !GCC$ ATTRIBUTES STDCALL :: GetConsoleMode
      END FUNCTION GetConsoleMode
    END INTERFACE
    INTEGER(DWORD), PARAMETER :: ENABLE_ECHO_INPUT = INT(Z'0004', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_INSERT_MODE = INT(Z'0020', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_LINE_INPUT = INT(Z'0002', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_MOUSE_INPUT = INT(Z'0010', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_PROCESSED_INPUT = INT(Z'0001', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_QUICK_EDIT_MODE = INT(Z'0040', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_WINDOW_INPUT = INT(Z'0008', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_VIRTUAL_TERMINAL_INPUT = INT(Z'0200', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_PROCESSED_OUTPUT = INT(Z'0001', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_WRAP_AT_EOL_OUTPUT = INT(Z'0002', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_VIRTUAL_TERMINAL_PROCESSING = INT(Z'0004', DWORD)
    INTEGER(DWORD), PARAMETER :: DISABLE_NEWLINE_AUTO_RETURN = INT(Z'00008', DWORD)
    INTEGER(DWORD), PARAMETER :: ENABLE_LVB_GRID_WORLDWIDE = INT(Z'0010', DWORD)

    INTERFACE
      FUNCTION SetConsoleMode(hConsoleHandle, dwMode) BIND(C, NAME='SetConsoleMode')
        IMPORT :: HANDLE
        IMPORT :: DWORD
        IMPORT :: BOOL
        IMPLICIT NONE
        INTEGER(HANDLE), INTENT(IN), VALUE :: hConsoleHandle
        INTEGER(DWORD), INTENT(IN), VALUE :: dwMode
        INTEGER(BOOL) :: SetConsoleMode
        !DEC$ ATTRIBUTES STDCALL :: SetConsoleMode
        !GCC$ ATTRIBUTES STDCALL :: SetConsoleMode
      END FUNCTION SetConsoleMode
    END INTERFACE
    INTEGER(DWORD), PARAMETER :: ENABLE_EXTENDED_FLAGS = INT(Z'0080', DWORD)

    INTEGER(HANDLE) :: output_handle
    INTEGER(BOOL) :: api_result
    INTEGER(DWORD) :: mode

    output_handle = GetStdHandle(STD_OUTPUT_HANDLE)
    IF (output_handle == INVALID_HANDLE_VALUE) THEN
      ERROR STOP 'GetStdHandle failed'
    END IF

    api_result = GetConsoleMode(output_handle, mode)
    IF (api_result == 0_BOOL) THEN
      ERROR STOP 'GetConsoleMode failed'
    END IF

    api_result = SetConsoleMode(  &
        output_handle,  &
        IOR(mode, ENABLE_VIRTUAL_TERMINAL_PROCESSING) )
    IF (api_result == 0_BOOL) THEN
      ERROR STOP 'SetConsoleMode failed'
    END IF

  END SUBROUTINE set_ansi

END PROGRAM WriteAnsi

 

mfinnis
New Contributor I
326 Views

Somewhere between CFV6.6b and Composer XE 2013 SP1 (two versions I have access to dflogm.f90/iflogm.f90) was added the mapping of the system menu close button to the callback procedure of the control with id IDCANCEL, if it exists. For the THERM example, add a button (can be invisible) with id IDCANCEL and, as the default behaviour of a button with no callback procedure is to close the dialog, Bob's your uncle. If you want to do some clearing up or confirm the closing, add a callback procedure for IDCANCEL.

Reply