Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #define fbc -s console
- 'default.rc
- #include once "windows.bi"
- #include once "win\commctrl.bi"
- #include once "crt.bi"
- '*************** Enumerating our control id's ***********
- enum WindowControls
- wcMain
- wcButton
- wcEdit
- wcLast
- end enum
- dim shared as hwnd CTL(wcLast) 'controls
- dim shared as hinstance APPINSTANCE 'instance
- dim shared as hfont MyFont 'fonts
- dim shared as string sAppName 'AppName (window title 'prefix')
- declare sub WinMain()
- sAppName = "GUI Example"
- InitCommonControls()
- APPINSTANCE = GetModuleHandle(null)
- WinMain() '<- main function
- ' *************** Procedure Function ****************
- function WndProc ( hWnd as HWND, message as UINT, wParam as WPARAM, lParam as LPARAM ) as LRESULT
- select case( message )
- case WM_CREATE 'Window was created
- if CTL(wcMain) then return 0
- CTL(wcMain) = hwnd
- 'just a macro to help creating controls
- #define CreateControl( mID , mExStyle , mClass , mCaption , mStyle , mX , mY , mWid , mHei ) CTL(mID) = CreateWindowEx(mExStyle,mClass,mCaption,mStyle,mX,mY,mWid,mHei,hwnd,cast(hmenu,mID),APPINSTANCE,null)
- #define UpDn UPDOWN_CLASS
- const cStyle = WS_CHILD or WS_VISIBLE 'Standard style for buttons class controls :)
- const cUpDnStyle = cStyle or UDS_AUTOBUDDY' or UDS_SETBUDDYINT
- const cButtonStyle = cStyle
- const cLabelStyle = cStyle
- const cTxtStyle = cStyle or ES_AUTOVSCROLL or WS_VSCROLL or ES_MULTILINE
- const RichStyle = cStyle or ES_READONLY or ES_AUTOVSCROLL or WS_VSCROLL or ES_MULTILINE
- const cBrd = WS_EX_CLIENTEDGE
- ' **** Creating a Control ****
- CreateControl( wcButton , null , "button" , "Click" , cStyle , 10 , 10 , 80 , 24 )
- CreateControl( wcEdit , cBrd , "edit" , "Hello World " , cTxtStyle , 10 , 44 , 320 , 240 )
- ' **** Creating a font ****
- var hDC = GetDC(hWnd) 'can be used for other stuff that requires a temporary DC
- var nHeight = -MulDiv(12, GetDeviceCaps(hDC, LOGPIXELSY), 72) 'calculate size matching DPI
- MyFont = CreateFont(nHeight,0,0,0,FW_NORMAL,0,0,0,DEFAULT_CHARSET,0,0,DRAFT_QUALITY or ANTIALIASED_QUALITY,0,"Verdana")
- ' **** Setting this font for all controls ****
- for CNT as integer = wcMain to wcLast-1
- SendMessage(CTL(CNT),WM_SETFONT,cast(wparam,MyFont),true)
- next CNT
- SendMessage(CTL(wcEdit),EM_SETLIMITTEXT,0,0)
- ReleaseDC(hWnd,hDC)
- SetFocus(hwnd)
- case WM_COMMAND 'Event happened to a control (child window)
- select case hiword(wparam)
- case EN_CHANGE
- print SendMessage(CTL(wcEdit),WM_GETTEXTLENGTH,0,0)
- case BN_CLICKED 'button click
- select case lparam
- case CTL(wcButton)
- Messagebox( hwnd , "Bye" , "Bye" , MB_ICONINFORMATION )
- PostQuitMessage(0)
- end select
- end select
- case WM_DESTROY 'Windows was closed/destroyed
- PostQuitMessage(0) ' to quit
- return 0
- end select
- ' *** if program reach here default predefined action will happen ***
- return DefWindowProc( hWnd, message, wParam, lParam )
- end function
- ' *********************************************************************
- ' *********************** SETUP MAIN WINDOW ***************************
- ' ******************* This code can be ignored ************************
- ' *********************************************************************
- sub WinMain ()
- dim wMsg as MSG
- dim wcls as WNDCLASS
- dim as HWND hWnd
- '' Setup window class
- with wcls
- .style = CS_HREDRAW or CS_VREDRAW
- .lpfnWndProc = @WndProc
- .cbClsExtra = 0
- .cbWndExtra = 0
- .hInstance = APPINSTANCE
- .hIcon = LoadIcon( APPINSTANCE, "FB_PROGRAM_ICON" )
- .hCursor = LoadCursor( NULL, IDC_ARROW )
- .hbrBackground = GetSysColorBrush( COLOR_BTNFACE )
- .lpszMenuName = NULL
- .lpszClassName = strptr( sAppName )
- end with
- '' Register the window class
- if( RegisterClass( @wcls ) = FALSE ) then
- MessageBox( null, "Failed to register wcls!", sAppName, MB_ICONINFORMATION )
- exit sub
- end if
- '' Create the window and show it
- const cStyleEx = 0 'WS_EX_COMPOSITED or WS_EX_LAYERED
- const cStyle = WS_VISIBLE or WS_TILEDWINDOW or WS_CLIPCHILDREN
- dim as RECT tWndRc = (0,0,640,480)
- AdjustWindowRectEx( @tWndRc , cStyle , FALSE , cStyleEx )
- hWnd = CreateWindowEx(cStyleEx,sAppName,sAppName,cStyle, _
- 200,200,tWndRc.right-tWndRc.left,tWndRc.bottom-tWndRc.top,null,null,APPINSTANCE,0)
- '' Process windows messages
- ' *** all messages(events) will be read converted/dispatched here ***
- UpdateWindow( hWnd )
- while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )
- 'if IsDialogMessage( hWnd ,@wMsg ) then continue while
- TranslateMessage( @wMsg )
- DispatchMessage( @wMsg )
- wend
- end sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement