EXIT via program or X on title bar

EXIT via program or X on title bar

In my QuickWin application I have a callback routine used when the user selects File > Exit. I use this to remind the user to save files if needed. Works just fine.

However when the user clicks on the Title Bar X, or shuts down the computer my routine is bypassed!
My callback routine is called "progexit". Is there something else I could call it to have it called when exiting as above?

8 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.

Yes, but you will need to bring in some non-Quickwin stuff, I believe. There is an example program under samples/quickwin/menudriv that I used as a starting point for what I needed.

David Jones

You'll have to subclass frame window and intercept WM_CLOSE. POKER sample illustrates subclassing technique.

I have the same problem, where/what is the POKER sample ?

In Intel Fortran 10.1, it is in C:Program FilesIntelCompilerFortran10.1.xxxsamplesQuickWinPoker

Retired 12/31/2016

I have version 10.0.025, and can not find this example, where can I get this ?

That sample is not in 10.0. It was added in 10.1 (it had been in CVF, but had bugs that I finally worked out.)

Retired 12/31/2016

Quoting - pmichael
In my QuickWin application I have a callback routine used when the user selects File > Exit. I use this to remind the user to save files if needed. Works just fine.

However when the user clicks on the Title Bar X, or shuts down the computer my routine is bypassed!
My callback routine is called "progexit". Is there something else I could call it to have it called when exiting as above?

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

Leave a Comment

Please sign in to add a comment. Not a member? Join today