1

深夜の星空観察用のプログラムを作成しようとしています。ラップトップの画面を赤だけにする必要があるため、赤のフィルターとして機能するプログラムを作成したいと考えています。画面全体を覆い、透明+赤になります。ユーザーはそれをクリックすることができます。これは、透明な赤いプラスチックを画面の前に置くようなものです。

これまでのところ、画面サイズに合わせてサイズを変更し、左上隅に移動するフォームがあります。少し透明で赤いです。

最終的にフォームを透明で赤くするため、フォームのすべてのクリックを通過させる必要がありますが、ユーザーがフォームを操作できないようにしたくありません。

プログラムは「Red_Filter」と呼ばれます

Public Class Form1

Dim Screens As Array
Dim TotalWidth As Integer
Dim TotalHeight As Integer
Dim Heights As List(Of Integer) = New List(Of Integer)

'Load / Close
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Screens = Screen.AllScreens

    For I As Integer = 0 To UBound(Screens)

        TotalWidth += Screens(I).Bounds.Width
        Heights.Add(Screens(I).Bounds.Height)

    Next

    TotalHeight = Heights.Max()

    Me.Width = TotalWidth
    Me.Height = TotalWidth

    Me.Location = New Point(0, 0)

    Me.BackColor = Color.Red
    Me.Opacity = 0.5
    Me.TopMost = True

    'Make it click through
    SetWindowLong(Me.Handle, GWL_EXSTYLE, WS_EX_TRANSPARENT)
End Sub


'Click Through Functionality
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const GWL_EXSTYLE = -20
Const WS_EX_TRANSPARENT = &H20

End Class

これは私がこれまでに持っていたもので、オンラインで見つけた「クリックスルー機能」の後の部分ですが、次のエラーが表示されます。

A call to PInvoke function 'Red Filter!Red_Filter.Form1::SetWindowLong' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.

オンラインで見つけたコードがどのように機能するかはわかりませんが、フォームのロード イベントの最後の行でエラーが発生します。

フォームをクリックスルーにする方法を知っている人はいますか?

4

5 に答える 5

3

このコードプロジェクトの投稿からコードをリッピングしました: http://www.codeproject.com/Articles/12877/Transparent-Click-Through-Forms

これは、すべてのコメントの良さを備えた複雑なバージョンです。

Imports System.Runtime.InteropServices

Public Class Form1

Private InitialStyle As Integer
Dim PercentVisible As Decimal

Private Sub Form_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    ' Grab the Extended Style information
    ' for this window and store it.
    InitialStyle = GetWindowLong(Me.Handle, GWL.ExStyle)
    PercentVisible = 0.8

    ' Set this window to Transparent
    ' (to the mouse that is!)

    ' This creates a new Extended Style
    ' for our window, which takes effect
    ' immediately upon being set, that
    ' combines the initial style of our window
    ' (saved in Form.Load) and adds the ability
    ' to be Transparent to the mouse.
    ' Both Layered and Transparent must be
    ' turned on for this to work AND have
    '  the window render properly!
    SetWindowLong(Me.Handle, GWL.ExStyle, InitialStyle Or WS_EX.Layered Or WS_EX.Transparent)

    ' Don't forget to set the Alpha
    ' for the window or else you won't be able
    ' to see the window! Possible values
    ' are 0 (visibly transparent)
    ' to 255 (visibly opaque). I'll set
    ' it to 70% visible here for show.
    ' The second parameter is 0, because
    ' we're not using a ColorKey!
    SetLayeredWindowAttributes(Me.Handle, 0, 255 * PercentVisible, LWA.Alpha)

    ' Just for giggles, set this window
    ' to stay on top of all others so we
    ' can see what's happening.
    Me.TopMost = True
    Me.BackColor = Color.Red
End Sub

Public Enum GWL As Integer
    ExStyle = -20
End Enum

Public Enum WS_EX As Integer
    Transparent = &H20
    Layered = &H80000
End Enum

Public Enum LWA As Integer
    ColorKey = &H1
    Alpha = &H2
End Enum

<DllImport("user32.dll", EntryPoint:="GetWindowLong")> _
Public Shared Function GetWindowLong( _
    ByVal hWnd As IntPtr, _
    ByVal nIndex As GWL _
        ) As Integer
End Function

<DllImport("user32.dll", EntryPoint:="SetWindowLong")> _
Public Shared Function SetWindowLong( _
    ByVal hWnd As IntPtr, _
    ByVal nIndex As GWL, _
    ByVal dwNewLong As WS_EX _
        ) As Integer
End Function

<DllImport("user32.dll", _
  EntryPoint:="SetLayeredWindowAttributes")> _
Public Shared Function SetLayeredWindowAttributes( _
    ByVal hWnd As IntPtr, _
    ByVal crKey As Integer, _
    ByVal alpha As Byte, _
    ByVal dwFlags As LWA _
        ) As Boolean
End Function
End Class

そして、これが私が使用している簡略化されたバージョンです。これは私にとってより理にかなっています:

Imports System.Runtime.InteropServices

Public Class Form1

Private InitialStyle As Integer
Dim PercentVisible As Decimal

Private Sub Form_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    InitialStyle = GetWindowLong(Me.Handle, -20)
    PercentVisible = 0.8

    SetWindowLong(Me.Handle, -20, InitialStyle Or &H80000 Or &H20)

    SetLayeredWindowAttributes(Me.Handle, 0, 255 * PercentVisible, &H2)

    Me.BackColor = Color.Red
    Me.TopMost = True
End Sub

<DllImport("user32.dll", EntryPoint:="GetWindowLong")> Public Shared Function GetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer) As Integer
End Function

<DllImport("user32.dll", EntryPoint:="SetWindowLong")> Public Shared Function SetWindowLong(ByVal hWnd As IntPtr, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
End Function

<DllImport("user32.dll", EntryPoint:="SetLayeredWindowAttributes")> Public Shared Function SetLayeredWindowAttributes(ByVal hWnd As IntPtr, ByVal crKey As Integer, ByVal alpha As Byte, ByVal dwFlags As Integer) As Boolean
End Function

End Class
于 2013-08-18T02:41:22.957 に答える
1

これを試して：

    Protected Overrides ReadOnly Property CreateParams() As CreateParams
    Get
        Const WS_EX_TRANSPARENT As Integer = &H20 'Check if it can
        Dim params As CreateParams = MyBase.CreateParams
        params.ExStyle = params.ExStyle Or WS_EX_TRANSPARENT
        Return params 'return
    End Get
End Property
于 2020-02-09T16:25:07.890 に答える