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

$ filename "Translucent.exe"
'uses rtl32
'uses rtl64

'% review

uses dialogs

% RDW_UPDATENOW=0x100


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

function DialogProc( sys hDlg, uint uMsg, sys wParam, lParam ) as int callback

  select case uMsg

    case WM_INITDIALOG

      int ANIMATION_MS = 250
      int ALPHA = 200
      int ALPHA_STEP = 10
      int 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.
      while bAlpha < ALPHA
        SetLayeredWindowAttributes( hDlg, 0, bAlpha, LWA_ALPHA )
        sleep( ANIMATION_TIMEOUT )
        bAlpha += ALPHA_STEP
      wend
      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

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

sys hDlg
MSG wMsg

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

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

hDlg = CreateModelessDialog( 0, @DialogProc, 0 )

while GetMessage( @wMsg, null, 0, 0 ) <> 0
  if IsDialogMessage( hDlg,  @wMsg ) = 0 then
      TranslateMessage( @wMsg )
      DispatchMessage( @wMsg )
  end if
wend

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