'Simple Cellular Automata Freebasic example by Mathias

 #define MAKDWD(x,y) (cint(x) shl 16 or cint(y))
             
 #INCLUDE ONCE "WINDOWS.BI"

 #INCLUDE once "win\COMMCTRL.BI"
DIM SHARED AS UBYTE Rulenumber, bmp_save
DIM SHARED AS BYTE n1,n2,n3
DIM SHARED AS UINTEGER screenx, screeny

Function Cellomat

ScreenRes screenx, screeny, 8 
SCREENINFO number_of_cells, number_of_generations

DIM AS UBYTE grid_at_t1(-1 TO number_of_cells+1), grid_at_t(-1 TO number_of_cells+1)

DIM AS STRING RULE 
Rule = Str$(Bin$(rulenumber))

FOR i = 0 TO number_of_generations
	grid_at_t1(-1) = grid_at_t1(number_of_cells)
    grid_at_t1(number_of_cells + 1)  =  grid_at_t1(0) 

    FOR  j = 0 TO number_of_cells
      
        DIM AS UBYTE Pattern
        Pattern = 1+(grid_at_t1(j+n1)*2^2) + (grid_at_t1(j+n2)*2^1) + (grid_at_t1(j+n3)*2^0)
        grid_at_t(j)= valint(MID$(Rule, INT(Pattern), 1))
        PSET (j,i), grid_at_t(j)
    NEXT j
    FOR k = 0 TO number_of_cells
        grid_at_t1(k) = grid_at_t(k)
    NEXT K
