Advertisement
Mysoft

Untitled

Mar 28th, 2016
573
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #define fbc -s console
  2. #include once "windows.bi"
  3. #include once "win\commctrl.bi"
  4.  
  5. '*************** Enumerating our control id's ***********
  6. enum WindowControls
  7.   wcMain  
  8.   wcStaticA
  9.   wcStaticB
  10.   wcStaticC  
  11.   wcLast
  12. end enum
  13.  
  14. dim shared as hwnd CTL(wcLast)       'controls
  15. dim shared as hinstance APPINSTANCE  'instance
  16. dim shared as hfont MyFont,MyFont2   'fonts
  17. dim shared as string sAppName        'AppName (window title 'prefix')
  18.  
  19. declare sub WinMain()
  20.  
  21. sAppName = "GUI Test"
  22. InitCommonControls()
  23. APPINSTANCE = GetModuleHandle(null)
  24. WinMain() '<- main function
  25.  
  26. dim shared as any ptr ButProc
  27.  
  28. ' *************** Procedure Function ****************
  29. ' *********** ALL EVENTS WILL HAPPEN HERE ***********
  30.  
  31.  
  32. function WndProc ( hWnd as HWND, message as UINT, wParam as WPARAM, lParam as LPARAM ) as LRESULT
  33.    
  34.   select case( message )
  35.   case WM_CREATE 'Window was created
  36.    
  37.     'just a macro to help creating controls
  38.     #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)
  39.    
  40.     const cStyle = WS_CHILD or WS_VISIBLE
  41.     const cButtonStyle = cStyle                        
  42.     const cEditStyle = cStyle or ES_NUMBER or ES_RIGHT      
  43.     const cStaticLabel = cStyle or SS_RIGHT
  44.     const cStaticFrame = cStyle or WS_DLGFRAME
  45.     const cExBorder = WS_EX_CLIENTEDGE
  46.     const TRACKBAR = TRACKBAR_CLASS
  47.        
  48.     CreateControl( wcStaticA , WS_EX_STATICEDGE , "static"   , "WS_EX_STATICEDGE" , cStaticLabel , 16 , 16 , 100 , 128 )
  49.     CreateControl( wcStaticB , WS_EX_CLIENTEDGE , "static"   , " WS_EX_CLIENTEDGE" , cStaticLabel , 132 , 16 , 100 , 128 )
  50.     CreateControl( wcStaticC , 0 , "static" , "WS_DLGFRAME" , cStaticFrame , 248 , 16 , 100 , 128 )
  51.        
  52.     ' **** Creating a font ****
  53.     MyFont = CreateFont(-8,0,0,0,FW_NORMAL,0,0,0,DEFAULT_CHARSET,0,0,0,0,"MS Shell Dlg")
  54.     MyFont2 = CreateFont(-8,0,-900,0,FW_NORMAL,0,0,0,DEFAULT_CHARSET,0,0,0,0,"MS Shell Dlg")
  55.     ' **** Setting this font for all controls ****
  56.     for CNT as integer = wcMain to wcLast-1
  57.       SendMessage(CTL(CNT),WM_SETFONT,cast(wparam,MyFont),true)
  58.     next CNT
  59.     SendMessage(CTL(wcStaticB),WM_SETFONT,cast(wparam,MyFont2),true)
  60.  
  61.   case WM_CLOSE,WM_DESTROY 'Windows was closed/destroyed    
  62.     PostQuitMessage(0) ' to quit
  63.     return 0
  64.   end select
  65.  
  66.   ' *** if program reach here default predefined action will happen ***
  67.   return DefWindowProc( hWnd, message, wParam, lParam )
  68.    
  69. end function
  70.  
  71. ' *********************************************************************
  72. ' *********************** SETUP MAIN WINDOW ***************************
  73. ' ******************* This code can be ignored ************************
  74. ' *********************************************************************
  75.  
  76. sub WinMain ()
  77.  
  78.   dim wMsg as MSG
  79.   dim wcls as WNDCLASS
  80.   dim as HWND hWnd  
  81.    
  82.   '' Setup window class  
  83.    
  84.   with wcls
  85.     .style         = 0 'CS_HREDRAW or CS_VREDRAW or CS_SAVEBITS
  86.     .lpfnWndProc   = @WndProc
  87.     .cbClsExtra    = 0
  88.     .cbWndExtra    = 0
  89.     .hInstance     = APPINSTANCE
  90.     .hIcon         = LoadIcon( APPINSTANCE, "FB_PROGRAM_ICON" )
  91.     .hCursor       = LoadCursor( NULL, IDC_ARROW )
  92.     .hbrBackground = cast(hBrush, COLOR_BTNFACE + 1) 'official hack!
  93.     .lpszMenuName  = NULL
  94.     .lpszClassName = @" " 'strptr( sAppName )
  95.   end with
  96.    
  97.   '' Register the window class    
  98.   var wATOM = cast(dword,RegisterClass( @wcls ))
  99.   if( wATOM = FALSE ) then
  100.     MessageBox( null, "Failed to register wcls!", sAppName, MB_ICONERROR )
  101.     exit sub
  102.   end if
  103.    
  104.   '' Create the window and show it
  105.   hWnd = CreateWindowEx(null,cast(zstring ptr,wATOM),null,WS_VISIBLE or WS_TILEDWINDOW, _
  106.   CW_USEDEFAULT,CW_USEDEFAULT,400,240,null,null,APPINSTANCE,NULL)  
  107.   SetforegroundWindow(hWnd)
  108.  
  109.   '' Process windows messages
  110.   ' *** all messages(events) will be read converted/dispatched here ***
  111.   UpdateWindow( hWnd )
  112.   while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )
  113.     'TranslateMessage( @wMsg )
  114.     DispatchMessage( @wMsg )    
  115.   wend    
  116.  
  117. end sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement