Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
29271 ディスカッション

QuickWin and Windows API

NotThatItMatters
ビギナー
3,647件の閲覧回数

I have created a Fortran app with QuickWin which makes use of a few user32 Windows API calls.  Why?  The app needs to build a dynamic menu structure where menu items come and go according to the whims of a governing input file.  The app also needs to properly post-process in case the user pushes the red X in the upper right-hand corner of the window.  Anyway, I had thought I would be able to handle these things strictly with QuickWin but have not been able.

The problem I am having with the app is that if any of the menus are active upon program termination, the application hangs as if in an infinite loop.  I am using a few calls to user32.  The final call is to the following skeletal routine which evidently does not work.

[fortran]

SUBROUTINE DESTROY_WINDOW()

INTEGER (KIND = 4) ITEMID

INTEGER (KIND = LRESULT) RESULT

ITEMID = SETACTIVEQQ(0_4)

WIN_HANDLE = GETHWNDQQ(QWIN$FRAMEWINDOW)

IF (WIN_HANDLE /= -1_HANDLE) THEN

IF (GETEXITQQ() == QWIN$EXITNOPERSIST) THEN

RESULT = SendMessage(WIN_HANDLE, WM_DESTROY, 0_fWPARAM, 0_fLPARAM)

END IF

END IF

END SUBROUTINE DESTROY_WINDOW

[/fortran]

0 件の賞賛
33 返答(返信)
jimdempseyatthecove
名誉コントリビューター III
1,063件の閲覧回数

FWIW I use the following:

[fortran]
! some place in main thread, may occur periodically (as user has option to kill dialog without killing app)
if(.not. ControlPannelRunning) then
  ! before  creating the dialog box insert values that may be examined/modified
  ! by the dialog box
  vIntegrationStepsize = DLHOST
  IntegrationStepsize = DLHOST
  ! Create seperate thread to run the Modal Dialog control pannel
  ControlPanelHandle = CreateThread(&
   & NULL, &
    & ControlPanelStack, &
    & loc(ControlPanel), &
    & loc(ControlPanelArg), &
    & ControlPanelFlags, &
    & loc(ControlPanelThread_ID))
  ! Check for CreateThread error here (if so inclined)
  !...
  ! Wait until flag set by control pannel thread
  ! indicates initialization complete
  do while(.not. ControlPannelRunning)
    milliseconds = 500
    call sleepqq(milliseconds)
  end do
  ! indicate for my thread that additional work needs to be done
  INIT_AVFRT_AllocateMemory = .false.
  AVFRT_Running = .true.
  ! My code has a Pause/Continue button, as well as
  ! if Pause was set as default startup, then wait for Continue or
  do while ((ControlPanelPause .eq. .true.) .and. (ControlPanelExit .eq. .false.))
    milliseconds = 500
    call sleepqq(milliseconds)
    call    Update_AVFRT('INIT_AVFRT') ! while in Pause allow for manipulation of 3D graphics
  end do
endif
! end of code in main thread (or subroutine periodically called from main)

{seperate source}

integer(4) FUNCTION ControlPanel(arg)
!DEC$ ATTRIBUTES STDCALL, ALIAS:"_controlpanel" :: ControlPanel
    USE IFLOGM
    use   GlobalData
    implicit none
    INCLUDE 'RESOURCE.FD'
    integer(4),POINTER :: arg
    integer(4) returnVal, ns
    CHARACTER(256) text
    LOGICAL retlog
    external ControlPanelCallBack
    retlog = DLGINIT( IDD_DIALOG1, ControlPanelDlg )
    if(.not. retlog) write(*,*) "Dialog error for IDD_DIALOG1"
    call DlgSetTitle( ControlPanelDlg, ControlPanelTitle )
...
    ControlPannelRunning = .true.
    returnVal = DlgModal( ControlPanelDlg ) ! Doesn't return unless cancled (or IDC_event not specified)
    ControlPanelExit = .TRUE.
    ControlPanelPause = .FALSE.
    ControlPanel = returnVal
end FUNCTION ControlPanel


