thinBasic 1.4.0.0 released as stable version

[erosolmi]

List of changes for this version: http://www.thinbasic.../version_1_4_0_0.htm

Some videos showing what thinBasic can do: http://www.youtube.c...arch_query=thinbasic

Give it a try and test the many script examples you will find under thinBasic\SampleScripts directory.
You will found even more advanced scripts in thinBasic forum at http://community.thinbasic.com/index.php

Have fun.
Eros

[cthorpe]

What is thinBasic?  Is it an automation type thing or more of a programming language?

[erosolmi]

Yes, you are right. What is thinBasic?
thinBasic is a fast Basic like interpreter with more than 1000 predefined commands covering many programming aspects from simple automations scripts to full OpenGL games creation. thinBasic is based on modules: collections of commands stored in special files.
Mainly all numeric and string data types are supported, functions and subs, parameters passed byref or byval, all flow control structures, pointers, user data types are there. Complete on the fly WIN32 api integration let you call any Windows function.

It is also possible to create standalone executable using thinBundle, a tool integrated into thinAir (thinBasic editor) will let create independent scripts able to be executed without thinBasic installed.
Obfuscated scripts are also supported.

To get an idea, see online help at http://www.thinbasic...help/html/index.html
Download it from here: http://www.thinbasic...=9&orderby=dateD

Ciao
Eros

[erosolmi]

An example. A 3D tree generated on the fly.
The folowing is the source code that can be executed just double clicking on it (having thinBasic installed and textures file).
Otherwise see attached independant executable.

Code: Text [Select]

1. Uses "TBGL"
2.  
3.   randomize timer
4.  
5.   Dim hWnd As Dword
6.   MsgBox 0, "Use [space bar] to generate new tree"+$CRLF+$CRLF+ _
7.             "Arrows to rotate"+$CRLF+$CRLF+ _
8.             "[PageUp], [PageDown] to zoom"+$CRLF+$CRLF+ _
9.             "[ESC] to quit", _
10.             %MB_OK or %MB_ICONINFORMATION,"StromekVFX"
11.  
12.   dim x,y,b as long
13.   tbgl_GetDesktopInfo x,y,b
14.   hWnd = TBGL_CreateWindowEx("StromekVFX demo", x, y, b, 1)
15.   TBGL_ShowWindow
16.  
17.   tbgl_LoadTexture "Textures\bark"+FORMAT$( rnd(1,7))+".bmp", 1, %TBGL_TEX_MIPMAP      
18.   tbgl_LoadTexture "Textures\listek1.tga", 2, %TBGL_TEX_MIPMAP      
19.   tbgl_BindTexture 1
20.   tbgl_usetexture 1
21.  
22.   tbgl_setPrimitiveQuality 8
23.   TBGL_GetAsyncKeyState(-1) ' Resets status of all keys
24.   tbgl_UseLighting 1
25.   tbgl_UseLightsource %GL_LIGHT0, 1
26.   tbgl_setLightParameter %GL_LIGHT0, %TBGL_LIGHT_DIFFUSE, 1, 0.5, 0, 0
27.  
28.   dim tangle, tsize, tlevel, ttwist, tlength as single
29.  
30.   ' Precaching of geometry parts
31.   ' First tree
32.   tbgl_NewList 1
33.     DrawBranch(0.5, 2,9, 30,30)    
34.   tbgl_endList
35.  
36.   ' Leaf quad
37.   tbgl_NewList 2
38.   tbgl_PushMatrix
39.  
40.     tbgl_BeginPoly %GL_QUADS
41.       tbgl_Normal 0,0,1
42.       tbgl_TexCoord2d 0,0
43.       tbgl_vertex -0.2, 0, 0
44.       tbgl_TexCoord2d 1,0
45.       tbgl_vertex  0.2, 0, 0        
46.       tbgl_TexCoord2d 1,1
47.       tbgl_vertex 0.2, 0.4, 0        
48.       tbgl_TexCoord2d 0,1
49.       tbgl_vertex -0.2, 0.4, 0        
50.     tbgl_EndPoly
51.   tbgl_PopMatrix    
52.   tbgl_endList
53.  
54.   dim FrameRate as double
55.   dim deltacamanglelr, deltacamangleud, deltacamdistance as single
56.   dim camanglelr, camangleud, camdistance as single  
57.   camdistance = 30  
58.  
59.    
60.   While TBGL_IsWindow(hWnd)
61.  
62.     tbgl_ClearFrame
63.    
64.       If TBGL_GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While    
65.      
66.       FrameRate = TBGL_GetFrameRate
67.      
68.       tbgl_Translate 0,-7,-camdistance
69.       tbgl_Rotate CamAngleUD,1,0,0
70.       tbgl_Rotate CamAngleLR,0,1,0
71.      
72.       tbgl_setLightParameter %GL_LIGHT0, %TBGL_LIGHT_position, sin(gettickcount/2000)*50, 7, cos(gettickcount/2000)*50, 1    
73.  
74.       tbgl_CallList 1
75.  
76.  
77.     tbgl_DrawFrame
78.  
79.       if tbgl_getWindowKeyState( hWnd, %VK_UP ) then deltaCamAngleUD += 30/FrameRate
80.       if tbgl_getWindowKeyState( hWnd, %VK_DOWN ) then deltaCamAngleUD -= 30/FrameRate
81.  
82.       if tbgl_getWindowKeyState( hWnd, %VK_LEFT ) then deltaCamAngleLR += 30/FrameRate
83.       if tbgl_getWindowKeyState( hWnd, %VK_RIGHT ) then deltaCamAngleLR -= 30/FrameRate
84.      
85.       if tbgl_getWindowKeyState( hWnd, %VK_PGUP ) then deltaCamDistance -= 10/FrameRate
86.       if tbgl_getWindowKeyState( hWnd, %VK_PGDn ) then deltaCamDistance += 10/FrameRate
87.       CamAngleUD += deltaCamAngleUD
88.       deltaCamAngleUD /= 1.5
89.      
90.       CamAngleLR += deltaCamAngleLR
91.       deltaCamAngleLR /= 1.5
92.  
93.       CamDistance += deltaCamDistance
94.       deltaCamDistance /= 1.5
95.      
96.       ' Creation of new tree
97.       if tbgl_getWindowKeyState( hWnd, %VK_SPACE ) then
98.         tbgl_LoadTexture "Textures\bark"+FORMAT$( rnd(1,7))+".bmp", 1, %TBGL_TEX_MIPMAP      
99.         tbgl_LoadTexture "Textures\listek"+FORMAT$(rnd(1,3))+".tga", 2, %TBGL_TEX_MIPMAP            
100.         tbgl_deletelist 1      
101.        
102.         tbgl_NewList 1
103.           tsize   = rndf(0.2, 1)
104.           tlength = rndf(1, 3)
105.           tlevel  = rndf(7, 10)
106.           tangle  = rndf(10, 30)
107.           ttwist  = rndf(20, 40)        
108.  
109.           DrawBranch(tsize, tlength, tlevel, tangle, ttwist)    
110.         tbgl_endList
111.        
112.       end if  
113.  
114.  
115.  
116.   Wend
117.  
118.   TBGL_DestroyWindow
119.  
120.   ' Recursive function to create branched branches :)
121.   sub DrawBranch( startRadius as single, startlength as single, levels as long, openangle as single, twist as single )
122.     local i as long
123.  
124.     local length as single
125.     local radiusS as single
126.     local radiusE as single
127.     if levels < 3 then
128.      
129.       tbgl_BindTexture 2
130.      
131.       ' Hot Alpha handling stuff
132.       tbgl_UseAlphaTest 1
133.       tbgl_AlphaFunc %tbGL_GREATER, 0.5
134.  
135.      
136.       for i = 1 to 3
137.         tbgl_rotate 120,1,0,1
138.         tbgl_calllist 2' 0.2,0.4,0.1
139.       next
140.  
141.       tbgl_BindTexture 1
142.       tbgl_UseAlphaTest 0
143.  
144.       if levels = 0 then exit sub
145.     end if  
146.    
147.     radiusS = startRadius
148.     radiusE = radiusS - startRadius/levels
149.     length = startlength
150.     tbgl_PushMatrix
151.       for i = 1 to levels
152. '        tbgl_setPrimitiveQuality levels/1.5        ' possible optional optimization
153.         tbgl_Cylinder radiusS , radiusE, length
154.         tbgl_Translate  0,  length, 0
155.        
156.         tbgl_Rotate openangle,0,0,1
157.         tbgl_Rotate twist,0,1,0
158.  
159.         tbgl_PushMatrix
160.  
161.           tbgl_Rotate -openangle*2,0,0,1
162.           if i = 1  then
163.             DrawBranch(radiusE, length, levels-1, -openangle, twist)
164.           else
165.             DrawBranch(radiusE,  length, levels-i, openangle, twist)
166.           end if  
167.            
168.         tbgl_PopMatrix
169.  
170.         radiusS = radiusE
171.         radiusE = radiusS - startRadius/levels
172.         length = length - startlength/levels
173.  
174.       next  
175.     tbgl_Popmatrix      
176.  
177.   end sub

