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

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

'% review

uses dialogs

% RDW_UPDATENOW=0x100


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

  typedef struct tagGDIStartup {
    uint           GdiplusVersion;
    sys            DebugEventCallback;
    bool           SuppressBackgroundThread;
    bool           SuppressExternalCodecs;
  } GdiplusStartupInput;
  '
  extern library "gdiplus.dll"
  ! GdiplusStartup
  ! GdiplusShutdown
  ! GdipCreateFromHDC
  ! GdipDeleteGraphics
  ! GdipLoadImageFromFile
  ! GdipDisposeImage
  ! GdipDrawImageRectI
  ! GdipGetImageWidth
  ! GdipGetImageHeight
  end extern

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

  'ACTIVATE GDIPLUS
  dword hr,GDIPtoken
  GdiplusStartupInput StartupInput
  StartupInput.GdiplusVersion = 1
  hr=GdiplusStartup @GDIPtoken, @StartupInput, null
  if hr then
    print "Error initializing GDIplus: " hex hr
    end
  end if

  sub GetImage(sys hWnd, RECT*r, wchar*fs)
  '=======================================
  '
  'https://docs.microsoft.com/en-us/windows/desktop/gdiplus/-gdiplus-image-flat
  '
  int      hstatus
  sys      hDC,pGraphics,pImage
  int      nwidth,nheight
  '
  hDC=GetDC( hWnd )
  hStatus GdipCreateFromHDC hDC, @pGraphics
  hStatus = GdipLoadImageFromFile fs, @pImage
  if hStatus then pImage=0 : exit sub
  'hStatus = GdipGetImageWidth pImage, nWidth
  'hStatus = GdipGetImageHeight pImage, nHeight
  nwidth=r.right
  nheight=r.bottom
  GdipDrawImageRectI pGraphics, pImage, 0, 0, nWidth, nHeight
  if pImage
    GdipDisposeImage(pImage)
  endif
  if pGraphics
    GdipDeleteGraphics(pGraphics)
  endif
  ReleaseDC hWnd,hDC
  pImage=0
  pGraphics=0
  end sub


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

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

  sys hDC

  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_ERASEBKGND

      RECT r
      GetClientRect hDlg,r
      GetImage( hDlg,r,"../images/mud.jpg" )
      InvalidateRect( hDlg,@r,0 )
      return 1
        
    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 )
'Ltext( "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

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

GdiplusShutdown GDIPtoken