! ! Subroutine: SAVEGrid ! ! subroutine SaveGrid !*************************************************************************** !* * !* THIS SUBROUTINE CREATES A DIALOG BOX THAT ALLOWS THE USER TO save THE * !* CHAOS DATA FILE. THIS ROUTINE USES THE SYSTEM COMMON DIALOG ACCESSES * !* THROUGH THE WINDOWS API'S * !* * !*************************************************************************** use dflib use dfwin use dflogm use Global implicit none TYPE (T_OPENFILENAME) iofn logical(4) bRet, checked, iRet integer(4) ierror integer(4) iUnit integer(4) dot_place, last_letter_place, last_place, j_look character(1) c1 character(4) c4 character(60) dlgtitle character(81) string character(26*7) allfilters type (dialog) dlg include 'resource.fd' ! ! update status bar ! call setstatusbar(0, 'SaveGrid'C) call setstatusbar(1,' 'C) !-------------------Invite user to update the title line of this grid-------------------------------- bRet = DlgInit(IDD_RETITLE_FEG,dlg) write(string,'(A80)') TRIM(old_FEG_title_line) string = ADJUSTL(string) ! NOT clear why this is necessary, but it is! Otherwise, title will be centered! bRet = DlgSet(dlg,IDC_Old_Title_text, TRIM(string) // CHAR(0)) write(string,'(A80)') TRIM(new_FEG_title_line) string = ADJUSTL(string) ! NOT clear why this is necessary, but it is! Otherwise, title will be centered! bRet = DlgSet(dlg,IDC_New_Title_text,TRIM(string) // CHAR(0)) iRet = DlgModal(dlg) if (iRet == IDOK) then bRet = DlgGetChar(dlg,IDC_New_Title_text, string) CALL Repair_String(string) new_FEG_title_line = TRIM(string) elseif (iRet == IDCANCEL) then ! (no change is made to the new FEG title line) end if call DlgUninit(dlg) !------------------ begin file-saving section (using Windows tools) --------------------------------- ! !* SET UP FILE SEARCH FILTER ALLFILTERS = 'Finite Element Grid files (*.feg)' // char(0) // '*.FEG' // char(0) // char(0) ! Dialogue Title DLGTITLE = 'Save Grid File'C !* SET UP STRUCTURE USED BY COMMON DIALOGS - SEE WIN32 API HELP FOR EXPLANATION !iofn%LSTRUCTSIZE = (BIT_SIZE(iofn%LSTRUCTSIZE) + & ! BIT_SIZE(iofn%HWNDOWNER) + & ! BIT_SIZE(iofn%HINSTANCE) + & ! BIT_SIZE(iofn%LPSTRFILTER) + & ! BIT_SIZE(iofn%LPSTRCUSTOMFILTER) + & ! BIT_SIZE(iofn%NMAXCUSTFILTER) + & ! BIT_SIZE(iofn%NFILTERINDEX) + & ! BIT_SIZE(iofn%LPSTRFILE) + & ! BIT_SIZE(iofn%NMAXFILE) + & ! BIT_SIZE(iofn%LPSTRFILETITLE) + & ! BIT_SIZE(iofn%NMAXFILETITLE) + & ! BIT_SIZE(iofn%LPSTRINITIALDIR) + & ! BIT_SIZE(iofn%LPSTRTITLE) + & ! BIT_SIZE(iofn%FLAGS) + & ! BIT_SIZE(iofn%NFILEOFFSET) + & ! BIT_SIZE(iofn%NFILEEXTENSION) + & ! BIT_SIZE(iofn%LPSTRDEFEXT) + & ! BIT_SIZE(iofn%LCUSTDATA) + & ! BIT_SIZE(iofn%LPFNHOOK) + & ! BIT_SIZE(iofn%LPTEMPLATENAME))/8 !N.B. When converting this program to the x64 platform, the above code stopped working; ! I found a hint on the web, and replaced it with: iofn%LSTRUCTSIZE = SizeOf(iofn) iofn%HWNDOWNER = NULL iofn%HINSTANCE = NULL iofn%LPSTRFILTER = LOC(ALLFILTERS) iofn%LPSTRCUSTOMFILTER = NULL iofn%NMAXCUSTFILTER = NULL iofn%NFILTERINDEX = 1 ! convert feg_sav back to C convention (null-terminated): feg_sav = TRIM(feg_sav) // CHAR(0) iofn%LPSTRFILE = LOC(FEG_SAV) iofn%NMAXFILE = LEN(FEG_SAV) iofn%LPSTRFILETITLE = NULL iofn%NMAXFILETITLE = NULL iofn%LPSTRINITIALDIR = NULL iofn%LPSTRTITLE = LOC(DLGTITLE) iofn%FLAGS = NULL iofn%NFILEOFFSET = NULL iofn%NFILEEXTENSION = NULL iofn%LPSTRDEFEXT = NULL iofn%LCUSTDATA = NULL iofn%LPFNHOOK = NULL iofn%LPTEMPLATENAME = NULL IF (GRIDLOADED) THEN !* CREATE & RUN DIALOG iRet = GETSAVEFILENAME(iofn) ! Note main side-effect: character-string feg_sav has new value, ! but this value is according to C conventions! CALL Repair_String(feg_sav) CALL COMDLGER(ierror) !* SAVE FILE IF THE "OK" BUTTON HAS BEEN PRESSED IF(iRet .AND. (ierror == 0))THEN ! ! correct output file name "feg_sav" if suffix ".feg" is missing last_letter_place = LEN_TRIM(feg_sav) ! which should work, after CALL Repair_String dot_place = MAX(1, last_letter_place - 3) c4 = feg_sav(dot_place:last_letter_place) if (.NOT.((c4 == ".feg").OR.(c4 == ".FEG"))) then feg_sav = feg_sav(1:last_letter_place) // ".feg" end if ! CALL Output_Grid CALL AutoSave('BACKUP.FEG') editingcounter = 0 ! modify window title iUnit = getactiveqq() iRet = SetWindowText(GetHwndQQ(iUnit), TRIM(feg_sav) // CHAR(0)) END IF ELSE CALL ERROR4 END IF ! update statusbar infor. call setstatusbar(0,'Ready'C) call setstatusbar(1,' 'C) RETURN END SUBROUTINE SaveGrid