Jag har försökt olika sätt att få en transparant label och form men jag vill texten i formen ska synas. Om du vill bara rita ut text på skärmen. Föreslår jag att du har ett tomtvormulär utan kanter. Skapar en region med textn. och sätter det till formulärets region. Om man vill att knappar och andra saker på formen ska vara synliga men inte själva formen, hur gör man då? Du får skapa en region som överensstämmer med dina kontroller. Här är ett exempel för rektangulära kontroller:Transparant Label och form
Någon som har en fungerande kod att ge mig?Sv: Transparant Label och form
Här är ett exempel:
<code>
' * Sätt borderstyle på formuläret till none
' * Klistra in följande kod
Option Explicit
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount 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 Sub Form_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim hRgn As Long
Const sText = "Click Here!"
Me.FontName = "Times New Roman"
Me.FontSize = 72
Me.BackColor = vbRed
Move Left, Top, TextWidth(sText), TextHeight(sText)
BeginPath Me.hdc
TextOut Me.hdc, 0, 0, sText, Len(sText)
EndPath Me.hdc
hRgn = PathToRegion(Me.hdc)
SetWindowRgn Me.hWnd, hRgn, True
DeleteObject hRgn
End Sub
</code>Sv: Transparant Label och form
Sv: Transparant Label och form
<code>
Option Explicit
Private Const RGN_OR As Long = 2
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Sub Form_Click()
Unload Me
End Sub
Function ControlRgn(ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long)
ControlRgn = CreateRectRgn(Left, Top, Left + Width, Top + Height)
End Function
Private Sub Form_Load()
Dim Ctrl As Control
Dim hRgn As Long
Dim hResultRgn As Long
Dim lpRect As RECT
Dim lpPoint As POINTAPI
Dim OffsetX As Long
Dim OffsetY As Long
GetWindowRect Me.hwnd, lpRect
ClientToScreen Me.hwnd, lpPoint
OffsetX = lpPoint.x - lpRect.Left
OffsetY = lpPoint.y - lpRect.Top
ScaleMode = vbPixels
For Each Ctrl In Me.Controls
hRgn = ControlRgn(OffsetX + Ctrl.Left, OffsetY + Ctrl.Top, Ctrl.Width, Ctrl.Height)
If hResultRgn Then
Debug.Print CombineRgn(hResultRgn, hResultRgn, hRgn, RGN_OR)
DeleteObject hRgn
Else
hResultRgn = hRgn
End If
Next
SetWindowRgn Me.hwnd, hResultRgn, True
DeleteObject hResultRgn
End Sub
</code>
Kommer inte fungera om du har en meny. Vilket saknar position men finns med i Controls.