!Windows initialization osd0a.f90 !*************************************************************************** ! Subroutines and functions defined in this file: ! ! WinMain( hInstance, hPrevInstance, lpCmdLine, nCmdShow ) ! InitApplication() ! InitInstance() ! function MainWndProc( hWnd, message, wParam, lParam ) ! ProcessCDError( dwErrorCode, hWnd) ! !*************************************************************************** !**************************************************************************** ! ! FUNCTION: WinMain(HANDLE, HANDLE, LPSTR, int) ! ! PURPOSE: calls initialization function, processes message loop ! ! COMMENTS: used by scrnsave.lib ! ! LAST MODIFICATIONS: E.G. 03/03/1997 ! LAST MODIFICATIONS: I.P. 10/02/1998 !**************************************************************************** integer function WinMain( hInstance, hPrevInstance, lpCmdLine, nCmdShow ) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain use win_intr include 'osd.fd' interface integer*4 function InitApplication() end function InitApplication end interface interface integer*4 function InitInstance() end function InitInstance end interface interface integer function CreateTheToolbar(hWndParent) integer hWndParent end function end interface !------------local variables integer hInstance, hPrevInstance, nCmdShow, lpCmdLine integer*4 ret logical(4) bret integer(handle):: ghwndmain1 ! 14-03-2026 type (T_MSG) mesg !-----------end local call OpticsoftInit() !calls OPTICSOFT-II initialization LastInfoSelected=0 !print initialization (Manu) hInstance=hInstance !to avoid warning of unused symbol hPrevInstance=hPrevInstance lpCmdLine=lpCmdLine nCmdShow=nCmdShow !Tools: hfontTools = 0 dyTools = 0 cntToolCtrls = 0 xCurrent =10 hbrBtnFace = 0 hbrWindow = 0 cntStatusField = 0 hwndStatus = 0 !For the menu file option: szDirName = ""C szFile = "\0"C szFilter = "Text Files (*.TXT)\0*.TXT\0All Files (*.*)\0*.*\0"C szFindString = ""C szReplaceString = ""C ghModule=GetModuleHandle(NULL) !from mdi example hInst=ghModule !from manu because of files if (hPrevInstance .eq. 0) then ! Other instances of app running? if (InitApplication() == 0) then ! Initialize shared things ! iret=MessageBox(ghwndMain,"InitApplication failure!"C,"Error"C,MB_OK) iret=MessageBox(ghwndMain1,"InitApplication failure!"C,"Error"C,MB_OK) WinMain = 0 return ! Exits if unable to initialize end if else end if ! Perform initializations that apply to a specific instance if (InitInstance() == 0) then WinMain = 0 return end if !bret=ShowWindow(ghwndmain,nCmdShow) ! Acquire and dispatch messages until a WM_QUIT message is received. do while (GetMessage(mesg,& ! message structure NULL,& ! handle of window receiving the message 0,& ! lowest message to examine 0)) ! highest message to examine bret = TranslateMessage(mesg) ! Translates virtual key codes ret = DispatchMessage(mesg) ! Dispatches message to window end do WinMain=1 return end ! integer function WinMain !**************************************************************************** ! ! FUNCTION: InitApplication ! ! PURPOSE: Initializes window data and registers window class ! ! COMMENTS: ! ! In this function, we initialize a window class by filling out a data ! structure of type WNDCLASS and calling the Windows RegisterClass() ! function. ! ! LAST MODIFICATIONS: E.G. 03/03/1997 ! LAST MODIFICATIONS: I.P. 10/02/1998 !**************************************************************************** integer*4 function InitApplication() ! current instance use win_intr interface integer*4 function MainWndProc( hWnd, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16':: MainWndProc integer*4 hWnd , message , wParam, lParam end function MainWndProc end interface interface integer(4) function MDIWndProc (hwnd, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_MDIWndProc@16' :: MDIWndProc integer*4 hWnd , message , wParam, lParam end function MDIWndProc end interface interface integer(4) function TextWndProc (hwnd, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_TextWndProc@16' :: TextWndProc integer*4 hWnd , message , wParam, lParam end function TextWndProc end interface interface INTEGER FUNCTION StatusProc (hwnd, msg,wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_StatusProc@16' ::StatusProc integer hwnd integer msg integer wParam integer lParam end function StatusProc end interface interface INTEGER FUNCTION StatusFieldProc (hwnd, msg, wParam,lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_StatusFieldProc@16' ::StatusFieldProc integer hwnd integer msg integer wParam integer lParam end function StatusFieldProc end interface interface INTEGER FUNCTION ToolsProc (hwnd,msg,wParam,lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_ToolsProc@16' :: ToolsProc integer hwnd integer msg integer wParam integer lParam end function ToolsProc end interface !-----------------Local variables type (T_WNDCLASS) wc !-----------------end local ! Fill in window class structure with parameters that describe the ! main window. !1---------- Main window wc%style = CS_OWNDC ! Class style(s). !old =0 wc%lpfnWndProc = LOC(MainWndProc) ! Function to retrieve messages for ! windows of this class. wc%cbClsExtra = 0 ! No per-class extra data. wc%cbWndExtra = 4 ! No per-window extra data. !old=0 wc%hInstance = ghModule ! Application that owns the class. !wc%hIcon = LoadIcon(NULL, IDI_APPLICATION) wc%hCursor = LoadCursor(NULL, IDC_ARROW) wc%hbrBackground = GetStockObject(WHITE_BRUSH) ! color of the child window lpszClassName = "OsdapClass"C ! old= "CmnDlgWClass" lpszMenuName = "CmnDlgMenu"C wc%lpszMenuName = LOC(lpszMenuName) ! Name of menu resource in .RC file. wc%lpszClassName = LOC(lpszClassName) ! Name used in call to CreateWindow. ! wc%lpszText = LOC(lpszText) ! Name used in call to CreateStatusWindow. !Manu ! Register the window class and return success/failure code. if (RegisterClass(wc) == 0) then InitApplication=0 return end if !2------------Child window wc%style = CS_OWNDC !IOR(CS_OWNDC) !IOR(CS_HREDRAW ,CS_VREDRAW)) !CS_SAVEBITS) !, IOR(CS_HREDRAW ,CS_SAVEBITS )) ! wc%lpfnWndProc = LOC(MDIWndProc) ! wc%hIcon = LoadIcon(NULL, IDI_APPLICATION) wc%lpszMenuName = NULL lpszClassName = "MDIClass"C !"OsdapClass"C wc%lpszClassName = LOC(lpszClassName) if (RegisterClass(wc) == 0) then InitApplication=0 return end if !3----------------Text window wc%style = IOR(CS_OWNDC , IOR(CS_HREDRAW , CS_VREDRAW)) wc%lpfnWndProc = LOC(TextWndProc) wc%hIcon = NULL wc%hCursor = LoadCursor(NULL, IDC_ARROW) wc%hbrBackground = (COLOR_BTNSHADOW) wc%lpszMenuName = NULL lpszClassName = "Text"C wc%lpszClassName = LOC(lpszClassName) if (RegisterClass(wc) == 0) then InitApplication =0 return end if !4----------------Tool bar hbrBtnFace = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) ! hbrWindow = CreateSolidBrush(GetSysColor(COLOR_WINDOW)) lpszClassName = "SamplerTools"C ! wc%style = IOR(CS_OWNDC , IOR(CS_HREDRAW , CS_VREDRAW)) wc%style = IOR(CS_HREDRAW,CS_VREDRAW) wc%lpfnWndProc = LOC(ToolsProc) wc%cbClsExtra = 0 wc%cbWndExtra = 0 ! wc%hInstance = hInstance !already defined wc%hIcon = NULL wc%hbrBackground= hbrBtnFace wc%hCursor = LoadCursor (NULL, IDC_ARROW) wc%lpszMenuName = NULL wc%lpszClassName= LOC(lpszClassName) if (RegisterClass(wc) == 0) then InitApplication =0 return end if !5 -----------------------Status bar hbrBtnFace = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) lpszClassName ="SamplerStatus"C !wc.style = CS_OWNDC ! IOR(CS_HREDRAW, CS_VREDRAW) wc%style = IOR(CS_HREDRAW , CS_VREDRAW) wc%lpfnWndProc = LOC(StatusProc) wc%cbClsExtra = 0 wc%cbWndExtra = 0 !wc.hInstance = hInstance wc%hIcon = NULL wc%hCursor = LoadCursor (NULL, IDC_ARROW) wc%hbrBackground = hbrBtnFace !(COLOR_BTNFACE) ! wc%hbrBackground = (COLOR_BTNSHADOW) wc%lpszMenuName = NULL wc%lpszClassName = LOC(lpszClassName) if (RegisterClass(wc) == 0) then InitApplication =0 !InitializeApp = 0 return end if hbrBtnFace = CreateSolidBrush(GetSysColor(COLOR_BTNFACE)) lpszClassName = "StatusField"C ! wc.style = CS_OWNDC !IOR(CS_HREDRAW , CS_VREDRAW) wc%style = IOR(CS_HREDRAW , CS_VREDRAW) wc%lpfnWndProc = LOC(StatusFieldProc) ! wndclass.cbClsExtra = 0 ! wndclass.cbWndExtra = 0 ! wndclass.hInstance = hInstance wc%hIcon = NULL wc%hCursor = LoadCursor (NULL, IDC_ARROW) ! wc%hbrBackground = (COLOR_BTNSHADOW) wc%hbrBackground = hbrBtnFace wc%lpszMenuName = NULL wc%lpszClassName = LOC(lpszClassName) if (RegisterClass(wc) == 0) then InitApplication =0 return end if InitApplication=1 end ! integer*4 function InitApplication !**************************************************************************** ! ! FUNCTION: InitInstance ! ! PURPOSE: Saves instance handle and creates main window ! ! COMMENTS: ! ! In this function, we save the instance handle in a static variable and ! create and display the main program window. ! ! LAST MODIFICATIONS: E.G. 03/03/1997 ! LAST MODIFICATIONS: I.P. 10/02/1998 !**************************************************************************** integer*4 function InitInstance() use win_intr include 'osd.fd' interface integer(4) function MDIWndProc (hwnd, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_MDIWndProc@16' :: MDIWndProc integer*4 hwnd, message, wParam ,lParam end function MDIWndProc end interface interface integer(4) function TextWndProc (hwnd, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_TextWndProc@16' :: TextWndProc integer*4 hwnd ,message ,wParam ,lParam end function TextWndProc end interface interface LOGICAL FUNCTION CreateToolBar (hwnd,hInstance,iId) integer hwnd integer hInstance integer iId ! integer(HANDLE):: hwnd ! 01-04-2026 ! integer(HANDLE):: hInstance ! integer(HANDLE):: iId ! integer*4 hwnd ! integer*4 hInstance ! integer*4 iId end function end interface interface LOGICAL FUNCTION CreateStatusBar (hwnd,iId) integer hwnd integer iId end function CreateStatusBar end interface interface INTEGER FUNCTION AddStatusField (hInst,iId,iMin,iMax,bNewGroup) integer hInst integer iId integer iMin integer iMax logical bNewGroup end function AddStatusField end interface interface INTEGER FUNCTION AddToolLabel(hInst,iId,szLabel,iWidth,dwStyle) integer hInst integer iId !INTEGER FUNCTION AddToolLabel(hInst1,iId,szLabel,iWidth,dwStyle) !integer(handle):: hInst1 !integer(handle):: iId !integer hInst1 !integer iId character*(*) szLabel integer iWidth integer dwStyle end function end interface interface LOGICAL FUNCTION AddToolSpace (iWidth,iHeight) integer iWidth integer iHeight end function end interface interface INTEGER FUNCTION AddToolCombo (hInst,iId,iWidth,dwStyle) integer hInst integer iId !INTEGER FUNCTION AddToolCombo (hInst1,iId,iWidth,dwStyle) !integer(handle):: hInst1 !integer(HANDLE):: iId integer iWidth integer dwStyle end function end interface interface INTEGER FUNCTION AddToolButton (hInst,iId,szLabel,iWidth,iHeight,dwStyle) integer hInst integer iId character*(*) szLabel integer iWidth integer iHeight integer dwStyle end function end interface !----------------local variables integer*4 ret logical bret !type (T_CLIENTCREATESTRUCT) clientcreate type (T_RECT) rect logical AdjustStatusBar logical AdjustToolBar integer StatusBarHeight integer ToolBarHeight !integer*4 ghWndMain1 ! 01-04-2026 !integer*4 hInst1 integer(handle):: ghWndMain1 ! 01-04-2026 integer(handle):: hInst1 integer(handle):: ghmodule1 integer(handle):: hmenu1 integer(handle):: hchildmenu1 integer(handle):: ghwndclient1 character*100 lpszMenuName_char !----------------end local ghWndMain1=ghWndMain hInst1=hInst ghmodule1=ghmodule hmenu1=hmenu hchildmenu1=hchildmenu ghwndclient1=ghwndclient ! Save the instance handle in static variable, which will be used in ! many subsequence calls from this application to Windows. ! hInst = hInstance !this is done in main?! ! Create a main window for this application instance. lpszMenuName = "CmnDlgMenu"C ! lpszMenuName_char = LOC(lpszMenuName) ! hMenu = LoadMenu(ghModule, LOC(lpszMenuName)) hMenu = LoadMenu(ghModule1, lpszMenuName_char) ! 10-04-2026 lpszMenuName = "CmnDlgMenu"C !"ChildMenu"C ! hChildMenu = LoadMenu(ghModule1, LOC(lpszMenuName)) hChildMenu = LoadMenu(ghModule1, lpszMenuName_char) hMenuWindow = GetSubMenu(hMenu1, 1) hChildMenuWindow= GetSubMenu(hChildMenu1, 2) lpszClassName = "OsdapClass"C !"MDIDemoClass"C lpszAppName = "OPTICSOFT-II version 2603"C i=getlasterror() ! ghwndMain = CreateWindowEx(0, lpszClassName, lpszAppName, & ghwndMain = CreateWindowEx_G1(0, lpszClassName, lpszAppName, & IOR(WS_OVERLAPPED, IOR(WS_CAPTION, IOR(WS_BORDER, & IOR(WS_THICKFRAME, IOR(WS_MAXIMIZEBOX, IOR(WS_MINIMIZEBOX, & IOR(WS_CLIPCHILDREN, IOR(WS_VISIBLE, WS_SYSMENU)))))))), & 0,& !CW_USEDEFAULT,& !NULL,& ! Default horizontal position. 0,& !CW_USEDEFAULT,& !NULL,& ! Default vertical position. 800,& !CW_USEDEFAULT,& !NULL,& ! SVGA. 600,& !CW_USEDEFAULT,& !NULL,& ! SVGA. NULL, hMenu1, ghModule1, NULL) ! If window could not be created, return "failure" if (ghWndMain == 0) then InitInstance = 0 return end if ! Tool bar IF (CreateToolBar(ghWndMain,hInst,ID_TOOLBAR)) THEN ! IF (CreateToolBar(ghWndMain1,hInst1,ID_TOOLBAR)) THEN hwndLabel1 = AddToolLabel(hInst,0,"**toolbar**"C,0,SS_RIGHT) ! hwndLabel1 = AddToolLabel(hInst1,0,"**toolbar**"C,0,SS_RIGHT) ! bret=AddToolSpace (1,0) ! 04/06/02 bret=AddToolSpace (0,0) ! 04/06/02 hwndCreateParam=AddToolCombo(hInst,ID_CREATEPARAM,-10,IOR(CBS_DROPDOWN,WS_VSCROLL)) ! hwndCreateParam=AddToolCombo(hInst1,ID_CREATEPARAM,-10,IOR(CBS_DROPDOWN,WS_VSCROLL)) ! bret=FillPath(hwndCreateParam) !Manu ! bret=AddToolSpace(10,0) hwndZoom=AddToolButton(hInst,ID_CONFIG,"CONFIG"C,40,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PSYS,"PSYS"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PABN,"PABN"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PSD,"PSD"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_POTF,"POTF"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PPSF,"PPSF"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PENEN,"PENEN"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PLOSS,"PLOSS"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PMAP,"PMAP"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PINTER,"PINTER"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PASPH,"PASPH"C,35,0,BS_OWNERDRAW) hwndZoom=AddToolButton(hInst,ID_PANG,"PANG"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_CONFIG,"CONFIG"C,40,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PSYS,"PSYS"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PABN,"PABN"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PSD,"PSD"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_POTF,"POTF"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PPSF,"PPSF"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PENEN,"PENEN"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PLOSS,"PLOSS"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PMAP,"PMAP"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PINTER,"PINTER"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PASPH,"PASPH"C,35,0,BS_OWNERDRAW) ! hwndZoom=AddToolButton(hInst1,ID_PANG,"PANG"C,35,0,BS_OWNERDRAW) ELSE InitInstance = 0 return END IF ! Status bar IF (CreateStatusBar (ghwndMain,ID_STATUSBAR)) THEN hwndMenuField=AddStatusField(hInst,ID_MENUFIELD,100,0,.FALSE.) hwndInfoField_01=AddStatusField(hInst,ID_INFOFIELD_01,-19,-19,.TRUE.) hwndInfoField_02=AddStatusField(hInst,ID_INFOFIELD_02,-12,-12,.TRUE.) hwndInfoField_03=AddStatusField(hInst,ID_INFOFIELD_03,-6,-6,.TRUE.) hwndInfoField_04=AddStatusField(hInst,ID_INFOFIELD_04,-6,-6,.TRUE.) hwndInfoField_05=AddStatusField(hInst,ID_INFOFIELD_05,-6,-6,.TRUE.) hwndInfoField_06=AddStatusField(hInst,ID_INFOFIELD_06,-6,-6,.TRUE.) hwndInfoField_07=AddStatusField(hInst,ID_INFOFIELD_07,-6,-6,.TRUE.) hwndInfoField_08=AddStatusField(hInst,ID_INFOFIELD_08,-6,-6,.TRUE.) hwndInfoField_09=AddStatusField(hInst,ID_INFOFIELD_09,-6,-6,.TRUE.) hwndInfoField_10=AddStatusField(hInst,ID_INFOFIELD_10,-6,-6,.TRUE.) ! IF (CreateStatusBar (ghwndMain,ID_STATUSBAR)) THEN ! hwndMenuField=AddStatusField(hInst1,ID_MENUFIELD,100,0,.FALSE.) ! hwndInfoField_01=AddStatusField(hInst1,ID_INFOFIELD_01,-19,-19,.TRUE.) ! hwndInfoField_02=AddStatusField(hInst1,ID_INFOFIELD_02,-12,-12,.TRUE.) ! hwndInfoField_03=AddStatusField(hInst1,ID_INFOFIELD_03,-6,-6,.TRUE.) ! hwndInfoField_04=AddStatusField(hInst1,ID_INFOFIELD_04,-6,-6,.TRUE.) ! hwndInfoField_05=AddStatusField(hInst1,ID_INFOFIELD_05,-6,-6,.TRUE.) ! hwndInfoField_07=AddStatusField(hInst1,ID_INFOFIELD_07,-6,-6,.TRUE.) ! hwndInfoField_08=AddStatusField(hInst1,ID_INFOFIELD_08,-6,-6,.TRUE.) ! hwndInfoField_09=AddStatusField(hInst1,ID_INFOFIELD_09,-6,-6,.TRUE.) ! hwndInfoField_10=AddStatusField(hInst1,ID_INFOFIELD_10,-6,-6,.TRUE.) ELSE InitInstance = 0 return END IF bret=AdjustToolBar(ghwndMain) bret=AdjustStatusBar(ghwndMain) bret=GetClientRect(ghwndMain1,rect) rect.top=rect.top+ToolBarHeight(ghwndMain) rect.bottom=rect.bottom-StatusBarHeight(ghwndMain) bret=SetWindowPos(ghWndClient1,NULL,rect.left,rect.top,rect.right-rect.left, & rect.bottom-rect.top,SWP_NOZORDER) ! /* Get handles to the various menus. Some of these we will use later */ ! /* to display menu descriptions in the status bar */ hSysMenuMain = GetSystemMenu(ghwndMain1,FALSE) hMenu = GetMenu(ghwndMain1) IF (hMenu.ne.0) THEN hFileMenu = GetSubMenu(hMenu1,1) hSystemMenu = GetSubMenu(hMenu1,2) hSpecsMenu = GetSubMenu(hMenu1,3) hOptimizationMenu = GetSubMenu(hMenu1,4) hPerformanceMenu = GetSubMenu(hMenu1,5) hGraphicsMenu = GetSubMenu(hMenu1,6) hMiscMenu = GetSubMenu(hMenu1,7) hFilterMenu = GetSubMenu(hMenu1,8) hJonesMenu = GetSubMenu(hMenu1,9) hWinMenu = GetSubMenu(hMenu1,10) hHelpMenu = GetSubMenu(hMenu1,11) END IF ret = SetWindowLong(ghwndMain1, GWL_USERDATA, 4) ret = SetWindowLong(ghwndMain1, GWL_USERDATA, 0) ret = SetFocus(ghwndMain1) InitInstance = 1 end ! integer*4 function InitInstance !*************************************************************************** ! ! FUNCTION: MainWndProc(HWND, unsigned, WORD, LONG) ! ! PURPOSE: Processes messages ! ! COMMENTS: ! ! This function processes all messags sent to the window. When the ! user choses one of the options from one of the menus, the command ! is processed here and passed onto the function for that command. ! ! LAST MODIFICATIONS: E.G. 03/03/1997 ! LAST MODIFICATIONS: I.P. 10/02/1998 ! !*************************************************************************** integer function MainWndProc( hWnd, message, wParam, lParam ) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' ::MainWndProc use win_intr include 'dia_intr.inc' integer hWnd ! window handle integer message ! type of message integer wParam ! additional information integer lParam ! additional information interface integer function About(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_About@16':: About integer hDlg, message, wParam, lParam end function end interface interface integer function OpenNewFile( hWnd ) integer hWnd end function end interface interface integer function SaveToFile() end function end interface interface integer function SaveAs( hWnd ) integer hWnd end function end interface interface subroutine PrintFile( hWnd ) integer hWnd end subroutine end interface interface integer function Open_File_Var( hWnd ) integer hWnd end function end interface !interface !integer function SaveAs_Var( hWnd ) !integer hWnd !end function !end interface interface integer function Dialog_Sys(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sys@16':: Dialog_Sys integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Fig(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Fig@16':: Dialog_Fig integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Tor(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Tor@16':: Dialog_Tor integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Dec(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Dec@16':: Dialog_Dec integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Til(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Til@16':: Dialog_Til integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Cao(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Cao@16':: Dialog_Cao integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Inn(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Inn@16':: Dialog_Inn integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Grin(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Grin@16':: Dialog_Grin integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Bire(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Bire@16':: Dialog_Bire integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Fres(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Fres@16':: Dialog_Fres integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Scat(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Scat@16':: Dialog_Scat integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Parax(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Parax@16':: Dialog_Parax integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Bin(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Bin@16':: Dialog_Bin integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Hoe(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Hoe@16':: Dialog_Hoe integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Seg(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Seg@16':: Dialog_Seg integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Spl(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Spl@16':: Dialog_Spl integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Nseq(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Nseq@16':: Dialog_Nseq integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Maln(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Maln@16':: Dialog_Maln integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Sym(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sym@16':: Dialog_Sym integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Asym(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Asym@16':: Dialog_Asym integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Illum(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Illum@16':: Dialog_Illum integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ath(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ath@16':: Dialog_Ath integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Lg(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Lg@16':: Dialog_Lg integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Wg(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Wg@16':: Dialog_Wg integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Mems(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Mems@16':: Dialog_Mems integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Config(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Config@16':: Dialog_Config integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Specl(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Specl@16':: Dialog_Specl integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Init(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Init@16':: Dialog_Init integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Gaus(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Gaus@16':: Dialog_Gaus integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Beam(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Beam@16':: Dialog_Beam integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Mirr(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Mirr@16':: Dialog_Mirr integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Lam(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Lam@16':: Dialog_Lam integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Vig(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Vig@16':: Dialog_Vig integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Apo(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Apo@16':: Dialog_Apo integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Mer(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Mer@16':: Dialog_Mer integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Cyc(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Cyc@16':: Dialog_Cyc integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Gsa(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Gsa@16':: Dialog_Gsa integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Gsatest(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Gsatest@16':: Dialog_Gsatest integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Par(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Par@16':: Dialog_Par integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Tie(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Tie@16':: Dialog_Tie integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Dfinc(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Dfinc@16':: Dialog_Dfinc integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ray(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ray@16'::Dialog_Ray integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Glob(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Glob@16'::Dialog_Glob integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Loss(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Loss@16'::Dialog_Loss integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Sst(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sst@16'::Dialog_Sst integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Tol(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Tol@16'::Dialog_Tol integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pep(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pep@16'::Dialog_Pep integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Poly(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Poly@16'::Dialog_Poly integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Otf(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Otf@16'::Dialog_Otf integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Psf(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Psf@16'::Dialog_Psf integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Rms(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Rms@16'::Dialog_Rms integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Enen(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Enen@16'::Dialog_Enen integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Sag(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sag@16'::Dialog_Sag integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Gla(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Gla@16'::Dialog_Gla integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Psys(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Psys@16':: Dialog_Psys integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pabn(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pabn@16'::Dialog_Pabn integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Psd(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Psd@16'::Dialog_Psd integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Potf(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Potf@16'::Dialog_Potf integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ppsf(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ppsf@16'::Dialog_Ppsf integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Penen(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Penen@16'::Dialog_Penen integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ploss(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ploss@16'::Dialog_Ploss integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pmap(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pmap@16'::Dialog_Pmap integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pinter(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pinter@16'::Dialog_Pinter integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pasph(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pasph@16'::Dialog_Pasph integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Pang(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Pang@16'::Dialog_Pang integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Zygo(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Zygo@16'::Dialog_Zygo integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Reconf(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Reconf@16':: Dialog_Reconf integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ce(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ce@16'::Dialog_Ce integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Ghost(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Ghost@16'::Dialog_Ghost integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Track(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Track@16'::Dialog_Track integer hDlg , message , wParam , lParam end function end interface interface integer function OpenNewFile_z( hWnd ) integer hWnd end function end interface interface integer function SaveAs_z( hWnd ) integer hWnd end function end interface interface integer function OpenNewFile_f( hWnd ) integer hWnd end function end interface interface integer function SaveToFile_f() end function end interface interface integer function SaveAs_f( hWnd ) integer hWnd end function end interface interface integer function Open_File_Var_f( hWnd ) integer hWnd end function end interface interface integer function SaveAs_Var_f( hWnd ) integer hWnd end function end interface interface integer function Dialog_Systf_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Systf_f@16':: Dialog_Systf_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Sysgl_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sysgl_f@16':: Dialog_Sysgl_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Plot_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Plot_f@16':: Dialog_Plot_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Specs_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Specs_f@16':: Dialog_Specs_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Par_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Par_f@16':: Dialog_Par_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Mer_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Mer_f@16':: Dialog_Mer_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Cyc_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Cyc_f@16':: Dialog_Cyc_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Dfinc_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Dfinc_f@16':: Dialog_Dfinc_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Init_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Init_f@16':: Dialog_Init_f integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Mask_f(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Mask_f@16':: Dialog_Mask_f integer hDlg , message , wParam , lParam end function end interface interface integer function OpenNewFile_j( hWnd ) integer hWnd end function end interface interface integer function SaveToFile_j() end function end interface interface integer function SaveAs_j( hWnd ) integer hWnd end function end interface interface integer function Dialog_Sys_j(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Sys_j@16':: Dialog_Sys_j integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Plot_j(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Plot_j@16':: Dialog_Plot_j integer hDlg , message , wParam , lParam end function end interface interface integer function Dialog_Init_j(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL, ALIAS : '_Dialog_Init_j@16':: Dialog_Init_j integer hDlg , message , wParam , lParam end function end interface integer idCtrl integer(uint_ptr):: wParam1 integer(long_ptr):: lParam1 type (T_PAINTSTRUCT) ps integer NewFont character*512 FileNameString character*512 FileNameFortran save NewFont type (T_CLIENTCREATESTRUCT) clientcreate integer*4 hwndChildWindow,CreateChildWindow type (T_RECT) rect logical AdjustStatusBar logical AdjustToolBar integer StatusBarHeight integer ToolBarHeight TYPE (T_SYSTEMTIME) datetime CHARACTER(2) moment CHARACTER(20) time_string INTEGER wmEvent INTEGER wmhWnd TYPE(T_POINT) point INTEGER*4 wmId CHARACTER(80) szMsg LOGICAL bret INTEGER idMenuSelect INTEGER tmp INTEGER wmMenuCmd INTEGER wmFlags INTEGER wmhMenu !***PD ! dialog structures for handling modeless dialog boxes !LOGICAL IRET integer nDmax ! maximum number of open dialog boxes parameter (nDmax=20) type (dialog) :: gDlg(nDmax) integer(4) CheckDialog,nDlg,hDC,hwndPic !integer hwnd ! 01-04-2026 !integer(handle):: hwnd ! 01-04-2026 integer(handle):: hwnd1 ! 01-04-2026 integer(handle):: wmhwnd1 integer(handle):: hInst1 integer(handle):: itemp integer(long_ptr):: longptr !character*(*) about !integer(handle):: GHWNDCLIENT integer(handle):: ghmodule1 integer(handle):: hmenu1 integer(handle):: hwndmenufield1 integer(handle):: ghwndclient1 type (T_TEXTMETRIC) tm !PD*** 100 FORMAT(i2,1A1,i2,1A1,i2,1A2) 110 FORMAT(i2,1A2,i1,1A2,i1,1A2) 120 FORMAT(i2,1A2,i1,1A1,i2,1A2) 130 FORMAT(i2,1A1,i2,1A2,i1,1A2) 150 FORMAT(1A80) ghmodule1=ghmodule hmenu1=hmenu hwndmenufield1=hwndmenufield ghwndclient1=ghwndclient wParam1=wParam lParam1=lParam szMsg='' m_handle= hWnd !to avoid passing it as a parameter for error messages select case (message) case (WM_CREATE) !Creation of the client area ! ret = SetWindowLong(hwnd, 0, NULL) ret = SetWindowLong(hwnd1, 0, NULL) ! 01-04-2026 clientcreate%hWindowMenu = hMenuWindow clientcreate%idFirstChild = 1 lpszAppName = "MDICLIENT"C i=getlasterror() hpen(1)=CreatePen(PS_SOLID,1,RGB(0,0,0)) hpen(2)=CreatePen(PS_SOLID,1,RGB(50,200,0)) hpen(3)=CreatePen(PS_SOLID,1,RGB(200,50,0)) hpen(4)=CreatePen(PS_SOLID,1,RGB(50,0,200)) hpen(5)=CreatePen(PS_SOLID,1,RGB(200,150,0)) hpen(6)=CreatePen(PS_SOLID,1,RGB(200,250,0)) hpen(7)=CreatePen(PS_SOLID,1,RGB(0,200,200)) hpen(8)=CreatePen(PS_SOLID,1,RGB(0,100,200)) hpen(9)=CreatePen(PS_SOLID,1,RGB(100,100,100)) hpen(10)=CreatePen(PS_SOLID,1,RGB(200,200,200)) hpen(11)=CreatePen(PS_SOLID,1,RGB(250,0,0)) hpen(12)=CreatePen(PS_SOLID,1,RGB(200,50,0)) hpen(13)=CreatePen(PS_SOLID,1,RGB(150,100,0)) hpen(14)=CreatePen(PS_SOLID,1,RGB(100,150,0)) hpen(15)=CreatePen(PS_SOLID,1,RGB(50,200,0)) hpen(16)=CreatePen(PS_SOLID,1,RGB(0,250,0)) hpen(17)=CreatePen(PS_SOLID,1,RGB(0,200,50)) hpen(18)=CreatePen(PS_SOLID,1,RGB(0,150,100)) hpen(19)=CreatePen(PS_SOLID,1,RGB(0,100,150)) hpen(20)=CreatePen(PS_SOLID,1,RGB(0,50,200)) hpen(21)=CreatePen(PS_SOLID,1,RGB(0,0,250)) hpen(22)=CreatePen(PS_SOLID,1,RGB(50,0,200)) hpen(23)=CreatePen(PS_SOLID,1,RGB(100,0,150)) hpen(24)=CreatePen(PS_SOLID,1,RGB(150,0,100)) hpen(25)=CreatePen(PS_SOLID,1,RGB(200,0,50)) hpen(26)=CreatePen(PS_SOLID,1,RGB(50,100,0)) hpen(27)=CreatePen(PS_SOLID,1,RGB(100,100,0)) hpen(28)=CreatePen(PS_SOLID,1,RGB(150,100,0)) hpen(29)=CreatePen(PS_SOLID,1,RGB(200,100,0)) hpen(30)=CreatePen(PS_SOLID,1,RGB(250,100,0)) hpen(31)=CreatePen(PS_SOLID,1,RGB(50,200,0)) hpen(32)=CreatePen(PS_SOLID,1,RGB(100,200,0)) hpen(33)=CreatePen(PS_SOLID,1,RGB(150,200,0)) hpen(34)=CreatePen(PS_SOLID,1,RGB(200,200,0)) hpen(35)=CreatePen(PS_SOLID,1,RGB(250,200,0)) hpen(36)=CreatePen(PS_SOLID,1,RGB(50,50,50)) hpen(37)=CreatePen(PS_SOLID,1,RGB(100,100,0)) hpen(38)=CreatePen(PS_SOLID,1,RGB(150,150,0)) hpen(39)=CreatePen(PS_SOLID,1,RGB(200,200,0)) hpen(40)=CreatePen(PS_SOLID,1,RGB(250,250,0)) hpen(41)=CreatePen(PS_SOLID,1,RGB(50,50,50)) hpen(42)=CreatePen(PS_SOLID,1,RGB(100,100,100)) hpen(43)=CreatePen(PS_SOLID,1,RGB(150,150,150)) hpen(44)=CreatePen(PS_SOLID,1,RGB(200,200,200)) hpen(45)=CreatePen(PS_SOLID,1,RGB(250,250,250)) hpen(46)=CreatePen(PS_SOLID,1,RGB(0,50,250)) hpen(47)=CreatePen(PS_SOLID,1,RGB(0,100,250)) hpen(48)=CreatePen(PS_SOLID,1,RGB(0,150,250)) hpen(49)=CreatePen(PS_SOLID,1,RGB(0,200,250)) hpen(50)=CreatePen(PS_SOLID,1,RGB(0,250,250)) hpen(51)=CreatePen(PS_SOLID,1,RGB(0,0,0)) hpen(52)=CreatePen(PS_SOLID,1,RGB(25,25,25)) hpen(53)=CreatePen(PS_SOLID,1,RGB(50,50,50)) hpen(54)=CreatePen(PS_SOLID,1,RGB(75,75,75)) hpen(55)=CreatePen(PS_SOLID,1,RGB(100,100,100)) hpen(56)=CreatePen(PS_SOLID,1,RGB(125,125,125)) hpen(57)=CreatePen(PS_SOLID,1,RGB(150,150,150)) hpen(58)=CreatePen(PS_SOLID,1,RGB(175,175,175)) hpen(59)=CreatePen(PS_SOLID,1,RGB(200,200,200)) hpen(60)=CreatePen(PS_SOLID,1,RGB(225,225,225)) hpen(61)=CreatePen(PS_SOLID,1,RGB(250,250,250)) ! hpen(1)=CreatePen(PS_SOLID,1,RGB(0_1,0_1,0_1)) ! hpen(2)=CreatePen(PS_SOLID,1,RGB(50_1,transfer(200,0_1),0_1)) ! hpen(3)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),50_1,0_1)) ! hpen(4)=CreatePen(PS_SOLID,1,RGB(50_1,0_1,transfer(200,0_1))) ! hpen(5)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(100,0_1),0_1)) ! hpen(6)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),0_1)) ! hpen(7)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(200,0_1),transfer(200,0_1))) ! hpen(8)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(100,0_1),transfer(200,0_1))) ! hpen(9)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(100,0_1),transfer(100,0_1))) ! hpen(10)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),transfer(200,0_1))) ! hpen(11)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),0_1,0_1)) ! hpen(12)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),50_1,0_1)) ! hpen(13)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(100,0_1),0_1)) ! hpen(14)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(150,0_1),0_1)) ! hpen(15)=CreatePen(PS_SOLID,1,RGB(50_1,transfer(200,0_1),0_1)) ! hpen(16)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(250,0_1),0_1)) ! hpen(17)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(200,0_1),50_1)) ! hpen(18)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(150,0_1),transfer(100,0_1))) ! hpen(19)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(100,0_1),transfer(150,0_1))) ! hpen(20)=CreatePen(PS_SOLID,1,RGB(0_1,50_1,transfer(200,0_1))) ! hpen(21)=CreatePen(PS_SOLID,1,RGB(0_1,0_1,transfer(250,0_1))) ! hpen(22)=CreatePen(PS_SOLID,1,RGB(50_1,0_1,transfer(200,0_1))) ! hpen(23)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),0_1,transfer(150,0_1))) ! hpen(24)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),0_1,transfer(100,0_1))) ! hpen(25)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),0_1,50_1)) ! hpen(26)=CreatePen(PS_SOLID,1,RGB(50_1,transfer(100,0_1),0_1)) ! hpen(27)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(100,0_1),0_1)) ! hpen(28)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(100,0_1),0_1)) ! hpen(29)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(100,0_1),0_1)) ! hpen(30)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),transfer(100,0_1),0_1)) ! hpen(31)=CreatePen(PS_SOLID,1,RGB(50_1,transfer(200,0_1),0_1)) ! hpen(32)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(200,0_1),0_1)) ! hpen(33)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(200,0_1),0_1)) ! hpen(34)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),0_1)) ! hpen(35)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),transfer(200,0_1),0_1)) ! hpen(36)=CreatePen(PS_SOLID,1,RGB(50_1,50_1,50_1)) ! hpen(37)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(100,0_1),0_1)) ! hpen(38)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(150,0_1),0_1)) ! hpen(39)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),0_1)) ! hpen(40)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),transfer(250,0_1),0_1)) ! hpen(41)=CreatePen(PS_SOLID,1,RGB(50_1,50_1,50_1)) ! hpen(42)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(100,0_1),transfer(100,0_1))) ! hpen(43)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(150,0_1),transfer(150,0_1))) ! hpen(44)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),transfer(200,0_1))) ! hpen(45)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),transfer(250,0_1),transfer(250,0_1))) ! hpen(46)=CreatePen(PS_SOLID,1,RGB(0_1,50_1,transfer(250,0_1))) ! hpen(47)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(100,0_1),transfer(250,0_1))) ! hpen(48)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(150,0_1),transfer(250,0_1))) ! hpen(49)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(200,0_1),transfer(250,0_1))) ! hpen(50)=CreatePen(PS_SOLID,1,RGB(0_1,transfer(250,0_1),transfer(250,0_1))) ! hpen(51)=CreatePen(PS_SOLID,1,RGB(0_1,0_1,0_1)) ! hpen(52)=CreatePen(PS_SOLID,1,RGB(25_1,25_1,25_1)) ! hpen(53)=CreatePen(PS_SOLID,1,RGB(50_1,50_1,50_1)) ! hpen(54)=CreatePen(PS_SOLID,1,RGB(75_1,75_1,75_1)) ! hpen(55)=CreatePen(PS_SOLID,1,RGB(transfer(100,0_1),transfer(100,0_1),transfer(100,0_1))) ! hpen(56)=CreatePen(PS_SOLID,1,RGB(transfer(125,0_1),transfer(125,0_1),transfer(125,0_1))) ! hpen(57)=CreatePen(PS_SOLID,1,RGB(transfer(150,0_1),transfer(150,0_1),transfer(150,0_1))) ! hpen(58)=CreatePen(PS_SOLID,1,RGB(transfer(175,0_1),transfer(175,0_1),transfer(175,0_1))) ! hpen(59)=CreatePen(PS_SOLID,1,RGB(transfer(200,0_1),transfer(200,0_1),transfer(200,0_1))) ! hpen(60)=CreatePen(PS_SOLID,1,RGB(transfer(225,0_1),transfer(225,0_1),transfer(225,0_1))) ! hpen(61)=CreatePen(PS_SOLID,1,RGB(transfer(250,0_1),transfer(250,0_1),transfer(250,0_1))) ghwndClient = CreateWindow( & lpszAppName, "Test!"C, & IOR(WS_CHILD , IOR(WS_CLIPCHILDREN, & IOR(WS_VISIBLE,WS_CLIPSIBLINGS))), 0, 0, 0,0, & !630, 435, works also ! hwnd, NULL, ghModule, LOC(clientcreate)) hwnd1, NULL, ghModule1, LOC(clientcreate)) ! 01-04-2026 MainWndProc = 0 !will draw in white first return case (WM_DESTROY) do i=1,50 ! bret=DeleteObject(hpen(i)) itemp=hpen(1) bret=DeleteObject(itemp) ! 01-04-2026 end do ! (i) call PostQuitMessage(0) case (WM_MOUSEACTIVATE) MainWndProc = 0 return case (WM_SIZE) IF((hwndStatus.ne.0).and.(hwndTools.ne.0)) THEN bret = AdjustToolBar(hwnd) bret = AdjustStatusBar(hwnd) ! bret = GetClientRect(hwnd,rect) bret = GetClientRect(hwnd1,rect) ! 01-04-2026 rect.top = rect.top+ToolBarHeight(hwnd) rect.bottom = rect.bottom-StatusBarHeight(hwnd) bret = SetWindowPos(ghwndClient1,NULL,rect.left,rect.top,rect.right-rect.left, & rect.bottom-rect.top,SWP_NOZORDER) END IF MainWndProc = 0 return case (WM_PARENTNOTIFY) IF((loword(wparam).ne.WM_CREATE).and.(loword(wparam).ne.WM_DESTROY)) THEN wmEvent = wParam point.x = LOWORD(lParam) point.y = HIWORD(lParam) ! bret = ClientToScreen(hwnd, point) bret = ClientToScreen(hwnd1, point) wmhWnd = WindowFromPoint(point) IF (wmhWnd.ne.0) THEN !#if defined (WIN32) !YES ! wmId = GetWindowLong (wmhWnd, GWL_ID) ! i=GetWindowLong (wmhWnd, GWL_USERDATA) wmId = GetWindowLong (wmhWnd1, GWL_ID) ! 02-04-2026 i=GetWindowLong (wmhWnd1, GWL_USERDATA) ELSE MainWndProc=0 RETURN END IF SELECT CASE (wmEvent) CASE (WM_LBUTTONDOWN,WM_MBUTTONDOWN,WM_RBUTTONDOWN) ! i=LoadString (hInst, wmId, szMsg, len(szMsg)) i=LoadString (hInst1, wmId, szMsg, len(szMsg)) ! IF (i.eq.0) THEN ! wsprintf ((LPSTR)szMsg, "Unable to load ParentNotify string #%u", wmId); ! END IF ! IF(i.lt.100) THEN !Not a valid ID ! szMsg=''C ! END IF bret= SetWindowText (hwndMenuField1, szMsg) END SELECT END IF MainWndProc=0 return case (WM_MENUSELECT) tmp = idMenuSelect wmMenuCmd = LOWORD(wParam) wmFlags = HIWORD(wParam) wmhMenu = lParam IF ((wmhMenu==0).and.(wmFlags==-1)) THEN idMenuselect= 0 tmp = idMenuSelect bret = SetWindowText (hwndMenuField1, "Ready..."C) ELSE IF (wmhMenu==0) THEN ELSE IF (IAND(wmFlags,MF_POPUP).ne.0) THEN i=GetSubMenu(hMenu1,wmMenuCmd) IF (i==hFileMenu) idMenuSelect = IDM_FILEMENU IF (i==hSystemMenu) idMenuSelect = IDM_SYSTEMMENU IF (i==hSpecsMenu) idMenuSelect = IDM_SPECSMENU IF (i==hOptimizationMenu) idMenuSelect = IDM_OPTIMIZATIONMENU IF (i==hPerformanceMenu) idMenuSelect = IDM_PERFORMANCEMENU IF (i==hGraphicsMenu) idMenuSelect = IDM_GRAPHICSMENU IF (i==hMiscMenu) idMenuSelect = IDM_MISCMENU IF (i==hFilterMenu) idMenuSelect = IDM_FILTERMENU IF (i==hJonesMenu) idMenuSelect = IDM_JONESMENU IF (i==hWinMenu) idMenuSelect = IDM_WINDOWSMENU IF (i==hHelpMenu) idMenuSelect = IDM_HELPMENU ELSE IF (wmMenuCmd.ne.0) THEN idMenuSelect=wmMenuCmd END IF IF (idMenuSelect.ne.tmp) THEN ! i=LoadString (hInst, idMenuSelect, szMsg, len(szMsg)) i=LoadString (hInst1, idMenuSelect, szMsg, len(szMsg)) IF (i.eq.0) THEN ! wsprintf ((LPSTR)szMsg, "Unable to load ParentNotify string #%u", wmId); END IF bret= SetWindowText (hwndMenuField1, szMsg) END IF MainWndProc=0 return case (WM_PAINT) !kind of refresh ! hDC = BeginPaint (hWnd, ps) ! i = EndPaint( hWnd,ps) hDC = BeginPaint (hWnd1, ps) ! 02-04-2026 i = EndPaint( hWnd1,ps) MainWndProc=0 return !******* plot system modifications 29/10/02 ******* case (WM_LBUTTONDOWN) ! i = InvalidateRect (hWnd, NULL_RECT, TRUE) i = InvalidateRect (hWnd1, NULL_RECT, TRUE) ! 02-04-2026 case (WM_LBUTTONUP) i = ReleaseCapture() !/* Releases hold on mouse input */ SCAL=SCAL*0.9 case (WM_KEYDOWN) if (((wParam .ne. VK_LEFT) .AND. (wParam .ne. VK_RIGHT) & .AND. (wParam .ne. VK_UP) .AND. (wParam .ne. VK_DOWN)) .EQV. .FALSE.) then repeat = repeat + 1 !/* Increases the repeat rate */ select case (wParam) !/* Adjust cursor position according to which key was pressed. */ case (VK_LEFT) SCALE=SCALE*0.9 case (VK_RIGHT) SCALE=SCALE/0.9 case (VK_UP) DATPL(2)=DATPL(2)+1. case (VK_DOWN) DATPL(2)=DATPL(2)-1. end select ! i = InvalidateRect (hWnd, NULL_RECT, TRUE) ! i = UpdateWindow (hWnd) i = InvalidateRect (hWnd1, NULL_RECT, TRUE) ! 02-04-2026 i = UpdateWindow (hWnd1) ! /* Capture all input even if the mouse goes outside of window */ ! i = SetCapture(hWnd) i = SetCapture(hWnd1) LastInfoSelected=INFO_PSYS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) end if !******* plot system modifications 29/10/02 ******* case (WM_COMMAND) ! message: command from application menu if (.not.breport) lineno=0 if (nozm.le.1) nz=1 cancel=.FALSE. first_time=.true. first_time_f=.true. first_time_j=.true. display_monitor=.true. call info_field select case ( INT4(LOWORD( wParam ))) case (IDM_TILE) iret = SendMessage( ghwndClient1, WM_MDITILE, 0, 0) case (IDM_CASCADE) iret = SendMessage( ghwndClient1, WM_MDICASCADE, 0, 0) case (IDM_ABOUT) ! i = DialogBoxParam(hInst, & ! current instance ! LOC("AboutBox"C), & ! resource to use ! hWnd, & ! parent handle ! LOC(About), 0) ! About() instance address ! about_box=LOC("AboutBox"C) longptr=LOC(About) i = DialogBoxParam_G(hInst1, & ! current instance ! DialogBoxParam_G replace DialogBoxParam from here on ! i = DialogBoxParam(hInst1, & ! current instance ! DialogBoxParam_G replace DialogBoxParam from here on NULL, & ! resource to use hWnd1, & ! parent handle longptr, 0) ! About() instance address case(IDM_HELP_INDEX) ! bret = WinHelp(hWnd,"opticsoft.hlp"C,HELP_CONTENTS,0) ! hWnd1 replace hWnd from here on bret = WinHelp(hWnd1,"help_opticsoft.hlp"C,HELP_CONTENTS,0) case(IDM_HELPUSE) bret=WinHelp(hWnd1,""C,HELP_HELPONHELP,0) case (IDM_OPENFILE) if ( OpenNewFile( hWnd ) == TRUE ) then ! enable the Save As and Print menu items i = EnableMenuItem( GetMenu( hWnd1 ), IDM_SAVEFILE,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = EnableMenuItem( GetMenu( hWnd1 ), IDM_PRINT,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = DrawMenuBar( hWnd1 ) ! reset the title in the title bar to reflect the new open file ! iret = ConvertFToCString(FileNameString,OpenFN%lpstrFile ) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile) ) ! writes the file name and the program name in the title bar j = lstrlen(FileNameString) !======= Manu modification FileNameFortran = "" DO i=1,j FileNameFortran(i:i) = FileNameString(i:i) END DO i = SetWindowText( hWnd1,'OPTICSOFT-II version 2603'C ) ! ======= end modification ! reset the current color and current font to the default crColor = 0 NewFont = FALSE ! i = InvalidateRect( hWnd, NULL_RECT, .TRUE.) end if case (IDM_SAVEFILE) !save the file that is open OpenFN%Flags = 0 i = SaveToFile() case (IDM_SAVEFILEAS) !save under a new name if ( SaveAs( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu(hWnd1),IDM_SAVEFILE, & IOR(MF_BYCOMMAND,MF_ENABLED)) ! iret = ConvertFToCString(FileNameString,OpenFN%lpstrFile) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = SetWindowText( hWnd1,'OPTICSOFT-II version 2603'C) i = DrawMenuBar( hWnd1 ) end if case (IDM_PRINT) display_monitor=.false. call PrintFile( hWnd ) ! // Getting default MDI functionalities... ! MainWndProc=0 ! return case (IDM_EXIT) do i=1,50 itemp=hpen(1) ! bret=DeleteObject(hpen(i)) bret=DeleteObject(itemp) end do ! (i) call PostQuitMessage(0) case (IDM_NEW) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_INIT),hWnd1, & LOC(Dialog_Init),0) IF (.not.(cancel)) THEN filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SYS),hWnd1, & LOC(Dialog_Sys),0) ENDIF case (IDM_SYS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SYS),hWnd1, & LOC(Dialog_Sys),0) ititle=ititle_l case (IDM_FIG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_FIG),hWnd1, & LOC(Dialog_Fig),0) case (IDM_TOR) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_TOR),hWnd1, & LOC(Dialog_Tor),0) case (IDM_DEC) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_DEC),hWnd1, & LOC(Dialog_Dec),0) case (IDM_TIL) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_TIL),hWnd1, & LOC(Dialog_Til),0) case (IDM_CAO) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_CAO),hWnd1, & LOC(Dialog_Cao),0) case (IDM_INN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_INN),hWnd1, & LOC(Dialog_Inn),0) case (IDM_FRES) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_FRES),hWnd1, & LOC(Dialog_Fres),0) case (IDM_SCAT) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SCAT),hWnd1, & LOC(Dialog_Scat),0) case (IDM_PARAX) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PARAX),hWnd1, & LOC(Dialog_Parax),0) case (IDM_DOE_BIN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_BIN),hWnd1, & LOC(Dialog_Bin),0) case (IDM_DOE_HOE) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_HOE),hWnd1, & LOC(Dialog_Hoe),0) case (IDM_GRIN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GRIN),hWnd1, & LOC(Dialog_Grin),0) case (IDM_BIRE) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_BIRE),hWnd1, & LOC(Dialog_Bire),0) case (IDM_SEG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SEG),hWnd1, & LOC(Dialog_Seg),0) case (IDM_SPL) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SPL),hWnd1, & LOC(Dialog_Spl),0) case (IDM_NONSEQ) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_NONSEQ),hWnd1, & LOC(Dialog_Nseq),0) case (IDM_MALN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_MALN),hWnd1, & LOC(Dialog_Maln),0) case (IDM_SYM) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SYM),hWnd1, & LOC(Dialog_Sym),0) case (IDM_ASYM) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_ASYM),hWnd1, & LOC(Dialog_Asym),0) case (IDM_ILLUM) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_ILLUM),hWnd1, & LOC(Dialog_Illum),0) case (IDM_ATH) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_ATH),hWnd1, & LOC(Dialog_Ath),0) case (IDM_LG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_LG),hWnd1, & LOC(Dialog_Lg),0) case (IDM_WG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_WG),hWnd1, & LOC(Dialog_Wg),0) case (IDM_MEMS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_MEMS),hWnd1, & LOC(Dialog_Mems),0) case (IDM_CONFIG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_CONFIG),hWnd1, & LOC(Dialog_Config),0) case (IDM_LIST_SYS) filen=file_lens ititle=ititle_l call Dialog_list_Sys IF (.not.breport) THEN LastInfoSelected=INFO_LIST_SYS idCtrl = LOWORD(wParam) ! hWndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_GAUS) filen=file_lens ititle=ititle_l call Dialog_List_Gaus i = DialogBoxParam_G(hInst1,(IDD_GAUS),hWnd1, & LOC(Dialog_Gaus),0) case (IDM_LAM) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_LAMBDA),hWnd1, & LOC(Dialog_Lam),0) case (IDM_VIG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_VIG),hWnd1, & LOC(Dialog_Vig),0) case (IDM_APO) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_APO),hWnd1, & LOC(Dialog_Apo),0) case (IDM_BEAM) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_BEAM),hWnd1, & LOC(Dialog_Beam),0) IF (.not.(cancel)) THEN CALL BEAM_TRACE_PRINTOUT(.TRUE.) IF (.not.breport) THEN LastInfoSelected=INFO_BEAM idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_MIRR) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_MIRR),hWnd1, & LOC(Dialog_Mirr),0) IF (.not.(cancel)) THEN call Mirror_Matrix IF (.not.breport) THEN LastInfoSelected=INFO_MIRR idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case(IDM_LIST_GAUS) filen=file_lens ititle=ititle_l call Dialog_List_Gaus IF (.not.breport) THEN LastInfoSelected=INFO_LIST_GAUS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case(IDM_PSI) filen=file_lens ititle=ititle_l call Dialog_Psi lineno_psi=lineno IF (.not.breport) THEN LastInfoSelected=INFO_PSI idCtrl = LOWORD(wParam) ! hWndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF DO i=1,lineno_psi print_line_psi(i)=print_line(i) END DO ! (i) case (IDM_CYC) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_CYC),hWnd, & LOC(Dialog_Cyc),0) IF (.not.(cancel)) THEN lineno=0 IF (cycle_resolve) THEN CALL optimization_cycle ELSE CALL resolve_cyc ENDIF lineno_cyc=lineno IF (.not.breport) THEN LastInfoSelected=INFO_CYC idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF DO i=1,lineno_cyc print_line_cyc(i)=print_line(i) END DO ! (i) ENDIF case (IDM_MER) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst,(IDD_MER),hWnd1, & LOC(Dialog_Mer),0) case (IDM_PAR) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PAR),hWnd1, & LOC(Dialog_Par),0) case (IDM_TIE) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_TIE),hWnd1, & LOC(Dialog_Tie),0) case (IDM_DFINC) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_DFINC),hWnd1, & LOC(Dialog_Dfinc),0) case(IDM_CHA) filen=file_lens ititle=ititle_l call Dialog_Cha IF (.not.breport) THEN LastInfoSelected=INFO_CHA idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_WPAR) filen=file_lens ititle=ititle_l ! if (SaveAs_Var(hWnd)==TRUE) then i = EnableMenuItem(GetMenu(hWnd1),IDM_WPAR, & IOR(MF_BYCOMMAND,MF_ENABLED)) ! iret = ConvertFToCString(FileNameString,OpenFN%lpstrFile) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = SetWindowText(hWnd1,'OPTICSOFT-II version 2603'C) i = DrawMenuBar(hWnd1) ! end if case (IDM_RPAR) filen=file_lens ititle=ititle_l if (Open_File_Var(hWnd)==TRUE) then !? i = EnableMenuItem(GetMenu(hWnd1),IDM_WPAR, & IOR(MF_BYCOMMAND,MF_ENABLED)) ! iret=ConvertFToCString(FileNameString,OpenFN%lpstrFile) iret=ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = SetWindowText(hWnd1,'OPTICSOFT-II version 2603'C) i = DrawMenuBar(hWnd1) end if case (IDM_ZYGO) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_ZYGO),hWnd1, & LOC(Dialog_Zygo),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_ZYGO idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case(IDM_MAT) filen=file_lens ititle=ititle_l call Dialog_Mat IF (.not.breport) THEN LastInfoSelected=INFO_MAT idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_LOSS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_LOSS),hWnd1, & LOC(Dialog_LOSS),0) IF (.not.(cancel)) THEN CALL THROUGHPUT lineno_loss=lineno IF (.not.breport) THEN LastInfoSelected=INFO_LOSS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF DO i=1,lineno_loss print_line_loss(i)=print_line(i) END DO ! (i) ENDIF case (IDM_TRACK) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_TRACK),hWnd1, & LOC(Dialog_Track),0) case (IDM_GSA) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GSA),hWnd1, & LOC(Dialog_Gsa),0) case (IDM_GSATEST) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GSATEST),hWnd1, & LOC(Dialog_Gsatest),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_GSATEST idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ! IF (.not.(cancel)) THEN ! IF (igsatest_run.eq.0) THEN ! LastInfoSelected=INFO_GSATEST ! hwndChildWindow=CreateChildWindow(LOWORD(wParam )) ! ELSE ! lineno=0 ! CALL gsatest_run ! lineno_gsatest=lineno ! IF (.not.breport) THEN ! LastInfoSelected=INFO_GSATEST ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) ! ENDIF ! DO i=1,lineno_gsatest ! print_line_gsatest(i)=print_line(i) ! END DO ! (i) ! ENDIF ! ENDIF case (IDM_RAY) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_RAY),hWnd1,LOC(Dialog_Ray),0) IF (.not.(cancel)) THEN CALL RAY_TRACE_PRINTOUT IF (.not.breport) THEN LastInfoSelected=INFO_RAY idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case(IDM_GLOB) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GLOB),hWnd1,LOC(Dialog_Glob),0) IF (.not.(cancel)) THEN CALL GLOBAL_PRINTOUT IF (.not.breport) THEN LastInfoSelected=INFO_GLOB idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case(IDM_SEI) filen=file_lens ititle=ititle_l call Dialog_Sei IF (.not.breport) THEN LastInfoSelected=INFO_SEI idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case(IDM_ABN) filen=file_lens ititle=ititle_l call Dialog_Abn IF (.not.breport) THEN LastInfoSelected=INFO_ABN idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PEP) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PEP),hWnd1, & LOC(Dialog_Pep),0) IF (.not.(cancel)) THEN call pep IF (.not.breport) THEN LastInfoSelected=INFO_PEP idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_POLY) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_POLY),hWnd1, & LOC(Dialog_Poly),0) IF (.not.(cancel)) THEN call pep call poly IF (.not.breport) THEN LastInfoSelected=INFO_POLY idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_OTF) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_OTF),hWnd1, & LOC(Dialog_Otf),0) IF (.not.(cancel)) THEN otpsb=.true. call pep call poly call otfpsf IF (.not.breport) THEN LastInfoSelected=INFO_OTF idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_PSF) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PSF),hWnd1, & LOC(Dialog_Psf),0) IF (.not.(cancel)) THEN inormsfp=idatpl(32) CALL psf_rms_enen_calc(0) IF (.not.breport) THEN LastInfoSelected=INFO_PSF idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_RMS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_RMS),hWnd1, & LOC(Dialog_Rms),0) IF (.not.(cancel)) THEN CALL psf_rms_enen_calc(1) IF (.not.breport) THEN LastInfoSelected=INFO_RMS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_ENEN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_ENEN),hWnd1, & LOC(Dialog_Enen),0) IF (.not.(cancel)) THEN CALL psf_rms_enen_calc(idatpl(36)+2) IF (.not.breport) THEN LastInfoSelected=INFO_ENEN idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_SST) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SST),hWnd1, & LOC(Dialog_Sst),0) IF (.not.(cancel)) THEN CALL TILT_TOLERANCING IF (.not.breport) THEN LastInfoSelected=INFO_SST idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_TOL) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_TOL),hWnd1, & LOC(Dialog_Tol),0) IF (.not.(cancel)) THEN CALL TOLERANCING lineno_tol=lineno IF (.not.breport) THEN LastInfoSelected=INFO_TOL idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF DO i=1,lineno_tol print_line_tol(i)=print_line(i) END DO ! (i) ENDIF case (IDM_RECONF) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_RECONF),hWnd1, & LOC(Dialog_Reconf),0) case (IDM_SAG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SAG),hWnd1, & LOC(Dialog_Sag),0) IF (.not.(cancel)) THEN CALL Sag_table IF (.not.breport) THEN LastInfoSelected=INFO_SAG idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_SPECL) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_SPECL),hWnd1, & LOC(Dialog_Specl),0) case (IDM_GLA_VIEW) filen=file_lens ititle=ititle_l call Dialog_Gla_View IF (.not.breport) THEN LastInfoSelected=INFO_GLA_VIEW idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_GLA_MOD) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GLA_MOD),hWnd1, & LOC(Dialog_Gla),0) case (IDM_PSYS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PSYS),hWnd1, & LOC(Dialog_Psys),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PSYS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PABN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PABN),hWnd1, & LOC(Dialog_Pabn),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PABN idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PSD) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PSD),hWnd1, & LOC(Dialog_Psd),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PSD idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_POTF) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_POTF),hWnd1, & LOC(Dialog_Potf),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_POTF idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PPSF) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PPSF),hWnd1, & LOC(Dialog_Ppsf),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PPSF idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PENEN) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PENEN),hWnd1, & LOC(Dialog_Penen),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PENEN idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PLOSS) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PLOSS),hWnd1, & LOC(Dialog_Ploss),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PLOSS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PMAP) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PMAP),hWnd1, & LOC(Dialog_Pmap),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PMAP idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PINTER) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PINTER),hWnd1, & LOC(Dialog_Pinter),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PINTER idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PASPH) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PASPH),hWnd1, & LOC(Dialog_Pasph),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PASPH idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_PANG) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_PANG),hWnd1, & LOC(Dialog_Pang),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PANG idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_CE) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_CE),hWnd1, & LOC(Dialog_Ce),0) IF (.not.(cancel)) THEN CALL Ce_printout IF (.not.breport) THEN LastInfoSelected=INFO_CE idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF ENDIF case (IDM_GHOST) filen=file_lens ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_GHOST),hWnd1, & LOC(Dialog_Ghost),0) IF (.not.(cancel).and.ianacon.eq.1) THEN CALL Ghost_printout lineno_ghost=lineno IF (.not.breport) THEN LastInfoSelected=INFO_GHOST idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF DO i=1,lineno_ghost print_line_ghost(i)=print_line(i) END DO ! (i) ENDIF case (IDM_ANALYSIS) filen=file_lens ititle=ititle_l call Dialog_List_Sys call Dialog_List_Gaus call Dialog_Sei call Dialog_Abn IF (.not.breport) THEN LastInfoSelected=INFO_ANALYSIS idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_REPORT_BEGIN) filen=file_lens ititle=ititle_l breport=.true. lineno=0 case (IDM_REPORT_END) filen=file_lens ititle=ititle_l breport=.false. I1=0 I2=2 DO I=1,200 IF (FILEN(I:I)=='\') I1=I IF (FILEN(I:I)=='.') I2=I END DO ! (I) OPEN(UNIT=3,FILE=FILEN(I1+1:I2-1)//'.REP') DO I=1,LINENO WRITE(3,150) PRINT_LINE(I) END DO ! (I) CLOSE(UNIT=3) case (IDM_DATA_SHEET) filen=file_lens ititle=ititle_l CALL Data_sheet case (IDM_ZEMAX_INPUT) filen=file_zemax ititle=ititle_l if ( OpenNewFile_z( hWnd ) == TRUE ) then ! enable the Save As and Print menu items i = EnableMenuItem( GetMenu( hWnd1 ), IDM_ZEMAX_OUTPUT,& IOR(MF_BYCOMMAND , MF_ENABLED )) ! i = EnableMenuItem( GetMenu( hWnd ), IDM_PRINT,& ! IOR(MF_BYCOMMAND , MF_ENABLED )) i = DrawMenuBar( hWnd1 ) ! reset the title in the title bar to reflect the new open file iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile) ) ! writes the file name and the program name in the title bar j = lstrlen(FileNameString) !======= Manu modification FileNameFortran = "" DO i=1,j FileNameFortran(i:i) = FileNameString(i:i) END DO crColor = 0 NewFont = FALSE end if case (IDM_ZEMAX_OUTPUT) filen=file_zemax ititle=ititle_l if ( SaveAs_z( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu(hWnd1),IDM_ZEMAX_OUTPUT, & IOR(MF_BYCOMMAND,MF_ENABLED)) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO ! i = DrawMenuBar( hWnd ) i = DrawMenuBar( hWnd1 ) end if !*************Filter commands************** case (IDM_FIL_NEW) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_INIT),hWnd1, & LOC(Dialog_Init_f),0) IF (.not.(cancel)) THEN filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_SYSTF),hWnd1, & LOC(Dialog_Systf_f),0) ititle=ititle_f ENDIF case (IDM_FIL_OPEN) filen=file_filter ititle=ititle_f if ( OpenNewFile_F( hWnd ) == TRUE ) then ! enable the Save As and Print menu items i = EnableMenuItem( GetMenu( hWnd1 ), IDM_FIL_SAVE,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = EnableMenuItem( GetMenu( hWnd1 ), IDM_PRINT,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = DrawMenuBar( hWnd1 ) ! reset the title in the title bar to reflect the new open file iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile) ) ! writes the file name and the program name in the title bar j = lstrlen(FileNameString) !======= Manu modification FileNameFortran = "" DO i=1,j FileNameFortran(i:i) = FileNameString(i:i) END DO crColor = 0 NewFont = FALSE end if case (IDM_FIL_SAVE) !save the file that is open filen=file_filter ititle=ititle_f OpenFN%Flags = 0 i = SaveToFile_F() case (IDM_FIL_SAVEAS) !save under a new name filen=file_filter ititle=ititle_f if ( SaveAs_F( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu(hWnd1),IDM_FIL_SAVE, & IOR(MF_BYCOMMAND,MF_ENABLED)) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = DrawMenuBar( hWnd1 ) end if case (IDM_FIL_PAR_SAVE) !save under a new name filen=file_filter ititle=ititle_f if ( SaveAs_Var_f( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu(hWnd1),IDM_FIL_PAR_SAVE, & IOR(MF_BYCOMMAND,MF_ENABLED)) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = DrawMenuBar( hWnd1 ) end if case (IDM_FIL_PAR_OPEN) filen=file_filter ititle=ititle_f if ( Open_File_Var_f( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu( hWnd1 ), IDM_FIL_PAR_SAVE,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = DrawMenuBar( hWnd1 ) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile) ) ! writes the file name and the program name in the title bar j = lstrlen(FileNameString) !======= Manu modification FileNameFortran = "" DO i=1,j FileNameFortran(i:i) = FileNameString(i:i) END DO crColor = 0 NewFont = FALSE end if case (IDM_FIL_SYSTF) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_SYSTF),hWnd1, & LOC(Dialog_Systf_f),0) ititle=ititle_f case (IDM_FIL_SYSGL) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_SYSGL),hWnd1, & LOC(Dialog_Sysgl_f),0) ititle=ititle_f case (IDM_FIL_SPECS) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_SPECS),hWnd1, & LOC(Dialog_Specs_f),0) case (IDM_FIL_MER) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_MER),hWnd1, & LOC(Dialog_Mer_f),0) case (IDM_FIL_PAR_MOD) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_PAR_MOD),hWnd1, & LOC(Dialog_Par_f),0) case (IDM_FIL_PAR_DFINC) filen=file_filter ititle=ititle_l i = DialogBoxParam_G(hInst1,(IDD_FIL_PAR_DFINC),hWnd1, & LOC(Dialog_Dfinc_f),0) case (IDM_FIL_CYC) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_CYC),hWnd1, & LOC(Dialog_Cyc_f),0) IF (.not.(cancel)) THEN lineno=0 IF (cycle_resolve_f) THEN CALL optimization_cycle_f(0) ELSE CALL resolve_delete_f ENDIF LastInfoSelected=INFO_CYC_F idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_FIL_PLOT) filen=file_filter ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_PLOT),hWnd1, & LOC(Dialog_Plot_f),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PLOT_F idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_FIL_LIST) filen=file_filter ititle=ititle_f CALL Dialog_List_f IF (.not.breport) THEN LastInfoSelected=INFO_LIST_F idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_FIL_TRA) filen=file_filter ititle=ititle_f CALL Dialog_Tra_f IF (.not.breport) THEN LastInfoSelected=INFO_TRA_F idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_FIL_MASK) ! filen=file_filter ! ititle=ititle_f i = DialogBoxParam_G(hInst1,(IDD_FIL_MASK),hWnd1, & LOC(Dialog_Mask_f),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_MASK_F idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF !*************Jones Matrix commands************** case (IDM_JM_NEW) filen=file_jm ititle=ititle_j i = DialogBoxParam_G(hInst1,(IDD_JM_INIT),hWnd1, & LOC(Dialog_Init_j),0) IF (.not.(cancel)) THEN filen=file_jm ititle=ititle_j i = DialogBoxParam_G(hInst1,(IDD_JM_SYS),hWnd1, & LOC(Dialog_Sys_j),0) ititle=ititle_j ENDIF case (IDM_JM_OPEN) filen=file_jm ititle=ititle_j if ( OpenNewFile_J( hWnd ) == TRUE ) then ! enable the Save As and Print menu items i = EnableMenuItem( GetMenu( hWnd1 ), IDM_JM_SAVE,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = EnableMenuItem( GetMenu( hWnd1 ), IDM_PRINT,& IOR(MF_BYCOMMAND , MF_ENABLED )) i = DrawMenuBar( hWnd1 ) ! reset the title in the title bar to reflect the new open file iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile) ) ! writes the file name and the program name in the title bar j = lstrlen(FileNameString) !======= Manu modification FileNameFortran = "" DO i=1,j FileNameFortran(i:i) = FileNameString(i:i) END DO crColor = 0 NewFont = FALSE end if case (IDM_JM_SAVE) !save the file that is open filen=file_jm ititle=ititle_j OpenFN%Flags = 0 i = SaveToFile_J() case (IDM_JM_SAVEAS) !save under a new name filen=file_jm ititle=ititle_j if ( SaveAs_J( hWnd ) == TRUE ) then i = EnableMenuItem( GetMenu(hWnd1),IDM_JM_SAVE, & IOR(MF_BYCOMMAND,MF_ENABLED)) iret = ConvertFToCString(FileNameString,INT(OpenFN%lpstrFile)) ! writes the file name and the program name in the title bar j=lstrlen(FileNameString) FileNameFortran="" DO i=1,j FileNameFortran(i:i)=FileNameString(i:i) END DO i = DrawMenuBar( hWnd1 ) end if case (IDM_JM_SYS) filen=file_jm ititle=ititle_j ! first_time=.true. i = DialogBoxParam_G(hInst1,(IDD_JM_SYS),hWnd1, & LOC(Dialog_Sys_j),0) ititle=ititle_j case (IDM_JM_PLOT) filen=file_jm ititle=ititle_j i = DialogBoxParam_G(hInst1,(IDD_JM_PLOT),hWnd1, & LOC(Dialog_Plot_j),0) IF (.not.(cancel)) THEN LastInfoSelected=INFO_PLOT_J idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_JM_COMP) filen=file_jm ititle=ititle_j CALL out_jm IF (.not.breport) THEN LastInfoSelected=INFO_COMP_J idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case (IDM_JM_LIST) filen=file_jm ititle=ititle_j CALL Dialog_List_j IF (.not.breport) THEN LastInfoSelected=INFO_LIST_J idCtrl = LOWORD(wParam) ! hwndChildWindow=CreateChildWindow(LOWORD(wParam)) hwndChildWindow=CreateChildWindow(idCtrl) ENDIF case default ! MainWndProc=DefFrameProc(hWnd1,ghwndClient,message,wParam,lParam) MainWndProc=DefFrameProc(hWnd1,ghwndClient1,message,wParam1,lParam1) return end select case default ! MainWndProc=DefFrameProc(hWnd1,ghwndClient,message,wParam,lParam) MainWndProc=DefFrameProc(hWnd1,ghwndClient1,message,wParam1,lParam1) return end select return end ! integer function MainWndProc !**************************************************************************** ! ! FUNCTION: CenterWindow (HWND, HWND) ! ! PURPOSE: Center one window over another ! ! COMMENTS: Dialog boxes take on the screen position that they were designed ! at, which is not always appropriate. Centering the dialog over a ! particular window usually results in a better position. ! !**************************************************************************** subroutine CenterWindow (hwndChild, hwndParent) use user32 use gdi32 use Win_intr implicit none ! integer hwndChild, hwndParent integer(handle):: hwndChild, hwndParent include 'osd.fd' ! Variables type (T_RECT) rChild, rParent integer wChild, hChild, wParent, hParent integer wScreen, hScreen, xNew, yNew ! integer hdc integer(handle):: hdc integer*4 retval ! Get the Height and Width of the child window retval = GetWindowRect (hwndChild, rChild) wChild = rChild.right - rChild.left hChild = rChild.bottom - rChild.top ! Get the Height and Width of the parent window retval = GetWindowRect (hwndParent, rParent) wParent = rParent.right - rParent.left hParent = rParent.bottom - rParent.top ! Get the display limits hdc = GetDC (hwndChild) wScreen = GetDeviceCaps (hdc, HORZRES) hScreen = GetDeviceCaps (hdc, VERTRES) retval = ReleaseDC (hwndChild, hdc) ! Calculate new X position, then adjust for screen xNew = rParent.left + ((wParent - wChild) /2) if (xNew .LT. 0) then xNew = 0 else if ((xNew+wChild) .GT. wScreen) then xNew = wScreen - wChild end if ! Calculate new Y position, then adjust for screen yNew = rParent.top + ((hParent - hChild) /2) if (yNew .LT. 0) then yNew = 0 else if ((yNew+hChild) .GT. hScreen) then yNew = hScreen - hChild end if ! Set it, and return retval = SetWindowPos (hwndChild, NULL, xNew, yNew, 0, 0, & IOR(SWP_NOSIZE , SWP_NOZORDER)) end ! *************************************************************************** ! ! FUNCTION: ProcessCDError(DWORD,hWnd) ! ! PURPOSE: Processes errors from the common dialog functions. ! ! COMMENTS: ! ! This function is called whenever a common dialog function ! fails. The CommonDialogExtendedError() value is passed to ! the function which maps the error value to a string table. ! The string is loaded and displayed for the user. ! ! RETURN VALUES: ! void. ! !*************************************************************************** subroutine ProcessCDError( dwErrorCode, hWnd) use win_intr include 'osd.fd' integer dwErrorCode, hWnd ! integer dwErrorCode ! 26-03-2026 integer(HANDLE):: hWnd1 integer wStringID character*256 buf select case(dwErrorCode) case (CDERR_DIALOGFAILURE) wStringID=IDS_DIALOGFAILURE case (CDERR_STRUCTSIZE) wStringID=IDS_STRUCTSIZE case (CDERR_INITIALIZATION) wStringID=IDS_INITIALIZATION case (CDERR_NOTEMPLATE) wStringID=IDS_NOTEMPLATE case (CDERR_NOHINSTANCE) wStringID=IDS_NOHINSTANCE case (CDERR_LOADSTRFAILURE) wStringID=IDS_LOADSTRFAILURE case (CDERR_FINDRESFAILURE) wStringID=IDS_FINDRESFAILURE case (CDERR_LOADRESFAILURE) wStringID=IDS_LOADRESFAILURE case (CDERR_LOCKRESFAILURE) wStringID=IDS_LOCKRESFAILURE case (CDERR_MEMALLOCFAILURE) wStringID=IDS_MEMALLOCFAILURE case (CDERR_MEMLOCKFAILURE) wStringID=IDS_MEMLOCKFAILURE case (CDERR_NOHOOK) wStringID=IDS_NOHOOK case (PDERR_SETUPFAILURE) wStringID=IDS_SETUPFAILURE case (PDERR_PARSEFAILURE) wStringID=IDS_PARSEFAILURE case (PDERR_RETDEFFAILURE) wStringID=IDS_RETDEFFAILURE case (PDERR_LOADDRVFAILURE) wStringID=IDS_LOADDRVFAILURE case (PDERR_GETDEVMODEFAIL) wStringID=IDS_GETDEVMODEFAIL case (PDERR_INITFAILURE) wStringID=IDS_INITFAILURE case (PDERR_NODEVICES) wStringID=IDS_NODEVICES case (PDERR_NODEFAULTPRN) wStringID=IDS_NODEFAULTPRN case (PDERR_DNDMMISMATCH) wStringID=IDS_DNDMMISMATCH case (PDERR_CREATEICFAILURE) wStringID=IDS_CREATEICFAILURE case (PDERR_PRINTERNOTFOUND) wStringID=IDS_PRINTERNOTFOUND case (CFERR_NOFONTS) wStringID=IDS_NOFONTS case (FNERR_SUBCLASSFAILURE) wStringID=IDS_SUBCLASSFAILURE case (FNERR_INVALIDFILENAME) wStringID=IDS_INVALIDFILENAME case (FNERR_BUFFERTOOSMALL) wStringID=IDS_BUFFERTOOSMALL case (0) ! User may have hit CANCEL or we got a *very* random error return case default wStringID=IDS_UNKNOWNERROR end select i = LoadString(NULL, wStringID, buf, len(buf)) ! iret = MessageBox(hWnd, buf, ""C, MB_OK) iret = MessageBox(hWnd1, buf, ""C, MB_OK) ! 10-04-2026 return end ! subroutine ProcessCDError !******************************************************************************* Subroutine info_field use win_intr include 'dia_intr.inc' ! INTEGER hIF(10) INTEGER(handle):: hIF(10) CHARACTER(2) string_2 110 FORMAT(I2) hIF(1)=hwndInfoField_01 hIF(2)=hwndInfoField_02 hIF(3)=hwndInfoField_03 hIF(4)=hwndInfoField_04 hIF(5)=hwndInfoField_05 hIF(6)=hwndInfoField_06 hIF(7)=hwndInfoField_07 hIF(8)=hwndInfoField_08 hIF(9)=hwndInfoField_09 hIF(10)=hwndInfoField_10 do ifcount=1,8 bret=SetWindowText(hIF(ifcount),' ') end do ! (ifcount) write(string_2,110) imct+1 bret=SetWindowText(hIF(1),'gaussian mode #'//string_2) if (nozm.gt.1) then write(string_2,110) nz bret=SetWindowText(hIF(2),' config #'//string_2//' ') else bret=SetWindowText(hIF(2),' config # 0 ') endif ifcount=2 if (icanon.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' can ') endif if (itelcen.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' tel ') endif if (igbp.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' gbp ') endif if (latcol_x.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' lcx ') endif if (latcol_y.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' lcy ') endif if (image.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' img ') endif if (idw20.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' w20 ') endif if (ipan.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' pan ') endif if (illum.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' ill ') endif if (itherm.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' ath ') endif if (scat.eq.1) then ifcount=ifcount+1 bret=SetWindowText(hIF(ifcount),' sct ') endif end !(info_field)