Visual Basic 6 - Form trasparente

Ciao a tutti ragazzi volevo sapere.. pura curiosità... è possibile far si che un form diventi trasparente?


so che si può.. ho degli esempi sul mio pc che fanno appunto questo..


però io vorrei che il form diventi trasparente lasciando solo degli shape


per esempio metto una linea rossa, e il form che è trasparente

quando lo apro il form nn si vede.. ma si vede solo la linea..

Spero di essere stato chiaro...

Potete darmi una mano voi? Grazie

ciao virus!

ho avuto la necessità anche io di rendere trasparente un form in un mio programma e cercando in Internet ho trovato il seguente codice...

incolla questo nel tuo form all'avvio:

    ' form trasparente
    For Each controllo In Me.Controls
        NumControlli = NumControlli + 1
    Next
    x = 0
    Me.ScaleMode = vbPixels
    ReDim obj(NumControlli - 1, 3) As Integer
    For Each controllo In Me.Controls
        On Error GoTo prossimo
        obj(x, 0) = controllo.Left
        obj(x, 1) = controllo.Top
        obj(x, 2) = controllo.Width
        obj(x, 3) = controllo.Height
        x = x + 1
'prossimo:
    Next
    SetTransparent frmPrincipale, obj
    ' fine form trasparente

e questo codice dove vuoi, in un modulo o nello stesso form:

Public Sub SetTransparent(frm As Form, obj() As Integer)
Dim rctClient As RECT, rctFrame As RECT
Dim hClient As Long, hFrame As Long, hObj As Long
Dim Start As Integer, Finish As Integer, i As Integer
Dim lpTL As POINTAPI, lpBR As POINTAPI

GetWindowRect frm.hWnd, rctFrame
GetClientRect frm.hWnd, rctClient

lpTL.x = rctFrame.Left
lpTL.Y = rctFrame.Top
lpBR.x = rctFrame.Right
lpBR.Y = rctFrame.Bottom
ScreenToClient frm.hWnd, lpTL
ScreenToClient frm.hWnd, lpBR
rctFrame.Left = lpTL.x
rctFrame.Top = lpTL.Y
rctFrame.Right = lpBR.x
rctFrame.Bottom = lpBR.Y
rctClient.Left = Abs(rctFrame.Left)
rctClient.Top = Abs(rctFrame.Top)
rctClient.Right = rctClient.Right + Abs(rctFrame.Left)
rctClient.Bottom = rctClient.Bottom + Abs(rctFrame.Top)
rctFrame.Right = rctFrame.Right + Abs(rctFrame.Left)
rctFrame.Bottom = rctFrame.Bottom + Abs(rctFrame.Top)
rctFrame.Top = 0
rctFrame.Left = 0
hClient = CreateRectRgn(rctClient.Left, rctClient.Top, rctClient.Right, rctClient.Bottom)
hFrame = CreateRectRgn(rctFrame.Left, rctFrame.Top, rctFrame.Right, rctFrame.Bottom)
Dim mode As Integer
mode = frm.ScaleMode
frm.ScaleMode = 3
CombineRgn hFrame, hClient, hFrame, RGN_XOR
Start = LBound(obj)
Finish = UBound(obj)

For i = Start To Finish
    hObj = CreateRectRgn(obj(i, 0), obj(i, 1), obj(i, 0) + obj(i, 2), obj(i, 1) + obj(i, 3))
    CombineRgn hFrame, hObj, hFrame, RGN_OR
Next

SetWindowRgn frm.hWnd, hFrame, True
frm.ScaleMode = mode
End Sub

in un modulo inserisci queste righe:

Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long
Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3

finito!
Facci sapere!

Giuggiolo

Ciao Giuggiolo grazie della risposta.


c'è un'errore quando faccio partire il programma.. mi dice tipo definito dall'utente non definito.. e mi segnala


Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long

dov'è può essere il problema?

Ovviamente manca la dichiarazione della struttura RECT

