Transparence création de bitmap sur une fenêtre dont je connais le hwndRésolu

Question

Bonjour &#224; tous,



Voici mon probl&#232;me :


Je voudrais faire une bitmap d'une fen&#234;tre dont je connais le hwnd
pour rendre cette fen&#234;tre transparente selon la couleur des points
contenus dans cette bitmap.


J'ai suivi avec int&#233;r&#234;t la r&#233;ponse &#224; ce message http://www.vbfrance.com/forum.v2.aspx?id=148568 (
CreateRGnFromBitmap)
et tenter de mixer le tout avec cette source
http://www.vbfrance.com/code.aspx?id=4927 (SCREENSHOT DE MASSE)



Donc si j'ai bien compris, je dois faire une bitmap
de cette fen&#234;tre puis cr&#233;er une r&#233;gion d&#233;pendante de la couleur des
points de cette bitmap pour ensuite appliquer cette r&#233;gion &#224; la fen&#234;tre.



Je n'y arrive pas ... Pourriez-vous me donner un petit coup de main je vous prie ?



D'avance merci pour votre aide 



PS : Analys&#233;e avec Winspector Spy, la fen&#234;tre n'a pas de contr&#244;les (bouton ou autre), c'est bien une "image"

PCPT · Accepted Answer

bon, je m'attendais à plus simple pour l'exemple, et sans contrôle extérieur mais bon. ouvre un nouveau projet, 2Forms par défaut. dans la première, rien de particulier, juste ce code : Option Explicit ' Private Sub Form_Load() Load Form2 End Sub Coloration syntaxique automatique [AFCK] dans la 2e, tu poses une shape par défaut, et un bouton par défaut. puis ce code : Option Explicit Const LWA_COLORKEY = &H1 Const LWA_ALPHA = &H2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Const RC_PALETTE As Long = &H100 Const SIZEPALETTE As Long = 104 Const RASTERCAPS As Long = 38 Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) 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 GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc 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 Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long 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 Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long ' ' ' Private Sub Form_Load() Shape1.Shape = 2 Shape1.FillStyle = 0 Shape1.FillColor = 255 Me.BackColor = 65280 Me.Show End Sub ' ' ' Private Sub Command1_Click() Dim lDC As Long lDC = GetDC(Me.hWnd) 'ici bien sur le handle désiré Form1.Picture = hDCToPicture(GetDC(Me.hWnd), 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY) Form1.Width = Me.Width Form1.Height = Me.Height Dim Ret As Long Ret = GetWindowLong(Form1.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Form1.hWnd, GWL_EXSTYLE, Ret SetLayeredWindowAttributes Form1.hWnd, 65280, 128, LWA_COLORKEY DoEvents Unload Me End Sub ' ' ' Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim R As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As GUID 'Fill GUID info With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill picture info With Pic .Size = Len (Pic) ' Length of structure .Type = vbPicTypeBitmap ' Type of Picture (bitmap) .hBmp = hBmp ' Handle to bitmap .hPal = hPal ' Handle to palette (may be null) End With 'Create the picture R = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) 'Return the new picture Set CreateBitmapPicture = IPic End Function ' ' ' Function hDCToPicture(ByVal hDCSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture Dim hDCMemory As Long, hBmp As Long, hBmpPrev As Long, R As Long Dim hPal As Long, hPalPrev As Long, RasterCapsScrn As Long, HasPaletteScrn As Long Dim PaletteSizeScrn As Long, LogPal As LOGPALETTE 'Create a compatible device context hDCMemory = CreateCompatibleDC(hDCSrc) 'Create a compatible bitmap hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 'Select the compatible bitmap into our compatible device context hBmpPrev = SelectObject(hDCMemory, hBmp) 'Raster capabilities? RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster 'Does our picture use a palette? HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette 'What's the size of that palette? PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Set the palette version LogPal.palVersion = &H300 'Number of palette entries LogPal.palNumEntries = 256 'Retrieve the system palette entries R = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) 'Create the palette hPal = CreatePalette(LogPal) 'Select the palette hPalPrev = SelectPalette(hDCMemory, hPal, 0) 'Realize the palette R = RealizePalette(hDCMemory) End If 'Copy the source image to our compatible device context R = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy) 'Restore the old bitmap hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then 'Select the palette hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If 'Delete our memory DC R = DeleteDC(hDCMemory) Set hDCToPicture = CreateBitmapPicture(hBmp, hPal) End Function Coloration syntaxique automatique [AFCK] voilà. à toi d'adapter, j'espère que çà t'ouvrira des pistes de recherches.... @+ PCPT [AFCK]

PCPT · Answer

