Soyez le premier à donner votre avis sur cette source.
Vue 25 165 fois - Téléchargée 2 156 fois
'----- DANS UNE FORM ----- Private Sub Form_Load() Dim WindowRegion As Long 'Propriétés de la picture box Picture1.AutoRedraw = True Picture1.BorderStyle = 0 Picture1.ScaleMode = 3 'Position de la picture box Picture1.Top = 0: Picture1.Left = 0 '"Découpe" la form suivant Picture1 WindowRegion = MakeRegion(Picture1) SetWindowRgn Me.hWnd, WindowRegion, True End Sub '----- DANS UN MODULE ----- Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Public Const RGN_OR = 2 Public Function MakeRegion(picSkin As PictureBox) As Long ' faites une fenêtre "région" basée sur une picture de picture box ' Ceci ce fait en passant l'image pixel par pixel et en créant une ' région pour chaque pixel non transparent ' Le code est optimisé, il est donc assez rapide Dim X As Long, Y As Long, StartLineX As Long Dim FullRegion As Long, LineRegion As Long Dim TransparentColor As Long Dim InFirstRegion As Boolean Dim InLine As Boolean Dim hDC As Long Dim PicWidth As Long Dim PicHeight As Long hDC = picSkin.hDC PicWidth = picSkin.ScaleWidth PicHeight = picSkin.ScaleHeight InFirstRegion = True: InLine = False X = Y = StartLineX = 0 ' Ici, la couleur de transparence est basé sur le pixel en haut a gauche ' Mais vous pouvez mettre la couleur ke vous voulez TransparentColor = GetPixel(hDC, 0, 0) For Y = 0 To PicHeight - 1 For X = 0 To PicWidth - 1 If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then If InLine Then InLine = False LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1) If InFirstRegion Then FullRegion = LineRegion InFirstRegion = False Else CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR DeleteObject LineRegion End If End If Else If Not InLine Then InLine = True StartLineX = X End If End If Next Next MakeRegion = FullRegion End Function
2 déc. 2006 à 22:08
10/10 sans probleme ca marche impec' !!
6 juil. 2006 à 07:01
ca marche très bien! seulement, il découte seulement autour de mon image...et j'ai un rectangle au milieu de l'image donc j'aimerai rendre transparent....et pourtant il est de la meme couleur que les contours qui ont été découpé...pourquoi n'est-il pas découpé?
Merci
Jn
18 mars 2005 à 22:35
10/10, Vraiment excellent !!!
Que dire de plus, un truc pas mal serait de rajouter un paramètre optionnel : un seuil de tolérence en pourcentage pour les couleur, mais bon, c'est déjà super bien :)
Bonne continuation
++
18 nov. 2004 à 23:08
pour l'exemple ( vu la date du 1er post )
a la place de :
LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
remplacer par
LineRegion = CreateRectRgn(StartLineX + 1, Y, X, Y + 1)
et hop plus aucune trace ...reste que les lettres
a+
Assel
10/10 cool code
31 juil. 2004 à 17:21
10/10 et sur tout avec les image au format bmp
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.