Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Debug Error On 'catch array/pointer errors - OFF in production
#Debug Display On 'display untrapped errors - OFF in production
#Tools Off 'use ON only when needed for Trace/Profile/CallStk
#Include "win32api.inc"
'use these inside procedures:
'#Debug Print "msg" 'on as-needed basis only
'#Debug Code ON 'ignored in production, use OFF for speed in development testing
Type canvas
st As Long '0-empty 1-filled 2-blocked
clr As Long 'color long integer
End Type
%ID_Timer = 500
%ID_Graphic = 600
%MaxP = 40000
%Empty = %Black
%Filled = %Red
%Blocked = %Blue
Global D() As Long 'canvas
Global TimerInterval As Long, hDlg As DWord
Global DrawLine As Long, xMax As Long, yMax As Long
Function PBMain() As Long
Randomize Timer
xMax = 200 : yMax = 200
Dim D(xMax,yMax)
Dialog New Pixels, 0, "Button Test",300,300,320,260, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Push", 50,10,100,20
Control Add Graphic, hDlg, %ID_Graphic, "", 20,40,200,200, %WS_Border Or %SS_Notify
Control Set Color hDlg, %ID_Graphic, %White, %White
Graphic Attach hdlg, %ID_Graphic, Redraw
Graphic Clear %Black
Initialize
TimerInterval = 15
SetTimer(hDlg, %ID_Timer, TimerInterval, 0)
Dialog Show Modal hDlg Call DlgProc
End Function
Sub Initialize
Dim x As Long, y As Long, i As Long
'clear all
For x = 0 To xMax
For y = 0 To yMax
'set background
D(x,y) = %Empty
Next y
Next x
'block
For x = 40 To 90
For y = 100 To 105
D(x,y) = %Blocked
Graphic Set Pixel (x,y), %Blocked
Next y
Next x
For x = 150 To 180
For y = 100 To 105
D(x,y) = %Blocked
Graphic Set Pixel (x,y), %Blocked
Next y
Next x
For x = 80 To 160
For y = 50 To 55
D(x,y) = %Blocked
Graphic Set Pixel (x,y), %Blocked
Next y
Next x
End Sub
CallBack Function DlgProc() As Long
Dim XMax As Long, YMax As Long
Select Case CB.Msg
Dim x As Long, y As Long
Case %WM_Timer
'randomly put particles in the shooter (0 position)
For x = .3*xMax To .33*xMax : D(x,0) = Rnd(0,1)*%Red : Next i
For x = .6*xMax To .63*xMax : D(x,0) = Rnd(0,1)*%Green : Next i
For x = .3*xMax To .33*xMax : D(x,0) = Rnd(0,1)*D(x,0) : Next i
For x = .6*xMax To .63*xMax : D(x,0) = Rnd(0,1)*D(x,0) : Next i
'relocate all per rules
For x = 1 To xMax
For y = yMax-1 To 0 Step -1
' 'rules - this position gets color from above
If D(x,y) <> %Blocked Then
Select Case D(x,y+1)
Case %Empty
D(x,y+1) = D(x,y)
D(x,y) = %Empty
Graphic Set Pixel (x,y+1), D(x,y+1)
Case %Red, %Green
Select Case D(x-1,y+1)
Case %Empty
D(x-1,y+1) = D(x,y)
D(x,y) = %Empty
Graphic Set Pixel (x-1,y+1), D(x-1,y+1)
Case %Red, %Green
Select Case D(x+1,y+1)
Case %Empty
D(x+1,y+1) = D(x,y)
D(x,y) = %Empty
Graphic Set Pixel (x+1,y+1), D(x+1,y+1)
Case %Red, %Green
End Select
End Select
End Select
End If
Next y
Next x
For x = 1 To xMax
D(x,ymax) = %Empty
Next i
Graphic Redraw
Case %WM_LButtonDown
DrawLine = 1
Case %WM_LButtonUp
Drawline = 0
Case %WM_SetCursor
If GetDlgCtrlID(CB.wParam)=%ID_Graphic AND DrawLine = 1 Then
Dialog Set Text hdlg, "setcursor"
Dim pt As point
GetCursorPos pt 'pt has xy screen coordinates
ScreenToClient CB.wParam, pt 'pt now has client coordinates
Graphic Ellipse (pt.x,pt.y)-(pt.x+10,pt.y+10), %Blue, %Blue
End If
Case %WM_Command
Select Case CB.Ctl
Case 100
If CB.Ctlmsg = %BN_Clicked Then
End If
End Select
End Select
End Function
'gbs_00440
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm