?
Solved

Transparent Forms?

Posted on 2003-03-11
8
Medium Priority
?
566 Views
Last Modified: 2007-12-19
I am able to fade a form in and out using the code below...

Option Explicit

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const ULW_OPAQUE = &H4
Private Const WS_EX_LAYERED = &H80000

Public Function IsTransparent(ByVal hWnd As Long) As Boolean
On Error Resume Next
Dim Msg As Long
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
  IsTransparent = True
Else
  IsTransparent = False
End If
If Err Then
  IsTransparent = False
End If
End Function

Public Function MakeTransparent(ByVal hWnd As Long, Perc As Integer) As Long
Dim Msg As Long
On Error Resume Next
If Perc < 0 Or Perc > 255 Then
  MakeTransparent = 1
Else
  Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
  Msg = Msg Or WS_EX_LAYERED
  SetWindowLong hWnd, GWL_EXSTYLE, Msg
  SetLayeredWindowAttributes hWnd, 0, Perc, LWA_ALPHA
  MakeTransparent = 0
End If
If Err Then
  MakeTransparent = 2
End If
End Function

Public Function MakeOpaque(ByVal hWnd As Long) As Long
Dim Msg As Long
On Error Resume Next
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
Msg = Msg And Not WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hWnd, 0, 0, LWA_ALPHA
MakeOpaque = 0
If Err Then
  MakeOpaque = 2
End If
End Function



Is there a way to make transparent picture boxes?
I couldnt get it to work so i tried using setParent to place the form inside the picture box then fade the form only the form wont fade inside the picture box??

Anybody know how to fade a picturebox or a form inside a picture box?

More points available for quick working answer.
0
Comment
Question by:crazyman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 14

Expert Comment

by:puranik_p
ID: 8110725
a workaround..
place a frame (or a form ?!??) in front of the picturebox. and manage its transperancy.
all the best!
0
 
LVL 3

Expert Comment

by:kokoloko
ID: 8111146
How about using regions?

Herés an example: open a new form, place a picturebox (Picture1) and paste the following code:


Option Explicit
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 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 Const RGN_DIFF = 4

Private Sub Form_Activate()
    Dim rgnForm As Long, rgnPictureBox As Long, rgnCombined As Long
    Dim borderWidth As Single, titleHeight As Single

    If Me.WindowState = vbMinimized Then
        Exit Sub
    End If

    ' Calculate the form border and title measures
    borderWidth = (Me.Width - Me.ScaleWidth) / 2
    titleHeight = Me.Height - Me.ScaleHeight - borderWidth
   
    ' Region for the whole form
    rgnForm = CreateRectRgn(0, 0, ScaleX(Me.Width, vbTwips, vbPixels), ScaleY(Me.Height, vbTwips, vbPixels))
    ' Region for the picture box
    rgnPictureBox = CreateRectRgn(ScaleX(Picture1.Left + borderWidth, vbTwips, vbPixels), ScaleY(Picture1.Top + titleHeight, vbTwips, vbPixels), ScaleX(Picture1.Left + Picture1.Width + borderWidth, vbTwips, vbPixels), ScaleY(Picture1.Top + Picture1.Height + titleHeight, vbTwips, vbPixels))
    ' Combined region
    rgnCombined = CreateRectRgn(0, 0, 0, 0)
   
    ' Make the picture box transparent by combining the two regions
    CombineRgn rgnCombined, rgnForm, rgnPictureBox, RGN_DIFF

    ' Set the clipping area of the window using the resulting region
    SetWindowRgn Me.hWnd, rgnCombined, True
    ' Tidy up
    DeleteObject rgnCombined
    DeleteObject rgnPictureBox
    DeleteObject rgnForm
End Sub

Run the project..... you'll have a transparent picture box.

0
 
LVL 1

Expert Comment

by:ocjared
ID: 8113319
Option Explicit

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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

