How to handle closing a console application ?

[jirina]

I would like to be able to handle closing a console application after clicking on the close button X in the upper right corner of the corresponding window or after pressing Ctrl+C (or Ctrl+Break) on the keyboard.

If I use Ctrl+C, I get forrtl: error (200): program aborting due to window-CLOSE event. It would be fine to close the application without showing this message. If there was any chance to perform some operations before closing the window, it would be even better.

[Jugoslav_Dujic]

Try SIGNALQQ or SetConsoleCtrlHandler.

[jirina]

Thank you for your suggestions; I tried both and decided to use SetConsoleCtrlHandler (even though it is not Fortran only anymore - I am using a dll created by VS C++), because SIGNALQQ does not seem to be able to handle closing the console application window using the close button X.

[g_f_thomas]

Ctrl C/Break is not for closing a window. With a handler you can eat the message instead of bombing. Alt F4 closes the active window with or without a handler.

Gerry

[kooka]

Quoting - jirina

I would like to be able to handle closing a console application after clicking on the close button X in the upper right corner of the corresponding window or after pressing Ctrl+C (or Ctrl+Break) on the keyboard.

If I use Ctrl+C, I get forrtl: error (200): program aborting due to window-CLOSE event. It would be fine to close the application without showing this message. If there was any chance to perform some operations before closing the window, it would be even better.

you have to subclass the main window and catch wm_close message to ask for save or not, i recently used that. i paste some code,i triednot paste redundantcode but its too much, the important message is wm_close in framewindowproc function, i hope you can take something:

program main
!main program; sets initialsettings, sets toolbar and wait for mouse events

use dflib
use dfwin
USE USER32
USE KERNEL32
USE VARIABLES
USE GLOBALS

implicit none
! variables
integer(4) iret,ideg,icount

record /qwinfo/qw
logical(4) bret
INTEGER HACCEL, iunit

type (rccoord) rc
TYPE(T_MSG) MESG
type (xycoord) pos
LOGICAL:: bSt
TYPE(T_RECT):: Rect
CHARACTER*15:: sClass
INTEGER:: iSt, jTop, jBottom, jLeft, jRight, jWidth, jHeight
!INTERFACE PARA FRAMEWNDPROC, PROCESAR MENSAJES
INTERFACE
INTEGER(4) FUNCTION FrameWndProc(hWnd,Msg,wParam,lParam)
!DEC$ATTRIBUTES STDCALL:: FrameWndProc
INTEGER:: hWnd,Msg,wParam,lParam
END FUNCTION
END INTERFACE






CALL CONTROLPARAM()


! maximize the size of the main window
qw%type =QWIN$MAX
iret = SETWSIZEQQ(QWIN$FRAMEWINDOW,qw)


!!destroy initial status bar
hFrame=GETHWNDQQ(QWIN$FRAMEWINDOW)
hMDI=FindWindowEx(hFrame,NULL,LOC('MDIClient'C),NULL)
hStatus=GetWindow(hMDI,GW_HWNDNEXT)
iSt=SendMessage(hStatus,WM_CLOSE,0,0)



!Handle of the frame window
hInst=GetWindowLong(hFrame,GWL_HINSTANCE) !Instance handle (needed to load resources)

!iSt=SendMessage(hFrame,WM_create,0,0)

iSt=SetWindowText(hFrame,"main")

hMDI = GetWindow(hFrame, GW_CHILD) !MDI parent window (the dark surface beneath childs)
!Subclass the Frame window with FrameWndProc. lpfnOldFrameProc is the
!address of default ("Old") Frame window procedure
lpfnOldFrameProc=SetWindowLong(hFrame,GWL_WNDPROC,LOC(FrameWndProc))

!This is a user-defined message sent to Frame window to create toolbar.
!Note that a direct call to CreateMyToolbar from here would fail (i.e.
!the toolbar would be created, but "dead", since QW has two threads:
!"primary", where mouse and menu callbacks, along with QW internal
!stuff is executed, and "secondary", where PROGRAM is executed).
!This, secondary thread does not contain a message loop; the primary
!(where FrameWndProc is executed) has.
iSt=SendMessage(hFrame,WM_CREATETOOLBAR,0,0)

iSt=SendMessage(hFrame,WM_app+1,0,0)





!WAIT FOR MESSAGE LOOPS
do while(GETMESSAGE(MESG,NULL,0,0))



IF(GHDLGMODELESS==0 .OR. ISDIALOGMESSAGE(GHDLGMODELESS,MESG)) THEN
IF(TRANSLATEACCELERATOR(MESG%HWND,HACCEL,MESG)==0) THEN
BRET=TRANSLATEMESSAGE(MESG)
IRET=DISPATCHMESSAGE(MESG)
END IF
END IF
end do