NEXT i

    
END FUNCTION



 SUB CircleOrRectangle (BYVAL hDC AS HDC, _
                BYVAL x AS INTEGER, BYVAL y AS INTEGER, _
                BYVAL x2 AS INTEGER, BYVAL y2 AS INTEGER, _
                BYVAL rw AS INTEGER, BYVAL rh AS INTEGER, _
                BYVAL BrushPattern AS INTEGER, BYVAL BrushClr AS INTEGER, _
                BYVAL PenType AS INTEGER, BYVAL PenWidth AS INTEGER, BYVAL PenClr AS INTEGER)

    DIM hBrush AS hBrush, hPen AS hPen
    hPen   = CreatePen(PenType, PenWidth, PenClr) ' create pen with given color
    hPen   = SelectObject(hDC, hPen)         ' select it into given dc
    IF BrushPattern = 0 THEN
        hBrush = CreateSolidBrush(BrushClr)  ' create solid brush with given color
    ELSE
        hBrush = CreateHatchBrush(BrushPattern, BrushClr)  ' create hatched brush with given color
    END IF 
    hBrush = SelectObject(hDC, hBrush)       ' select it into given dc
    IF rw THEN                                                     
       RoundRect hDC, x, y, x2, y2, rw, rh      ' draw the actual rectangle 
    ELSE                                                                    
       Rectangle hDC, x, y, x2, y2              ' draw the actual rectangle 
    END IF                                                                  
    DeleteObject SelectObject(hDC, hBrush)       ' delete what we created
    DeleteObject SelectObject(hDC, hPen)         ' to avoid memory leaks
 END SUB



 FUNCTION ProcessWindow (BYVAL hDlg AS HWND, BYVAL wMsg AS Uint, BYVAL wParam _ 
                  AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   DIM wmID AS INTEGER, wmEvent AS INTEGER 
   DIM ps AS PAINTSTRUCT
   DIM Lt1 AS STRING
   DIM Lt2 AS STRING
   DIM HPos1 AS INTEGER, hp1 AS STRING
   DIM Lt3 AS STRING
   DIM Lt4 AS STRING
   DIM HPos2 AS INTEGER, hp2 AS STRING
   DIM vPos3 AS INTEGER, vp3 AS STRING
   DIM vPos4 AS INTEGER, vp4 AS STRING
   DIM vPos5 AS INTEGER, vp5 AS STRING
   InitCommonControls

  SELECT CASE wMSG
     CASE WM_CREATE         'Create and initialize Controls 

        Lt1=Lt1 + "CA CONFIG"

         CreateWindowEx(0, "static",  STRPTR( LT1 ), _ 
             WS_CHILD OR WS_VISIBLE, _
            20,  57,  250,  38, _   
            hdlg, Cast(Hmenu,  101), GetModuleHandle(null),  NULL)    

        Lt2=Lt2 + "Rule:"

         CreateWindowEx(0, "static",  STRPTR( LT2 ), _ 
             WS_CHILD OR WS_VISIBLE, _
            20,  95,  250,  38, _   
            hdlg, Cast(Hmenu,  102), GetModuleHandle(null),  NULL)    

        Lt3=Lt3 + "GFX CONFIG"

         CreateWindowEx(0, "static",  STRPTR( LT3 ), _ 
             WS_CHILD OR WS_VISIBLE, _
            310,  57,  350,  38, _   
            hdlg, Cast(Hmenu,  105), GetModuleHandle(null),  NULL)    

        Lt4=Lt4 + "Screen Resolution"

         CreateWindowEx(0, "static",  STRPTR( LT4 ), _ 
             WS_CHILD OR WS_VISIBLE, _
            310,  95,  350,  38, _   
            hdlg, Cast(Hmenu,  106), GetModuleHandle(null),  NULL)    

        CreateWindowEx(WS_EX_CLIENTEDGE, "Button", "&ACTION", _ 
           WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR  BS_PUSHBUTTON, _
           330,  380,  100,  76, _   
           hdlg, Cast(Hmenu,  109), GetModuleHandle(null),  NULL)    
           
             CreateWindowEx(WS_EX_CLIENTEDGE, "Button", "&Make BMP", _ 
           WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR  BS_PUSHBUTTON, _
           430,  380,  100,  76, _   
           hdlg, Cast(Hmenu,  116), GetModuleHandle(null),  NULL)   

        CreateWindowEx(WS_EX_ClientEdge, "MSCTLS_TRACKBAR32", "", _ 
           WS_CHILD OR WS_VISIBLE  OR WS_TABSTOP  OR TBS_AUTOTICKS OR WS_CLIPSIBLINGS , _  
           58,  133,  212,  38, _   
           hdlg, Cast(Hmenu,  103), GetModuleHandle(null),  NULL) 

        CreateWindowEx(WS_EX_ClientEdge, "MSCTLS_TRACKBAR32", "", _ 
           WS_CHILD OR WS_VISIBLE  OR WS_TABSTOP  OR TBS_AUTOTICKS OR WS_CLIPSIBLINGS , _  
           379,  133,  312,  38, _   
           hdlg, Cast(Hmenu,  107), GetModuleHandle(null),  NULL) 
        CreateWindowEx(WS_EX_ClientEdge, "MSCTLS_TRACKBAR32", "", _ 
           WS_CHILD OR WS_VISIBLE  OR WS_TABSTOP OR TBS_vert or TBS_AUTOTICKS OR WS_CLIPSIBLINGS , _  
           110,  383,  40,  130, _   
           hdlg, Cast(Hmenu,  110), GetModuleHandle(null),  NULL) 

        CreateWindowEx(WS_EX_ClientEdge, "MSCTLS_TRACKBAR32", "", _ 
           WS_CHILD OR WS_VISIBLE  OR WS_TABSTOP OR TBS_vert or TBS_AUTOTICKS OR WS_CLIPSIBLINGS , _  
           160,  383,  40,  130, _   
           hdlg, Cast(Hmenu,  112), GetModuleHandle(null),  NULL) 

        CreateWindowEx(WS_EX_ClientEdge, "MSCTLS_TRACKBAR32", "", _ 
           WS_CHILD OR WS_VISIBLE  OR WS_TABSTOP OR TBS_vert or TBS_AUTOTICKS OR WS_CLIPSIBLINGS , _  
           210,  383,  40,  130, _   
           hdlg, Cast(Hmenu,  114), GetModuleHandle(null),  NULL) 

        SendMessage GetDlgItem(hDlg,  103), TBM_SETRANGE,TRUE, MAKDWD(255, 0)  ' Set Track bar range 
        SendMessage GetDlgItem(hDlg,  107), TBM_SETRANGE,TRUE, MAKDWD(9, 0)  ' Set Track bar range 
        SendMessage GetDlgItem(hDlg,  110), TBM_SETRANGE,TRUE, MAKDWD(255, 0) ' Set Track bar range  
        SendMessage GetDlgItem(hDlg,  112), TBM_SETRANGE,TRUE, MAKDWD(255, 0)' Set Track bar range  
        SendMessage GetDlgItem(hDlg,  114), TBM_SETRANGE,TRUE, MAKDWD(255, 0)' Set Track bar range  
        SetWindowPos hDlg, HWND_TOP, 0, 0, 0, 0, SWP_NoSize OR SWP_NoMove


     CASE WM_COMMAND        ' Messages sent for Command Items 
        wmID = Loword(wparam)            ' Control ID   
        wmEvent = Hiword(wparam)         ' Window Event  

        SELECT CASE wmID
           CASE  109 AND wmEVENT = BN_CLICKED    ' User Created Button 
              Cellomat
            CASE  116 AND wmEVENT = BN_CLICKED    ' User Created Button 
              dim as string filename
              filename = chr(INT(RND(1) * 254) + 1 )+chr(INT(RND(1) * 254) + 1 )+chr(INT(RND(1) * 254) + 1 )+chr(INT(RND(1) * 254) + 1 )+chr(INT(RND(1) * 254) + 1 )+"lkjsdf.bmp"
           
              BSAVE filename,0  
           END SELECT
     CASE  WM_HSCROLL 

        IF lParam = GetDlgItem(hDlg,  103) THEN                           
           hpos1 = Sendmessage (GetDlgItem(hDlg,  103), TBM_GETPOS, 0, 255)  
           vpos1 = Sendmessage (GetDlgItem(hDlg,  104), TBM_GETPOS, 0, 50)  
           rulenumber = hpos1
           hp1 = str$(hpos1)                                                       
           
           CreateWindowEx WS_EX_ClientEdge, "static", hp1, WS_CHILD OR _ 
              WS_VISIBLE,        20,  133,  38,  38, _   
              hdlg,  Cast(Hmenu,  104), GetModuleHandle(null),  NULL  
        END IF  

        IF lParam = GetDlgItem(hDlg,  107) THEN                           
           hpos2 = Sendmessage (GetDlgItem(hDlg,  107), TBM_GETPOS, 0, 50)  
           hp2 = str$(hpos2)
           if hpos2 = 0 then
               screenx = 320
               screeny = 200
               hp2 = "320x200"
           elseif hpos2 = 1 then
                screenx = 320
                screeny = 240
                hp2 = "320x240"
            elseif hpos2 = 2 then
                screenx = 400
                screeny = 300
                hp2 = "400x300"
            elseif hpos2 = 3 then
                screenx = 512
                screeny = 384
                hp2 = "512x384"
           elseif hpos2 = 4 then
                screenx = 640
                screeny = 200
                hp2 = "640x200"    
            elseif hpos2 = 5 then
                screenx = 640
                screeny = 350
                hp2 = "640x350"
            elseif hpos2 = 6 then
                screenx = 640
                screeny = 480
                hp2 = "640x400"
            elseif hpos2 = 7 then
                screenx = 800
                screeny = 600
                hp2 = "800x600"
            elseif hpos2 = 8 then
                screenx = 1024
                screeny = 768
                hp2 = "1024x768"
            elseif hpos2 = 9 then
                screenx = 1280
                screeny = 1024
                hp2 = "1280x1024"
            end if
           CreateWindowEx WS_EX_ClientEdge, "static", hp2, WS_CHILD OR _ 
              WS_VISIBLE,        310,  133,  76,  38, _   
              hdlg,  Cast(Hmenu,  108), GetModuleHandle(null),  NULL  
        END IF  
        
        CASE WM_VSCROLL 

        IF lParam = GetDlgItem(hDlg,  110) THEN 
           vpos3 = Sendmessage (GetDlgItem(hDlg,  110), TBM_GETPOS, 0, 50)  
           n1 = vpos3
           vp3 = str$(vpos3)  
           screen 0
           print n1
           CreateWindowEx WS_EX_ClientEdge, "static", vp3, WS_CHILD OR _ 
              WS_VISIBLE,        110,  361,  40,  20, _   
              hdlg,  Cast(Hmenu,  111), GetModuleHandle(null),  NULL  
        End IF  

        IF lParam = GetDlgItem(hDlg,  112) THEN 
           vpos4 = Sendmessage (GetDlgItem(hDlg,  112), TBM_GETPOS, 0, 50)  
           n2 = vpos4
           vp4 = str$(vpos4)                                                       
           CreateWindowEx WS_EX_ClientEdge, "static", vp4, WS_CHILD OR _ 
              WS_VISIBLE,        160,  361,  40,  20, _   
              hdlg,  Cast(Hmenu,  113), GetModuleHandle(null),  NULL  
        End IF  

        IF lParam = GetDlgItem(hDlg,  114) THEN 
           vpos5 = Sendmessage (GetDlgItem(hDlg,  114), TBM_GETPOS, 0, 50)  
           n3 = vpos5
           vp5 = str$(vpos5)                                                       
           CreateWindowEx WS_EX_ClientEdge, "static", vp5, WS_CHILD OR _ 
              WS_VISIBLE,        210,  361,  40,  20, _   
              hdlg,  Cast(Hmenu,  115), GetModuleHandle(null),  NULL  
        End IF  


     CASE WM_PAINT    ' dialog is to be redrawn
        BeginPaint hDlg, @ps  ' get device context to draw in
           CircleOrRectangle ps.hDC, 10,  38,  280,  532, 0, 0, _
           0, &HEEEEEE, PS_SOLID, 1, 0
           CircleOrRectangle ps.hDC, 300,  38,  670,  323, 0, 0, _
           0, &HEEEEEE, PS_SOLID, 1, 0
           CircleOrRectangle ps.hDC, 310,  323,  660,  513, 0, 0, _
           0, &HEEEEEE, PS_SOLID, 1, 0
        EndPaint hDlg, @ps            ' end painting
     CASE WM_CLOSE     ' Message from Clicking on system close Icon
        PostQuitMessage 0 
  END SELECT
  ProcessWindow = DefWindowProc(hdlg, wMsg, wParam, lParam)  
END FUNCTION 


'---------------------------------------------------------------
'                     Starting     Main 
'---------------------------------------------------------------


    DIM wMsg       AS Msg      
    DIM wcls       AS wndclass  
    DIM hWnd       AS HWND, hMenu AS HMENU 
    DIM szpgmname  AS STRING, style as INTEGER 



     szpgmname = "FreeBasic GUI Samples"
     WITH wcls
         .style         = CS_HREDRAW OR CS_VREDRAW 
         .lpfnWndProc   = @ProcessWindow  'point to callback code  
         .cbClsExtra    = 0  
         .cbWndExtra    = 0  
         .hInstance     = GetModuleHandle(NULL)
         .hIcon = LoadIcon( null, IDI_APPLICATION ) 
         .hCursor       = LoadCursor( NULL,  IDC_ARROW ) 
         .hbrBackground = CAST( HGDIOBJ, 5 )
         .lpszMenuName  = NULL 
         .lpszClassName = Sadd(szpgmname) 
     END WITH
     RegisterClass @wcls 
          style =   WS_VISIBLE OR WS_OVERLAPPEDWINDOW

        CreateWindowEx(0, szpgmname, "EzeeGUI Example", _
                      Style,  0,  0,  799,  583, _ 
                      HWND_DESKTOP, hMenu, GetModuleHandle(null),  NULL) 

     ShowWindow(hWnd, SW_SHOWNORMAL)     
     UpdateWindow hWnd             
     While (GetMessage(@wMsg, NULL, 0, 0) <> false ) 
        If IsDialogMessage(hWnd, @wMsg) = FALSE Then 'For TabKey,  Comment out if using WM_KEYDOWN
           TranslateMessage @wMsg  
           DispatchMessage  @wMsg  
        End If                                       'For TabKey,  Comment out if using WM_KEYDOWN
     WEND                            




