capture the background behind a form 8

[CubeE101]

How can you capture the background behind a form (such as desktop and other windows) and display it in the form, in a picture box to be exact...?

thnx N advnc Have Fun, Be Young... Code BASIC
-Josh Stribling

http://cubee.topcities.com

 

[strongm]

And, just for fun, here's how to do something similar in W98/Me (will also work on 2000/XP, but the SetLayeredWindowAttributes method is preferable and cleaner on them). Note this is purely a demo of the technique. It sure as heck isn't production code (there's a noticeable flicker during the 'snapshot' setup phase, which can probably be reduced although not eliminated by some restructuring).
[tt]
Option Explicit

Const AC_SRC_OVER = &H0

Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type

Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020

Private Sub Form_Load()
Fader 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Fader 0
End Sub

Private Function Fader(Direction As Long)
Dim ScreenCopyDC As Long
Dim myDC As Long
Dim myBMP As Long
Dim oldBMP As Long
Dim myrect As RECT
Dim BF As BLENDFUNCTION
Dim lBF As Long
Dim fade As Long

GetWindowRect Me.hwnd, myrect

If Direction = 0 Then
Me.Hide
Else
Me.Show
End If
DoEvents

' Snapshot the either the form or the desktop under the form, depending on whether
' fade in or fade out is required
myDC = GetWindowDC(GetDesktopWindow())
ScreenCopyDC = CreateCompatibleDC(myDC)
myBMP = CreateCompatibleBitmap(myDC, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top) ' Me.ScaleWidth, Me.ScaleHeight)
oldBMP = SelectObject(ScreenCopyDC, myBMP)
BitBlt ScreenCopyDC, 0, 0, myrect.Right - myrect.Left + 100, myrect.Bottom - myrect.Top + 100, myDC, myrect.Left, myrect.Top, SRCCOPY

If Direction = 0 Then
Me.Show
Else
Me.Hide
End If
DoEvents

For fade = 0 To 127 Step 4
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = fade
.AlphaFormat = 0
End With

RtlMoveMemory lBF, BF, 4

AlphaBlend myDC, myrect.Left, myrect.Top, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top, ScreenCopyDC, 0, 0, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top, lBF

Next

'Clean up
SelectObject ScreenCopyDC, oldBMP
DeleteObject myBMP
ReleaseDC GetDesktopWindow(), myDC
DeleteDC myDC
DeleteDC ScreenCopyDC

If Direction = 0 Then
Me.Hide
Else
Me.Show
End If
End Function

 

[Hypetia]

Yes, there were some "spelling mistakes" in my code as I forgot to use Option Explicit.
The code was working OK as the Byte variable Opactiy was not used at all and the one being used in the For loop was a Variant.

Moreover, the declaration of the function SetLayeredWindowAttributes contains bAlpha parameter declared as Byte. It should be declared as Long as all the parameters in Win32 API are typically 32-bit long.

In fact, I translated this declaration from MSDN which declares the syntax of this function as:
[tt]
BOOL SetLayeredWindowAttributes(
HWND hwnd,
COLORREF crKey,
BYTE bAlpha,
DWORD dwFlags
);
[/tt]
Thats why I declared bAlpha as Byte.

I suggest you to modify the declaration of the function as below.
[tt]
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal lAlpha As Long, ByVal dwFlags As Long) As Long
[/tt]
And also declare the variable Opacity (not Opactiy) as Long.
However, the value of this parameter will still range from 0 to 255.

Rest of the code is fine.

 

[Error7]

Hi Guys,

Reporting back as promised. By changing the declarations to long, it works in 2000.

BigAl

 

[CubeE101]

Thanx also to

BigAl, for your feedback on 2000 &

StrongM for the 98/Me method Have Fun, Be Young... Code BASIC
-Josh Stribling

http://cubee.topcities.com

 

[Error7]

Yeh, thanks StrongM, I tried your code and it worked fine (apart from the flicker you reported). I just need to think of an app to use it in!

Big Al

 

[CubeE101]

Is there a way to use Alpha blending on picture boxes within a form...

to see the form through a picture box...

I tried using the Pictture boxes hwnd in place of the form's, but had no luck...

*This will be for WinXP

Have Fun, Be Young... Code BASIC
-Josh Stribling

http://cubee.topcities.com

 

[bjd4jc]

This is really cool! Another Star for Hypetia

 

[BiggerBrother]

This is fantastic. However, does anyone know if its at all possible to alter this coding - Hypetia's code - to work on MDI forms?

Thanks

BB

 

[BiggerBrother]

If you want to do this with MDI forms, simply remove the Refresh call.

BB

 

[mych]

Is any of this possible on NT4?

I have tried StrongM's 98/ME version but the code complains that it can't find msimg32.dll

Any solutions?

Thanks
Mych

 

[strongm]

strongm's code example makes it clear that the code only works on 95/98/Me/2000/XP (and I'd assume 2003, but I've not tested it on that).

 

[mych]

Hi

I'm trying to slim down my code and save my fingers....

I have various forms with multiple text boxes. I want some code on the get focus event that will select whatever text happens to be in the box.

In the past I have used...

Private Sub [i]txtBoxName[/i]_GotFocus()

    [i]txtBoxName[/i].SelStart = 0
    [i]txtBoxName[/i].SelLength = Len([i]txtBoxName[/i].Text)

End Sub

But with the number of boxes I have, I need to make a call to a simple module... I have this so far....

In the get focus event of each text box I have...

Private Sub txtBoxName_GotFocus()
    
    SelectAllTxt (Me)

End Sub

In a module I have....

Public Sub SelectAllTxt(txtBox As Control)
    
    txtBox.SelStart = 0
    txtBox.SelLength = Len(txtBox.Text)
    
End Sub

This gives me a type 13 Mismatch error. Where have I gone wrong???

Help appreciated

 

[HarleyQuinn]

Mych Might be a better idea to start your question in a new thread. You will get better responses that way

Harleyquinn

---------------------------------
For tsunami relief donations

 

[mych]

Ooops... I thought I had started a new thread.... silly fingers.