[RESOLVED] tinted or faded look to form?

Dont know how to do this in VB6, but I've seen with some programs, when a user opens a dialog box, the main form (or window) gets a shadow, or faded look to it. See the examples;

Attachment 139949

Can this be done in VB6?

Hmmm, interesting idea. I sort of like it.

The first thing that comes to mind to me is the following:

• Grab a screen-shot of the rectangle being ocupied by your form.
• Take this rectangle (as a pic in your program) and darken it.
• Have a special no borders, no titlebar form in your program with a picturebox on it.
• Load this special form in the exact spot of your other form.
• Then show your modal form (or dialog).
• When code continues from your modal form (or dialog), unload the special form.

There might be issues of dealing with forced minimization, and possibly some other issues, but I think that approach could work. Also, dealing with the few pixels where Windows rounds our forms at the edges might be a bit tricky to get right.

But I can at least see my way through how to do it with this approach. If you're worried about speed, you could just keep this special covering form loaded and hidden until it's needed.

I'm curious as to what ideas others come up with.

Regards,
Elroy

EDIT: Just to say it, those steps are far from trivial, but they're also certainly doable.

So have a 'fake' form load and the actual form invisible. Would work, and a simple solution. I've used .Enabled=False, which is OK, but doesnt darken the window.

I sort of like the idea too, but then again hate it. Guess it depends on the program. If you have a reason to disable the main window, then its fine. But to do it just for 'kicks' can be not so good...............

I would say that you do not need to go through all those hoops and bounds, which could work - I agree.

You could consider playing with the form's Opacity properties or even check out the SetLayeredWindowAttributes API function

I didn't think we were talking about opacity. And also, any direct manipulation of the form would also require going through all the controls and messing with the colors on some of them as well, and that could wind up being a huge mess.

I think we're talking about something more along the lines of doing a gamma adjustment, basically doing something like take 20% off of the value of each color value in each pixel that represents the image displayed on the screen by the form and all its controls.

Meopilite, I agree. This isn't something I'll probably ever mess with, simply because there's not really any strong need for it. However, if the top form is modal, I'm not sure there's EVER any strong need for it, regardless of the application. So, if you really believe that "to do it just for 'kicks' can be not so good", then you should mark this thread as resolved, and we can all move on.

Regards,
Elroy

But if you really wanted to do it, my thoughts were along the lines of HanneSThEGreaT, in that you can create a form, a black borderless form with opacity set using SetLayeredWindowAttributes, and you would show that form over your main form before launching the dialog.

Ohhh, that's actually a nice idea. I didn't read HanneSThEGreaT's post that way. I thought he was suggesting messing with the opacity of the form to be darkened.

But yes, overlaying it with a 50% translucent gray form would do the job perfectly, and would be much easier than capturing a screenshot and messing with that.

In fact, it was such a good idea, I had to play with it a bit. Default project with two buttons (Command1 and Command2).

Code:

---

Option Explicit
'
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
'
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 crColor As Long, ByVal nAlpha As Byte, ByVal dwFlags As Long) As Long
'

Private Sub Command1_Click()
    Translucent Me, 50
End Sub

Private Sub Command2_Click()
    Translucent Me, 100
End Sub

