Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: xmbeat en Enero 21, 2010, 10:09:02 pm

Título: Como poner sombra a Imagenes
Publicado por: xmbeat en Enero 21, 2010, 10:09:02 pm

lo que pasa estoy mejorando un control de usuario el cual tiene una propiedad de poner un icono, lo que logro pintar con DrawIconEx, pero se me ocurrio que dicha imagen al momento del MouseDown se ponga con sombra o que tenga como escala de grises, alguien me ayuda con un ejemplo sencillo?

Título: Re:Como poner sombra a Imagenes
Publicado por: LeandroA en Enero 22, 2010, 12:15:42 am

hola Fijate si con esta DrawState te puede servir

probalo en un formulario con un commandbuton

Código: [Seleccionar]

Option Explicit
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal flags As Long) As Long

Private Const DSS_MONO As Long = &H80
Private Const DSS_NORMAL As Long = &H0
Private Const DSS_DISABLED As Long = &H20
Private Const DST_BITMAP As Long = &H4
Private Const DST_ICON As Long = &H3
Private Const DST_COMPLEX As Long = &H0

Private Enum tDrawState
    Normal = 0
    Hot = 1
    Pressed = 2
    Disabled = 3
End Enum


Private Sub DrawButtonImage(ByVal DestDC As Long, _
                            ByVal x As Long, _
                            ByVal y As Long, _
                            ByVal Width As Long, _
                            ByVal Height As Long, _
                            ByRef Pic As StdPicture, _
                            ByVal BtnDrawState As tDrawState)
                           

  Dim lFlags As Long
  Dim hBrush As Long

    On Local Error Resume Next
   
    Select Case Pic.Type
     Case vbPicTypeBitmap
        lFlags = DST_BITMAP
     Case vbPicTypeIcon
        lFlags = DST_ICON
     Case Else
        lFlags = DST_COMPLEX
    End Select
   
    Select Case BtnDrawState
        Case Normal, Pressed
            DrawState DestDC, 0, 0, Pic.Handle, 0, x, y, Width, Height, lFlags Or DSS_NORMAL
        Case Hot
            hBrush = CreateSolidBrush(&HB4B4B4)
            DrawState DestDC, hBrush, 0, Pic.Handle, 0, x, y, Width, Height, lFlags Or DSS_MONO
            DrawState DestDC, 0, 0, Pic.Handle, 0, x - 2, y - 2, Width, Height, lFlags Or DSS_NORMAL
            DeleteObject hBrush
        Case Disabled
            DrawState DestDC, hBrush, 0, Pic.Handle, 0, x, y, Width, Height, lFlags Or DSS_DISABLED
    End Select

End Sub

Private Sub Command1_Click()
    DrawButtonImage Me.hDC, 10, 10, 32, 32, Me.Icon, Normal
   
    DrawButtonImage Me.hDC, 10, 40, 32, 32, Me.Icon, Hot
   
    DrawButtonImage Me.hDC, 10, 80, 32, 32, Me.Icon, Pressed
   
    DrawButtonImage Me.hDC, 10, 120, 32, 32, Me.Icon, Disabled
End Sub

el problema es que no respeta las medidas en los iconos, por lo que si el icono es de 32x32 y vos lo queres mostrar de 16x16 no te lo ajusta. una opcion seria utilizar

Código: [Seleccionar]

Private Declare Function CopyImage Lib "user32.dll" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long
Private Const LR_COPYFROMRESOURCE As Long = &H4000
Private Const IMAGE_ICON As Long = 1


donde al cargar el icono lo redimencionas a las medidas que vos quieras, acordate que tenes que eliminarlo (DestroyIcon)

por ejemplo para copiar uno de 32x32 a 16x16

Código: [Seleccionar]

NewhIcon= CopyImage(hIcon, IMAGE_ICON, 16, 16, LR_COPYFROMRESOURCE)

Saludos.