si, scusami, non ti ho postato le dichiarazioni dei tipi RECT e POINTAPI!

eccoli...

Type POINTAPI
    x As Long
    Y As Long
End Type


Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

facci sapere!

Giulio

ho problemi con questa parte di codice:

Private Sub Form_Load()
    ' form trasparente
    For Each controllo In Me.Controls
        NumControlli = NumControlli + 1
    Next
    x = 0
    Me.ScaleMode = vbPixels
    ReDim obj(NumControlli - 1, 3) As Integer
    For Each controllo In Me.Controls
        'On Error GoTo prossimo
        obj(x, 0) = controllo.Left
        obj(x, 1) = controllo.Top
        obj(x, 2) = controllo.Width
        obj(x, 3) = controllo.Height
        x = x + 1
'prossimo:
    Next
    SetTransparent Form1, obj
    ' fine form trasparente
End Sub

mi dice :indice non compreso nell'intervallo..
e mi evidenzia questo: ReDim obj(NumControlli - 1, 3) As Integer

scusate la mia ignoranza ma non riesco a capire cosa sia...


EDIT:

se metto controlli tipo commandbutton option o altro.. non da problemi...

ma se non metto controlli O METTO SOLO UNO SHAPE SUL FORM..

mi da questo errore :S


e la mia domanda era proprio questa.. form trasparente solo con uno shape sopra.. è possibile?

RIEDIT:

con gli shape non da errori, però si vedono male.. cioè a metà non tutti interi.

come mai?

In che senso? Magari posta uno screen per capirci meglio.

RIIISOLTO


ho cambiato tipo di codice facendo delle ricerche...

ed ora funziona...


per gli interessati ecco il codice:


in un modulo:

''
Option Explicit
Public visu As String

Const SW_SHOWNORMAL = 1

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

nel form:

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 FormTrasparente(frm As Form)
on error resume next
    frm.ScaleMode = vbPixels
    Const RGN_DIFF = 4
    Const RGN_OR = 2

    Dim rgn_esclusa As Long
    Dim rgn_inclusa As Long
    Dim rgn_combinate As Long
    Dim wid As Single
    Dim hgt As Single
    Dim border_width As Single
    Dim title_height As Single
    Dim control_rgn As Long

    If frm.WindowState = vbMinimized Then Exit Sub

    ' Crea la regione principale del form.
    wid = frm.ScaleX(frm.Width, vbTwips, vbPixels)
    hgt = frm.ScaleY(frm.Height, vbTwips, vbPixels)
    rgn_esclusa = CreateRectRgn(0, 0, wid, hgt)

    border_width = (wid - frm.ScaleWidth) / 2
    title_height = hgt - border_width - frm.ScaleHeight
    rgn_inclusa = CreateRectRgn(border_width, title_height, wid - border_width, _
        hgt - border_width)

    ' Esclude la sezione inclusa da quella esclusa.
    rgn_combinate = CreateRectRgn(0, 0, 0, 0)
    CombineRgn rgn_combinate, rgn_esclusa, rgn_inclusa, RGN_DIFF
   For Each ctl In frm.Controls
        If ctl.Container Is frm Then
            ctl_left = frm.ScaleX(ctl.Left, frm.ScaleMode, vbPixels) _
                + border_width
            ctl_top = frm.ScaleX(ctl.Top, frm.ScaleMode, vbPixels) + title_height
            ctl_right = frm.ScaleX(ctl.Width, frm.ScaleMode, vbPixels) + ctl_left
            ctl_bottom = frm.ScaleX(ctl.Height, frm.ScaleMode, vbPixels) + ctl_top
            control_rgn = CreateRectRgn(ctl_left, ctl_top, ctl_right, ctl_bottom)
            CombineRgn rgn_combinate, rgn_combinate, control_rgn, RGN_OR
        End If

    Next ctl

    'Limita la form alla regione
    SetWindowRgn frm.hwnd, rgn_combinate, True
End Sub

Private Sub Form_Resize()
    FormTrasparente Me
End Sub