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
对话框.png (24.84 KB, 下载次数: 227)
对话框
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(STR) !//***传入字符串STR
!STR1=WDIR !//***此句不要
RESULTS=DlgSet(dlg,IDC_INPDIR,STR)!//改变编辑对话框中的内容
!WRITE(STR,*)STR1 !//***此句不要
END SUBROUTINE INPSEC
SUBROUTINE XZWJ(STR) !//***传入字符串STR
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
fcode 发表于 2015-11-19 19:19
涉及修改部分,用 !//*** 标出
[mw_shl_code=fortran,true]SUBROUTINE INPSEC(DLG,ID,CALLBACKTYPE) !// ...
欢迎光临 Fortran Coder (http://bbs.fcode.cn/) | Powered by Discuz! X3.2 |