Título: Fondo transparente
Publicado por: Alex_bro en 9 Mayo 2005, 16:10 pm
buenas , tengo la duda de si se puede poner el fondo del Form transparente , es decir sin color.
gracias y cuidense
Título: Re: Fondo transparente
Publicado por: Cicklow en 9 Mayo 2005, 16:21 pm
si esto se puede por medio de esto: '---------------------------------------------------------------------------------------------------- Attribute VB_Name = "Transparent" Option Explicit 'Declaraciones de los diferentes tipos de regiones a crear 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 CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long 'POINTAPI tipo requerido para CreatePolygonRgn Private Type POINTAPI X As Long Y As Long End Type 'Fija la region Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 'Combina la region Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long 'Tipo de combinacion Const RGN_XOR = 3 '---------------------------------------------------------------------------------------------------- Public Sub MakeTransparent(TransForm As Form) Dim ErrorTest As Double 'en caso de que haya un error, se ignora On Error Resume Next Dim Regn As Long Dim TmpRegn As Long Dim TmpControl As Control Dim LinePoints(4) As POINTAPI 'Puesto que las API trabajan en pixels, cambiamos el modo de escala a pixels TransForm.ScaleMode = 3 'Debe ejecutarse sobre un formulario son bordes. If TransForm.BorderStyle <> 0 Then MsgBox "Cambia el borderstyle a 0!", vbCritical, "ACK!": End 'Hace todo invisible Regn = CreateRectRgn(0, 0, 0, 0) 'Un bucle para controlar cada control en el formulario For Each TmpControl In TransForm 'Si el control es una linea... If TypeOf TmpControl Is Line Then 'Comprueba la inclinacion If Abs((TmpControl.Y1 - TmpControl.Y2) / (TmpControl.X1 - TmpControl.X2)) > 1 Then 'Si es mas vertical que horizontal entonces.. 'Fija los puntos LinePoints(0).X = TmpControl.X1 - 1 LinePoints(0).Y = TmpControl.Y1 LinePoints(1).X = TmpControl.X2 - 1 LinePoints(1).Y = TmpControl.Y2 LinePoints(2).X = TmpControl.X2 + 1 LinePoints(2).Y = TmpControl.Y2 LinePoints(3).X = TmpControl.X1 + 1 LinePoints(3).Y = TmpControl.Y1 Else 'Si es mas horizontal que vertical, entonces... 'Fija los puntos LinePoints(0).X = TmpControl.X1 LinePoints(0).Y = TmpControl.Y1 - 1 LinePoints(1).X = TmpControl.X2 LinePoints(1).Y = TmpControl.Y2 - 1 LinePoints(2).X = TmpControl.X2 LinePoints(2).Y = TmpControl.Y2 + 1 LinePoints(3).X = TmpControl.X1 LinePoints(3).Y = TmpControl.Y1 + 1 End If 'Crea el nuevo poligono con los puntos TmpRegn = CreatePolygonRgn(LinePoints(0), 4, 1) 'Si el control es una figura... ElseIf TypeOf TmpControl Is Shape Then 'si es asi, comprobamos el tipo If TmpControl.Shape = 0 Then 'Es un rectangulo TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height) ElseIf TmpControl.Shape = 1 Then 'Es un cuadrado If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width) Else TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height) End If ElseIf TmpControl.Shape = 2 Then 'Es un ovalo TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + TmpControl.Height + 0.5) ElseIf TmpControl.Shape = 3 Then 'Es un circulo If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 0.5) Else TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 0.5, TmpControl.Top + TmpControl.Height + 0.5) End If ElseIf TmpControl.Shape = 4 Then 'Es un rectangulo redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Width / 4, TmpControl.Width / 4) End If ElseIf TmpControl.Shape = 5 Then 'Es un cuadrado redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 1, TmpControl.Width / 4, TmpControl.Width / 4) End If End If 'Si el control es una figura con fondo transparente If TmpControl.BackStyle = 0 Then 'Combinamos la region en memoria y creamos una nueva CombineRgn Regn, Regn, TmpRegn, RGN_XOR If TmpControl.Shape = 0 Then 'Rectangulo TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + TmpControl.Height - 1) ElseIf TmpControl.Shape = 1 Then 'Cuadrado If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 1) Else TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 1, TmpControl.Top + TmpControl.Height - 1) End If ElseIf TmpControl.Shape = 2 Then 'Ovalo TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + TmpControl.Height - 0.5) ElseIf TmpControl.Shape = 3 Then 'Circulo If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 0.5) Else TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 0.5, TmpControl.Top + TmpControl.Height - 0.5) End If ElseIf TmpControl.Shape = 4 Then 'Rectangulo redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Width / 4, TmpControl.Width / 4) End If ElseIf TmpControl.Shape = 5 Then 'Cuadrado redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width, TmpControl.Width / 4, TmpControl.Width / 4) End If End If End If Else 'Crea una region rectangular con estos parametros TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height) End If 'Comprueba que el control tiene ancho o conseguiremos extraños resultados ErrorTest = 0 ErrorTest = TmpControl.Width If ErrorTest <> 0 Or TypeOf TmpControl Is Line Then 'Combina las regiones CombineRgn Regn, Regn, TmpRegn, RGN_XOR End If Next TmpControl 'Crea las regiones SetWindowRgn TransForm.hwnd, Regn, True
End Sub
'----------------------------------------------------------------------------------------------------
Esto lo que hace es dejar el form transparente y los controles NO :) Kual kier cosa: http://www.elguille.info/colabora/vb/lcg_Transparente.htm
Título: Re: Fondo transparente
Publicado por: Alex_bro en 9 Mayo 2005, 16:45 pm
gracias por responder , me da error en la siguiente linea: Attribute VB_Name = "Transparent" es posible que sea por que uso la version 6.0 de vb? salu2
Título: Re: Fondo transparente
Publicado por: Cicklow en 9 Mayo 2005, 16:48 pm
Borralo, ya que ese datos esta dentro del form y no en el codigo fuente. ese seria el nombre del formulario. SUerTE.
Título: Re: Fondo transparente
Publicado por: Alex_bro en 9 Mayo 2005, 20:26 pm
si... ya probe quitando esa linea pero no hace efecto , el Form sale con su color de fondo por defecto... es como si no tubiese puesto ningun codigo.
voy a seguir viendo haber si detecto el error. salu2 y grax.
PD: ya no me hace falta , solo sigo preguntando por si alguien tiene el mismo problema que yo y asi dejar el tema resuelto .
Título: Re: Fondo transparente
Publicado por: Cicklow en 9 Mayo 2005, 22:39 pm
Es facil eso es una funcion; solo coloka esto en el evento load del form
|