Voila vous dever uniquement metre se code dans un module dans votreproject
, vous pouver vous servir du demo pour comprendre le fonctionnelent de se module.La structure du project est tres basique et le texte est mal gerer pou linstant(vous pouver y remedier avec les valeur font de votre form se jsute palte).
Aretenir :
---l'index du menu doit etre egal au nombre maximal de menu posible
---Les iamges et le texte util;ise mle meme SubIndex
---Menu index sert a savoir a quel couche seras afficher le ou les controle
---La transparence se fait de 0 a 255(par pitier ne meter pas 254 ,se n.est pas visible et sa ralentit le prog)
A noter dans le zip il y a egalement un previem du programme DreamMaker(partie armement et item)il marche pas dutout ou presque(Alpha)mais sa donne une bone ider des posibiliter a venir.
A noter que se programme est egalement En Phase Alpha.
Je remercirait qui conque posede le talant nesesaire pour trouver un moyen de fair eles chose suivant sur mno prog:
1-Enlever lobligation davoir des picturebox comme varaible
2-RAAAAAPPPIIDDDIITTTEEERRRR.....en gros sa lag mon menu plus que le reste du projet reunis.
Source / Exemple :
Public Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
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 Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long
Private ParametrageTIMenuIndex(0 To 100) As Integer
Private ParametrageTISubIndex(0 To 100) As Integer
Private ParametrageTOrI(0 To 100) As AsType
Private ParametrageTexte(0 To 100) As String
Private ParametrageImage(0 To 100) As PictureBox
Private ParametrageTIX1(0 To 100) As Integer
Private ParametrageTIY1(0 To 100) As Integer
Private ParametrageTIW(0 To 100) As Integer
Private ParametrageTIH(0 To 100) As Integer
Private ParametrageTIOpaciter(0 To 100) As Byte
Private ParametrageClickSubIndex(0 To 100) As Integer
Private ParametrageClickX1(0 To 100) As Integer
Private ParametrageClickY1(0 To 100) As Integer
Private ParametrageClickW(0 To 100) As Integer
Private ParametrageClickH(0 To 100) As Integer
Private ParametrageClickValide(0 To 100, 0 To 100) As Integer 'Deux variable index plus array
Private NombreClickValide(0 To 100) As Integer
Private CoucheActuel As Integer
'Private ClickOrClavier as Boolean
Private ParametrageMenuIndex(0 To 100) As Integer
Private ParametrageMenuImage(0 To 100) As PictureBox
Private ParametrageMenuX1(0 To 100) As Integer
Private ParametrageMenuY1(0 To 100) As Integer
Private ParametrageMenuW(0 To 100) As Integer
Private ParametrageMenuH(0 To 100) As Integer
Private ParametrageTIMax As Integer
Private ParametrageMenuOpaciter(0 To 100) As Byte
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Function GdiAlphaBlend Lib "gdi32.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 BF As BLENDFUNCTION, lBF As Long
Private Enum AsType
Image = 0
Texte = 1
End Enum
'MenuIndex permet d'identifier a quel couche il doit etre rafraichi
Public Sub AfficherMenu(Objectif As Form, Index As Integer)
Dim I As Integer
Dim G As Integer
'Set the graphics mode to persistent
'Objectif.AutoRedraw = True
'Picture2.AutoRedraw = True
'API uses pixels
Objectif.ScaleMode = vbPixels
'Picture2.ScaleMode = vbPixels
'set the parameters
'copy the BLENDFUNCTION-structure to a Long
CoucheActuel = Index
'ParametrageMenuImage(I)
For I = 0 To CoucheActuel
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = ParametrageMenuOpaciter(I)
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
GdiAlphaBlend Objectif.hdc, ParametrageMenuX1(I), ParametrageMenuY1(I), ParametrageMenuW(I), ParametrageMenuH(I), ParametrageMenuImage(I).hdc, 0, 0, ParametrageMenuImage(I).ScaleWidth, ParametrageMenuImage(I).ScaleHeight, lBF
'Call TransparentBlt(Objectif.hdc, ParametrageMenuX1(I), ParametrageMenuY1(I), ParametrageMenuW(I), ParametrageMenuH(I), Objectif.Picture1.hdc, 0, 0, Objectif.Picture1.ScaleWidth, Objectif.Picture1.ScaleHeight, RGB(0, 0, 0))
'Call Objectif.PaintPicture(DreamTexte.Picture1.Picture, ParametrageMenuX1(I), ParametrageMenuY1(I), ParametrageMenuW(I), ParametrageMenuH(I))
For G = 0 To ParametrageTIMax 'erreur ici(grosse erreur)doit etre valeur nombre object
If ParametrageTIMenuIndex(G) = I Then
If ParametrageTOrI(G) = Image Then
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = ParametrageTIOpaciter(G)
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
GdiAlphaBlend Objectif.hdc, ParametrageTIX1(G), ParametrageTIY1(G), ParametrageTIW(G), ParametrageTIH(G), ParametrageImage(G).hdc, 0, 0, ParametrageImage(G).ScaleWidth, ParametrageImage(G).ScaleHeight, lBF
'Call TransparentBlt(Objectif.hdc, ParametrageTIX1(G), ParametrageTIY1(G), ParametrageTIW(G), ParametrageTIH(G), Objectif.Picture1.hdc, 0, 0, Objectif.Picture1.ScaleWidth, Objectif.Picture1.ScaleHeight, RGB(0, 0, 0))
'Call Objectif.PaintPicture(DreamTexte.Picture1.Picture, ParametrageTIX1(G), ParametrageTIY1(G), ParametrageTIW(G), ParametrageTIH(G))
Else
Call TextOut(Objectif.hdc, ParametrageTIX1(G), ParametrageTIY1(G), ParametrageTexte(G), Len(ParametrageTexte(G)))
End If
End If
Next G
Next I
'alpha blending
Objectif.Refresh
End Sub
Public Sub ParametrerMenu(MenuIndex As Integer, Image As PictureBox, X1 As Integer, Y1 As Integer, W As Integer, H As Integer, Opaciter As Byte)
ParametrageMenuIndex(MenuIndex) = MenuIndex
Image.ScaleMode = vbPixels
Set ParametrageMenuImage(MenuIndex) = Image
ParametrageMenuX1(MenuIndex) = X1
ParametrageMenuY1(MenuIndex) = Y1
ParametrageMenuW(MenuIndex) = W
ParametrageMenuH(MenuIndex) = H
ParametrageMenuOpaciter(MenuIndex) = Opaciter
End Sub
Public Sub ParametrerTexte(MenuIndex As Integer, SubIndex As Integer, MaxIndex As Integer, Texte As String, X1 As Integer, Y1 As Integer, Optional W As Integer, Optional H As Integer)
ParametrageTIMenuIndex(SubIndex) = MenuIndex
ParametrageTISubIndex(SubIndex) = SubIndex
ParametrageTOrI(SubIndex) = 1
ParametrageTexte(SubIndex) = Texte
ParametrageTIX1(SubIndex) = X1
ParametrageTIY1(SubIndex) = Y1
ParametrageTIW(SubIndex) = W
ParametrageTIH(SubIndex) = H
ParametrageTIMax = MaxIndex
End Sub
Public Sub ParametrerImage(MenuIndex As Integer, SubIndex As Integer, MaxIndex As Integer, Image As PictureBox, Opaciter As Byte, X1 As Integer, Y1 As Integer, Optional W As Integer, Optional H As Integer)
Image.ScaleMode = vbPixels
ParametrageTIMenuIndex(SubIndex) = MenuIndex
ParametrageTISubIndex(SubIndex) = SubIndex
ParametrageTOrI(SubIndex) = 0
Set ParametrageImage(SubIndex) = Image
ParametrageTIX1(SubIndex) = X1
ParametrageTIY1(SubIndex) = Y1
ParametrageTIW(SubIndex) = W
ParametrageTIH(SubIndex) = H
ParametrageTIMax = MaxIndex
ParametrageTIOpaciter(SubIndex) = Opaciter
End Sub
Public Sub ParametrerClick(SubIndex As Integer, X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer, ParamArray MenuIndex())
Dim I As Integer
ParametrageClickSubIndex(SubIndex) = SubIndex
ParametrageClickX1(SubIndex) = X1
ParametrageClickY1(SubIndex) = Y1
ParametrageClickW(SubIndex) = X2
ParametrageClickH(SubIndex) = Y2
'Call DreamTexte.PaintPicture(DreamTexte.Picture1.Picture, X1, Y1, X2, Y2)
I = 0
For Each X In MenuIndex
ParametrageClickValide(SubIndex, I) = X 'notez valeur consernner seulement pour sauver variable
NombreClickValide(SubIndex) = I
I = I + 1
Next X
End Sub
Public Sub RecupererClick(X As Single, Y As Single)
Dim I As Integer
Dim G As Integer
For I = 0 To 100
If X > ParametrageClickX1(I) And X < ParametrageClickX1(I) + ParametrageClickW(I) And Y > ParametrageClickY1(I) And Y < ParametrageClickY1(I) + ParametrageClickH(I) Then
For G = 0 To NombreClickValide(I)
If ParametrageClickValide(I, G) = CoucheActuel Then EvenementClick (I)
Next G
End If
Next I
End Sub
Public Sub EvenementClick(Index As Integer)
'Call DreamMenu1.ParametrerMenu(3, DreamTexte.Picture1, 40, 40, 500, 500, 255)
'Call DreamMenu1.AfficherMenu(DreamTexte, 3)
End Sub
'Public Sub SetObjectFocus(Index As Integer, MargeGauche As Integer, MargHaut As Integer, MargeDroite As Integer, MargeBas As Integer)
'End Sub
Conclusion :
Bogue Connue..... liamge picture box de reference doit etre visible
---limage pciture box de reference doit etre entierement dans lecran et autosize a true
---se lent
---jatend que vous me les dites
merci de ne pas lancer des insulte dans le vide ,sa ne me touche pas et se project est Alpha de toute facon.
En le publiant jespere surtout avoir un coup de main pour trouver un moyen de le rendre leger..
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.