fcode 发表于 2015-11-19 19:19
涉及修改部分，用 !//*** 标出

[mw_shl_code=fortran,true]SUBROUTINE INPSEC(DLG,ID,CALLBACKTYPE)   !// ...

谢谢大神，非常感谢

涉及修改部分，用 !//*** 标出

[Fortran] 纯文本查看 复制代码

MODULE CONTROLS 
  INTEGER,PARAMETER:: IDD_DHK    = 102  !//对话框ID
  INTEGER,PARAMETER:: IDB_BITMAP1= 105 
  INTEGER,PARAMETER:: IDC_INPDIR = 1000 !//编辑对话框ID，用以显示“文件路径”
  INTEGER,PARAMETER:: IDC_INPSEC = 1001 !//“浏览灬”按钮对应的ID
END MODULE CONTROLS

PROGRAM MAIN         !//主程序
  USE IFQWIN
  IMPLICIT NONE
  INTEGER(KIND=4)::RESULTS
  TYPE(QWINFO)::WINFO     
  WINFO%TYPE=QWIN$MAX     
  RESULTS=SETWSIZEQQ(0,WINFO) 
  RESULTS=SETEXITQQ(QWIN$EXITPERSIST)
  DO WHILE(.TRUE.)
  ENDDO
END PROGRAM MAIN

LOGICAL(4)FUNCTION INITIALSETTINGS() !//初始化主窗口
  USE IFQWIN
  IMPLICIT NONE
  INTEGER(KIND=4)::RESULTS
  LOGICAL(KIND=4)::RES
  TYPE(QWINFO)::WINFO
  EXTERNAL::SHOW_DHK

  WINFO%W=1200
  WINFO%H=800
  WINFO%TYPE=QWIN$SET
  RESULTS=SETWSIZEQQ(QWIN$FRAMEWINDOW,WINFO)

  RES=APPENDMENUQQ(1,$MENUENABLED,'文件'C,NUL)
  RES=APPENDMENUQQ(2,$MENUENABLED,'数据...'C,SHOW_DHK) !//点击主窗口“数据...”后，显示如图所示对话框

  INITIALSETTINGS=.TRUE.
  RETURN
END FUNCTION INITIALSETTINGS

SUBROUTINE SHOW_DHK
  USE IFQWIN
  USE IFLOGM
  USE CONTROLS
  IMPLICIT NONE
  INTEGER(KIND=4)::RESULTS
  LOGICAL(KIND=4)::RETLOG
  TYPE(DIALOG)::DATADLG 
  EXTERNAL::XZWJ,INPSEC

  RETLOG=DLGINIT(IDD_DHK,DATADLG)
  RETLOG=DLGSETSUB(DATADLG,IDC_INPSEC,INPSEC)  !//点击对话框“浏览灬”按钮后，执行子程序INPSEC
  RESULTS=DLGMODAL(DATADLG)  
  CALL DLGUNINIT(DATADLG)
END SUBROUTINE SHOW_DHK

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!该子程序未能实现预期功能，请大神们指点!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE INPSEC(DLG,ID,CALLBACKTYPE)   !//该子程序的目的是将子程序“XZWJ”中获得的文件路径写入到编辑对话框中
  USE IFQWIN
  USE IFLOGM
  USE CONTROLS
  IMPLICIT NONE
  TYPE(DIALOG)::DLG
  LOGICAL*4 RESULTS
  INTEGER(KIND=4)::ID,CALLBACKTYPE
  INTEGER :: WDIR
  CHARACTER(LEN=50)::STR,STR1     
  CALL XZWJ(WDIR)                   !//执行子程序“XZWJ”获取文件路径WDIR 
  STR1=WDIR                         !//获取到的文件路径WDIR赋值给STR1
  RESULTS=DlgSet(dlg,IDC_INPDIR,STR)!//改变编辑对话框中的内容
  WRITE(STR,*)STR1                  !//在编辑对话框中显示路径
END SUBROUTINE INPSEC

SUBROUTINE XZWJ(WDIR)   !该子程序来源于fcode大神“楚香饭”，在此谢过
  USE IFQWIN
  IMPLICIT NONE
  INTEGER :: WDIR
  CHARACTER(LEN=50)::STR
  CHARACTER( LEN = 512 ) :: C
  WDIR = SELECTFILE( C )
  STR=TRIM(C)   
  IF ( WDIR /=0 ) WRITE(*,*) "已选择文件:" , STR
CONTAINS

  INTEGER FUNCTION SELECTFILE( C )  !// 弹出选择文件对话框，等待用户选择输入文件

    USE COMDLG32
    USE USER32
    USE KERNEL32

    IMPLICIT NONE
    CHARACTER( LEN = * ) :: C
    TYPE(T_OPENFILENAME) :: OFN !// 定义打开文件对话框派生类型
    CHARACTER(LEN=*),PARAMETER:: FILTER_SPEC = "ASCII文件 (*.txt)\0*.txt\0所有文件 (*.*)\0*.*\0"C !// 打开文件对话框 文件过滤器
    CHARACTER(LEN=512) :: FILE_SPEC = ""C
    CHARACTER( LEN = MAX_PATH )::FILEFILTER
    INTEGER :: ILEN
    FILEFILTER = "ALL FILES (*.*)\0*.*\0\0"C  
    OFN.LSTRUCTSIZE = SIZEOF(OFN)
    OFN.HWNDOWNER = GETFOREGROUNDWINDOW()
    OFN.HINSTANCE = NULL
    OFN.LPSTRFILTER = LOC(FILEFILTER) !LOC(FILTER_SPEC) !// 指定文件过滤器
    OFN.LPSTRCUSTOMFILTER = NULL
    OFN.NMAXCUSTFILTER = 1
    OFN.NFILTERINDEX = 1 !// 指定初始的 文件过滤器 序号
    OFN.LPSTRFILE = LOC(FILE_SPEC)
    OFN.NMAXFILE = SIZEOF(FILE_SPEC)
    OFN.NMAXFILETITLE = 0
    OFN.LPSTRINITIALDIR = NULL
    OFN.LPSTRTITLE = LOC('请选择一个文件'//""C) !// 指定打开文件对话框的标题
    OFN.FLAGS = OFN_FILEMUSTEXIST
    OFN.LPSTRDEFEXT = LOC("TXT"C)
    OFN.LPFNHOOK = NULL
    OFN.LPTEMPLATENAME = NULL
    SELECTFILE = GETOPENFILENAME( OFN )
    IF ( SELECTFILE == 0) THEN
      RETURN
    ELSE
      ILEN = INDEX( FILE_SPEC , CHAR(0) )
      C = FILE_SPEC( 1 : ILEN - 1 )
    END IF
  END FUNCTION SELECTFILE

END SUBROUTINE XZWJ