Messages

51

Official Announcements / Re: Please welcome two new DontionCoder Official Volunteers: Ampa and Josh

« on: May 27, 2006, 06:58 AM »

Hehe,

As I said to you mouser, I am more than happy to help out the site. If any of the members wish a screencast of an app or apps used in their mini-review or review, simply send me a private message or email me at crosscut @t whaddu d0t com and I will do my best to get it for them to include as quickly as I can. Include what you want demonstrated in the screencast, what points you want made, who makes it, where it can be downloaded, etc (any pertinent information to the program(s)). I will be glad to help out with full reviews as well, and will gladly work along with you as you test and review each application.

As for donationcredits, please, I ask that you instead send those to mouser or the dc.com general account as my work here is done probono. (spelling?). The sheer fact that the site gets more promotion and more recognition is enough for me.

Anyways, My thanks go out to mouser for entrusting me with this task, and I hope to be able to further contribute more to the donationcoder.com website so that it gets the recognition it deserves.

Thanks again and look forward to working with all of you.

Josh

-Josh (May 26, 2006, 08:06 PM)

I think I got a mission for your man

52

General Software Discussion / Re: help.... need a tool/utility to auto terminate a process

« on: May 27, 2006, 01:11 AM »

Hello,

Gerome,

This works fine, but i wanted to avoid manually clicking. If possible I want to have a program which monitors for these processses and issues this type of command to kill them.

Thanks

-zeemar (May 03, 2006, 01:42 PM)

Here is a complete and GUI version of my process killer.
It works from Win95b up to Vista Beta 2 version

[Select]

#Option Explicit
#DllDeclare Kernel32( "CloseHandle", "OpenProcess", "TerminateProcess" )
#DllDeclare User32( "FindWindow", "GetWindowThreadProcessId" )

Const NBSECTOWAITBEFORE = 10

Sub Cleaner()
  Fbsl_settext( hLabel, " > Killer @" & Time(1) & ":" & Time(2) & ":" & Time(3) & " <" )
  '// Put your program list here: its class name or its caption
  Kill( "Notepad", Null )
  Kill( "XLMAIN", Null )
End Sub

Function Kill( byVal szClass, byval szCaption ) As Integer
Dim %pid = 0, %hWnd = 0, %hProc = 0, %PROCESS_TERMINATE = 1
    hwnd = FindWindow( szClass, szCaption )
    If hwnd = 0 Then Return False
    GetWindowThreadProcessId( hWnd, @pid )
    If pid = 0 Then Return False
    hProc = OpenProcess( PROCESS_TERMINATE, False, pid )
    If hProc Then
        TerminateProcess( hProc, 0 )
        CloseHandle( hProc )
        Return True
    End If
    Return False
End Function

Dim %hLabel = FBSL_Control (_
            "static", Me, "zzzz", 1000, 20, 20, 170, 20,_
            WS_CHILD + SS_LEFT + WS_VISIBLE, WS_EX_TRANSPARENT )
FBSL_SetFont(hLabel, "Arial", 12, FW_BOLD, 0 ,0 ,0)
Fbsl_SetFormColor( Me, RGB(128,0,0) )

Cleaner()
SetTimer( Me, 1000, NBSECTOWAITBEFORE * 1000 )

Resize( Me, 0, 0, 220, 90 )
Fbsl_settext( Me, "Process killer" )
Center(Me)
Show(Me)

Begin Events
    Select Case cbmsg
      Case wm_timer
    Cleaner()
      Case wm_close
        Killtimer(Me, 1000)
        Exitprogram(-1)
    End Select
End Events

53

Developer's Corner / FBSL - Fbsl Script Factory

« on: May 25, 2006, 01:25 PM »

Dear all,

As you know, Fbsl project evolves, and onto its basket we have a RAD a la VB in progress...
what you are seeing is 100% Fbsl coded!



Enjoy

54

Post New Requests Here / Re: IDEA: meter my bandwidth during specific daily interval each month

« on: May 11, 2006, 04:51 PM »

Hi,

I got a 8 Mb DSL unlimited band for 15 Euro per month ( between $17 to $20 )

55

Developer's Corner / FBSL - Vista & RAD

« on: May 05, 2006, 12:43 PM »

Hello,

Good news !
FBSL is supported under Windows Vista!
It has been tested with success under Vista beta 2

As you can see, FBSL is still in progress and it has a complete RAD à la VStudio.NET if you pay attention to the following screen capture...
This Visual Studio like is 100% developped in FBSL and no extra DLL or specific component is used for this Visual studio like !

Any opinions ?

56

General Software Discussion / Re: help.... need a tool/utility to auto terminate a process

« on: May 02, 2006, 05:09 PM »

Hello,

A pure process killer that you can use from a batch file once the source compiled as a standalone executable

[Select]

#Option Explicit
#AppType CONSOLE

#DllDeclare Kernel32( "CloseHandle", "OpenProcess", "TerminateProcess" )
#DllDeclare User32( "FindWindow", "GetWindowThreadProcessId" )

Print Kill( "Notepad", Null )
Print Kill( "XLMAIN", Null )
Pause

Function Kill( byVal szClass, byval szCaption ) As Integer
Dim %pid = 0, %hWnd = 0, %hProc = 0, %PROCESS_TERMINATE = 1
    hwnd = FindWindow( szClass, szCaption )
    If hwnd = 0 Then Return False
    GetWindowThreadProcessId( hWnd, @pid )
    If pid = 0 Then Return False
    hProc = OpenProcess( PROCESS_TERMINATE, False, pid )
    If hProc Then
        TerminateProcess( hProc, 0 )
        CloseHandle( hProc )
        Return True
    End If
    Return False
End Function

57

Developer's Corner / Re: FBSL - Icon viewer

« on: April 28, 2006, 05:12 PM »

Hello,

I'm disapointed... This was just now going to be very usefull, but it doesn't work..

-jgpaiva (April 26, 2006, 04:30 AM)

Sorry, but it works... into the CLASS, you just have to replace all DIM with STATIC keyword and all will work nicely
Sorry for the inconvenient...