Public Sub TransForm(frm As Form)
Const RGN_DIFF = 4
Const RGN_OR = 2

Dim outer_rgn As Long
Dim inner_rgn As Long
Dim wid As Single
Dim hgt As Single
Dim border_width As Single
Dim title_height As Single
Dim ctl_left As Single
Dim ctl_top As Single
Dim ctl_right As Single
Dim ctl_bottom As Single
Dim control_rgn As Long
Dim combined_rgn As Long
Dim ctl As Control

    If WindowState = vbMinimized Then Exit Sub

    ' Create the main form region.
    wid = ScaleX(Width, vbTwips, vbPixels)
    hgt = ScaleY(Height, vbTwips, vbPixels)
    outer_rgn = CreateRectRgn(0, 0, wid, hgt)

    border_width = (wid - ScaleWidth) / 2
    title_height = hgt - border_width - ScaleHeight
    inner_rgn = CreateRectRgn( _
        border_width, _
        title_height, _
        wid - border_width, _
        hgt - border_width)

    ' Subtract the inner region from the outer.
    combined_rgn = CreateRectRgn(0, 0, 0, 0)
    CombineRgn combined_rgn, outer_rgn, _
        inner_rgn, RGN_DIFF

    ' Create the control regions.
    For Each ctl In Controls
        If ctl.Container Is frm Then
            ctl_left = ScaleX(ctl.Left, frm.ScaleMode, vbPixels) _
                + border_width
            ctl_top = ScaleX(ctl.Top, frm.ScaleMode, vbPixels) _
                + title_height
            ctl_right = ScaleX(ctl.Width, frm.ScaleMode, vbPixels) _
                + ctl_left
            ctl_bottom = ScaleX(ctl.Height, frm.ScaleMode, vbPixels) _
                + ctl_top
            control_rgn = CreateRectRgn( _
                ctl_left, ctl_top, _
                ctl_right, ctl_bottom)
            CombineRgn combined_rgn, combined_rgn, _
                control_rgn, RGN_OR
        End If
    Next ctl

    ' Restrict the window to the region.
    SetWindowRgn hWnd, combined_rgn, True
End Sub

Private Sub Form_Load()
    Me.ScaleMode = 3
End Sub

Private Sub Form_Resize()
    GlassifyForm Me
End Sub


http://home.online.no/~rkaste/vb/vbhowto/glassh.htm
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 2

Accepted Solution

by:
JoaTex earned 2000 total points
ID: 8116883
Hi
Try This Litle Code and ypu4ll have your Transparent Forms:

In a Form Put a PictureBox Named= PicPrincipal
Put a Picture in The PictureBox
In That PictureBox put an empty Image Control to mark the area to unload the form.
Set form property Border Style = 0 - None

Now, after run the program with your mouse down over your picture you move the form.
When you click the area marked with your empty Image, you Close the form.

Put the code Module in a Module and the Code: in Your Form.

Module:

