Other Software > Developer's Corner
FBSL - Multithreaded GUI Application
Gerome:
Hello,
JFYI, here is a Multithreaded GUI Application that shows FBSL capacities at managing threads...
You can use the Online compiler to see the result onto your machine :)
--- ---' ==============================================
' Derived from: SpiralGraph 2.0 by Scott Frick
' ==============================================
'#################################################################################
' COMPILER OPTIONS
'#################################################################################
#Option Explicit
'#################################################################################
' PROTOTYPES
'#################################################################################
#DllDeclare Kernel32("CreateSemaphore", "ReleaseSemaphore", "WaitForSingleObject")
#DllDeclare User32("InvalidateRect", "GetDC")
#DllDeclare Gdi32("SetPixelV")
'#################################################################################
' CONSTANTS
'#################################################################################
Const mt = 10 'Max thread count
Const time2draw = 100 'Max time a thread draws its spiral
Const INFINITE = -1
'#################################################################################
' INITIALIZED DATA
'#################################################################################
Dim %tc = 1 'Initial thread count
Dim %hSpiral = CreateSemaphore(NULL, mt, mt, NULL) 'Create semaphore object used to control the amount of threads
Dim x: Alloc(x, 8 * mt) 'Equation variables, used for drawing spirals
Dim y: Alloc(y, 8 * mt)
Dim a: Alloc(a, 8 * mt)
Dim b: Alloc(b, 8 * mt)
Dim h: Alloc(h, 8 * mt)
Dim t: Alloc(t, 8 * mt)
Dim kol: Alloc(kol, 4 * mt)
Dim toggle: Alloc(toggle, 4 * mt)
Dim #speed = 0.51 'Initial speed setting
Dim %MainMenu = CreateMenu() 'That's not a true menu, just a quick help note
Dim %Max_X = 800, %Max_Y = 600 'Window size, used to calculate spiral size and placement
Dim %PauseSpiral = TRUE 'Pause flag
'#################################################################################
' BEGIN CODE SECTION
'#################################################################################
Fbsl_SetText(ME, "Multi Graph")
Resize(ME, 0, 0, 800, 600) 'Size the form
InsertMenu(MainMenu, 1, MF_STRING, 2, _
"*SPEED* = (+ or - or Mouse Wheel) *ERASE* = (SpaceBar or Left Click) *PAUSE* = (0 or Right Click) *THREAD COUNT* = (1 to 9)")
SetMenu(ME, MainMenu)
SetTimer(ME, 1, 4000) 'Timer to change the spirals' settings every 4 secs
SetTimer(ME, 2, time2draw / tc) 'Timer to set the draw time for each thread
Fbsl_SetFormColor(ME, 0) 'Make the form black
Center(ME)
Show(ME)
ReleaseSemaphore(hSpiral, mt, NULL) 'Release semaphore to initilize
Randomize 'Make sure the spirals are different each time the app starts
ChangeSpiral(tc) 'Modify the variables giving the spirals a random look
'===========================
' Main events loop
'===========================
Begin Events
Dim %i
Select Case CBMSG
Case WM_MOUSEWHEEL
'===========================
' Adjust the drawing speed
'===========================
Select Case CBWPARAM
Case 7864320
'================
' Wheel forward
'================
IncreaseSpeed()
Case - 7864320
'================
' Wheel back
'================
DecreaseSpeed()
End Select
Case WM_KEYDOWN
If CBWPARAM > 48 And CBWPARAM < 58 Then
'======================
' Choose the number of threads
'======================
InvalidateRect(ME, NULL, TRUE)
tc = CBWPARAM - 48
SetTimer(ME, 2, time2draw / tc)
ChangeSpiral(tc)
Else If CBWPARAM = 48 Then
'======================
' 0 pauses the drawing process
'======================
PauseSpiral = Not PauseSpiral
Else If CBWPARAM = 32 Then
'======================
' Space bar clears the form
'======================
InvalidateRect(ME, NULL, TRUE)
ChangeSpiral(tc)
Else If CBWPARAM = 107 Or CBWPARAM = 187 Then
'======================
' Plus key (white and gray)
'======================
IncreaseSpeed()
Else If CBWPARAM = 109 Or CBWPARAM = 189 Then
'======================
' Minus key (white and gray)
'======================
DecreaseSpeed()
End If: End If: End If: End If: End If
Case WM_LBUTTONDOWN
'===========================
' Clear the form
'===========================
InvalidateRect(ME, NULL, TRUE)
ChangeSpiral(tc)
Case WM_RBUTTONDOWN
'===========================
' Pause the drawing process
'===========================
PauseSpiral = Not PauseSpiral
Case WM_PAINT
For i = 1 To tc
'======================
' Wait till semafore is released
'======================
WaitForSingleObject(hSpiral, INFINITE)
'======================
' Launch a new thread
'======================
Fbsl_ThreadResume(Fbsl_Thread(AddressOf CalcSpiral))
Next
Case WM_TIMER
'===========================
' Change or draw a spiral
'===========================
If PauseSpiral Then
Select Case CBWPARAM
Case 1
'===========
' Timer #1
'===========
ChangeSpiral(tc)
Case 2
'===========
' Timer #2
'===========
WaitForSingleObject(hSpiral, INFINITE)
Fbsl_ThreadResume(Fbsl_Thread(AddressOf CalcSpiral))
End Select
End If
Case WM_SIZE
'===========================
' Adjust the variables
'===========================
Max_X = LoWord(CBLPARAM)
Max_Y = HiWord(CBLPARAM)
Case WM_CLOSE
'===========================
' Clean up and terminate
'===========================
KillTimer(ME, 1)
KillTimer(ME, 2)
ExitProgram(0)
End Select
End Events
'===========================
' Increase the speed smoothly
'===========================
Sub IncreaseSpeed()
If speed < 15 And speed > 5 Then
speed = speed + 0.5
SetTimer(ME, 1, 1000)
Else If speed <= 5 And speed > 1 Then
speed = speed + 0.1
SetTimer(ME, 1, 2000)
Else If speed <= 1 And speed > 0.5 Then
speed = speed + 0.05
SetTimer(ME, 1, 4000)
Else If speed <= 0.5 Then
speed = speed + 0.025
End If: End If: End If: End If
End Sub
'===========================
' Decrease the speed smoothly
'===========================
Sub DecreaseSpeed()
If speed > 2 Then
speed = speed - 0.5
Else If speed > 1 And speed <= 2 Then
speed = speed - 0.1
SetTimer(ME, 1, 3000)
Else If speed > 0.5 And speed <= 1 Then
speed = speed - 0.1
SetTimer(ME, 1, 4000)
Else If speed > 0.1 And speed <= 0.5 Then
speed = speed - 0.05
SetTimer(ME, 1, 8000)
End If: End If: End If: End If
End Sub
'===========================
' Change the pattern and color
'===========================
Sub ChangeSpiral(ndx)
Dim %k, %kval, %red, %green, %blue, #xval = Max_X / 400 + 0.2
Dim %LocalToggle = -1
For k = 0 To ndx - 1
kval = k << 3
red = Rnd() * 255
blue = Rnd() * 255
green = Rnd() * 255
SetMem(kol, Rgb(red, green, blue), kval >> 1)
SetMem(a, Rnd() * 65 + 3 * k, kval)
SetMem(b, Rnd() * 45 + 3 * k, kval)
SetMem(h, Rnd() * 35 + 3 * k, kval)
SetMem(a, GetMem(a, kval, #8) * xval, kval)
SetMem(b, GetMem(b, kval, #8) * xval, kval)
SetMem(h, GetMem(h, kval, #8) * xval, kval)
SetMem(t, Rnd() * 5 * k + 25, kval)
SetMem(toggle, LocalToggle, kval >> 1)
LocalToggle = -LocalToggle
Next
End Sub
'===========================
' Calculate and draw part of a spiral
'===========================
Sub CalcSpiral()
Static %counter = 1
Dim %i, %j, %hdc
Dim #aval, #bval, #hval, #tval, #sum, #div
If counter < tc - 1 Then
Incr(counter)
Else
counter = 0
End If
j = counter << 3
aval = GetMem(a, j, #8)
bval = GetMem(b, j, #8)
hval = GetMem(h, j, #8)
sum = aval + bval
div = sum / bval
'===============================
' 1 loop = 1 pixel
'===============================
For i = 1 To 400
SetMem(t, GetMem(t, j, #8) + 0.01132 * speed, j)
tval = GetMem(t, j, #8)
If GetMem(toggle, j >> 1, 4) = 1 Then
SetMem(x, (sum * Cos(tval)) - (hval * (Cos(div * tval))) + (Max_X >> 1), j)
Else
SetMem(x, (sum * Cos(tval)) + (hval * (Cos(div * tval))) + (Max_X >> 1), j)
End If
SetMem(y, (sum * Sin(tval)) - (hval * (Sin(div * tval))) + (Max_Y >> 1), j)
hdc = GetDC(ME)
SetPixelV(hdc, %GetMem(x, j, #8), %GetMem(y, j, #8), GetMem(kol, j >> 1, 4))
ReleaseDC(ME, hdc)
Next
'===============================
' Release semafore to allow a new thread in
'===============================
ReleaseSemaphore(hSpiral, 1, NULL)
End Sub
'#################################################################################
' END PROGRAM CODE
'#################################################################################
I just bet my trousers that Ahk is not capable of this?... :)
Cpilot:
Really nice effect actually. Could be used to create a nice screensaver.
Gerome:
Hello,
Really nice effect actually. Could be used to create a nice screensaver.
-Cpilot (March 15, 2006, 09:11 PM)
--- End quote ---
Simply try to do the same sample using VB : impossible since VB is not capable of multithreading...
f0dder:
You *can* do multi-threading in VB, although it is a bit hacky. You can't access global variables without going through a lot of tricky hoops, and there's a bunch of language features you can't use from secondary threads. But it *is* possible :)
That's for v5 and v6 btw, dunno about vb.net - but I assume they've fixed threading issues there.
Gerome:
Hi,
You *can* do multi-threading in VB, although it is a bit hacky. You can't access global variables without going through a lot of tricky hoops, and there's a bunch of language features you can't use from secondary threads. But it *is* possible :)
That's for v5 and v6 btw, dunno about vb.net - but I assume they've fixed threading issues there.
-f0dder (March 18, 2006, 01:35 PM)
--- End quote ---
In VBnet it's possible becasue vbnet is no more VB, but the net platform supports multithreading and it works same way as we've done MT support into Fbsl.
Navigation
[0] Message Index
[#] Next page
Go to full version