Insertar fotos transparentes

[XYON126]

Hola!

Una pregunta, en un formulario estoy insertando una foto como logo de fondo y esta su fondo es transparente (la de la foto) pero cuando me la visualiza me la pone en fondo blanco, he probado con todos los formatos validos para insertar fotos y en todos me sale con fondo blanco, ¿Existe alguna manera de hacer que su fondo transparente se active y vea como tal igual que se hace con un texto?

Muchas gracias

[pkj]

He estado investigando y he conseguido hacerlo, pero aunque parece algo simple me ha costado un montón y el código es bastante extenso. Si tienes mucho empeño te lo paso por si te vale. Yo recorté unos trozos a una foto y he conseguido que se transparenten, pero igual con tu foto no sirve, ¿quien sabe?

Saludos

PD:

Lo he conseguido con menos código, aunque me ha costado.

El caso es que el código que encontré funcionaba, pero la imagen no se quedaba fija. Cuando minimizaba el form o ponía otra ventana delante, al volver a mostrarlo la imagen se había borrado.

Despues de mucho pensar he encontrado una solución que no conlleva meter otro tanto código, (que no es poco el que lleva), solo para fijar la imagen. Simplemente la repinto cuando hace falta.

En fín, este es el código:

Esto va en un módulo

Código vb:

Option Explicit
 
Dim hRgn As Long
 
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
 
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
 
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
 
Private Sub SetRegion(ShapedObject As Object)
  On Local Error Resume Next
  If hRgn Then DeleteObject hRgn
  hRgn = GetBitmapRegion(ShapedObject.Picture, vbWhite)
  SetWindowRgn ShapedObject.hwnd, hRgn, True
End Sub
 
Private Function GetBitmapRegion(cPicture As StdPicture, cTransparent As Long) As Long
  Dim hRgn As Long, tRgn As Long
  Dim x As Integer, y As Integer, X0 As Integer
  Dim hDC As Long, BM As BITMAP
  On Local Error Resume Next
  hDC = CreateCompatibleDC(0)
  If hDC Then
    SelectObject hDC, cPicture
    GetObject cPicture, Len(BM), BM
    hRgn = CreateRectRgn(0, 0, BM.bmWidth, BM.bmHeight)
    For y = 0 To BM.bmHeight
      For x = 0 To BM.bmWidth
        While x <= BM.bmWidth And GetPixel(hDC, x, y) <> cTransparent
          x = x + 1
        Wend
        X0 = x
        While x <= BM.bmWidth And GetPixel(hDC, x, y) = cTransparent
          x = x + 1
        Wend
        If X0 < x Then
          tRgn = CreateRectRgn(X0, y, x, y + 1)
          CombineRgn hRgn, hRgn, tRgn, 4
          DeleteObject tRgn
        End If
      Next x
    Next y
    GetBitmapRegion = hRgn
    DeleteObject SelectObject(hDC, cPicture)
  End If
  DeleteDC hDC
End Function
 
Sub CargaImagenTransp(Fichero As String, Picture As PictureBox)
  On Local Error Resume Next
  Picture.Visible = False
  Picture.Picture = LoadPicture(Fichero)
  SetRegion Picture
  Picture.Visible = True
End Sub
 
Sub RefrescaImagen(Fichero As String, Picture As PictureBox)
  On Local Error Resume Next
  Picture.Picture = LoadPicture(Fichero)
  SetWindowRgn Picture.hwnd, hRgn, True
End Sub
 

Y esto en el form.

Código vb:

Option Explicit
Dim FicheroImagen As String
 
Private Sub Form_Load()
  On Local Error Resume Next
  Me.AutoRedraw = False
  Picture1.AutoSize = True
  FicheroImagen = App.Path & "\foto.jpg"
  CargaImagenTransp FicheroImagen, Picture1
End Sub
 
Private Sub Form_Paint()
  RefrescaImagen FicheroImagen, Picture1
End Sub
 

Solo hay que indicar en el Load la foto que quieres cargar.

Espero que a alguien le sirva. Yo me lo guardaré, aunque seguro que si un día lo necesito no lo encontraré.

Saludos

[XYON126]

Hola pkj!

Gracias por el curro que te has pegado no era necesario a ese nivel pero si como información, la verdad es que comentaba que era para poder insertar un logo de fondo transparente en un formulario, supongo que lo que has creado servira aunque con tanto codigo, casi vale la pena mejor el cambiarle el fondo del logo y ponerle el mismo que el del fornulario, pero aún asi muchas gracias de todo corazon.

Un saludo