salut,

tu as une Form1 (sans contr&#244;le).

le but c'est quoi? de faire un screen de cette form et l'appliquer sur
elle-m&#234;me en enlevant le gris par exemple? (laissant appara&#238;tre le
bureau?



oui?

en VB6?

Tamplan · Answer

C'est un truc dans le genre mais ce n'est pas une form, c'est une fen&#234;tre d'une application externe. Et donc une simple image.

PCPT · Answer

ok.

je regarde &#231;&#224; plus tard (aujourd'hui)

doit pouvoir fonctionner en dessous de W2K ?

PCPT · Answer

et copie d&#233;j&#224; ton code pour la capture, voire d&#233;tection du handle stp, ce sera &#231;&#224; de gagn&#233; ;)

Tamplan · Answer

Ok merci de t'occuper de mon probl&#232;me.



Voici le code que j'utilise :



Option Explicit



Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long,
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As
Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal
nCombineMode As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) 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 Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long



Private Type RECT

        Left As Long

        Top As Long

        Right As Long

        Bottom As Long

End Type



Global RegionD&#233;but As Long



Private Const RGN_XOR = 3



Public Function ScreenRegion(ByRef Screen As IMeedioScreen) As Long

Dim x As Long

Dim y As Long

Dim RectScreen As RECT



Dim RetRgn As Long

Dim TmpRgn As Long

Dim TempObject As Object

Dim Rgn_Start As Long

Dim Rgn_End As Long

Dim hdc As Long



Dim mWidth As Long

Dim mHeight As Long



Set TempObject = Screen



hdc = GetWindowDC(Screen.WindowHandle)

SelectObject hdc, TempObject.Handle



GetWindowRect Screen.WindowHandle, RectScreen



mWidth = RectScreen.Right - RectScreen.Left

mHeight = RectScreen.Bottom - RectScreen.Top



RetRgn = CreateRectRgn(0, 0, mWidth, mHeight)



If mWidth > 0 Then

For y = 0 To mHeight - 1

Rgn_Start = -1

For x = 0 To mWidth - 1

If GetPixel(hdc, x, y) = 0 Then

If Rgn_Start -1 Then Rgn_Start x

Rgn_End = x + 1

If x = (mWidth - 1) Then

TmpRgn = CreateRectRgn(Rgn_Start, y, Rgn_End, y + 1)

Call CombineRgn(RetRgn, TmpRgn, RetRgn, RGN_XOR)

Call DeleteObject(TmpRgn)

End If

Else

If Rgn_Start > -1 Then

TmpRgn = CreateRectRgn(Rgn_Start, y, Rgn_End, y + 1)

Call CombineRgn(RetRgn, TmpRgn, RetRgn, RGN_XOR)

Call DeleteObject(TmpRgn)

End If

Rgn_Start = -1

End If

Next x

Next y

End If



DoEvents

SetWindowRgn Screen.WindowHandle, RetRgn, True



ReleaseDC Screen.WindowHandle, hdc

Set TempObject = Nothing

End Function



Screen est un objet du SDK de Meedio, il poss&#233;d&#233; un hwnd et un handle (comme une picturebox je pr&#233;sume)



Je suis oblig&#233; de pass&#233; par un objet temporaire pour r&#233;cup&#233;rer le
handle et bidouill&#233; pour avoir les dimensions de la r&#233;gion de d&#233;part.



Ca semble fonctionner mais cette fen&#234;tre est en fait un menu compos&#233;
d'images (1 image par "bouton" en surbrillance), je n'arrive pas &#224;
redonner la r&#233;gion d'origine entre changement de "bouton".



Je sais c'est un peu tordu &#224; expliquer.

Tamplan · Answer

Merci, je vais &#233;tudi&#233; tout &#231;a

Tamplan · Answer

Et j'ai test&#233; vite fait sous VB et &#231;a me plait beaucoup !!



Merci encore de m'avoir r&#233;pondu si vite

PCPT · Answer

ok

n'oublie pas de cl&#244;turer ton ce Topic

@+

Tamplan · Answer

On fait comme &#231;a ? D&#233;sol&#233;, je suis perdu l&#224;.

PCPT · Answer

oui c'est bien &#231;&#224; ;)


le but &#233;tant essentiellement pour les autres lecteurs (trouver
rapidement la r&#233;ponse) et quand c'est rapide (premier jour), le topic
est


alors coch&#233; dans la liste de la page d'accueil. on perd moins de temps comme &#231;&#224;...





@+


PCPT    [AFCK]

Transparence création de bitmap sur une fenêtre dont je connais le hwnd

11 réponses

Discussions similaires