
'=====================================================================
'' Screem "melt" demo, modeless dialog as main.
''
'' Use the Escape key to restore the screen and exit the program.
'' If this should fail for some reason, then do a Ctrl-Alt-Delete
'' and use Task Manager to end the program process.
'=====================================================================

#include "dialogs.bas"
#include once "win/mmsystem.bi"

'=====================================================================

Function DialogProc( Byval hDlg As  HWND, _
                     Byval uMsg As UINT, _
                     Byval wParam As WPARAM, _
                     Byval lParam As LPARAM ) As Integer
  Select Case uMsg

    Case WM_CLOSE

      DestroyWindow( hDlg )

    Case WM_DESTROY

      PostQuitMessage( null )

  End Select

  Return 0

End Function

'=====================================================================

Dim As LPDLGTEMPLATE lpdt
Dim As HWND hDlg
Dim As MSG wMsg
Dim As HDC hDC
Dim As Integer screen_w, screen_h
Dim As Integer w, h, x, y, y1

hDC = GetDC( 0 )
screen_w = GetSystemMetrics( SM_CXSCREEN )
screen_h = GetSystemMetrics( SM_CYSCREEN )

Dialog( 0, 0, 0, 0, 0, "", lpdt, WS_POPUP Or WS_VISIBLE )

hDlg = CreateModelessDialog( 0, @DialogProc, 0, lpdt )

For y As Integer = 0 To 2
  For x As Integer = 0 To screen_w
    SetPixel( hDC, x, y, 0 )
  Next
  Sleep 100
Next

Do

  If PeekMessage( @wMsg, 0, 0, 0, PM_RemOVE ) then

    TranslateMessage( @wMsg )
    DispatchMessage( @wMsg )

  Else

    If GetAsyncKeyState(VK_ESCAPE) Then
      DestroyWindow( hDlg )
      InvalidateRect( 0, 0, FALSE )
      Exit Do
    End If

    '--------------------------------------------------------
    '' This code essentially selects random gtoups of pixels
    '' and shifts them down by one pixel pitch.
    '--------------------------------------------------------

    w = (Rnd * (screen_w - 3) / 3) + 1
    h = (Rnd * (screen_h - 3)) - 100
    x = (Rnd * (screen_w - w - 1)) + 1
    y = (Rnd * (screen_h - h)) + 2

    BitBlt( hDC,x,y,w,h,hDC,x,y-1,SRCCOPY )

    '----------------------------------------------------------------
    '' Without a sleep 1 statement the Escape key cannot be detected
    '' reliably, and without setting the minimum timer resolution to
    '' 1 ms, instead of the default 10 ms, the message loop will run
    '' too slow.
    '----------------------------------------------------------------

    timeBeginPeriod( 1 ) ' set minimum resolution to 1 ms
    Sleep 1
    timeEndPeriod( 1 )   ' restore to default

  End If

Loop

'=====================================================================
 