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

[Résolu]
Signaler
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009
-
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
-
Bonjour à tous,



Voici mon problème :


Je voudrais faire une bitmap d'une fenêtre dont je connais le hwnd
pour rendre cette fenêtre transparente selon la couleur des points
contenus dans cette bitmap.


J'ai suivi avec intérêt la réponse à 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être puis créer une région dépendante de la couleur des
points de cette bitmap pour ensuite appliquer cette région à la fenê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ée avec Winspector Spy, la fenêtre n'a pas de contrôles (bouton ou autre), c'est bien une "image"

11 réponses

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
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



<small> Coloration
syntaxique automatique [AFCK]</small>









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





<small> Coloration
syntaxique automatique [AFCK]</small>







voilà.

à toi d'adapter, j'espère que çà t'ouvrira des pistes de recherches....



@+

PCPT [AFCK]
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 70 internautes nous ont dit merci ce mois-ci

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
salut,

tu as une Form1 (sans contrôle).

le but c'est quoi? de faire un screen de cette form et l'appliquer sur
elle-même en enlevant le gris par exemple? (laissant apparaître le
bureau?



oui?

en VB6?
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

C'est un truc dans le genre mais ce n'est pas une form, c'est une fenêtre d'une application externe. Et donc une simple image.
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
ok.

je regarde çà plus tard (aujourd'hui)

doit pouvoir fonctionner en dessous de W2K ?
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
et copie déjà ton code pour la capture, voire détection du handle stp, ce sera çà de gagné ;)
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

Ok merci de t'occuper de mon problè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é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édé un hwnd et un handle (comme une picturebox je présume)



Je suis obligé de passé par un objet temporaire pour récupérer le
handle et bidouillé pour avoir les dimensions de la région de départ.



Ca semble fonctionner mais cette fenêtre est en fait un menu composé
d'images (1 image par "bouton" en surbrillance), je n'arrive pas à
redonner la région d'origine entre changement de "bouton".



Je sais c'est un peu tordu à expliquer.
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

Merci, je vais étudié tout ça
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

Et j'ai testé vite fait sous VB et ça me plait beaucoup !!



Merci encore de m'avoir répondu si vite
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
ok

n'oublie pas de clôturer ton ce Topic

@+
Messages postés
26
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
31 mars 2009

On fait comme ça ? Désolé, je suis perdu là.
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
46
oui c'est bien çà ;)


le but étant essentiellement pour les autres lecteurs (trouver
rapidement la réponse) et quand c'est rapide (premier jour), le topic
est


alors coché dans la liste de la page d'accueil. on perd moins de temps comme çà...





@+


PCPT [AFCK]