
'====================================================================
'' Translucent dialog demo, with fade in, modeless dialog as main.
''
'' Requires Windows 2000 or later.
''
'' Adapted from http://www.codeproject.com/dialog/smoothalpha.asp
'====================================================================

#include "dialogs.bas"

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

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_INITDIALOG

      Const ANIMATION_MS = 250
      Const ALPHA = 200
      Const ALPHA_STEP = 10
      Const ANIMATION_TIMEOUT = ALPHA_STEP * ANIMATION_MS / ALPHA

      Dim As Ubyte bAlpha

      '' Make the dialog a layered window.
      ''
      SetWindowLong(hDlg, GWL_EXSTYLE, GetWindowLong( hDlg, _
                    GWL_EXSTYLE ) Or WS_EX_LAYERED )

      '' Start at an alpha value of zero (completely transparent).
      ''
      SetLayeredWindowAttributes( hDlg, 0, 0, LWA_ALPHA )

      '' Display the dialog.
      ''
      ShowWindow( hDlg, SW_SHOW )

      '' Force an update of the client area so the controls
      '' will be included in the fade in.
      ''
      RedrawWindow( hDlg, null, null, RDW_UPDATENOW )

      '' Gradually fade the dialog in, stopping when the
      '' alpha value reaches ALPHA.
      ''
      Do While bAlpha < ALPHA
        SetLayeredWindowAttributes( hDlg, 0, bAlpha, LWA_ALPHA )
        Sleep( ANIMATION_TIMEOUT )
        bAlpha += ALPHA_STEP
      Loop
      SetLayeredWindowAttributes( hDlg, 0, bAlpha, LWA_ALPHA )

      Return true

    Case WM_COMMAND

      If loword(wParam) = IDCANCEL Then
        DestroyWindow( hDlg )
      End If

    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

'' The dialog must start out invisible, so no WS_VISIBLE style.
''
Dialog( 1, 0, 0, 120, 90, "Translucent Dialog Demo", lpdt, _
        WS_OVERLAPPEDWINDOW Or DS_CENTER )

DefPushButton( IDCANCEL, -1, 65, 40, 12, "Close" )

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

Do While GetMessage( @wMsg, null, 0, 0 ) <> 0
  If IsDialogMessage( hDlg,  @wMsg ) = 0 Then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
  End If
Loop

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