module:

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 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 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 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 CriarEfeito(PicEfeito As PictureBox) As Long
      Dim X, Y As Long                                'Coordenadas
      Dim LinhaInicial As Long                        'Linha Inicial
      Dim RegPreenchida As Long                 'Regico Final
      Dim RegLinha As Long                            'Regico Partida
      Dim CorTransparente As Long               'Cor Transparente
      Dim PrimeiraReg As Boolean                      'Indica se se encontra na Regico de Partida
      Dim NumaLinha As Boolean                  'Regico nco Transparente
      Dim hDC As Long                                 'handle contexto dispositivo
      Dim PicLargura As Long                    'largura imagem
      Dim PicAltura As Long                           'Altura Imagem
     
      hDC = PicEfeito.hDC                       'Definir picture box
      PicLargura = PicEfeito.ScaleWidth
      PicAltura = PicEfeito.ScaleHeight
      PrimeiraReg = True                              'Tudo no inmcio
      NumaLinha = False
      X = 0: Y = 0
      LinhaInicial = 0
      CorTransparente = GetPixel(hDC, 0, 0)     'Primeiro pixel canto esquerdo i cor transparente
     
      For Y = 0 To PicAltura - 1                'Duplo Loop pela pictue box
            For X = 0 To PicLargura - 1
                  If GetPixel(hDC, X, Y) = CorTransparente Or X = PicLargura Then
                        If NumaLinha Then                   'Atingimos um pixel transparente
                              NumaLinha = False
                              RegLinha = CreateRectRgn(LinhaInicial, Y, X, Y + 1)   'cria nova regico rectangular
                              If PrimeiraReg Then
                                    RegPreenchida = RegLinha      'Associa regico a nova regico rectangular Criada
                                    PrimeiraReg = False
                              Else
                                    CombineRgn RegPreenchida, RegPreenchida, RegLinha, RGN_OR   'Combinar duas regiues
                                    DeleteObject RegLinha         'libertar regico anterior
                              End If
                        End If
                  Else
                        If Not NumaLinha Then         'Atingimos pixel nco transparente
                              NumaLinha = True
                              LinhaInicial = X
                        End If
                  End If
            Next X
      Next Y
      CriarEfeito = RegPreenchida               'Associa fungco a regico criada
End Function

Code:

Option Explicit

Private Sub Form_Load()
      Dim Efeito As Long            'variavel para chamar fungco criar efeito
     
      PicPrincipal.ScaleMode = vbPixels   'Acerta propriedades para fungco API
      PicPrincipal.AutoRedraw = True
      PicPrincipal.AutoSize = True
      PicPrincipal.BorderStyle = vbBSNone
      PicPrincipal.Top = 0
      PicPrincipal.Left = 0
     
      'Set PicPrincipal.Picture = LoadPicture(App.Path & "\Imagem.bmp")
      Me.Width = PicPrincipal.Width             'Defenir tamanho picture box
      Me.Height = PicPrincipal.Height
     
      Efeito = CriarEfeito(PicPrincipal)              'Cria efeito
      SetWindowRgn Me.hWnd, Efeito, True        'Defenir regico de acordo com efeito
End Sub
Private Sub Image1_Click()
      End               'Sair
End Sub

Private Sub PicPrincipal_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      ReleaseCapture          'Mover Picture Box
      SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub

Hope You Like it.
Jo
0
 
LVL 13

Author Comment

by:crazyman
ID: 8118150
All these examples work well, however my code allows you to fade the transparency so as only to be partially transparent, these are completley transparent.

I wish to fade the transparency of a picture box?
0
 
LVL 2

Expert Comment

by:JoaTex
ID: 8119713
Hi Crazyman!

You didn't play with may code.
The form is Transparent? Yes
The picturebox is Transparent? Yes,PARTIALLY.

Well, I Explain how it Works.
When you put a picture on the picturebox, the program looks for the first pixel,(normally is the background)and turns that color transparent, that makes the picturebox partially transparent.

Making a litlle example:
Open your paint program and draw something on it.
Save the picture.
Load the picture in your program in PicPrincipal Picture Property.
When you run the program you'll see that all pixels of your color background are Transparent.

Try it. It Works
Jo

0
 
LVL 2

Expert Comment

by:JoaTex
ID: 8119749
Sorry, once again.
You can also Try to put some controls in your picture PicPrincipal and see what happens.Sorry bau this is a great code.
Jo
0
 
LVL 3

Expert Comment

by:kokoloko
ID: 8120077
crazyman:
  There's an example of fading only selected areas in vbaccelerator. Please follow this link:
http://www.vbaccelerator.com/home/VB/Code/Libraries/Graphics_and_GDI/Selection_Fade/article.asp

Using this, you can call FadeRect to fade only the picturebox you want.

JoaTex:
  I tried your code, and it does very cool stuff...
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month15 days, 6 hours left to enroll

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question