me too found the same thing in the end i added a timing delay, but the trick is working out how fast that little window is running at seems at lest triple if not 4 times as fast, now depending on system specs its going to fly on some bigger machines.....might have to build an fps counter for it in both preview and real and compare them.
at the moment i have added a timing routine from the archives
http://www.blitzbasic.com/codearcs/codearcs.php?code=2152thanks to Leadwerks, but it isnt very effective in the preview window seems to be based on the whole windows system rather than that little window so may need to alter it...
this is the main code now
Framework brl.GLMax2D
Import brl.Basic
Import brl.System
Import brl.Retro
Import pub.Win32
Import brl.RamStream
Import brl.PNGLoader
Import brl.Random
Import brl.timer
Import "-lshell32"
Import "-luser32"
Import "-lkernel32"
Include "Timimingmodule.bmx"
Extern "win32"
Function FindWindow (x:Byte Ptr, y:Byte Ptr) = "FindWindowA@8"
Function MoveWindow (hWnd,x,y,w,h,d) = "MoveWindow@24"
Function ShowWindow (hWnd,style) = "ShowWindow@8"
Function GetWindowLong (hwnd, nIndex) = "GetWindowLongA@8"
Function SetWindowLong (hWnd,x,y) = "SetWindowLongW@12"
Function SetParent (hWnd1,hWnd2) = "SetParent@8"
Function IsWindowVisible (hWnd) = "IsWindowVisible@4"
Function GetDesktopWindow () = "GetDesktopWindow@0"
Function GetWindowRect (hWnd:Int,r:Byte Ptr) = "GetWindowRect@8"
Function CreateSemaphore (a:Byte Ptr, b:Int, c:Int, d:String) = "CreateSemaphoreW@16"
Function GetLastError () = "GetLastError@0"
EndExtern
'**************** Get Current Desktop Resolution *******************
Global r:Int[4]
Global p:Byte Ptr = VarPtr( r[0] )
' This is advisable because it is best not to switch screen
deskWnd = GetDesktopWindow( ) ' settings when the screen saver starts.
GetWindowRect(deskWnd, p)
Global DeskWidth :Float =r[2]
Global DeskHeight:Float =r[3]
'**************** End Get Current Desktop Resolution ***************
Global Width: Float = 0
Global Height:Float = 0
Global startmousex:Int = 0
Global startmousey:Int = 0
Const ERROR_ALREADY_EXISTS:Int = 183
Const PREVIEW_ACTIVE:Int = 0
Const CONFIG_ACTIVE:Int = 1
Const SAVER_ACTIVE:Int = 2
Global PrevWnd:Int
If AppArgs.length = 3
PrevWnd:Int = Int( AppArgs[2] ) 'Handle of the preview window
EndIf
Global pscale:Float = 1 'scale value to apply depending on screen size
Global bmw:Int = 0 'Handle of the BMax window
Global Status:Int = 0 'Program status, identifies preview, regular, or config modes
Global timemark:Int = 0 'Time marker to use for a makeshift timer
SetGraphicsDriver GLMax2DDriver( )
If AppArgs.length > 1
Select AppArgs[1]
Case "/p"
InitPreviewMode( )
Case "/s"
InitSaverMode( )
Case "/c"
InitConfigMode( )
Default
InitConfigMode( )
End Select
Else
InitConfigMode( )
EndIf
SeedRnd MilliSecs()
For Local i = 0 To 100
Tstreak.Create()
Next
While not KeyHit( KEY_ESCAPE )
'**************** TODO: Write your own presentation code ***************
'
' Multiply any scaling by pscale (=1 in Saver mode, .15-.25 in Preview)
' You will scale your speeds too (nothing moving in this one)
'
'***********************************************************************
Cls
UpdateAppTime()
Tstreak.update()
Tstreak.draw()
Flip
'******* This block is boilerplate ********
Select Status
Case PREVIEW_ACTIVE
CheckVisible( )
Case SAVER_ACTIVE
CheckMovement( )
End Select
'************* Do Not Remove **************
Wend
End
Type Tstreak
Global streaks:TList = New TList
Field x:Float, y:Float, sp:Float, f:Int
Function Create()
Local s:Tstreak = New Tstreak
s.x = Rand(0, DeskWidth)
s.y = Rand(0, 88000) * -1
s.f = Rand(0, 3)
s.sp = Rand(4, 8)
streaks.addlast s
End Function
Function update()
For Local s:Tstreak = EachIn streaks
s.y = s.y + (s.sp * AppSpeed:Float())
If s.sp < 12 Then s.sp = s.sp * 1.09
If s.y > DeskHeight * pscale
s.y = 0 - Rand(100 * pscale, 1080 * pscale)
s.x = Rand(0, DeskWidth * pscale)
s.sp = Rand(4, 8)
EndIf
Next
End Function
Function draw()
For Local s:Tstreak = EachIn streaks
SetColor 200, 200, 0
DrawOval s.x, s.y, 100, 100
Next
End Function
End Type
Function InitSaverMode()
If SetProcessLock( "SaverModeLock" ) <> 0 Then End
Status = SAVER_ACTIVE
Width = DeskWidth
Height = DeskHeight
Graphics Width, Height, 32
SetWindowPos(FindWindow(Null, "BlitzMax Application"), HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE)
pscale = 1
startmousex = MouseX( )
startmousey = MouseY()
FlushMouse
FlushKeys
Return
EndFunction
Function InitPreviewMode()
If SetProcessLock("PreviewModeLock") <> 0 Then End
Status = PREVIEW_ACTIVE
Width = 152
Height = 112
Graphics Width, Height, 0, -1
bmw = FindWindow( Null, "BlitzMax Application" )
Local bmx_Style = GetWindowLong( bmw, -16 )
bmx_Style = bmx_Style And $40000000 Or $800000 And $10000000
SetWindowLong bmw, -16, bmx_Style;
SetParent( bmw,PrevWnd )
MoveWindow ( bmw, 0, 0, 152, 112, True )
pscale = 152/DeskWidth
SetScale pscale, pscale
timemark = MilliSecs()
Return
EndFunction
Function InitConfigMode( )
Status = CONFIG_ACTIVE
Width = 320
Height = 200
AppTitle = "Configuration Screen"
Graphics Width,Height, 0
bmw = FindWindow( Null, "Configuration Screen" )
MoveWindow ( bmw, ( DeskWidth/2-Width/2 ),( DeskHeight/2-Height/2 ), 320, 200, True )
SetClsColor 192, 192, 192
SetColor 0, 0, 0
Cls
DrawText "TODO: Write config code", 50, 80
DrawText "Press <ANY KEY> to exit", 55, 130
Flip
WaitKey
End
EndFunction
Function SetProcessLock:Int( LockStr:String )
Global MySem = CreateSemaphore( Null, 0, 1, LockStr )
If MySem <> 0 and GetLastError( ) = ERROR_ALREADY_EXISTS
Return 1
Else
Return 0
EndIf
EndFunction
Function CheckVisible( )
If MilliSecs() - timemark > 2000 'Delay visibility check til window is drawn
If Not IsWindowVisible(PrevWnd)
End
EndIf
EndIf
EndFunction
Function CheckMovement( )
If MouseX( ) <> startmousex or MouseY( ) <> startmousey Then End
If GetChar( ) <> 0 Then End
'Probably want to put some more keyhits in here; I'm too lazy
EndFunction
this is the timing code from leadwerks i called it "Timimingmodule.bmx" and is an include
'Module leadwerks.apptiming
Private
Global AppTime_UPS
Global AppTime_Iterator
Global AppTime_CurrentTime
Global AppTime_PauseStart=0
Global AppTime_Speed:Float=1.0
Global AppTime_DesiredLoopTime#=1000.0/60.0
Global AppTime_LastUpdateTime=0
Global AppTime_LastUPSTime
Global AppTime_DesiredFrequency% 'mainly to avoid float rounding errors
Public
Rem
bbdoc:
EndRem
Function UpdateAppTime(framerate = 60)
Local time
Local elapsed
If AppTime_PauseStart Return
AppTime_DesiredFrequency = framerate
AppTime_DesiredLoopTime=1000.0/framerate
time=MilliSecs()
If AppTime_LastUpdateTime=0
AppTime_Speed#=1.0
AppTime_LastUpdateTime=time
AppTime_CurrentTime=time
AppTime_LastUPSTime=time
Else
elapsed=time-AppTime_LastUpdateTime
If Not elapsed
elapsed=1
Delay 1
time:+1
EndIf
AppTime_Speed=Float(elapsed)/Float(AppTime_DesiredLoopTime)
AppTime_CurrentTime=time
AppTime_LastUpdateTime=time
EndIf
AppTime_Iterator:+1
If AppTime_CurrentTime-AppTime_LastUPSTime>=1000
AppTime_UPS=Float(AppTime_Iterator)/(Float(AppTime_CurrentTime-AppTime_LastUPSTime)/1000.0)
AppTime_LastUPSTime=AppTime_CurrentTime
AppTime_Iterator=0
EndIf
EndFunction
Rem
bbdoc:
EndRem
Function AppTime()
Return AppTime_CurrentTime
EndFunction
Rem
bbdoc:
EndRem
Function AppSpeed#()
Return AppTime_Speed
EndFunction
Rem
bbdoc:
EndRem
Function UPS:Int()
Return AppTime_UPS
EndFunction
Rem
bbdoc:
EndRem
Function PauseApp()
If AppTime_PauseStart Return
AppTime_PauseStart=MilliSecs()
AppTime_UPS = 0
AppTime_Speed = 0
EndFunction
Rem
bbdoc:
EndRem
Function ResumeApp()
If Not AppTime_PauseStart Return
If AppTime_LastUpdateTime
Local elapsed=MilliSecs()-AppTime_PauseStart
AppTime_LastUpdateTime:+elapsed
EndIf
AppTime_PauseStart=0
UpdateAppTime( AppTime_DesiredFrequency )
EndFunction
this is the link to the working version i have
http://www.filecrunch.com/fileDownload.php?sub=2918da1da91be977f0e05a006fff0250&fileId=138534i just realised i forgoto to take out some of the modules for png and jpeg loading so the file is bloated...doh...works though..