The newest CLASS layer will be flexible and inherits will also work

58

Developer's Corner / Re: FBSL - Special visual effects : how to render raindrops onto a JPG

« on: April 20, 2006, 03:05 PM »

Hello,

Yes, I know - iirc they added asm blocks in v6. Before that, only "inline machine code" was possible, which looked a lot like what FBSL does. Ie, something like...

[Select]

function getBP:word; inline($8b/$c5);

-f0dder (April 20, 2006, 04:15 AM)

FBSL was not exclusively developped to have a structured ASM layer, that is why i've simply added the tweak to load and play 'pseudo asm code' on the fly.
Sincerely, I don't have planned other kinda ASM support into my language, the demo was aimed to see a pure and nice living sample, aka tears falling down to the water via Fbsl, nothing more...

And don't forget that FBSL is NOT compiled.

59

Developer's Corner / FBSL - Special visual effects : how to render raindrops onto a JPG

« on: April 14, 2006, 05:31 PM »

Hello,

This script reveals multithreading capabilities of FBSL v3 inspired by Tom Kenny's Water Effect Demo...

Water _Effect_Demo.fbs

[Select]

'###########################################################################
'
'  Original Name: Tears.fbs
'             Author: Mike Lobko-Lobanovsky ([email protected])
' Creation Date: April 13, 2006
'      Description: This script reveals multithreading capabilities of FBSL v3 inspired by Tom Kenny's Water Effect Demo
'
'###########################################################################
#Option Explicit

#DllDeclare User32("GetClientRect")
#DllDeclare Gdi32("CreateDIBSection")
#DllDeclare Kernel32("RtlMoveMemory", "GetModuleHandle", "GetProcessHeap", "HeapAlloc")

Begin Const
Running = 0 'Thread running flag
DropSize = 4 'Strength (weight) of a drop
XOffset = 8 'X-offset from the left margin of the window
YOffset = 12 'Y-offset from the top of the window
SourceBitmap = 16 'Handle to the original 100x100 pixel tile
DropBitmap = 20 'Handle to the watered 100x100 pixel tile
SourceBits = 24 'Pointer to the original tile's RGB data
DropBits = 28 'Pointer to the watered tile's RGB data
FirstMap = 32 'The initial height map
LastMap = 36 'The last computed height map
WaterProc = 40 'Compute the new height map based on the initial and last height maps
FrameProc = 44 'Set drop bitmap bits according to the currently computed height map
TileProc = 48 'Blit the drop bitmap to the window device context
AnimateProc = 52 'Loop the preceding 3 procs for 60 frames
AnimateArgs = 56 'Pointer to the args for the animation proc
End Const 'len=60 bytes

Begin Const
SRCCOPY = &HCC0020
DIB_RGB_COLORS = 0
HORZRES = 8
VERTRES = 10
End Const

Dim $BmpInfo: FillString(BmpInfo, 40, 0) 'BITMAPINFOHEADER
Dim $TileStruct: FillString(TileStruct, 600, 0) 'Array of 10 tile structures
Dim $TileParams: Alloc(TileParams, 28) 'Parameter array for Tile()
Dim $AnimateParams: Alloc(AnimateParams, 8) 'Parameter array for Animate()


'=======================================================================
' This machine code function processes two height maps to compute the new height map for one
' of the 60 animation frames. It  processes 10,000 pixels with a dozen Peeks and Pokes involved.
' Clearly enough, none of the known interpreters can do it in real time fast enough for the animation
' to look natural. This is the reason why it is written in Assembler.
'=======================================================================
Dim $Water = Data( _
&H55, &H8B, &HEC, &H83, &HEC, &H0C, &H53, &H51, &H52, &H56, &H57, &H6A, &H62, &H8F, &H45, &HF8, _
&H6A, &H06, &H8F, &H45, &HF4, &HDB, &H45, &HF4, &H8B, &H75, &H08, &H8B, &H7D, &H08, &H8B, &H76, _
&H20, &H8B, &H7F, &H24, &HB8, &HC8, &H00, &H00, &H00, &H8D, &H3C, &H38, &H6A, &H02, &H8F, &H45, _
&HFC, &HB9, &H02, &H00, &H00, &H00, &H8D, &H14, &H31, &H0F, &HBE, &H02, &H8D, &H52, &H64, &H0F, _
&HB6, &H5A, &HFF, &H03, &HC3, &H0F, &HB6, &H1A, &H03, &HC3, &H0F, &HB6, &H5A, &H01, &H03, &HC3, _
&H8D, &H52, &H64, &H0F, &HBE, &H5A, &HFE, &H03, &HC3, &H0F, &HBE, &H5A, &HFF, &H03, &HC3, &H0F, _
&HBE, &H5A, &H01, &H03, &HC3, &H0F, &HBE, &H5A, &H02, &H03, &HC3, &H8D, &H52, &H64, &H0F, &HBE, _
&H5A, &HFF, &H03, &HC3, &H0F, &HBE, &H1A, &H03, &HC3, &H0F, &HBE, &H5A, &H01, &H03, &HC3, &H8D, _
&H52, &H64, &H0F, &HBE, &H1A, &H03, &HC3, &H48, &H89, &H45, &HF4, &HDB, &H45, &HF4, &HD8, &HF1, _
&HDB, &H5D, &HF4, &H8B, &H45, &HF4, &H0F, &HBE, &H1C, &H39, &H2B, &HC3, &H8B, &HD8, &HC1, &HE8, _
&H04, &H2B, &HD8, &H83, &HFB, &H02, &H7D, &H02, &H33, &HDB, &H88, &H1C, &H39, &H41, &H3B, &H4D, _
&HF8, &H72, &H83, &H83, &HC7, &H64, &H83, &HC6, &H64, &HFF, &H45, &HFC, &H8B, &H4D, &HFC, &H3B, _
&H4D, &HF8, &H0F, &H82, &H69, &HFF, &HFF, &HFF, &HD9, &H5D, &HF4, &H5F, &H5E, &H5A, &H59, &H5B, _
&H83, &HC4, &H0C, &HC9, &HC2, &H10)

'=======================================================================
' This machine code function takes the new height map bytes, combines them with the source bitmap
' bits and saves the result to the destination bitmap. If the given byte is zero then the resulting bit
' is the same as that in the source bitmap, otherwise some other source pixel is chosen to produce a
' refraction-like picture. Reasons for choosing Assembler are the same as above.
'=======================================================================
Dim $Frame = Data( _
&H55, &H8B, &HEC, &H83, &HEE, &H10, &H53, &H51, &H52, &H57, &H56, &H33, &HC0, &H89, &H45, &HF4, _
&H89, &H45, &HF0, &H8B, &H5D, &H08, &H8B, &H43, &H18, &H89, &H45, &HFC, &H8B, &H43, &H1C, &H89, _
&H45, &HF8, &H8B, &H45, &H08, &H8B, &H70, &H20, &H8B, &H7B, &H24, &H89, &H78, &H20, &H89, &H70, _
&H24, &H33, &HC9, &H8B, &HC1, &H8B, &H55, &HF0, &H85, &HC9, &H74, &H13, &H83, &HF9, &H63, &H73, _
&H0E, &H0F, &HBE, &H7C, &H32, &HFF, &H0F, &HBE, &H5C, &H32, &H01, &H2B, &HDF, &H03, &HC3, &H8B, _
&H5D, &HF4, &H85, &HDB, &H74, &H11, &H83, &HFB, &H63, &H73, &H0C, &H0F, &HBE, &H54, &H32, &H9C, _
&H0F, &HBE, &H3E, &H2B, &HFA, &H03, &HDA, &H85, &HC0, &H79, &H02, &H33, &HC0, &H85, &HDB, &H79, _
&H02, &H33, &HDB, &HBA, &H63, &H00, &H00, &H00, &H3B, &HC2, &H7E, &H02, &H8B, &HC2, &H3B, &HDA, _
&H7E, &H02, &H8B, &HDA, &H42, &HC1, &HE3, &H02, &H0F, &HAF, &HD3, &H8D, &H04, &H82, &H8B, &H55, _
&HF0, &H03, &H45, &HFC, &H0F, &HBE, &H14, &H32, &H0F, &HB6, &H18, &H03, &HDA, &H81, &HFB, &HFF, _
&H00, &H00, &H00, &H7C, &H05, &HBB, &HFF, &H00, &H00, &H00, &H8B, &HFB, &H0F, &HB6, &H58, &H01, _
&H03, &HDA, &H81, &HFB, &HFF, &H00, &H00, &H00, &H7C, &H05, &HBB, &HFF, &H00, &H00, &H00, &HC1, _
&HE3, &H08, &H0B, &HFB, &H0F, &HB6, &H58, &H02, &H03, &HDA, &H81, &HFB, &HFF, &H00, &H00, &H00, _
&H7C, &H05, &HBB, &HFF, &H00, &H00, &H00, &HC1, &HE3, &H10, &H0B, &HFB, &H8B, &H45, &HF0, &H8B, _
&H55, &HF8, &H89, &H3C, &H82, &HFF, &H45, &HF0, &H41, &H83, &HF9, &H64, &H0F, &H82, &H41, &HFF, _
&HFF, &HFF, &H8B, &H4D, &HF4, &H41, &H89, &H4D, &HF4, &H83, &HF9, &H64, &H0F, &H82, &H2F, &HFF, _
&HFF, &HFF, &H5E, &H5F, &H5A, &H59, &H5B, &H83, &HC6, &H10, &HC9, &HC2, &H10)

'=======================================================================
' This machine code function blits the destination bitmap to the screen. This function is part of the
' animation loop written in Assembler therefore it has been written in Assembler too.
'=======================================================================
Dim $Tile = Data( _
&H55, &H8B, &HEC, &H83, &HEE, &H0C, &H57, &H56, &H8B, &H7D, &H08, &H8B, &H75, &H0C, &H6A, &H00, _
&HFF, &H16, &H89, &H45, &HFC, &HFF, &H77, &H14, &HFF, &H75, &HFC, &HFF, &H56, &H08, &H89, &H45, _
&HF8, &HFF, &H76, &H18, &HFF, &H56, &H10, &H89, &H45, &HF4, &H68, &H20, &H00, &HCC, &H00, &H6A, _
&H00, &H6A, &H00, &HFF, &H75, &HFC, &H6A, &H64, &H6A, &H64, &HFF, &H77, &H0C, &HFF, &H77, &H08, _
&H50, &HFF, &H56, &H0C, &HFF, &H75, &HF4, &HFF, &H76, &H18, &HFF, &H56, &H14, &HFF, &H75, &HF8, _
&HFF, &H75, &HFC, &HFF, &H56, &H08, &HFF, &H75, &HFC, &HFF, &H56, &H04, &H5E, &H5F, &HC9, &HC2, _
&H10)

'=======================================================================
' This machine code function animates the refraction. It runs 60 loops each of which comprises a call
' to Water() to produce a new height map, a call to Frame() to combine the height map and the
' source bitmap into a current frame of animation, and a call to Tile() to blit the frame to the screen.
' Then the function calls Sleep() to yield control to other running threads for 10 milliseconds and
' resumes control to run another loop. The function incorporates a loop counter, so Assembler was
' chosen to isolate it from the other threads' counters to make looping persistent after the current
' thread resumes control. The function also clears the 'Busy' flag when thread execution is over.
'=======================================================================
Dim $Animate = Data( _
&H55, &H8B, &HEC, &H83, &HEC, &H04, &H57, &H56, &H6A, &H00, &H8F, &H45, &HFC, &H6A, &H00, &H6A, _
&H00, &H6A, &H00, &H8B, &H7D, &H08, &H57, &HFF, &H57, &H28, &H6A, &H00, &H6A, &H00, &H6A, &H00, _
&H8B, &H7D, &H08, &H57, &HFF, &H57, &H2C, &H6A, &H00, &H6A, &H00, &H8B, &H7D, &H08, &H8B, &H7F, _
&H38, &HFF, &H77, &H04, &H8B, &H7D, &H08, &H57, &HFF, &H57, &H30, &H6A, &H0A, &H8B, &H7D, &H08, _
&H8B, &H7F, &H38, &HFF, &H17, &HFF, &H45, &HFC, &H83, &H7D, &HFC, &H3C, &H72, &HBF, &H33, &HC0, _
&H8B, &H7D, &H08, &H89, &H07, &H5E, &H5F, &HC9, &HC2, &H04)

