[SNIPPET-VB6] DrawGraph - Dibujar sobre controles.

[F3B14N]

Lo hice hace ya un tiempo para hacer poner imágenes en los commandbutton y que queden en la misma linea, pero se puede aplicar a cualquier control.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Const WM_PAINT As Long = &HF
Private Const GWL_WNDPROC = -4

Private Type DRAW_DATA
    DrawPic As PictureBox
    DrawTop As Long
    DrawLeft As Long
    lpPrevWndProc As Long
    ControlHwnd As Long
    ControlDC As Long
End Type

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 CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal Hwnd As Long) As Long
Private Declare Function GdiTransparentBlt Lib "GDI32" (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

Private DrawArray() As DRAW_DATA

Public Sub DrawGraph(Hwnd As Long, Pic As PictureBox, Top As Long, Left As Long)
    Dim i As Long
   
    If Not Not DrawArray Then: i = UBound(DrawArray) + 1
    ReDim Preserve DrawArray(i)
   
    With DrawArray(i)
        Set .DrawPic = Pic
        .DrawPic.BorderStyle = 0
        .DrawPic.ScaleMode = vbPixels
        .DrawPic.BackColor = &HFF00FF
        .DrawPic.AutoSize = True
        .DrawPic.Refresh
   
        .ControlHwnd = Hwnd
        .lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf ControlProc)
        .ControlDC = GetDC(Hwnd)
        .DrawTop = Top: .DrawLeft = Left
    End With
End Sub

Public Sub UnDrawGraph(ByVal Hwnd As Long)
    Dim i As Long
   
    For i = 0 To UBound(DrawArray)
        If DrawArray(i).ControlHwnd = Hwnd Then
            Call SetWindowLong(Hwnd, GWL_WNDPROC, DrawArray(i).lpPrevWndProc)
        End If
    Next i
End Sub

Private Function ControlProc(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Long

    For i = 0 To UBound(DrawArray)
        With DrawArray(i)
            If .ControlHwnd = Hwnd Then
                ControlProc = CallWindowProc(.lpPrevWndProc, Hwnd, Msg, wParam, lParam)
                If (Msg = WM_PAINT) Then
                    Call GdiTransparentBlt(.ControlDC, .DrawLeft, .DrawTop, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, .DrawPic.hdc, 0, 0, .DrawPic.ScaleWidth, .DrawPic.ScaleHeight, &HFF00FF)
                End If
            End If
        End With
    Next i
End Function