|
XHello is "Hello World" Xeffort Sample:
Download XHello Project (dependent on Xeffort Full Installation)
!======================================================================= ! _____________________________ ! \\//----------------------------- ! )( //= //= //= //// //)) // ! //\\ //_ // // /__/ //\\ // !======================================================================= ! XEFFORT LIBRARY SAMPLES !======================================================================= ! XHello.f90 - Xeffort "Hello world" sample ! ! 2005. Xeffort.com ! Jugoslav Dujic (jdujic@uns.ns.ac.yu) ! ! You are free to use the code for both commercial and non-commercial ! use. The code is provided as-is without warranties. You are free to ! distribute and modify this source code provided that the list of ! original author(s) remains untouched and your revisions are indicated ! as such. Contributions are welcome. !======================================================================= MODULE XHello USE Xeffort USE DFWIN IMPLICIT NONE TYPE(X_MENU):: xMenu !Main menu !====================================================================== CONTAINS !===================================================================== !PURPOSE: Initialization function called by Xeffort library on app start. LOGICAL FUNCTION XInit(szCmdLine,nCmdShow) !DEC$IF (_DF_VERSION_.GT.650) !DEC$ATTRIBUTES DEFAULT, DECORATE, ALIAS: 'XINIT':: XInit !DEC$ELSE !DEC$ATTRIBUTES ALIAS: '_XINIT@12':: XInit !DEC$ENDIF IMPLICIT NONE CHARACTER(*), INTENT(IN):: szCmdLine INTEGER, INTENT(IN):: nCmdShow LOGICAL:: bSt INTEGER:: ist INCLUDE 'Resource.fd' !Loading menu resource xMenu = XLoadMenu(IDR_MENU_HELLO) bSt = XLoadAccelerators(IDR_ACCELERATOR) !Creation of App & frame window bSt = XCreateSDIApp(xMenu, "Xeffort Hello World", IDI_ICON_XFT) bSt = XSetHandler(XW_FRAME, WM_PAINT, XW_FRAME_OnPaint) bSt = XSetHandler(XW_FRAME, WM_SIZE, XW_FRAME_OnSize) bSt = XSetCommand(XW_FRAME, IDM_HELP_ABOUT, XW_FRAME_OnAbout) bSt = XSetCommand(XW_FRAME, IDM_FILE_CLOSE, XW_FRAME_OnExit) XInit = .TRUE. END FUNCTION XInit !===================================================================== !Handler for painting in the main window. Does not use double-buffering LOGICAL FUNCTION XW_FRAME_OnPaint(xWnd,xDC,iX1,iY1,iX2,iY2) TYPE(X_WINDOW):: xWnd !Window TYPE(X_DC):: xDC !Window's DC INTEGER,INTENT(IN):: iX1,iY1,iX2,iY2 !Dimensions of update rectangle LOGICAL:: iSt iSt = XFillViewport(xDC, X_BRUSH(BS_SOLID, XCOLOR_WHITE, 0)) CALL XSetWindow(xDC, 0., 0., 100., 100.) iSt = XSetFont_W(xDC, "Arial", 14.) iSt = XTextOut_W(xDC,50.,50.,"Hello World!", XCOLOR_BLACK, iStyle=TA_CENTER) XW_FRAME_OnPaint = .TRUE. END FUNCTION XW_FRAME_OnPaint !===================================================================== !Handler for File/Exit menu SUBROUTINE XW_FRAME_OnExit(xWnd,ID,nCode) TYPE(X_WINDOW):: xWnd INTEGER:: ID, nCode INTEGER:: iSt iSt=XSendMessage(XW_FRAME,WM_CLOSE,0,0) END SUBROUTINE XW_FRAME_OnExit !===================================================================== !Help/About handler SUBROUTINE XW_FRAME_OnAbout(xWnd,ID,nCode) TYPE(X_WINDOW):: xWnd INTEGER:: ID, nCode TYPE(X_WINDOW):: xDlg LOGICAL:: bSt INTEGER:: iSt INCLUDE "Resource.fd" bSt = XLoadDialog(IDD_DIALOG_ABOUT, xDlg, xWnd) iSt = XModalDialog(xDlg) CALL XDestroyDialog(xDlg) END SUBROUTINE XW_FRAME_OnAbout !======================================================================= !XW_FRAME_OnSize is called after the window XW_FRAME is resized LOGICAL FUNCTION XW_FRAME_OnSize(xWnd, iWidth, iHeight, nFlag) TYPE(X_WINDOW):: xWnd INTEGER, INTENT(IN):: iWidth, iHeight !Dimensions of client area INTEGER, INTENT(IN):: nFlag !Type of sizing requested CALL XUpdateWindow(xWnd) XW_FRAME_OnSize = .FALSE. !Return .TRUE. to prevent default processing END FUNCTION XW_FRAME_OnSize !===================================================================== END MODULE XHello |