Transparence via bidouilles pour win9x

Télécharger le projet
Commenter

Description

Bon je tiens a le preciser td suite, ceci est une grosse bidouille mais ki marche a merveille !
En gros cele permet de faire des OSD (ou tout autre application que vous pourrez realiser avec) semis transparents ...

le principe:
- creer une image de fond en damier gris en blanc.
sachant bien sur que la couleur blanche sera la couleur transparente; donc si damier 1 carré sur 2 alors transparent a 50% ! plus il y aura de blanc plus ca sera transparent :)
- mettre en transparent ce blanc (image + form)

et c tout !
rien de plus dur que cela !

bonne bidouille koi mais ca marche :) a 50% de transparence ca va c correct pas trop aliasé mais + ou - alors il faut trouver un systeme de lissage ou je ne c koi car ca pixelise a mort :)

Pour les grincheux les critiques inutiles ne sont pas forcements les biens venues mais bon vive la liberte dexpression ... :)

Source / Exemple : 


'Dans un form mettre une picturebox nommée Picture1
'mettre le scalemode sur PIXEL pour la form et la picturebox (Picture1)
'mettre un timer intervale 1000 et enabled=false
'et mettre ce code

Dim wr(11)
Dim a As Integer

Private Sub Form_Load()
    'affichage du pointeur de la souris (sablier)
    Screen.MousePointer = 11
    DoEvents
    'positionnement de la fenetre
    Me.Top = 2000
    Me.Left = 1000
    DoEvents
    'chargement des differentes region pour chaque image (transparence)
    For a = 0 To 10
        'vide la picturebox
        Picture1.Picture = Nothing
        'charge la picturebox avec un bitmap mit en ressource
        Picture1.Picture = LoadResPicture(101 + a, vbResBitmap)
        'creer la region en transparence suivant la couleur de masque (ici 255,255,255 cad blanc)
        wr(a) = MakeRegion(Picture1, "255,255,255")
    Next a
    'charge une image temporaire
    Picture1.Picture = LoadResPicture(101, vbResBitmap)
    'mets en transparence la form suivant les zone de transparences definits par limage temporaire
    SetWindowRgn Me.hwnd, wr(0), True
    a = 0
    Timer1.Enabled = True
    Screen.MousePointer = 0
    'mets la form au premier plan
    RendreFormTjsVisible Me
End Sub

Private Sub Timer1_Timer()
    If a > 11 Then a = 0
    Picture1.Picture = Nothing
    Picture1.Picture = LoadResPicture(101 + a, vbResBitmap)
    a = a + 1
    If Me.Visible = False Then Me.Visible = True
End Sub

'----------------------------

'dans un module mettre le code ci-dessous

'############# -------
'un de mes nombreux modules à tout faire :)
'############# -------

Public Type IconeTray
   cbSize As Long   'Taille de l'icône (en octets)
   hwnd As Long   'Handle de la fenêtre chargée de recevoir les messages envoyés lors des évènements sur l'icône (clics, doubles-clics...)
   uID As Long   'Identificateur de l'icône
   uFlags As Long
   uCallbackMessage As Long   'Messages à renvoyer
   hIcon As Long   'Handle de l'icône
   szTip As String * 64   'Texte à mettre dans la bulle d'aide
End Type
Public IconeT As IconeTray
Public Const AJOUT = &H0
Public Const MODIF = &H1
Public Const SUPPRIME = &H2
Public Const MouseMove = &H200
Public Const MESSAGE = &H1
Public Const Icone = &H2
Public Const TIP = &H4
Public Const DOUBLE_CLICK_GAUCHE = &H203
Public Const BOUTON_GAUCHE_POUSSE = &H201
Public Const BOUTON_GAUCHE_LEVE = &H202
Public Const DOUBLE_CLICK_DROIT = &H206
Public Const BOUTON_DROIT_POUSSE = &H204
Public Const BOUTON_DROIT_LEVE = &H205
Public Limage As Integer
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean

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 ReleaseCapture Lib "USER32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Public Declare Function SetWindowPos Lib "USER32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Const RGN_OR = 2
Public Const WINDING = 2
Public Const ALTERNATE = 1

Public Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_SENDWININICHANGE = &H2
Private Const SPIF_UPDATEINIFILE = &H1
                               
Public Function ChangeWallpaper(sFichier As String)
    Dim lgRep As Long
    lgRep = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, sFichier, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
End Function

Public Function MakeRegion(picSkin As PictureBox, mSk As String) As Long
    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
    TransparentColor = RGB(CInt(Mid$(mSk, 1, 3)), CInt(Mid$(mSk, 5, 3)), CInt(Mid$(mSk, 9, 3)))
    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

Public Sub RendreFormTjsVisible(MonForm As Object)
     SetWindowPos MonForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Public Sub RendreFormTjsNONVisible(MonForm As Object)
     SetWindowPos MonForm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

'---------------------------------

'ensuite mettre 11 images dans un fichier ressource (101 a 112) en bitmap avec un fond en damier blanc et la couleur de votre choix (blanc pour les parties transparentes

Conclusion :


Pour les feneant ya un zip (oui je sais kil y en a :))
avec un exemple sympa d'un OSD nvo de volume :)

Bien a vous.
@++++ Christophe.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (lumesh)