Sub Main()
'===================================================
' Main entry point
'===================================================
Dim %pTStruct
Dim %BmpBits
Dim %BmpDC = CreateCompatibleDC(NULL)
'===================================================
' One bitmapinfo header will be sufficient to create all the bmps we need
'===================================================
SetMem(BmpInfo, 40, 0) 'size of BITMAPINFOHEADER
SetMem(BmpInfo, 100, 4) 'bmp width
SetMem(BmpInfo, 100, 8) 'bmp height
SetMem(BmpInfo, 1, 12) '# of planes
SetMem(BmpInfo, 32, 14) '32-bit color
'===================================================
' Fill in the Tile() function parameter array
'===================================================
Dim %hModule = GetModuleHandle("Gdi32.dll")
SetMem(TileParams, GetProcAddress(hModule, "CreateCompatibleDC"), 0)
SetMem(TileParams, GetProcAddress(hModule, "DeleteDC"), 4)
SetMem(TileParams, GetProcAddress(hModule, "SelectObject"), 8)
SetMem(TileParams, GetProcAddress(hModule, "BitBlt"), 12)
hModule = GetModuleHandle("User32.dll")
SetMem(TileParams, GetProcAddress(hModule, "GetDC"), 16)
SetMem(TileParams, GetProcAddress(hModule, "ReleaseDC"), 20)
SetMem(TileParams, ME, 24)
'===================================================
' Fill in the Animate() function parameter array
'===================================================
hModule = GetModuleHandle("Kernel32.dll")
SetMem(AnimateParams, GetProcAddress(hModule, "Sleep"), 0)
SetMem(AnimateParams, @TileParams, 4)
'===================================================
' Allocate memory for bitmaps, assembler functions, and assembler
' functions' parameter arrays. Copy the assembler procedure code
' to the allocated space to completely isolate each thread from others.
'===================================================
For pTStruct = @TileStruct To  @TileStruct + 540 Step 60
Poke(pTStruct + DropBitmap, CreateDIBSection(BmpDC, @BmpInfo, DIB_RGB_COLORS, @BmpBits, NULL, NULL))
Poke(pTStruct + DropBits, BmpBits)
Poke(pTStruct + SourceBitmap, CreateDIBSection(BmpDC, @BmpInfo, DIB_RGB_COLORS, @BmpBits, NULL, NULL))
Poke(pTStruct + SourceBits, BmpBits)
Poke(pTStruct + FirstMap, HeapAlloc(GetProcessHeap(), 8, 10000))
Poke(pTStruct + LastMap, HeapAlloc(GetProcessHeap(), 8, 10000))
Poke(pTStruct + WaterProc, HeapAlloc(GetProcessHeap(), 8, Len(Water)))
RtlMoveMemory(Peek(pTStruct + WaterProc, 4), @Water, Len(Water))
Poke(pTStruct + FrameProc, HeapAlloc(GetProcessHeap(), 8, Len(Frame)))
RtlMoveMemory(Peek(pTStruct + FrameProc, 4), @Frame, Len(Frame))
Poke(pTStruct + TileProc, HeapAlloc(GetProcessHeap(), 8, Len(Tile)))
RtlMoveMemory(Peek(pTStruct + TileProc, 4), @Tile, Len(Tile))
Poke(pTStruct + AnimateProc, HeapAlloc(GetProcessHeap(), 8, Len(Animate)))
RtlMoveMemory(Peek(pTStruct + AnimateProc, 4), @Animate, Len(Animate))
Poke(pTStruct + AnimateArgs, HeapAlloc(GetProcessHeap(), 8, Len(AnimateParams)))
RtlMoveMemory(Peek(pTStruct + AnimateArgs, 4), @AnimateParams, Len(AnimateParams))
Next
DeleteDC(BmpDC)
'===================================================
' Set the main window style bits and display the picture
'===================================================
SetWindowLong(ME, GWL_STYLE, &H6000000)
SetWindowLong(ME, GWL_EXSTYLE, &H200)
Fbsl_SetText(ME, "Uriah Heep")
Fbsl_Tile(ME, Fbsl_LoadImage(".\Rain.jpg"))
'===================================================
' Set the initial delay. Let the watcher catch a glimpse of the picture...
' The delay will become shorter as the loop progresses.
'===================================================
SetTimer(ME, 1001, 2000)
Resize(ME, 0, 0, 800, 533)
Center(ME)
Show(ME)
'===================================================
' Make drop positions alter each time the program starts
'===================================================
Randomize
'===================================================
' Run the thread launching loop
'===================================================
Begin Events
Select Case CBMSG
Case WM_TIMER
Storm()
Return 0
Case WM_CLOSE, WM_LBUTTONDOWN, WM_RBUTTONDOWN
CleanUp()
End Select
End Events
End Sub

