+- Mirage Source (https://mirage-engine.uk/forums)
+-- Forum: Mirage Source (Nostalgia) (https://mirage-engine.uk/forums/forumdisplay.php?fid=61)
+--- Forum: Archive (2006-2011) (https://mirage-engine.uk/forums/forumdisplay.php?fid=18)
+---- Forum: General (https://mirage-engine.uk/forums/forumdisplay.php?fid=17)
+---- Thread: Fading / Darkning (/showthread.php?tid=205)
Fading / Darkning - Robin - 25-07-2006
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
- Reece - 26-07-2006
[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
- Robin - 26-07-2006
Im afraid not. Wind's Whisper only uses one form. The whole game is done via blting :\
Thanks anyway.
- William - 27-07-2006
Nice code.
- Reece - 28-07-2006
Not mine. Googled