[erosolmi]

The following code loads any CSV text files into a matrix. Matrix is dimensioned on the fly.
90% of the code is just presentation while the main load is done by a single line.

Code: Text [Select]

1. uses "file"
2.   uses "console"
3.  
4.   dim FileToLoad  as string value app_sourcepath & "CSV_SampleData.csv"
5.   dim MyMatrix()  as string
6.   dim nLines      as long
7.   dim nCols       as long
8.   dim T0, T1      as double
9.  
10.   console_writeline "This script demonstrate the use of PARSE function for loading, parsing and filling a string array with the content of a CSV file. All with only one line of code."
11.   console_writeline "Input file: " & FileToLoad
12.   console_writeline "File size : " & file_size(FileToLoad) & " bytes"
13.   console_writeline "Press any key to start."
14.   console_writeline repeat$(79, "-")
15.   console_waitkey
16.  
17.   '---
18.   '---Starting to load and parse input file
19.   '------
20.   T0 = timer
21.     '---
22.     '---Just one line do the job of loading file data, parsing text lines, dimensioning and filling the matrix.
23.     '------
24.     PARSE(FILE_Load(FileToLoad), MyMatrix(), $crlf , ",")
25.  
26.     '--Now get the number of lines and max number of columns parsed
27.     nLines = ubound(MyMatrix(1))
28.     nCols  = ubound(MyMatrix(2))
29.    
30.   T1 = timer
31.  
32.   '---Write some info
33.   console_writeline "Total loading and parsing time: " & format$(T1 - T0, "#0.000000") & " secs"
34.   console_writeline "Total number of lines : " & nLines
35.   console_writeline "Total number of colums: " & nCols
36.   console_writeline "Press any key to show result on screen"
37.   console_writeline repeat$(79, "-")
38.   console_waitkey
39.  
40.   dim CountLine   as long
41.   dim CountCol    as long
42.  
43.   for CountLine = 1 to nLines
44.     for CountCol = 1 to nCols
45.       console_write(MyMatrix(CountLine, CountCol) & " ")
46.     next
47.     console_writeline("")
48.   next
49.  
50.   console_writeline repeat$(79, "-")
51.   console_writeline "Program terminated. Press any key to close."
52.   console_waitkey