Sub Storm()
Dim %x, %y, %i, %j, %k, %Dummy
'===================================================
' Set the length of time the program runs
'===================================================
Static %Counter = 200
'===================================================
' Don't let tiles go off the window canvas
'===================================================
Dim $rct: Alloc(rct, 16): GetClientRect(ME, rct)
Dim %WinX = GetMem(rct, 8, 4) - 100
Dim %WinY = GetMem(rct, 12, 4) - 100
Clean rct
Static %Delay = 600
For j = 0 To 9
'==============================================
' Exit the loop at a first vacant tile structure
'==============================================
If Not GetMem(TileStruct, j * 60 + Running, 4) Then Exit For
Next
'===================================================
' A vacant tile structure has been found
'===================================================
If j < 10 Then
'==============================================
' Randomize the tile position
'==============================================
x = RandInt(0, WinX)
y = RandInt(0, WinY)
'==============================================
' Check if this position interferes with any running thread.
' If yes, tile interference occurs which prevents proper
' original picture restoration.
'==============================================
For k = 0 To 9
If GetMem(TileStruct, k * 60 + Running, 4) Then
Dummy = k * 60 + XOffset
If (x > GetMem(TileStruct, Dummy, 4) - 100) And (x < GetMem + 100) Then
Dummy = k * 60 + YOffset
If (y > GetMem(TileStruct, Dummy, 4) - 100) And (y < GetMem + 100) Then
'========================
' Interference: skip the rest of sub
'========================
Exit Sub
End If
End If
End If
Next
'==============================================
' No interference: start a new thread
'==============================================
Dummy = j * 60
'==============================================
' Fill in coordinate offsets and drop size
'==============================================
SetMetrics(Dummy, x, y)
Incr(Dummy, @TileStruct)
'==============================================
' Blit the picture into the source bitmap
'==============================================
BlitSource(Dummy)
'==============================================
' Calculate the initial height map for the drop
'==============================================
CalcDrop(Dummy)
'==============================================
' Launch a new thread
'==============================================
Fbsl_ThreadResume(Fbsl_Thread(Peek(Dummy + AnimateProc, 4), Dummy))
End If
KillTimer(ME, 1001)
Decr(Counter)
If Not Counter Then
PostMessage(ME, WM_CLOSE, 0, 0)
Exit Sub
End If
'===================================================
' Shorten the delay to make the drops fall faster
'===================================================
Decr(Delay, IIf(Delay > 50, 10, 0))
SetTimer(ME, 1001, Delay)
End Sub

Sub SetMetrics(%Index, %x, %y)
'===================================================
' Set the 'Busy' flag to notify the Storm() loop that the thread is running
'===================================================
SetMem(TileStruct, TRUE, Index + Running)
'===================================================
' Store positional data
'===================================================
SetMem(TileStruct, x, Index + XOffset)
SetMem(TileStruct, y, Index + YOffset)
'===================================================
' Randomize the drop strength
'===================================================
SetMem(TileStruct, RandInt(50, 200), Index + DropSize)
End Sub

Sub BlitSource(%pTStruct)
'===================================================
' Blit a part of the picture to the tile's original bitmap
'===================================================
Dim %BmpDC = CreateCompatibleDC(NULL)
Dim %pOldBmp = SelectObject(BmpDC, Peek(pTStruct + SourceBitmap, 4))
Dim %hDC = GetDC(ME)
BitBlt(BmpDC, 0, 0, 100, 100, hDC, %Peek(pTStruct + XOffset, 4), %Peek(pTStruct + YOffset, 4), SRCCOPY)
ReleaseDC(ME, hDC)
SelectObject(BmpDC, pOldBmp)
DeleteDC(BmpDC)
End Sub

Sub CalcDrop(%pTStruct)
'===================================================
' CalcDrop() rolls the peripheral bits into the central "drop" which will
' further be unrolled into concentric circles by calls to Water()
'===================================================
Dim %Depth = Peek(pTStruct + DropSize, 4)
Dim %Radius = Depth >> 3
Dim %Distance
Dim %CalcDepth
Dim %i = 50, %j = i - Radius, %k = i + Radius, %l = Peek(pTStruct + FirstMap, 4), %m, %n, %o
For m = j To k
n = (m - i) ^ 2
For o = j To k
Distance = %SqRt((o - i) ^ 2 + n)
If Distance < Radius Then
CalcDepth = Depth * (Radius - Distance) \ Radius
Poke(l + m * 100 + o, Chr(%CalcDepth))
End If
Next
Next
End Sub

Sub CleanUp()
Dim %pTStruct
'===================================================
' No more new threads in case a mouse button has been clicked
'===================================================
KillTimer(ME, 1001)
'===================================================
' Let the last threads complete drawing
'===================================================
Sleep(1500)
'===================================================
' Clean up the GDI stuff. Memory is released automatically when the
' process exits.
'===================================================
For pTStruct = @TileStruct To @TileStruct + 540 Step 60
DeleteObject(Peek(pTStruct + DropBitmap, 4))
DeleteObject(Peek(pTStruct + SourceBitmap, 4))
Next
ExitProgram(0)
End Sub

And it works in combination with this JPG file :


Enjoy multithreading with FBSL!

60

Developer's Corner / Re: Farr's 'Calc' program completely revisited!

« on: April 12, 2006, 04:24 AM »

Hi mouser,

I hope you won't forget to include this newest version to the next FARR distro...

61

Developer's Corner / Re: FBSL - Process killer

« on: April 07, 2006, 07:52 PM »

Hi,

Does this work in any version of Windows - otherwise aren't there built in command line admin tools in Windows XP/2003 ? (eg. SC.exe)

-Carol Haynes (April 07, 2006, 07:43 PM)

This script uses WSH, it's an optional COM component that natively comes with XP, and with 2k it comes with services pack, and finally you can install WSH onto versions inferior to 2k like NT4 and Win 9.x.
SC.EXE is part of XP and >, and is unavailable for other versions...

The purpose of my script was to encapsulate a wsh code into Fbsl to show perfect interaction between FBSL and WSH COM interface.

For instance and witrh a bit of patience, it just would say you can develop your own IDE for 3rd party COM interfaces with FBSL, and making a step by step WSH or JS or VBS debugger, yes really you can.

62

General Software Discussion / Re: Find and Run Robot got an Award

« on: April 07, 2006, 03:23 PM »

Hi,

Find and Run Robot got an Download of the week Award 

http://www.wintotal....re/index.php?id=3081

-masu (April 07, 2006, 03:19 PM)

Nice
I bet it is thanks to my Fbsl's calculator script that Farr holds... ^^ ROFL...

63

Developer's Corner / Re: FBSL - Process killer

« on: April 07, 2006, 02:59 PM »

Hello,

It might be nice for you to add a few comments, for what purposes you made it, how to use it, etc. etc.

