Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Fading / Darkning
#1
Well, In my game Wind's Whisper, I need help with getting some code which will allow me to darken the game screen till it is 100% black!

I have tried tons of methods, including the darken API, alphablending a big black bitmap onto screen and even taking a screenshot of the game, blting it onto the screen and darkening it.

I cannot find a fast, low-memory code to make it do this!

I need it for when going through different menu's and loading random battles.

Any help at all would be appreciated

~Kite
Reply
#2
[code]
Option Explicit


Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) _
As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long

Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, _
ByVal crKey As Byte, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) _
As Long

Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal nCmdShow As Long) _
As Long

Private Declare Function UpdateWindow Lib "user32" _
(ByVal hWnd As Long) _
As Boolean


Private Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long

Private Const GWL_EXSTYLE As Long = -20
Private Const LWA_ALPHA As Long = &H2
Private Const RDW_NOERASE As Long = &H20
Private Const RDW_NOFRAME As Long = &H800
Private Const RDW_INVALIDATE As Long = &H1
Private Const RDW_NOINTERNALPAINT As Long = &H10
Private Const RDW_UPDATENOW As Long = &H100
Private Const SW_SHOWNORMAL As Long = 1
Private Const WS_EX_LAYERED As Long = &H80000

'

Public Sub FadeIn(ByVal hWnd As Long, _
ByVal lngAlphaMax As Long, _
Optional ByVal lngStep As Long = 1)

Dim bAlpha As Byte
Dim lngWindowStyle As Long

bAlpha = 1

lngWindowStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle Or WS_EX_LAYERED

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA

' Show + refresh
ShowWindow hWnd, SW_SHOWNORMAL
UpdateWindow hWnd

Do
If (Not ((bAlpha + lngStep) > lngAlphaMax)) Then
bAlpha = bAlpha + lngStep

Else
bAlpha = lngAlphaMax

End If

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
UpdateWindow hWnd

Loop Until (bAlpha >= lngAlphaMax)

' Remove the WS_EX_LAYERED flag, as it vastly
' slows down moving/resizing
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle

End Sub

Private Sub FadeOut(ByVal hWnd As Long, _
ByVal lngAlphaMax As Long, _
ByVal lngAlphaMin As Long, _
Optional ByVal lngStep As Long = 1, _
Optional ByVal blnUnload As Boolean = False)

Dim bAlpha As Byte
Dim lngWindowStyle As Long

' Add WS_EX_LAYERED flag
lngWindowStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWindowStyle Or WS_EX_LAYERED

RedrawWindow hWnd, 0, 0, RDW_NOINTERNALPAINT + RDW_NOERASE + RDW_NOFRAME

bAlpha = CByte(lngAlphaMax)
Do
If ((bAlpha - lngStep) > lngAlphaMin) Then
bAlpha = bAlpha - lngStep

Else
bAlpha = lngAlphaMin

End If

SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
UpdateWindow hWnd

Loop Until (bAlpha
Reply
#3
Im afraid not. Wind's Whisper only uses one form. The whole game is done via blting :\

Thanks anyway.
Reply
#4
Nice code.
Reply
#5
Not mine. Googled
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)