[erosolmi]

A user interface example.
The following code is a simple editor using rich edit control.

Code: Text [Select]

1. USES "UI"
2.   USES "FILE"
3.   'uses "console"
4.  
5.   #include "%APP_INCLUDEPATH%\RichEdit32.inc"
6.  
7.   DECLARE FUNCTION GetDlgItem LIB "USER32.DLL" ALIAS "GetDlgItem" (BYVAL hDlg AS DWORD, BYVAL nIDDlgItem AS LONG) AS DWORD
8.  
9.  
10.   %IDBTN_BOLD     = %WM_USER + 110
11.   %IDBTN_ITALIC   = %WM_USER + 111
12.   %IDBTN_ULINE    = %WM_USER + 112
13.   %IDBTN_STRIKE   = %WM_USER + 113
14.   %IDCHK_COLOR    = %WM_USER + 120
15.   %IDCB_FONTNAME  = %WM_USER + 130
16.   %IDCB_FONTSIZE  = %WM_USER + 131
17.   %IDCB_ZOOM      = %WM_USER + 132
18.  
19.   %ID_EDITOR      = %WM_USER + 150
20.   %ID_STATUSBAR   = %WM_USER + 151
21.  
22.   '%IDM_UNDO       = %WM_USER + 220
23.   '%IDM_CUT        = %WM_USER + 222
24.   '%IDM_COPY       = %WM_USER + 223
25.   '%IDM_PASTE      = %WM_USER + 224
26.   '%IDM_DELETE     = %WM_USER + 225
27.   '%IDM_SELALL     = %WM_USER + 226
28.  
29.  
30.   GLOBAL hDlg AS LONG
31.   global hEdit AS LONG
32.  
33.   DIM Msg       AS LONG
34.   DIM wParam    AS LONG
35.   DIM lParam    AS LONG
36.  
37.   dim lColor  as long
38.  
39.   dim sFileName as string
40.  
41.   '---Menu handle
42.     LOCAL hMenu         AS dword
43.     LOCAL hPopupFile    AS dword
44.     local hPopupEdit    as dword
45.     local hPopupFormat  as dword
46.     local hPopupControl as dword
47.     LOCAL hPopupHelp    AS dword
48.  
49.   '---Menu commands
50.     '---File
51.     %ID_MENU_FILE_OPEN        = 401
52.     %ID_MENU_FILE_SAVEAS      = 405
53.     %ID_MENU_FILE_EXIT        = 410
54.  
55.     '---Edit
56.    
57.     '---Format
58.     %ID_MENU_FORMAT_BG_COLOR  = 510
59.     %ID_MENU_FORMAT_FG_COLOR  = 511
60.  
61.     '---RTF Control
62.     %ID_MENU_CONTROL_BG_COLOR = 610
63.     %ID_MENU_CONTROL_TEST_UBB = 615
64.  
65.     '---Help
66.     %ID_MENU_HELP             = 700
67.     %ID_MENU_ABOUT            = 705
68.  
69.  
70.   '---First create a top-level menu:
71.     MENU NEW BAR TO hMenu
72.  
73.   '---Add a top-level menu item with a popup menu:
74.     MENU NEW POPUP TO hPopupFile
75.     MENU ADD POPUP,  hMenu, "&File", hPopupFile, %MF_ENABLED
76.     MENU ADD STRING, hPopupFile, "&Open ...", %ID_MENU_FILE_OPEN, %MF_ENABLED
77.     MENU ADD STRING, hPopupFile, "&Save as ...", %ID_MENU_FILE_SAVEAS, %MF_ENABLED
78.     MENU ADD STRING, hPopupFile, "-",      0, 0
79.     MENU ADD STRING, hPopupFile, "&Exit", %ID_MENU_FILE_EXIT, %MF_ENABLED
80.  
81.   '---Add a top-level menu item with a popup menu:
82.     MENU NEW POPUP TO hPopupFormat
83.     MENU ADD POPUP,  hMenu, "&Format", hPopupFormat, %MF_ENABLED
84.     MENU ADD STRING, hPopupFormat, "&Background color ...", %ID_MENU_FORMAT_BG_COLOR, %MF_ENABLED
85.     MENU ADD STRING, hPopupFormat, "&Foreground color ...", %ID_MENU_FORMAT_FG_COLOR, %MF_ENABLED
86.  
87.   '---Add a top-level menu item with a popup menu:
88.     MENU NEW POPUP TO hPopupControl
89.     MENU ADD POPUP,  hMenu, "&Control", hPopupControl, %MF_ENABLED
90.     MENU ADD STRING, hPopupControl, "&Background color ...", %ID_MENU_CONTROL_BG_COLOR, %MF_ENABLED
91.     MENU ADD STRING, hPopupControl, "-"      , 0, 0
92.     MENU ADD STRING, hPopupControl, "Test UBB Code", %ID_MENU_CONTROL_TEST_UBB, %MF_ENABLED
93.  
94.   '---Finally, we'll add a second top-level menu and popup
95.   '---For this popup, we can reuse the first popup variable:
96.     MENU NEW POPUP TO hPopupHelp
97.     MENU ADD POPUP , hMenu     , "&Help"  , hPopupHelp, %MF_ENABLED
98.     MENU ADD STRING, hPopupHelp, "&Help"  , %ID_MENU_HELP, %MF_ENABLED
99.     MENU ADD STRING, hPopupHelp, "-"      , 0, 0
100.     MENU ADD STRING, hPopupHelp, "&About" , %ID_MENU_ABOUT, %MF_ENABLED
101.  
102.  
103.  
104.  
105.   DIALOG NEW 0, "TinyWord - RichEdit sample", -1, -1, 600, 350, _
106.                                                 %WS_DLGFRAME          OR  _
107.                                                 %ds_center            or  _
108.                                                 %WS_CAPTION           OR  _
109.                                                 %WS_SYSMENU           OR  _
110.                                                 %WS_OVERLAPPEDWINDOW  ,   _
111.                                                 0 TO hDlg
112.  
113.   DIM lx, ly, wx, hy AS LONG
114.   DIALOG GET SIZE   hDlg TO lx, ly
115.   DIALOG GET CLIENT hDlg TO wx, hy
116.   '---Status Bar
117.   Control Add "msctls_statusbar32", hDlg, %ID_STATUSBAR, "", %NULL, %NULL, %NULL, %NULL, _
118.                                                     %WS_CHILD           Or _
119.                                                     %WS_CLIPSIBLINGS    Or _
120.                                                     %WS_DLGFRAME        Or _
121.                                                     %WS_VISIBLE
122.   DIM sbParts(3) AS LONG
123.   'hStatusbar = CreateStatusWindow(%WS_CHILD OR %WS_VISIBLE, BYVAL %NULL, hDlg, 200)
124.   sbParts(1) = 100
125.   sbParts(2) = 200
126.   sbParts(3) = -1
127.   control send hDlg, %ID_STATUSBAR, %SB_SETPARTS, 3, VARPTR(sbParts(1))
128.  
129.   CONTROL ADD rtf_GetClass, hDlg, %ID_EDITOR, "", 0, 24, 600, 310, _
130.                                                     %WS_CHILD           OR _
131.                                                     %WS_CLIPCHILDREN    OR _
132.                                                     %WS_VISIBLE         OR _
133.                                                     %ES_MULTILINE       OR _
134.                                                     %WS_VSCROLL         OR _
135.                                                     %ES_AUTOVSCROLL     OR _
136.                                                     %ES_AUTOHSCROLL     OR _
137.                                                     %ES_WANTRETURN      , _
138.                                                     %WS_EX_CLIENTEDGE
139.                                                     '%WS_HSCROLL         OR _
140.  
141.   '---Set event mask so we'll get EN_SELCHANGE and %ENM_MOUSEEVENTS notifications
142.     CONTROL SEND hDlg, %ID_EDITOR, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE OR %ENM_MOUSEEVENTS
143.     '---Set some options
144.     CONTROL SEND hDlg, %ID_EDITOR, %EM_SETOPTIONS, %ECOOP_OR, %ECO_SELECTIONBAR
145.     '---Allow 1 meg files
146.     control send hDlg, %ID_EDITOR, %EM_LIMITTEXT, 1000000, 0
147.  
148.     '---Set automatic url detection to true. The following link are usable: http: file: mailto: ftp: https: gopher: nntp: prospero: telnet: news: wais:
149.     'control send hDlg, %ID_EDITOR, %EM_AUTOURLDETECT, %TRUE, 0
150.  
151.  
152.   '---Return window handle to richedit text
153.     CONTROL HANDLE hDlg, %ID_EDITOR TO hEdit
154.  
155.   '---Create combo box for font names
156.     dim FontList() as string
157.     PARSE(Font_List, FontList, $tab)
158.     CONTROL ADD COMBOBOX, hDlg, %IDCB_FONTNAME, FontList(), 4, 4, 100, 120, %CBS_DROPDOWNLIST OR %CBS_SORT OR %WS_VSCROLL
159.  
160.   '---Create combo box for font size
161.     DIM FontSize() AS STRING
162.     dim tmpFontSizeString as string
163.     tmpFontSizeString = "2 4 6 8 9 10 11 12 14 16 18 20 22 24 26 28 30 32 34 36 40 42 44 46 48 50 60 72"
164.     PARSE(tmpFontSizeString, FontSize, $spc)
165.     CONTROL ADD COMBOBOX, hDlg, %IDCB_FONTSIZE, FontSize(), 110, 4, 30, 120, %CBS_DROPDOWNLIST OR %WS_VSCROLL
166.  
167.   '---Create some push button
168.     CONTROL ADD BUTTON, hDlg, %IDBTN_BOLD,     "&B",    150, 4, 14,  14, %BS_AUTOCHECKBOX OR %BS_PUSHLIKE
169.     CONTROL ADD BUTTON, hDlg, %IDBTN_ITALIC,   "&I",    164, 4, 14,  14, %BS_AUTOCHECKBOX OR %BS_PUSHLIKE
170.     CONTROL ADD BUTTON, hDlg, %IDBTN_ULINE ,   "&U",    178, 4, 14,  14, %BS_AUTOCHECKBOX OR %BS_PUSHLIKE
171.     CONTROL ADD BUTTON, hDlg, %IDBTN_STRIKE ,  "&S",    192, 4, 14,  14, %BS_AUTOCHECKBOX OR %BS_PUSHLIKE
172.  
173.   '---Create combo box for font size
174.     DIM Zooms() AS STRING
175.     dim tmpZoomsString as string
176.     tmpZoomsString = "10% 20% 30% 40% 50% 60% 70% 80% 90% 100% 110% 120% 130% 140% 150% 160% 170% 180% 190% 200% 250% 300%"
177.     PARSE(tmpZoomsString, Zooms, $spc)
178.     CONTROL ADD COMBOBOX, hDlg, %IDCB_ZOOM, Zooms(), 210, 4, 40, 100, %CBS_DROPDOWNLIST OR %WS_VSCROLL
179.     COMBOBOX SELECT hDlg, %IDCB_ZOOM, 10
180.  
181.     control set resize hDlg, %ID_EDITOR    , 1, 1, 1, 1
182.     control set resize hDlg, %ID_STATUSBAR , 1, 1, 0, 1
183.  
184.   DIALOG SHOW MODELESS hDlg
185. '  
186.  
187.   dim pNmh    AS NMHDR
188.   dim tmpStr  as string
189.   dim tmpVal  as ext
190.   dim Refresh as long value %false
191.   dim looper  as long
192.  
193.   '------
194.   ' Start of the main message pump loop
195.   '---
196.   dim counter as long
197.   WHILE IsWindow(hDlg)                  
198.  
199.     '---Get the message and fill wParam and lParam
200.     Msg = getMessage(hDlg, wParam, lParam)
201. 'incr Counter
202. 'if Msg <> 0 and Msg <> 512 then
203. '  console_writeline(  _
204. '                      "msg:"   & msg            & _
205. '                      " WP:"   & wParam         & _
206. '                      " lwWP:" & lowrd(wParam)  & _
207. '                      " hwWP:" & hiwrd(wParam)  & _
208. '                      " LP:"   & lParam         & _
209. '                      " lwLP:" & lowrd(lParam)  & _
210. '                      " hwLP:" & hiwrd(lParam)  & _
211. '                      "")
212. '                      
213. 'end if
214.  
215.     '---Now test the message
216.     SELECT CASE Msg
217.  
218.       case %WM_INITDIALOG  '---Message fired at the very beginning when dialog is initialized
219.         '---Attach menu to dialog          
220.         MENU ATTACH hMenu, hDlg
221.         '---Fill richedit with above created text
222.         'CONTROL REDRAW hDlg, %ID_EDITOR
223.         RTF_SetFontName(hDlg, %ID_EDITOR, "Courier New")
224.         RTF_SetFontSize(hDlg, %ID_EDITOR, 12)
225.  
226.         '---This set word wrap mode ON
227.         control send  hDlg, %ID_EDITOR, %EM_SETTARGETDEVICE, 0, 0
228.        
229.        
230.         'sendmessage hDlg, %wm_size, 0, 0
231.         'control send hDlg, %ID_STATUSBAR, %SB_SETPARTS, 3, VARPTR(sbParts(1))
232.  
233.       CASE %WM_NOTIFY
234.         '---Get notification UDT
235.         'pNmh = peek$(lParam, sizeof(NMHDR))
236.  
237.         SELECT CASE lowrd(wParam)
238.           CASE %ID_EDITOR
239.             Refresh = %TRUE
240.  
241.         end select
242.  
243.        
244.       CASE %WM_COMMAND
245.        
246.         SELECT CASE lowrd(wParam)
247.           case %ID_MENU_FILE_EXIT, %IDCANCEL
248.             exit while
249.              
250.           case %ID_MENU_FILE_OPEN
251.             sFileName = RichEdit_OpenFile
252.             if sFileName <> "" then
253.               select case ucase$(FILE_PATHSPLIT(sFileName, %Path_Ext))
254.                 case "RTF"
255.                   RTF_LoadFromFile(hDlg, %ID_EDITOR, sFileName, %SF_rtf)
256.                 case else
257.                  
258.                   RTF_LoadFromFile(hDlg, %ID_EDITOR, sFileName, %sf_text)
259.               end select
260.             else
261.               'msgbox 0, "No file selected"
262.             end if
263.             Refresh = %TRUE
264.            
265.           case %ID_MENU_FILE_SAVEAS
266.             '---Ask for file name
267.             sFileName = RichEdit_SaveFile
268.             sFileName = trim$(sFileName)
269.             '---If not empty ...
270.             if sFileName <> "" then
271.  
272.               '---Check if file exists and if yes ask if to be replaced
273.               if RichEdit_Check_FileExistsGO(sFileName) = %true then
274.                 '---Now call relevant save function depending on file extension
275.                 select case ucase$(right$(sFileName, 4))
276.                   case ".TXT"
277.                     RTF_SaveToFile(hDlg, %ID_EDITOR, sFileName, %SF_TEXT)
278.                     'msgbox 0, "File saved as " & sFileName
279.                   case ".RTF"
280.                     RTF_SaveToFile(hDlg, %ID_EDITOR, sFileName, %SF_rtf)
281.                     'msgbox 0, "File saved as " & sFileName
282.                 end select
283.               end if
284.             end if            
285.  
286.           case %ID_MENU_FORMAT_FG_COLOR
287.             '---Set foreground color of current word or selected text
288.             'lColor = Dialog_ChooseColor(hDlg, RTF_GetFGColor(hDlg, %ID_EDITOR), %CC_RGBINIT OR %CC_FULLOPEN )
289.             lColor = Dialog_ChooseColor(hDlg, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
290.             RTF_SetFGColor(hDlg, %ID_EDITOR, lColor)
291.             Refresh = %TRUE
292.            
293.           case %ID_MENU_FORMAT_BG_COLOR
294.             '---Set background color of current word or selected text
295.             'lColor = Dialog_ChooseColor(hDlg, RTF_GetBGColor(hDlg, %ID_EDITOR), %CC_RGBINIT OR %CC_FULLOPEN )
296.             lColor = Dialog_ChooseColor(hDlg, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
297.             RTF_SetBGColor(hDlg, %ID_EDITOR, lColor)
298.             Refresh = %TRUE
299.  
300.           case %ID_MENU_CONTROL_BG_COLOR
301.             '---Set background color of control
302.             lColor = Dialog_ChooseColor(hDlg, rgb(255, 0, 0), %CC_RGBINIT OR %CC_FULLOPEN )
303.             if lColor <> -1 then
304.               CONTROL SEND hDlg, %ID_Editor, %EM_SETBKGNDCOLOR, 0, lColor
305.               Refresh = %TRUE
306.             end if
307.                                    
308.           CASE %IDCB_FONTNAME
309.             IF hiwrd(wParam) = %CBN_SELENDOK THEN
310.               COMBOBOX GET TEXT hDlg, %IDCB_FONTNAME TO tmpStr
311.               if tmpStr <> "" then RTF_SetFontName(hDlg, %ID_Editor, tmpStr)
312.               Refresh = %TRUE
313.             END IF
314.  
315.           CASE %IDCB_FONTSIZE
316.             IF hiwrd(wParam) = %CBN_SELENDOK THEN
317.               COMBOBOX GET TEXT hDlg, %IDCB_FONTSIZE TO tmpStr
318.               if val(tmpStr) > 0 then RTF_SetFontSIZE(hDlg, %ID_Editor, val(tmpStr))
319.               Refresh = %TRUE
320.             END IF
321.  
322.           CASE %IDCB_ZOOM
323.             IF hiwrd(wParam) = %CBN_SELENDOK THEN
324.               COMBOBOX GET TEXT hDlg, %IDCB_ZOOM TO tmpStr
325.               tmpStr = remove$(tmpStr, "%")
326.               if val(tmpStr) > 0 then
327.                 tmpVal = val(tmpStr)
328.                 control send  hDlg, %ID_EDITOR, %EM_SETZOOM, tmpVal, 100
329.                 Refresh = %TRUE
330.               end if
331.             END IF
332.              
333.           CASE %IDBTN_BOLD
334.             IF SendMessage(GetDlgItem(hDlg, %IDBTN_BOLD), %BM_GETCHECK, 0, 0) THEN
335.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) OR %CFE_BOLD)
336.             ELSE
337.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) AND NOT %CFE_BOLD)
338.             END IF
339.             Refresh = %TRUE
340.  
341.           CASE %IDBTN_ITALIC
342.             IF SendMessage(GetDlgItem(hDlg, %IDBTN_ITALIC), %BM_GETCHECK, 0, 0) THEN
343.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) OR %CFE_ITALIC)
344.             ELSE
345.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) AND NOT %CFE_ITALIC)
346.             END IF
347.             Refresh = %TRUE
348.  
349.           CASE %IDBTN_ULINE
350.             IF SendMessage(GetDlgItem(hDlg, %IDBTN_ULINE), %BM_GETCHECK, 0, 0) THEN
351.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) OR %CFE_UNDERLINE)
352.             ELSE
353.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) AND NOT %CFE_UNDERLINE)
354.             END IF
355.             Refresh = %TRUE
356.  
357.           CASE %IDBTN_STRIKE
358.             IF SendMessage(GetDlgItem(hDlg, %IDBTN_STRIKE), %BM_GETCHECK, 0, 0) THEN
359.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) OR %CFE_STRIKEOUT)
360.             ELSE
361.               RTF_SetEffect(hDlg, %ID_Editor, RTF_GetEffect(hDlg, %ID_Editor) AND NOT %CFE_STRIKEOUT)
362.             END IF
363.             Refresh = %TRUE
364.            
365.           case %ID_MENU_CONTROL_TEST_UBB
366.             rtf_appendtext(hDlg, %ID_Editor, _
367.                     "[b]t[/b] [u]e[/u] [i]s[/i] [s]t[/s]" & $crlf & $crlf, %RTF_UBB)
368.  
369.             rtf_appendtext(hDlg, %ID_Editor, _
370.                     "This is [b]Bold[/b] and this is not bold"      & $crlf & _
371.                     "This is [i]Italic[/i] and this is not italic"  & $crlf & _
372.                     "This is [u]Underlined[/u] and this is not underlined"  & $crlf & _
373.                     "This is [s]Strikeout[/s] and this is not strikeout"  & $crlf & _
374.                     "[RIGHT]This is on the RIGHT side" & $crlf & _
375.                     "[CENTER]This is in the CENTER"  & $crlf & _
376.                     "[LEFT]This is on the LEFT side"  & $crlf & _
377.                     "[font=arial]This line should be Arial"  & $crlf & _
378.                     "[font=courier new]This line should be Courier New"  & $crlf & _
379.                     "[font=times new roman]This line should be Times New Roman"  & $crlf & _
380.                     "[font=courier new][size=6]This line 6 points font"  & $crlf & _
381.                     "[size=12]This line 12 points font"  & $crlf & _
382.                     "[size=18]This line 18 points font"  & $crlf & _
383.                     "[size=24]This line 24 points font"  & $crlf & _
384.                     "[size=40]This line 40 points font"  & $crlf & _
385.                     "[size=12]Back to 12 points font."  & $crlf & _
386.                     "", %RTF_UBB)
387.  
388.             randomize
389.             rtf_appendtext(hDlg, %ID_Editor, _
390.                     "[b]And now some random foreground color:[/b]"      & $crlf & _
391.                     "", %RTF_UBB)
392.             for looper = 1 to 10
393.               rtf_appendtext(hDlg, %ID_Editor, _
394.                       "[color=" & rgb(rnd(0, 255), rnd(0,255), rnd(0, 255)) & "]colored foregound color, colored foregound color"      & $crlf & _
395.                       "", %RTF_UBB)
396.             next
397.             rtf_appendtext(hDlg, %ID_Editor, _
398.                     "[color=0][b]followed by some random background color:[/b]"      & $crlf & _
399.                     "", %RTF_UBB)
400.  
401.             for looper = 1 to 5
402.               rtf_appendtext(hDlg, %ID_Editor, _
403.                       "[bcolor=" & rnd(0, 255) & "," & rnd(0,255) & "," & rnd(0, 255) & "]colored backgound color, colored backgound color"      & $crlf & _
404.                       "", %RTF_UBB)
405.             next
406.  
407.             rtf_appendtext(hDlg, %ID_Editor, _
408.                     "[bcolor=255,255,255][b]to finish with both fore/back color at the same time:[/b]"      & $crlf & _
409.                     "", %RTF_UBB)
410.  
411.             for looper = 1 to 5
412.               rtf_appendtext(hDlg, %ID_Editor, _
413.                       "[color=" & rnd(0, 255) & "," & rnd(0,255) & "," & rnd(0, 255) & "]" & "[bcolor=" & rnd(0, 255) & "," & rnd(0,255) & "," & rnd(0, 255) & "]colored foregound color, colored backgound color"      & $crlf & _
414.                       "", %RTF_UBB)
415.             next
416.  
417.             msgbox 0, "OK, now we will change the control color."
418.             for looper = 1 to 100
419.               rtf_appendtext(hDlg, %ID_Editor, "[ccolor=" & rnd(0, 255) & "," & rnd(0,255) & "," & rnd(0, 255) & "]", %RTF_UBB)
420.             next
421. '                    "--- finish ---"  & $crlf & _
422.  
423.             Refresh = %TRUE
424.  
425. '                    "[b][i][u][s]This is bold, italic, underlined and strikeout[/s][/u][/i][/b] "  & $crlf & _
426.                        
427.         END SELECT
428.  
429.       CASE %WM_SIZE
430.        'DIALOG GET CLIENT hDlg TO wx, hy
431.        'sbParts(1) = wx - 5
432.        'sbParts(2) = wx - 0
433.        'sbParts(3) = -1
434.        'control send hDlg, %ID_STATUSBAR, %SB_SETPARTS, 3, VARPTR(sbParts(1))
435.  
436.        
437.       CASE %WM_SYSCOMMAND
438.  
439.         SELECT CASE wParam
440.  
441.           CASE %SC_CLOSE
442.             EXIT WHILE
443.  
444.         END SELECT  
445.  
446.       CASE ELSE
447.      
448.     END SELECT
449.  
450.  
451.     '---In case we need to update editor control ...
452.     if Refresh = %true then
453.       UpdateControls
454.       Refresh = %false
455.     end if
456.  
457.   WEND
458.  
459.   '---Close the dialog
460.   DIALOG END hDlg
461.  
462.    
463.   '--------------------------------------------------------------------
464.   ' Update comboboxes and font effect buttons
465.   '--------------------------------------------------------------------
466.   SUB UpdateControls()
467.     LOCAL lRet AS LONG, txt AS STRING
468.     local cRange      as CHARRANGE
469.    
470.     dim SelStart, SelEnd, SelNBytes as long
471.     dim CurLine, CurPos, LineStart, LineLen as long
472.  
473.     txt = RTF_GetFontName(hDlg, %ID_EDITOR)
474.     SendMessage GetDlgItem(hDlg, %IDCB_FONTNAME), %CB_SELECTSTRING, -1, STRPTR(txt)
475.     'console_writeline "GetRFname " & txt
476.    
477.     txt = FORMAT$(rtf_GetFontSize(hDlg, %ID_Editor))
478.     SendMessage GetDlgItem(hDlg, %IDCB_FONTSIZE), %CB_SELECTSTRING, -1, STRPTR(txt)
479.    
480.     lRet = RTF_GetEffect(hDlg, %ID_Editor)
481.     CONTROL SEND hDlg, %IDBTN_BOLD, %BM_SETCHECK, IIF((lRet AND %CFE_BOLD), %BST_CHECKED, %BST_UNCHECKED), 0
482.    
483.    
484.     CONTROL SEND hDlg, %IDBTN_ITALIC, %BM_SETCHECK, _
485.                  IIF((lRet AND %CFE_ITALIC), %BST_CHECKED, %BST_UNCHECKED), 0
486.    
487.     CONTROL SEND hDlg, %IDBTN_ULINE, %BM_SETCHECK, _
488.                  IIF((lRet AND %CFE_UNDERLINE), %BST_CHECKED, %BST_UNCHECKED), 0
489.    
490.     CONTROL SEND hDlg, %IDBTN_STRIKE, %BM_SETCHECK, _
491.                  IIF((lRet AND %CFE_STRIKEOUT), %BST_CHECKED, %BST_UNCHECKED), 0
492.    
493.  
494.     SendMessage(hEdit, %EM_EXGETSEL, 0, varptr(cRange)) '---Pass the simulated structure pointer
495.     SelStart = cRange.cpMin                             '---Get back data using binary conversion
496.     SelEnd   = cRange.cpMin
497.     CurLine = SendMessage(hEdit, %EM_EXLINEFROMCHAR, 0, SelStart) 'line number
498.     CurPos  = SelEnd - SendMessage(hEdit, %EM_LINEINDEX, -1, 0)   'pos. in line
499.  
500.  
501. '    SendMessage hStatusbar, %SB_SETTEXT, 0, BYVAL STRPTR(s)
502. '    END IF
503. '    CONTROL SEND hDlg, %IDC_Text, %EM_GETSEL, VARPTR(j), 0
504. '    CONTROL SEND hDlg, %IDC_Text, %EM_LINEFROMCHAR, j, 0 TO k
505. '    s = "Row:" + STR$(k + 1)
506. '    SendMessage hStatusbar, %SB_SETTEXT, 1, BYVAL STRPTR(s)
507. '    '----------------------------------------------------------------
508. '    CONTROL SEND hDlg, %IDC_Text, %EM_LINEINDEX, -1, 0 TO k
509. '    s = "Col:" + STR$(j - k + 1)
510. '    SendMessage hStatusbar, %SB_SETTEXT, 2, BYVAL STRPTR(s)
511.  
512.     txt = "Row: " & format$(CurLine + 1)
513.     control send hDlg, %ID_STATUSBAR, %SB_SETTEXT, 0, strPTR(txt)
514.     txt = "Col: " & format$(CurPos + 1)
515.     control send hDlg, %ID_STATUSBAR, %SB_SETTEXT, 1, strPTR(txt)
516.     'control set text hDlg, %ID_STATUSBAR, txt
517.  
518.  
519.    
520.     'SetFocus hEdit
521.     control set focus hDlg, %ID_EDITOR
522.    
523.   END SUB
524.  
525.   '-----------------------------------------------------------------------------
526.   ' Load a file inside rich edit control
527.   '-----------------------------------------------------------------------------
528.   function RichEdit_OpenFile() as string
529.     dim sFile   as string
530.     dim sFilter as string
531.  
532.     sFilter  = "Rich Text Format (*.rtf)|*.rtf|"
533.     sFilter += "thinBasic Files (*.tBasic, *.tBasicc)|*.tBasic;*.tBasicc|"
534.     sFilter += "Text Files (*.TXT)|*.TXT|"
535.     sFilter += "All Files (*.*)|*.*"
536.  
537.     sFile = Dialog_OpenFile(hDlg, _
538.                             "Open an file", _
539.                             DIR_GetCurrent, _
540.                             sFilter, _
541.                             "rtf", _
542.                             %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY or %OFN_ENABLESIZING)
543.     function = sFile
544.   end function
545.  
546.  
547.   function RichEdit_SaveFile() as string
548.     dim sFile   as string
549.     dim sFilter as string
550.  
551.     sFilter  = "Rich Text Format (*.rtf)|*.rtf|"
552.     sFilter += "thinBasic Files (*.tBasic, *.tBasicc)|*.tBasic;*.tBasicc|"
553.     sFilter += "Text Files (*.TXT)|*.TXT|"
554.     sFilter += "All Files (*.*)|*.*"
555.  
556.     sFile = Dialog_SaveFile(hDlg, _
557.                             "Open an file", _
558.                             DIR_GetCurrent, _
559.                             sFilter, _
560.                             "tBasic", _
561.                             %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY or %OFN_ENABLESIZING)
562.     function = sFile
563.   end function
564.  
565.   function RichEdit_Check_FileExistsGO(sFileName as string) as long
566.     DIM Message   AS STRING
567.    
568.     function = %true
569.        
570.     '---If file already exists, ask if to replace
571.     if file_exists(sFileName) then
572.  
573.       Message = "File " & sFileName & "\n\n"
574.       Message += "already exists. Do yoy want to replace?\n\n"
575.       DIM lResult AS LONG = MSGBOX(0, Message, %MB_YESNOcancel, "Replace file?")
576.       IF lResult = %IDNO or lResult = %idcancel THEN
577.         function = %false
578.       END IF
579.     end if
580.    
581.   end function