-brotherS (April 07, 2006, 01:01 PM)

Purpose is simple :
Either beeing able to kill from your computer a named running process immediately and irremediably, either beeing able to kill from your computer a distant process that is running from a server where for sure you are granted to access and then killing a distant process.
This sample can be handy for administrative tasks.

64

Developer's Corner / FBSL - Process killer

« on: April 07, 2006, 12:00 PM »

' ------------------------------------------------
' // PROCESS KILLER
' // April, 7th 2006
' // By Gerome GUILLEMIN
' // Requires : WSH COM interface installed
' ------------------------------------------------

Process_killer.fbs

[Select]

#Option Explicit

If standalone = false Then
    Fbsl2exe( Command(1) )
    Exitprogram(1)
End If

#DllDeclare kernel32( "GetEnvironmentVariable" )

Sub Main()
    Dim $strProcess = Inputbox("Process name to kill :", "Name :", "Excel.exe" ), %iResult = 0
    iResult = KillProcess( strProcess )
    $AppType CONSOLE
    Print "--------------------------------------------------------"
    If iResult = 0 Then
        Print "No '" & strProcess & "' process to kill was found :/"
    Else
        Print "Found "& iResult & " '" & strProcess & "' processe(s) to kill :)"
    End If
    Print "--------------------------------------------------------"
    Sleep(2000)
End Sub

' ------------------------------------------------
' // PROCESS KILLER
' ------------------------------------------------
Function %KillProcess( Byval $szProcess, Byval $szPassword = "" )
    Dim $strComputer = GetEnvironmentVar("COMPUTERNAME")
    Dim $strDomain   = GetEnvironmentVar("USERDOMAIN")
    Dim $strUser     = GetEnvironmentVar("USERNAME")

    Dim %objSWbemLocator = CreateObject( "WbemScripting.SWbemLocator" )

    Dim %objWMIService   = GetValue( "%o", objSWbemLocator, ".ConnectServer(%s, %s, %s, %s, %s, %s )", _
                           strComputer, "root\CIMV2", strUser, szPassword, "MS_409", "ntlmdomain:" & strDomain )

    Dim %colProcessList  = EnumBegin( objWMIService, ".ExecQuery(%s)", _
                           "SELECT * FROM Win32_Process WHERE Name = '" & szProcess & "'" )

    Dim %objProcess, %iCounter = 0
    While EnumGetNext( colProcessList, objProcess ) = 0
        Print GetValue( "%s", objProcess, ".Name" ) & " killed!"
        Callmethod( objProcess, ".Terminate" )
        Incr(iCounter)
    Wend

    Releaseobject( objSWbemLocator ): Releaseobject( objWMIService )
    Releaseobject( colProcessList ):  Releaseobject( objProcess )
    Return iCounter
End Function

' ------------------------------------------------
' // GETENVIRONMENTVAR
' ------------------------------------------------
Function GetEnvironmentVar( Byval $sName ) As String
    Dim $GetEnvironmentVar: Alloc( GetEnvironmentVar, 255 )
    GetEnvironmentVariable( sName, GetEnvironmentVar, 255 )
    Return GetEnvironmentVar
End Function

65

Post New Requests Here / Re: IDEA: Some programm which is able to recognize newer versions when copying

« on: April 06, 2006, 02:20 AM »

Hello,

Just copy the XCOPY line into Notepad, and save it as "Backup.cmd" (including the quotation marks, or it will end up a text file). Now make a shortcut to it to put on your desktop and change the icon, and you're good to go. And maybe add it to Scheduler to have it run automatically every night.

Skrommel

-skrommel (April 05, 2006, 08:07 PM)

Yes, but XPCOPY is not able to see IF the file has been REALLY updated aka NOT only the DATE but ALSO the inner contents!!!

BUT, if you want to use COPY and log it onto a living window, you can use Fbsl to execute and pipe in perfect sync

[Select]

Dim %hEdit = Fbsl_control("edit", Me, "", 1, 0, 0, 160, 250, 0x50310084, 0)
 
  Fbsl_SetText( Me, "Copy..." )
  Resize(Me, 0, 0, 170, 280 ): Center(Me): Show(me)

  Dim $buf = StrPipe("CMD.EXE /C DIR c:\DDE\*.* | copy /Y /V c:\DDE\*.* d:\Temp\" )
  Fbsl_SetText( hEdit, buf )
  MsgBox( Me, "Operation completed!", "CHECK POINT", MB_ICONINFORMATION )

Begin Events
End Events

Enjoy

66

Post New Requests Here / Re: IDEA: Some programm which is able to recognize newer versions when copying

« on: April 05, 2006, 05:25 PM »

Hi,

Thank you jgpaiva, I have checked the site. It seems, that it is in fact a backup tool which I am looking for.

Gerome! You really made my day :-) Thank you very much for the code. The only problem is, that I do not know, what to do with it, since a little html and css and such are my only code-skills. Could you tell me, where I can put the code into? Only if it is not too time-consuming for you. 

-Webijou (April 05, 2006, 05:21 PM)

Either you can download FBSL there : http://gedd123.free.fr/FBSLv3.exe
Or either you can try the code i gave you by pasting there : http://gedd123.free.fr/studio

The 1st solution will install the full interpreter + compiler + editor + 525 pahe Help manual with tutorials
The 2nd solution will allow you to quick and blindly compile the script i gave you into a stand alone EXEcutable.

Both solutions are able to produce standalone EXEcutable and the memory footprint is around 2 Mb of RAM, that is to say not greedy at all onto our decent machines

67

Post New Requests Here / Re: IDEA: Some programm which is able to recognize newer versions when copying

« on: April 05, 2006, 05:00 PM »

Hello,

More than a long discuss, here's a script code that does the exact trick you want
Enjoy!

[Select]

#Option Explicit
$AppType Console
' **********************************************************************
' // Source dir to Dest dir with CRC script
' // CRC changed? If Yes, then modified file will be replaced onto Dest
' // Author   : Gerome GUILLEMIN
' // Date     : 06th Of April 2006
' // Language : FBSL
' **********************************************************************
Dim $Src = "C:\Source\"
Dim $Dst = "D:\Backup\"
Dim $Joker = "*.*"

