Forum - Visual Basic 6
- Form trasparente
.:ViRuS:. (Ex-Member)
Pro
Messaggi: 174
Iscritto: 01/06/2008
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
Ultima modifica effettuata da .:ViRuS:. il 14/06/2009 alle 12:36
giuggiolo (Normal User)
Newbie
Messaggi: 6
Iscritto: 14/06/2009
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:
Codice sorgente - presumibilmente VB.NET
' 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:
Codice sorgente - presumibilmente VB.NET
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:
Codice sorgente - presumibilmente VB.NET
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
.:ViRuS:. (Ex-Member)
Pro
Messaggi: 174
Iscritto: 01/06/2008
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?
theprogrammer (Normal User)
Guru^2
Messaggi: 2509
Iscritto: 28/01/2009
Postato originariamente da .:ViRuS:. :
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
giuggiolo (Normal User)
Newbie
Messaggi: 6
Iscritto: 14/06/2009
si, scusami, non ti ho postato le dichiarazioni dei tipi RECT e POINTAPI!
eccoli...
Codice sorgente - presumibilmente VB.NET
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
.:ViRuS:. (Ex-Member)
Pro
Messaggi: 174
Iscritto: 01/06/2008
ho problemi con questa parte di codice:
Codice sorgente - presumibilmente VB.NET
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?
Ultima modifica effettuata da .:ViRuS:. il 15/06/2009 alle 22:05
ruggy94 (Member )
Guru
Messaggi: 890
Iscritto: 21/04/2008
Postato originariamente da .:ViRuS:. :
con gli shape non da errori, però si vedono male.. cioè a metà non tutti interi.
In che senso? Magari posta uno screen per capirci meglio.
.:ViRuS:. (Ex-Member)
Pro
Messaggi: 174
Iscritto: 01/06/2008
RIIISOLTO
ho cambiato tipo di codice facendo delle ricerche...
ed ora funziona...
per gli interessati ecco il codice:
in un modulo:
Codice sorgente - presumibilmente VB.NET
''
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:
Codice sorgente - presumibilmente VB.NET
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
Ultima modifica effettuata da .:ViRuS:. il 15/06/2009 alle 23:06