end PROGRAM

!=======================================================================

!Subclassed procedure of Frame client window
INTEGER FUNCTION FrameWndProc(hWnd,Msg,wParam,lParam)
!DEC$ATTRIBUTES STDCALL:: FrameWndProc

USE DFWIN
!DEC$IF (_DF_VERSION_ <=650)
USE COMCTL
!DEC$ENDIF
USE GLOBALS
USE COMCTL32
use dflogm
USE ToolTipsGlobals
use dfwina
use variables
IMPLICIT NONE



logical errorf
character(50) :: file_output
character*10 ind
integer(4):: isbfieldpos(5), jwidth,iret
integer(4) hfont
INTEGER:: hWnd,Msg,wParam,lParam
INTEGER:: iSt, ID, iState, itbHeight,itbHeight1
TYPE(T_RECT):: tbRect, mdiRect, tbrect1, mainrect, rc
TYPE(T_NMHDR):: NMH; POINTER(pNMH, NMH)
!DEC$IF (_DF_VERSION_ <=650)
TYPE(T_TOOLTIPTEXT):: DI; POINTER(pDI, DI)
!DEC$ELSE
TYPE(T_NMTTDISPINFO):: DI; POINTER(pDI, DI)
!DEC$ENDIF
type (T_INITCOMMONCONTROLSEX) iccex
! Variables
character(SIZEOFAPPNAME) lpszName
character(SIZEOFAPPNAME) lpszHeader
integer(4) cxClient,cyClient
integer(4) ierror
integer(4) hwndEdit

logical(4) :: redraw = .true.
INCLUDE "Resource.fd"

interface
integer(4) function InitializeFont
end function
end interface

interface
integer function InitializeChooseFont( hWnd )
integer hWnd
end function
end interface