Public Sub Translucent(frm As Form, OpacityPct As Long)
    Dim Alpha As Long
    '
    If OpacityPct < 0 Or OpacityPct > 100 Then Exit Sub
    Alpha = 255 * (OpacityPct / 100) ' 0 to 255.  An opacity setting.
    '
    Call SetWindowLong(frm.hwnd, GWL_EXSTYLE, GetWindowLong(frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    '
    Select Case Alpha
    Case 255:  Call SetLayeredWindowAttributes(frm.hwnd, RGB(255, 0, 255), 255, LWA_COLORKEY)
    Case Else: Call SetLayeredWindowAttributes(frm.hwnd, RGB(255, 0, 255), Alpha, LWA_ALPHA Or LWA_COLORKEY)
    End Select
End Sub

---

I'll let meopilite work out how to actually use this to create his effect though.

This example combines Elroy's and HanneSThEGreaT's suggestions.

Attachment 139955

GOOD IEDE

MAY BE can used this ider

http://leandroascierto.com/foro/inde...13376#msg13376

Nice work, Bonnie. :) I like the error checking you put into it.

Now that it's all worked out, I've even got a place I'll probably use it.

The only thing I changed was to move the SetFocusTo call to the Form_Terminate event, and then I unloaded the implicit COM object in the Form_Unload event. That way, it obviated the need for the "Set frmDimmer = Nothing" by the calling program. Also, the call to SetFocusTo is made at the last possible moment. In other words, I added/changed the following events in the frmDimmer code:

Code:

---

Private Sub Form_Unload(Cancel As Integer)
    Set frmDimmer = Nothing ' Unload the implicit COM object.
End Sub

Private Sub Form_Terminate()
    If m_hWndOwner Then SetFocusTo m_hWndOwner ' Make sure the owner Form doesn't lose the focus when this modeless window is destroyed
End Sub

---

This also makes sure that "Static Done" is correctly re-initialized each time it's used.

Regards,
Elroy

EDIT: I also did a couple of other things. I checked m_hWndOwner before using SetFocusTo (shown above). And I also moved the "Done = True" line up to just underneath the "If Not Done Then" test. If it failed once in any way, I didn't see the point of trying over and over every time Form_Resize is fired.

EDIT2: There is just a touch of an issue of moving that "Set frmDimmer = Nothing" to inside the frmDimmer code, but not really. However, the following is a function that's in my AllPurpose.bas module that I find myself frequently calling, especially with respect to various "help" forms that the user may have called up:

Code:

---

Public Function IsLoaded(FormName As String) As Boolean
    ' Does not have the side effect of needing to load the form just to see if it's loaded.
    Dim frm As Form
    For Each frm In Forms
        If frm.Name = FormName Then
            IsLoaded = True
            Exit Function
        End If
    Next frm
    IsLoaded = False
End Function

---

This allowed me to change the calling program's code to the following:

Code:

---

Private Sub cmdShowColor_Click()
    frmDimmer.Show vbModeless, Me
    CD.ShowColor
    If IsLoaded("frmDimmer") Then Unload frmDimmer
End Sub

---

However, IsLoaded("frmDimmer") would only return false if it failed to do its thing. And even then, it would just be quickly loaded twice, once on "frmDimmer.Show vbModeless, Me" and then again on "Unload frmDimmer", which wouldn't really hurt anything.

Cool, even though I didn't start this thread, I really like the idea, and have already slipped it into my program. The following is a spot where there are "alternate" data entry screens because data entry is complex and certain users like things organized a bit differently. As you can see, it's much more clear what's going on with the back form grayed.

Attachment 139975

i like how just the client area of the previous form is greyed out in xxdoc's example.

Hi.
You can improve this solution (if you are interested), and fix some bugs:
https://www.youtube.com/watch?v=mCkLJiZakjA

Code:

---

Option Explicit

Private mMemDc      As Long
Private mFadeBmp    As Long
Private mCounter    As Long

Public Function InitializeDarkBlur() As Boolean
    Dim hdc    As Long
    Dim inIde  As Boolean
   
    Debug.Assert MakeTrue(inIde)
   
    If mCounter = 0 Then
   
        ' // Create memory DC
        hdc = GetDC(0)
        mMemDc = CreateCompatibleDC(hdc)
        ReleaseDC 0, hdc
       
        If mMemDc = 0 Then Exit Function
       
        If inIde Then
            Dim bi      As BITMAPINFO
            Dim pBit    As Long
               
            ' // Create fade bitmap
            With bi.bmiHeader
               
                .biSize = Len(bi.bmiHeader)
                .biBitCount = 32
                .biHeight = 1
                .biWidth = 1
                .biPlanes = 1
           
            End With
       
            mFadeBmp = CreateDIBSection(mMemDc, bi, 0, pBit, 0, 0)
           
            ' // Black pixel
            memcpy ByVal pBit, &HFF000000, 4
           
        End If
       
        Debug.Print "Initialize"
       
    End If
   
    mCounter = mCounter + 1
   
    InitializeDarkBlur = True
   
End Function

Public Sub UninitializeDarkBlur()
    Dim inIde  As Boolean
   
    mCounter = mCounter - 1
   
    If mCounter <= 0 Then
   
        Debug.Assert MakeTrue(inIde)
   
        If mMemDc Then DeleteDC mMemDc
   
        If inIde Then
       
            If mFadeBmp Then DeleteObject mFadeBmp
       
        End If
       
        Debug.Print "Uninitialize"
       
    End If
   
End Sub


Public Function ShowModal( _
                ByVal frmModal As Form, _
                ByVal frmBackground As Form) As Boolean
    Dim fb      As DarkBlurData
    Dim inIde  As Boolean
   
    Debug.Assert MakeTrue(inIde)
   
    Set fb.frmBackground = frmBackground
    Set fb.frmModal = frmModal
   
    ' // Get window screenshot
    If Not InitializeBackgroundFormData(fb) Then Exit Function
   
    ' // Set translation timer
    fb.timId = SetTimer(frmBackground.hWnd, VarPtr(fb), 16, AddressOf TimerProc)
    If fb.timId = 0 Then Exit Function
   
    ' // Set layered style to background window
    SetWindowLong frmBackground.hWnd, GWL_EXSTYLE, GetWindowLong(frmBackground.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
   
    ' // Remove non-client area
    SetWindowSubclass frmBackground.hWnd, AddressOf BackSubclassProc, 1, fb
    SetWindowPos frmBackground.hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE
    RemoveWindowSubclass frmBackground.hWnd, AddressOf BackSubclassProc, 1
   
    If inIde Then
        FadeForm fb
    Else
        SetDarkBlurData fb
    End If
   
    ' // Set layered style to modal window
    SetWindowLong frmModal.hWnd, GWL_EXSTYLE, GetWindowLong(frmModal.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    frmModal.Show vbModal
   
CleanUp:
   
    ' // Restore modal window style
    SetWindowLong frmModal.hWnd, GWL_EXSTYLE, GetWindowLong(frmModal.hWnd, GWL_EXSTYLE) And Not (WS_EX_LAYERED)
   
    ' // Restore background window style
    SetWindowLong frmBackground.hWnd, GWL_EXSTYLE, GetWindowLong(frmBackground.hWnd, GWL_EXSTYLE) And Not (WS_EX_LAYERED)
   
    ' // Restore non-client area of background window
    SetWindowPos frmBackground.hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOSIZE
    RedrawWindow frmBackground.hWnd, ByVal 0&, 0, RDW_ALLCHILDREN Or RDW_INVALIDATE Or RDW_FRAME
   
    ' // Free resources
    If fb.hdc Then
        RestoreDC fb.hdc, -1
        DeleteDC fb.hdc
    End If
   
    If fb.hDib Then DeleteObject fb.hDib
   
    If fb.timId Then KillTimer frmBackground.hWnd, fb.timId
   
End Function

Private Sub TimerProc( _
            ByVal hWnd As Long, _
            ByVal uMsg As Long, _
            ByRef fb As DarkBlurData, _
            ByVal dwTime As Long)
    Dim delta  As Single
    Dim inIde  As Boolean
   
    Debug.Assert MakeTrue(inIde)
   
    If fb.frame >= TRANSLATION_FRAMES Then
        KillTimer hWnd, fb.timId
        fb.timId = 0
        SetWindowLong fb.frmModal.hWnd, GWL_EXSTYLE, GetWindowLong(fb.frmModal.hWnd, GWL_EXSTYLE) And Not (WS_EX_LAYERED)
        Exit Sub
    End If
   
    If inIde Then
       
        FadeForm fb
       
    Else
   
        BlurImage fb
        SetDarkBlurData fb
       
    End If
   
    If fb.frame = 0 Then
        fb.lInitPos = fb.frmModal.Top
    End If
   
    fb.frame = fb.frame + 1
   
    delta = Sin((fb.frame / TRANSLATION_FRAMES * 2.467) ^ 0.5)

    fb.frmModal.Move fb.frmModal.Left, fb.lInitPos - (1 - delta) * 100 * Screen.TwipsPerPixelY
    SetLayeredWindowAttributes fb.frmModal.hWnd, 0, delta * 255, ULW_ALPHA
   
End Sub

Private Function BackSubclassProc( _
                ByVal hWnd As Long, _
                ByVal Msg As Long, _
                ByVal wParam As Long, _
                ByVal lParam As Long, _
                ByVal uIdSubclass As Long, _
                ByRef fb As DarkBlurData) As Long
   
    Select Case Msg
    Case WM_NCCALCSIZE
        Exit Function
    Case Else
        BackSubclassProc = DefSubclassProc(hWnd, Msg, wParam, lParam)
    End Select
   
End Function

' // Blur pixels and fade
Private Sub BlurImage( _
            ByRef fb As DarkBlurData)
    BlurH fb
    BlurV fb
End Sub

Private Sub BlurH( _
            ByRef fb As DarkBlurData)
    Dim x      As Long
    Dim y      As Long
    Dim index  As Long

    index = 8
   
    For y = 1 To (-fb.bi.bmiHeader.biHeight) - 2
        For x = 8 To (fb.bi.bmiHeader.biWidth - 3) * 4 + 3
       
            If (index And &H3) <> 3 Then
                fb.bBits(index) = (CLng(fb.bBits(index - 4)) + fb.bBits(index) + fb.bBits(index + 4)) * 50 \ 152
            End If
           
            index = index + 1
           
        Next
       
        index = index + 16
       
    Next
   
End Sub

Private Sub BlurV( _
            ByRef fb As DarkBlurData)
    Dim x      As Long
    Dim y      As Long
    Dim index  As Long
    Dim offset  As Long

    offset = fb.bi.bmiHeader.biWidth * 4
    index = offset * 2
   
    For y = 2 To (-fb.bi.bmiHeader.biHeight) - 3
        For x = 0 To (fb.bi.bmiHeader.biWidth - 1) * 4 + 3
       
            If (index And &H3) = 3 Then
                fb.bBits(index) = 255
            Else
                fb.bBits(index) = (CLng(fb.bBits(index - offset)) + fb.bBits(index) + fb.bBits(index + offset)) * 50 \ 152
            End If
           
            index = index + 1
           
        Next
    Next
   
End Sub

' // Make screenshot and initialize some data for window
Private Function InitializeBackgroundFormData( _
                ByRef fb As DarkBlurData) As Boolean
    Dim lWidth      As Long
    Dim lHeight    As Long
    Dim pBmpData    As Long
    Dim index      As Long
    Dim bRet        As Boolean
   
    ' // Create dc for layered window
    fb.hdc = CreateCompatibleDC(mMemDc)
    If fb.hdc = 0 Then GoTo CleanUp
   
    ' // Save its state
    SaveDC fb.hdc
   
    lWidth = fb.frmBackground.Width / Screen.TwipsPerPixelX
    lHeight = fb.frmBackground.Height / Screen.TwipsPerPixelY
   
    With fb.bi.bmiHeader
   
        .biSize = Len(fb.bi.bmiHeader)
        .biBitCount = 32
        .biHeight = -lHeight
        .biWidth = lWidth
        .biPlanes = 1
   
    End With
   
    ' // Create background bitmap
    fb.hDib = CreateDIBSection(mMemDc, fb.bi, 0, pBmpData, 0, 0)
    If fb.hDib = 0 Then GoTo CleanUp
   
    ' // Make screenshot
    SelectObject fb.hdc, fb.hDib
    PrintWindow fb.frmBackground.hWnd, fb.hdc, 0
   
    ReDim fb.bBits(lWidth * lHeight * 4 - 1)
   
    memcpy fb.bBits(0), ByVal pBmpData, UBound(fb.bBits) + 1
   
    bRet = True
   
CleanUp:
   
    If Not bRet Then
       
        If fb.hDib Then
            DeleteObject fb.hDib
            fb.hDib = 0
        End If
       
        If fb.hdc Then
            DeleteDC fb.hdc
            fb.hdc = 0
        End If
       
    End If
   
    InitializeBackgroundFormData = bRet
   
End Function

' // Set bits to background window
Private Function SetDarkBlurData( _
                ByRef fb As DarkBlurData) As Boolean
    Dim pt      As Size
    Dim sz      As Size
    Dim pos    As Size
   
    pt.cx = fb.frmBackground.Left / Screen.TwipsPerPixelX
    pt.cy = fb.frmBackground.Top / Screen.TwipsPerPixelY
   
    If fb.frmBackground.Width > Screen.Width Then
        sz.cx = Screen.Width / Screen.TwipsPerPixelX
    Else
        sz.cx = fb.bi.bmiHeader.biWidth
    End If
   
    sz.cy = -fb.bi.bmiHeader.biHeight
   
    SetDarkBlurData = SetDIBitsToDevice(fb.hdc, 0, 0, fb.bi.bmiHeader.biWidth, -fb.bi.bmiHeader.biHeight, _
                                    0, 0, 0, -fb.bi.bmiHeader.biHeight, fb.bBits(0), fb.bi, 0)
                                   
    UpdateLayeredWindow fb.frmBackground.hWnd, ByVal 0&, pt, sz, fb.hdc, pos, 0, AB_32Bpp255, ULW_ALPHA
   
End Function

' // Fast fade form (in IDE mode)
Private Sub FadeForm( _
            ByRef fb As DarkBlurData)
    Dim blend  As Long
    Dim oBmp    As Long
    Dim pt      As Size
    Dim sz      As Size
    Dim pos    As Size
   
    pt.cx = fb.frmBackground.Left / Screen.TwipsPerPixelX
    pt.cy = fb.frmBackground.Top / Screen.TwipsPerPixelY

    sz.cx = fb.bi.bmiHeader.biWidth
    sz.cy = -fb.bi.bmiHeader.biHeight
   
    ' // &H10 - alpha value
    blend = &H8 * &H10000
   
    oBmp = SelectObject(mMemDc, mFadeBmp)
    AlphaBlend fb.hdc, 0, 0, fb.bi.bmiHeader.biWidth, -fb.bi.bmiHeader.biHeight, mMemDc, 0, 0, 1, 1, blend
    SelectObject mMemDc, oBmp
   
    ' // &HFF - alpha value
    blend = &HFF * &H10000
   
    UpdateLayeredWindow fb.frmBackground.hWnd, ByVal 0&, pt, sz, fb.hdc, pos, 0, blend, ULW_ALPHA
   
End Sub

Private Function MakeTrue( _
                ByRef v As Boolean) As Boolean
    v = True
    MakeTrue = True
End Function

---

When you'll have compiled the project form has the "DarkBlur" effect, in IDE it has only the "Dark" effect.

Great effect

This is similar to part of the question I asked here in this my thread :
my question 2 :

Quote:

---

2- How can you display a slide like a panel on the form that darkens or blurs the background

---

Thread: any body can help about design this 3d rotate contents and then this slide effect?
but there is one difference,Here, a form is displayed on top of another form. Is it possible to display this mode inside a form without showing another form? For example, we want to display a slide panel or list while the list is displayed on the form and below it has such an blurred and dark effect?