SUBROUTINE ControlPanelCallBack( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: ControlPanelCallBack
  USE IFLOGM
    use GlobalData
    implicit none
    INCLUDE 'RESOURCE.FD'
  TYPE (dialog) dlg
  INTEGER id, callbacktype, iStat
  CHARACTER(256), automatic :: text
  LOGICAL retlog
  INTEGER cel, far, retint
  real(8), automatic :: xyz(3)
  text = 'undefined'
  ControlPanelPauseRefresh = .true.
  NextDisplayTime = 0 ! update now

  SELECT CASE (id)
    CASE (IDC_RADIO1)
    ! Radio button 1 selected by user so
    ! change display accordingly
      vIavDisplayFrame = 0   ! vIavDisplayFrame = 0 Inertial Frame
      ! vIavDisplayFrame = 1 Orbital Frame
    CASE (IDC_RADIO2)
...
  END SELECT
END SUBROUTINE ControlPanelCallBack
[/fortran]

This uses a seperate thread running a Modal Dialog (not modeless).

Jim Dempseyt

jimdempseyatthecove
名誉コントリビューター III
1,063件の閲覧回数

I should add. The main app is a console application (compute intensive parallel OpenMP), using a seperate thread to run a Modal Dialog Box. The application also uses "CALL avNewViewer(viewerID)" zero, one, or multiple times to create zero, one or more Intel Array Visualizer processes connected to the applicaiton. IOW I can have multiple display processes running concurrently with the computation process showing different aspects of the simulation. e.g. multiple 3D views from different perspectives, and/or 2D charts.

Jim Dempsey

andrew_4619
名誉コントリビューター III
1,063件の閲覧回数

Steve Lionel (Intel) wrote:

Something has to handle the messages for the modeless window - perhaps QuickWin does that automatically.

Yes is must do that or more specifically windows will, the quickwin routines are afterall just a wrapper for standard windows api functionality.  You can capture the for the modeless dialog by having a callback subroutine to to dialog name itself which will be called with the callback type set to DLG_DESTROY when the x is hit or DLG_INIT when the doalog it is first displayed after dlgmodeless is called.

I normal check something like:

if(mydlg%DLGID.ne.0 .and. mydlg%HWND.ne.0 ) return ! dlg is already initialised AND active

before calling dlgmodeless so I don't end up with 2 instances on the screen

andrew_4619
名誉コントリビューター III
1,063件の閲覧回数

why do my posts disappear and then appear an hour or three later? No message about being 'moderated' was given?

dboggs
新規コントリビューター I
1,063件の閲覧回数

Well I stand corrected--I guess. I'm sure the older documentation I was familiar with stated that modeless dialog boxes could not be used with Quickwin, but the current documentation only IMPLIES that it cannot. Or at least that is what I infer. It says that modeless boxes are "typically used in a Windows application" while "modal boxes can be used in any application," and when you look up DLGMODELESS in the A-Z reference, under Compatibility, it lists "Windows Console DLL Lib" but Quickwin is conspiculously absent.

But if it works, it works.

NotThatItMatters
ビギナー
1,063件の閲覧回数

This is a little something along the lines of "and now, for something completely different..."  I have been reading Using Intel Visual Fortran to Create and Build Windows-Based Applications and have noted most dialog-based code has the following stuff at the top of the code:

[fortran]USE IFLOGM

IMPLICIT NONE

INCLUDE 'RESOURCE.FD'[/fortran]

My project for not quite obvious reasons has a "resource.h" file which looks like a C include file.  It also includes a version.h file for executable versioning.  I am noting the symbols I need are within this file but apparently not readily available to the Fortran code.  Any hints as to how I might get these symbols or perhaps reconfigure the code?

andrew_4619
名誉コントリビューター III
1,063件の閲覧回数

There is a tool deftofd to convert, it can be run from in VS but I use from a script..

"C:\Program Files (x86)\Intel\Composer XE 2011 SP1\bin\ia32\deftofd.exe" resource.h >resource.fd

Steven_L_Intel1
従業員
1,063件の閲覧回数

There's instructions for setting up deftofd in Using Intel®Visual Fortran to Create andBuild Windows*-Based Applications - search for deftofd.

NotThatItMatters
ビギナー
1,063件の閲覧回数

Now that this small problem is settled, I am having another small problem that I cannot resolve.  The compiler is complaining:

error #6423: This name has already been used as an external function name.

Most compiler errors are self-explanatory.  This one has me stumped.  Any ideas?

andrew_4619
名誉コントリビューター III
1,063件の閲覧回数

what is the name it objects to? The is something that is  declared twice.

NotThatItMatters
ビギナー
1,063件の閲覧回数

Actually, removing the error was simple.  Let me show how it arose:

[fortran]CHARACTER (LEN = 8) FUNCTION WHATEVER(IW)

...

! Reference to function was as follows:

A = WHATEVER(I)(1:5)

! The substring yielded the error.  Without it, it compiles fine.[/fortran]

Steven_L_Intel1
従業員
1,063件の閲覧回数
You can't substring a function call. But in this context WHATEVER is the result value, which is a scalar, so the (I) is incorrect and made it look like a functiion call. If you want it to be a function call, you have to declare the function RECURSIVE and use the RESULT clause to give the result a different name. But you still can't substring a function result.
NotThatItMatters
ビギナー
1,063件の閲覧回数

Getting back to the problem at hand, I would like to launch a QuickWin SDI which has at its core a few menus and a client area which, if right-clicked, will launch a modeless dialog box.  The dialog box will have a drop-down list of choices and the customary OK and Cancel buttons.  I would like the dialog to disappear if (1) the user presses cancel, (2) the user presses the closing X (just like cancel), (3) the user presses OK which then grabs the user's choice from the drop-down list, and (4) the original QuickWin app quits.  Most of the first three would seem to follow with an appropriately formed [fortran]IRESULT = REGISTERMOUSEEVENT(IUNIT, MOUSE$RBUTTONDOWN, MouseLaunch)[/fortran].  The MouseLaunch routine would initialize the dialog and its contents.  The question then is where the message pump goes.  Is it part of MouseLaunch?  Should I be worried about the underlying QuickWin app quitting with the modeless dialog active?

返信