If FindFirst( Src & Joker ) <> "" Then
  CheckAndCopy ( Findfirst )
  While FindNext() <> ""
    CheckAndCopy( Findnext )
  Wend
End If
Pause

Sub CheckAndCopy(Byref $szFound)
  If szFound = "." OrElse szFound = ".." Then Exit Sub
  Dim %srcCRC = 0, %dstCRC = 0

  srcCRC = CheckSum(FileLoad(Src & szFound))
  If FileExist( Dst & szFound ) Then
    dstCRC = CheckSum(FileLoad(Dst & szFound))
  End If
  If (srcCRC = dstCRC) AndAlso dstCRC <> 0 Then Exit Sub
  ? "[CRC diff] Copying ", Src & szFound, " -> ", Dst & szFound

  CopyF( Src & szFound, Dst & szFound )
End Sub

68

Living Room / Re: Incredible Fishing Video!

« on: April 02, 2006, 06:29 PM »

Hello,

Just a good joke for the 1st of April... ^^

69

Developer's Corner / FBSL - Drawing a nice avatar...

« on: March 30, 2006, 12:27 PM »

Hello,

The following snippet will draw a nice avatar onto a form 
You can use the 'online compiler' to see the results...

[Select]

Dim %hdc = GetDC(ME)
Const WM_DRAW = WM_USER + &H100

Fbsl_SetText(ME, "SideshowBob's Special")
Resize(ME, 0, 0, 50, 150)
Center(ME)
Show(ME)
Draw()

Begin Events
Select Case CBMSG
Case WM_DRAW
Draw()
Case WM_PAINT, WM_NCPAINT
PostMessage(ME, WM_DRAW, 0, 0)
Case WM_CLOSE
ReleaseDC(ME, hdc)
ExitProgram(0)
End Select
End Events

Sub Draw()
'=======
' Hair
'=======
Arc(hdc, 25, 41, 8, 56, 0, 3)
Arc(hdc, 8, 56, 20, 27, 0, -0.3)
Arc(hdc, 20, 28, 0, 38, 0, 3)
Arc(hdc, 0, 38, 24, 13, 0, -0.3)
Arc(hdc, 24, 13, 7, 8, 0, 0.3)
Arc(hdc, 7, 9, 42, 9, 0, -2)
Arc(hdc, 41, 9, 64, 2, 0, -0.4)
Arc(hdc, 64, 4, 53, 13, 0, 2)
Arc(hdc, 53, 14, 79, 22, 0, -2)
Arc(hdc, 79, 22, 62, 21, 0, 0.3)
Arc(hdc, 62, 21, 76, 46, 0, -2)
Arc(hdc, 76, 46, 62, 32, 0, 0.5)
Arc(hdc, 62, 32, 66, 62, 0, -3)
Arc(hdc, 66, 62, 60, 51, 0, 0.5)
Arc(hdc, 61, 41, 48, 67, 0, -0.3)
Arc(hdc, 48, 67, 44, 42, 0, 0.2)
Arc(hdc, 46, 35, 40, 49, 0, -0.1)
Arc(hdc, 40, 49, 34, 35, 0, 0.05)
Arc(hdc, 34, 35, 26, 46, 0, -0.05)
Arc(hdc, 26, 46, 20, 35, 0, 0.05)
Fill(hdc, 30, 30, Rgb(196, 0, 52))
'=======
' Face
'=======
Arc(hdc, 46, 49, 41, 60, 0, 7)
Arc(hdc, 39, 61, 38, 66, 0, -2)
Arc(hdc, 40, 66, 38, 84, 0, 7)
Arc(hdc, 24, 43, 22, 54, 0, 3)
Arc(hdc, 27, 49, 20, 63, 0, 5)
Arc(hdc, 20, 63, 26, 62, 0, 3)
Arc(hdc, 26, 62, 19, 65, 0, -1)
Arc(hdc, 20, 66, 16, 69, 0, 3)
Arc(hdc, 16, 69, 35, 68, 0, 4)
Arc(hdc, 22, 69, 29, 85, 0, 0.1)
Arc(hdc, 29, 83, 28, 95, 0, 7)
Arc(hdc, 28, 93, 38, 84, 0, -0.3)
'=======
' Eyes
'=======
Arc(hdc, 30, 48, 40, 48, 0, 1.4)
Arc(hdc, 29, 50, 40, 50, 0, 0.1)
Arc(hdc, 30, 56, 36, 57, 0, 0.3)
Arc(hdc, 21, 50, 26, 50, 0, 0.1)
PSet(hdc, 23, 51)
PSet(hdc, 35, 51)
PSet(hdc, 40, 62)
Fill(hdc, 30, 45, Rgb(250, 215, 0))
'=======
' Shirt
'=======
Arc(hdc, 15, 90, 50, 90, 0, 0.7)
Arc(hdc, 14, 90, 29, 83, 0, -0.3)
Arc(hdc, 39, 84, 50, 90, 0, -3)
Arc(hdc, 23, 92, 29, 83, 0, -0.3)
Arc(hdc, 38, 94, 44, 85, 0, -0.3)
Arc(hdc, 33, 88, 38, 94, 0, -3)
Fill(hdc, 30, 95, Rgb(55, 115, 44))
End Sub

70

Developer's Corner / FBSL - How to do charts

« on: March 29, 2006, 01:51 PM »

Hello,

FBSL has some GUI primitives that allows user to develop simple but efficient 'charts'.
Here's the code that will make random charts...

Charts.fbs

[Select]

Dim %hdc = GetDC(ME)
Const WM_DRAW = WM_USER + &H100

Fbsl_SetText(ME, "Horns & Hoofs, Inc. (left click to redraw)")
BackColor(hdc, Rgb(255, 255, 0))
Resize(ME, 0, 0, 800, 500)
Center(ME)
Show(ME)
Draw()

