GESTINO DE MENU JEU SUPER NINTENDO

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

Télécharger le zip