Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

como cambiar la imagen

Estas en el tema de como cambiar la imagen en el foro de Visual Basic clásico en Foros del Web. hola a todos los foreros! bueno lo q estoy tratando de hacer es q una aplicacion que estoy haciendo en visual basic se le pueda ...
  #1 (permalink)  
Antiguo 01/07/2005, 19:09
 
Fecha de Ingreso: mayo-2005
Mensajes: 65
Antigüedad: 18 años, 11 meses
Puntos: 0
como cambiar la imagen

hola a todos los foreros!
bueno lo q estoy tratando de hacer es q una aplicacion que estoy haciendo en visual basic se le pueda cambiar la imagen de fondo con el image control y un boton, con el comon dialog control tambien. o si ustedes saben de algo parecido diganme xq lo que quiero lograr es que paresca que tenga el efecto de q pueda tener skins. la aplicacion
  #2 (permalink)  
Antiguo 02/07/2005, 01:36
 
Fecha de Ingreso: abril-2005
Mensajes: 351
Antigüedad: 19 años
Puntos: 3
Este codgio lo puso un amigo [EX3] en el foro http://www.canalvisualbasic.net
(que te lo recomiendo)


Para crear el skin o piel de nuestra ventana utilizaremos la API de Windows para definir regiones en el formulario que sean visibles mediante una imagen. A continuacion muestro como hacerlo por codigo con ayuda solo de un PictureBox:

Primero crearemos un formulario y meteremos un PictureBox de nombre "picMainSkin" (el nombre se puede cambiar pero se debera cambiar tambien en el codigo del ejemplo) y despues crea un modulo *.bas. Dimensiona el PictureBox al tamaño que desees que tenga la ventana:

--[Module1.bas]------------------------------------------------
Option Explicit

Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_OR = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Public Function MakeRegion(picSkin As PictureBox) As Long

' Make a windows "region" based on a given picture box'
' picture. This done by passing on the picture line-
' by-line and for each sequence of non-transparent
' pixels a region is created that is added to the
' complete region. I tried to optimize it so it's
' fairly fast, but some more optimizations can
' always be done - mainly storing the transparency
' data in advance, since what takes the most time is
' the GetPixel calls, not Create/CombineRgn

Dim X As Long, Y As Long, StartLineX As Long
Dim FullRegion As Long, LineRegion As Long
Dim TransparentColor As Long
Dim InFirstRegion As Boolean
Dim InLine As Boolean ' Flags whether we are in a non-tranparent pixel sequence
Dim hDC As Long
Dim PicWidth As Long
Dim PicHeight As Long

hDC = picSkin.hDC
PicWidth = picSkin.ScaleWidth
PicHeight = picSkin.ScaleHeight

InFirstRegion = True: InLine = False
X = Y = StartLineX = 0

' The transparent color is always the color of the
' top-left pixel in the picture. If you wish to
' bypass this constraint, you can set the tansparent
' color to be a fixed color (such as pink), or
' user-configurable
TransparentColor = GetPixel(hDC, 0, 0)

For Y = 0 To PicHeight - 1
For X = 0 To PicWidth - 1

If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then
' We reached a transparent pixel
If InLine Then
InLine = False
LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)

If InFirstRegion Then
FullRegion = LineRegion
InFirstRegion = False
Else
CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
' Always clean up your mess
DeleteObject LineRegion
End If
End If
Else
' We reached a non-transparent pixel
If Not InLine Then
InLine = True
StartLineX = X
End If
End If
Next
Next

MakeRegion = FullRegion
End Function
-------------------------------------------------------------

--[Form1.frm]------------------------------------------------
Option Explicit

Sub Cargar_Skin()
'Este codigo es el responsable de cargar y crear las trasparencias en la ventana.
'Se necesita el modulo para ke funcione el programa.
'El skin lo carga en el control picture, ke es el ke dara la imagen del formulario.
Dim WindowRegion As Long

picMainSkin.ScaleMode = vbPixels
picMainSkin.AutoRedraw = True
picMainSkin.AutoSize = True
picMainSkin.BorderStyle = vbBSNone
Me.BorderStyle = vbBSNone

'Carga el fichero BMP con la imagen deseada de la ventana.
Set picMainSkin.Picture = LoadPicture(App.Path & "\main.bmp")

'Automaticamente se adapta la ventana al tamaño del skin.
Me.Width = picMainSkin.Width
Me.Height = picMainSkin.Height

'Crea la trasparencia usando el color ke linda con los limites de la imagen,
'en este caso el negro (puede ser otro color, depende el ke haga limite).
WindowRegion = MakeRegion(picMainSkin)
SetWindowRgn Me.hWnd, WindowRegion, True
End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Nos permite mover el formulario por la pantalla.

ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&

End Sub
-------------------------------------------------------------

Con esto la ventana tomara la forma del contorno del dibujo. Las partes que sean del mismo color que el primer Pixel del dibujo, por ejemplo Negro (vbBlack o RGB(0,0,0)), no seran dibujadas, haciendo transparente a la ventana dichas secciones.
  #3 (permalink)  
Antiguo 04/07/2005, 18:19
 
Fecha de Ingreso: mayo-2005
Mensajes: 65
Antigüedad: 18 años, 11 meses
Puntos: 0
ok gracias, lo voy a probar y si me funciona lo implementare si no lo volvere a plantear
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 10:30.