Begin Events
Select Case CBMSG
Case WM_DRAW
Draw()
Case WM_PAINT, WM_NCPAINT, WM_LBUTTONDOWN
PostMessage(ME, WM_DRAW, 0, 0)
Case WM_CLOSE
ReleaseDC(ME, hdc)
ExitProgram(0)
End Select
End Events

Sub Draw()
Clear(hdc)
FontTransparent(hdc, TRUE)
DrawArrows(10)
CurrentX(hdc, 20): CurrentY(hdc, 40)
DrawLine(Rgb(0, 0, 255), DRAW_DASH)
CurrentX(hdc, 20): CurrentY(hdc, 120)
DrawLine(Rgb(255, 0, 0), DRAW_DASHDOT)
CurrentX(hdc, 20): CurrentY(hdc, 160)
DrawLine(Rgb(0, 255, 0), DRAW_DASHDOTDOT)
DrawText(200, 20)
DrawBoxes()
DrawArrows(250)
CurrentX(hdc, 320): CurrentY(hdc, 250)
Text(hdc, "Production Turnover")
End Sub

Sub DrawLine(ByVal clr, ByVal style)
Dim %stp = 775 \ 12
DrawStyle(style)
ForeColor(hdc, clr)
For i = stp To 775 Step stp
Line(hdc, CurrentX(hdc), CurrentY(hdc), i, RandInt(1, 4) * 40)
Next
End Sub

Sub DrawText(ByVal x, ByVal y)
ForeColor(hdc, Rgb(0, 0, 255)): CurrentX(hdc, x): CurrentY(hdc, y)
Text(hdc, "Income")
ForeColor(hdc, Rgb(255, 0, 0)): CurrentX(hdc, CurrentX(hdc) + 200)
Text(hdc, "Expenses")
ForeColor(hdc, Rgb(0, 255, 0)): CurrentX(hdc, CurrentX(hdc) + 200)
Text(hdc, "Profit")
End Sub

Sub DrawArrows(ByVal y)
Dim %stp = 775 \ 12
ForeColor(hdc, 0)
DrawStyle(DRAW_SOLID)
DrawWidth(2)
Line(hdc, 10, y, 10, y + 190)
Line(hdc, 10, y, 7, y + 5)
Line(hdc, 10, y, 12, y + 5)
Line(hdc, 10, y + 190, 780, y + 190)
Line(hdc, 780, y + 190, 776, y + 187)
Line(hdc, 780, y + 190, 776, y + 192)
DrawWidth(3)
For i = stp To 775 Step stp
PSet(hdc, i, y + 190)
Text(hdc, i * 12 \ 775 + 1)
Next
For i = y + 30 To y + 160 Step 40
PSet(hdc, 10, i)
Text(hdc, (y + 190 - i) \ 40)
Next
CurrentX(hdc, 18): CurrentY(hdc, y)
Text(hdc, "Bln USD")
CurrentX(hdc, 730): CurrentY(hdc, y + 170)
Text(hdc, "Month")
DrawWidth(1)
End Sub

Sub DrawBoxes()
Dim %stp = 775 \ 12
DrawStyle(DRAW_SOLID)
For i = stp To 775 Step stp
FillStyle(RandInt(0, 6))
FillColor(Rgb(%RandInt(0, 255), %RandInt(0, 255), %RandInt(0, 255)))
Line(hdc, i - 3, 400 - %RandInt(0, 3) * 40, i - 47, 438, _
Rgb(%RandInt(0, 255), %RandInt(0, 255), %RandInt(0, 255)), _
TRUE, %RandInt(0, 1))
Next
End Sub

Here's a screnshot of the result:

Enjoy

71

Developer's Corner / Re: FBSL - Newest version with a 525 pages help file available!

« on: March 28, 2006, 04:49 PM »

Hello mouser et al,

you should be very proud gerome -
help pages are so important for a programming language and you are to be commended for spending so much time and effort on them.

is there a "what's new" post on your forum? maybe you could give us the link.  such posts are extremely helpful i think.

-mouser (March 28, 2006, 04:34 PM)

Yes there is a link that is alive once per week at least for that update thing...
Just have to simply jump there... http://www.fbsl.net/...2/viewtopic.php?t=63

72

Developer's Corner / FBSL - Newest version with a 525 pages help file available!

« on: March 28, 2006, 04:31 PM »

Hello,

A newest FBSL version with a 525 pages help file are now available!
Check the links below...
Enjoy;)

73

Living Room / Re: The Most Expensive PCs

« on: March 27, 2006, 04:59 PM »

Hi,

Got some ~$300,000 to spend and own already 4 cars? What about a new PC?

Got some ~$800,000 to spend and your house is already big enough? What about a decadent display?

http://blog.wired.com/expensivepcs/

-brotherS (March 27, 2006, 02:41 PM)

Yup!
Just other useless things...
The opposite web site would be nicer!

74

General Software Discussion / Re: Microsoft Confirms Highly Critical IE Hole March 23, 2006

« on: March 27, 2006, 04:53 PM »

Hello,

LOL - true - but ... and it is a big but ... I didn't mean no one should program in C/C++ just MS !!

Actually a lot of the 'old time' stuff did have a lot going for it! Just imagine running decent graphics software (the orogonal Xara) and good DTP software on a system with 8Mb of memory and a 120Mb hard disc. (plus it has internet access etc). I still have the machine upstairs and it still works. I also used it as a MIDI control system. The OS was written in machine code and never crashed ... ever!

-Carol Haynes (March 27, 2006, 04:45 PM)

There was a time when true developpers were really developping more interesting things rather blogging and developping marketting stuff for nutthin'
Thanks God, those developpers are still there, but they dont possess latest Intel or Amd or ... or latest CPU of the 'market', that's why we can still find many applications that are not memory greedy, but rather functional even on little computers... and even little interesting languages/tools can be found if people would take care 5 minutes... ^^

75

General Software Discussion / Re: Gabbly!

« on: March 27, 2006, 04:09 PM »

Hello!

Haaaa nice!
This is the 1st nice and use-fool plugin i've found there!
Try this : http://gabbly.com/fbsl.net

LOL!