[erosolmi]

Some NeHe examples can be found here: http://community.thi...index.php?board=87.0

[erosolmi]

What about a math evaluator? thinBasic has a module called EVAL that will let you evaluate math expressions at run-time also linking script variables dynamically with string expression.

See the following example:

Code: Text [Select]

1. uses "EVAL"
2.   uses "CONSOLE"
3.  
4.   '---
5.   ' This example shows how to connect thinBasic script variable with
6.   ' internal Eval variables in order to allow Eval to interact
7.   ' directly with script variable
8.   '---
9.    
10.   '---Some timing variable
11.   dim t0, t1 as double = timer
12.  
13.   '---This string will contain math function to eval
14.   dim MyFunction as string
15.  
16.   '---Define some y = f(x) ... function or whatever function
17.   MyFunction = "y = cos(x) * 10 + 20"
18.  
19.   '---Now define some script variable that will be used to interact
20.   '---with eval
21.   dim y, x as ext
22.  
23.   '---Here it is the trick. Using Eval_LinkExt you link together
24.   '---script variable with eval variables passing to eval
25.   '---the name of the eval variable name, the pointer to a script
26.   '---variable, and an initial value
27.   '---From now on every change in script variable value will effect
28.   '---the next eval execution and the other way round
29.   Eval_linkext("y", varptr(y), 0)
30.   Eval_linkext("x", varptr(x), 0)
31.  
32.   '---Define some globals
33.   dim MaxCount  as long value 500
34.  
35.   '---And now go in a loop
36.   for x = 1 to MaxCount
37.  
38.     '---Eval MyFunction. Remember x and y in script are linked at x, y in Eval formula
39.     Eval(MyFunction)
40.  
41.     '---Write some info output
42.     console_writeline format$(x, "0000") & " " & y
43.  
44.   next
45.  
46.   '---Measure the ending time
47.   t1 = timer
48.  
49.   '---Final results    
50.   Console_writeline "------------------------------------------------------"
51.   Console_writeline "Total execution time for " & MaxCount & " loops: " & format$(t1-t0, "#0.00000")
52.  
53.   '---Stop execution
54.   console_waitkey