INTERFACE
integer*4 function running( hDlg, message, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_running@16' :: running
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'running' :: running
!DEC$ ENDIF
integer*4 hwnd
integer*4 mesg
integer*4 wParam
integer*4 lParam
end function
end interface
interface
SUBROUTINE ADDstrt(dlg,control_name, callbacktype)
use dflib
use dflogm
use dfwin
USE COMCTL32
use variables
use globals
implicit none
include 'resource.fd'
type(dialog), optional:: dlg
TYPE(INTERVAL),ALLOCATABLE:: TEMP(:), TEMPORAL(:)
TYPE(TDPARAM),ALLOCATABLE:: TEMPTDPN(:)
!type(numero) no1,no2
type(T_SYSTEMTIME) st
type(T_FILETIME) ft
!type(t_ULARGE_INTEGER) lt
INTEGER*4 i, J, htime, ii
integer(4) iret,N, result
logical(4) bret
integer(4) d1,d2
integer(4), optional:: control_name,callbacktype
integer*8 mn
CHARACTER*20 STR
character*11 c1,c2
end subroutine
end interface
! internal QuickWin routine to set status bar at screen bottom
interface
integer*4 function setstatusbar(msg)
!DEC$ IF DEFINED (_X86_)
!dec$ attributes C, alias: "__QWINTSetStatusBar" :: setstatusbar
!DEC$ else
!dec$ attributes C, alias: "_QWINTSetStatusBar" :: setstatusbar
!DEC$ endif
integer msg ! to hold address of string
end function setstatusbar
end interface

iccex.dwSize = sizeof(iccex)
iccex.dwICC = ICC_DATE_CLASSES
call initcommoncontrolsex(iccex)









SELECT CASE(Msg)

CASE (WM_app+1)
! hStatus=CreateStatusWindow(WS_CHILD,''C,hFrame,0)
statustext= 'Click Open or New Model to Start'c
hStatus=CreateStatusWindow(IOR(WS_CHILD,WS_VISIBLE), statustext,hFrame,0)
jwidth=400
iSBFieldPos(5)=jWidth
iSBFieldPos(4)=jWidth-100
iSBFieldPos(3)=jWidth-180
iSBFieldPos(2)=jWidth-260
iSBFieldPos(1)=160
iSt=SendMessage(hStatus,SB_SETPARTS,1,LOC(iSBFieldPos(5)))
iSt=ShowWindow(hStatus,SW_SHOW)
! FrameWndProc=0

!CASE (WM_CREATE)
iret = InitializeFont()
iret = InitializeChooseFont(hWnd)
hfont = CreateFontIndirect(lf)
iret = SendMessage(hwnd, WM_SETFONT, hfont,.true.)
! hwndEdit = CreateWindow("EDIT"C, " "C, IOR(WS_VISIBLE , &
! IOR(WS_CHILD ,IOR(WS_VSCROLL,IOR(ES_LEFT,IOR(WS_BORDER , &
!IOR(ES_Multiline,IOR(ES_NOHIDESEL,IOR(ES_Autovscroll, &
! WS_CLIPSIBLINGS)))))))),&
! 0,0, 0,0,hwnd, NULL, ghInstance, NULL)
!iret = SendMessage (hwndEdit, EM_LIMITTEXT, Buffer_Len , 0)
FrameWndProc=0
return



CASE (WM_close ) !here is where you intercept that message
iSt=MessageBox(hwnd,"The Document has changed, save current changes?"C,"Program CPF"C,ior(MB_ICONQUESTION,MB_YESNOCANCEL))
if(ist==idno) FrameWndProc=CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
if(ist==idyes) call savefile
FrameWndProc = 0
return

case (WM_CTLCOLOREDIT )
iret = SetTextColor (wParam, chf%rgbColors)
FrameWndProc=0
return

CASE (WM_COMMAND)

!Click on a menu or toolbar button
ID=IAND(wParam,#FFFF) !Button ID
!TODO add your own handlers here. See "Toolbars" section in SDK help
!for toolbar messages (TB_xxx)
SELECT CASE(ID)

! TENDON DATA MENU
case (1110) !tendon data dialog box


ghDlgModeless = CreateDialogParam(ghInstance,idd_TENDONDATA ,hWnd,&
LOC(TENDONDATADLGPROC), 0)
frameWndProc = 0
return

case (1102) !template dialog box
call TDPNDPARAM
IF(CANCLOPT==1) RETURN
IF(ITPND==0.OR.ITDATA==0.AND.(IRELAX==0.OR.IRELAX==1.OR.IRELAX==2)) then
call ADDstrt(control_name=0)
else
call startdlgproc
end if

ghDlgModeless = DialogBOXParam(ghInstance, idd_TEMPLATE,hWnd,&
LOC(TEMPLATEDLGPROC), 0)
!CALL TDcontrolparam(AINTERVAL)
timedependent(ainterval)%ibc=1
frameWndProc = 0
return

case (1115) ! font edit box
iret = ChooseFont( chf )
if (iret /= 0) then
iret = DeleteObject(hFont )
hFont = CreateFontIndirect(lf)
iret = SendMessage (hwndEdit, WM_SETFONT, hFont, .true.)
iret = GetClientRect (hWndEdit, rc)
iret = InvalidateRect (hWndEdit, rc, TRUE)
else
! check for error
call comdlger(ierror)
end if
frameWndProc = 0
return

case (IDc_combo1000)
if(hiWORD(wParam)==CBN_SELendok) then
iret = SendMessage(ghWndCombo1, CB_getCURSEL, 0,0 )
aunits=iret+1
call unitconv(aunits,5)
!iret = SendMessage(ghWndCombo1, CB_GETLBTEXT, iret,loc(ind) )
!iret = MessageBox (hWnd,ind,ind, MB_OK)
end if
frameWndProc = 0
return

case (IDC_COMBO1001)
if(hiWORD(wParam)==CBN_SELendok) then
iret = SendMessage(ghWndCombo2, CB_getCURSEL, 0,0 )
ainterval=iret+1

!iret = SendMessage(ghWndCombo2, CB_GETLBTEXT, iret,loc(ind) )
!iret = MessageBox (hWnd,ind,ind, MB_OK)
end if
frameWndProc = 0
return
CASE(ID_BUTTON40001)
!iSt=MessageBox(hFrame,"Button 1"C,"Toolbar"C,MB_OK)
call TDPNDPARAM
IF(CANCLOPT==1) RETURN
IF(ITPND==0.OR.ITDATA==0.AND.(IRELAX==0.OR.IRELAX==1.OR.IRELAX==2)) then
call ADDstrt(control_name=0)
else
call startdlgproc
end if

ghDlgModeless = DialogBOXParam(ghInstance, idd_TEMPLATE,hWnd,&
LOC(TEMPLATEDLGPROC), 0)
timedependent(ainterval)%ibc=1
frameWndProc = 0
return
!if (errorf .eq. .false.) then
!archivo=file_output
!call leer_archivo
!end if
CASE(ID_BUTTON40002)
call abrir
frameWndProc = 0
return
!CALL TDcontrolparam(AINTERVAL)

CASE(ID_BUTTON40003)
call savefile
return



CASE(ID_BUTTON40025)
call addmatdlgproc
return

CASE(ID_BUTTON40026)

return
!iSt=MessageBox(hFrame,"Button 4"C,"Toolbar"C,MB_OK)

CASE(ID_BUTTON40027)
!iSt=MessageBox(hFrame,"Button 4"C,"Toolbar"C,MB_OK)
ghDlgModeless = CreateDialogParam(ghInstance,idd_TENDONDATA ,hWnd,&
LOC(TENDONDATADLGPROC), 0)
frameWndProc = 0
return
CASE(ID_BUTTON40028)
!iSt=MessageBox(hFrame,"Button 4"C,"Toolbar"C,MB_OK)
call PUNTUALESdlgproc
return
CASE(ID_BUTTON40029)
!iSt=MessageBox(hFrame,"Button 4"C,"Toolbar"C,MB_OK)
call distloadsdlgproc
return
CASE(ID_BUTTON40030)
!iSt=MessageBox(hFrame,"Button 4"C,"Toolbar"C,MB_OK)
call NODALSdlgproc
return
CASE(ID_BUTTON40031)
iState=SendMessage(hToolbar,TB_GETSTATE,ID,0)
!call longnsec

ghDlgModeless = DialogBOXParam(ghInstance, idd_running,hWnd,&
LOC(running), 0)

!CALL CPF




END SELECT
FrameWndProc=CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)

CASE (WM_NOTIFY)
!Tooltips send a WM_NOTIFY message.
!lParam points to NMHDR structure. Its code member contains TTN_GETDISPINFO
pNMH = lParam
IF (NMH%code.EQ.TTN_NEEDTEXT) THEN
!NMTTDISPINFO DI contains NMHDR as the first member. So, we
!have to cast lParam to a pointer to DI.
pDI = lParam
DI%hInst = GetModuleHandle(0)
DI%lpszText = wParam
END IF
FrameWndProc = CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
CASE (WM_SIZE)
!QuickWin will try to move the MDI client area over the toolbar. We have to
!resize hMDI so that it comes below the toolbar.
iSt = GetClientRect(hwnd, mdiRect)
iSt = GetWindowRect(hToolbar, tbRect)
iSt = GetWindowRect(hstatus, tbRect1)
iSt = GetWindowRect(hwnd, mainRect)
!mover child window para que no borre la barra de herramientas
itbHeight = tbRect%Bottom-tbRect%Top
itbHeight1 = tbRect1%Bottom-tbRect1%Top
iSt = MoveWindow(hMDI, 0,itbHeight, mdiRect%Right, mdiRect%Bottom - itbHeight-itbHeight1, .true.)
!mover child window para que no borre la barra de estado
!iSt = MoveWindow(hMDI, 0,itbHeight, mdiRect%Right, mdiRect%Bottom - itbHeight, .true.)


! mover toolbar
iSt = MoveWindow(htoolbar, 0,mainrect%top+itbHeight, mainRect%Right,itbHeight, .TRUE.)

!mover statusbar
iSt = MoveWindow(hstatus, 0,mainrect%bottom-itbHeight1, mainRect%Right,itbHeight1, .TRUE.)
FrameWndProc = 0



!FrameWndProc = 0
!return
CASE DEFAULT
!Send all other messages further to normal processing
FrameWndProc=CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
END SELECT

END FUNCTION FrameWndProc

[kooka]

Quoting - jirina

I would like to be able to handle closing a console application after clicking on the close button X in the upper right corner of the corresponding window or after pressing Ctrl+C (or Ctrl+Break) on the keyboard.

If I use Ctrl+C, I get forrtl: error (200): program aborting due to window-CLOSE event. It would be fine to close the application without showing this message. If there was any chance to perform some operations before closing the window, it would be even better.

i made a mistake, i was searching for another post and didn't read well the title , this code dosn't work for you. sorry

[Jugoslav_Dujic]

Quoting - jirina

I tried both and decided to use SetConsoleCtrlHandler (even though it is not Fortran only anymore - I am using a dll created by VS C++),.

Huh? You can call SetConsoleCtrlHandler from Intel Fortran:

use IFWIN

interface

  integer function MyHandler(nType)

  !DEC$ATTRIBUTES STDCALL:: MyHandler

  integer:: nType

  end function MyHandler

end interface

iret = SetConsoleCtrlHandler(MyHandler,1)

...

integer function MyHandler(nType)

!DEC$ATTRIBUTES STDCALL:: MyHandler

integer:: nType

...
end function MyHandler

Of course, you can just declare MyHandler in a module and avoid the interface block -- the key thing is the STDCALL attribute.