Lock workstation III



Picture 1 

\


    As shown in Picture 1, before you copy and paste the following code to be compiled, not only the project MyBlog_Created_202407_09 must be created,but also the code CodeFile1.vb has to be added in.


Picture 2

Imports System.Runtime.InteropServices
Partial Public Class Form1
    Private Sub Form1_HandleCreated(sender As Object, e As EventArgs) Handles Me.HandleCreated
        MyCode_put_in_This_module.DeleteBlankLines = New Delete_Blank_Lines(CType(sender, Form1).Handle)
        RegisterHotKey(Me.Handle, HotKey_ID1, MOD_ALT Or MOD_NOREPEAT, CUInt(Keys.A))
        RegisterHotKey(Me.Handle, HotKey_ID2, MOD_ALT Or MOD_NOREPEAT, CUInt(Keys.B))
    End Sub
    Protected Overrides Sub WndProc(ByRef m As Message)
        If m.Msg = WM_HOTKEY Then
            MyCode_put_in_This_module.OnHotKey(m)
        ElseIf m.Msg = WM_PARENTNOTIFY Then
            MyCode_put_in_This_module.OnParentNotify(m)
        ElseIf m.Msg = WM_SIZE Then
            Previous_WMsize = WMsize
            WMsize = m.WParam
        End If
        MyBase.WndProc(m)
    End Sub
    Private Sub Form1_HandleDestroyed(sender As Object, e As EventArgs) Handles Me.HandleDestroyed
        UnregisterHotKey(Me.Handle, HotKey_ID1)
        UnregisterHotKey(Me.Handle, HotKey_ID2)
        MyCode_put_in_This_module.GetMyWindowPlacement(Me.Handle)
        MyCode_put_in_This_module.DeleteBlankLines.Dispose()
    End Sub
End Class
Partial Module MyCode_put_in_This_module
    Sub GetMyWindowPlacement(hWnd As IntPtr)
        Dim ptr_winpl As IntPtr = Marshal.AllocHGlobal(1000)
        Marshal.WriteInt32(ptr_winpl, WinPL_Len)
        If GetWindowPlacement(hWnd, ptr_winpl) Then
            Dim winPL_Bytes(WinPL_Len) As Byte
            Marshal.Copy(ptr_winpl, winPL_Bytes, 0, WinPL_Len)
            Interaction.SaveSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
             "MySection", "winPL", BitConverter.ToString(winPL_Bytes).Replace("-", ""))
        End If
    End Sub
    Sub SetMyWindowPlacement(hWnd As IntPtr)
        Try
            Dim winPL_string As String =
            Interaction.GetSetting(Reflection.Assembly.GetExecutingAssembly.GetName.Name,
             "MySection", "winPL")
            Dim winPL_Bytes(WinPL_Len) As Byte
            For index As Int32 = 0 To WinPL_Len - 1
                winPL_Bytes(index) = Convert.ToByte(winPL_string.Substring(index * 2, 2), 16)
            Next
            Dim ptr_winPL As IntPtr = Marshal.AllocHGlobal(1000)
            Marshal.Copy(winPL_Bytes, 0, ptr_winPL, WinPL_Len)
            If Not SetWindowPlacement(hWnd, ptr_winPL) Then
                'MsgBox("SetWindowPlacement fault", Title:=My.User.Name)
            End If
            Marshal.FreeHGlobal(ptr_winPL)
        Catch ex As Exception

        End Try
    End Sub
    Sub DeleteBlankLines_method()
        If Clipboard.ContainsText() Then
            Dim ClipboardText As String = Clipboard.GetText()
            Dim str() As String = ClipboardText.Split(New String() {NewLine},
                                     StringSplitOptions.RemoveEmptyEntries)
            Dim str_settext As String = String.Join(NewLine, str, 0, str.Length)
            If Not String.IsNullOrWhiteSpace(str_settext) Then
                Clipboard.SetText(str_settext)
                System.Media.SystemSounds.Beep.Play()
                TextBox1.WriteLine($"Delete blank lines[{str.Length}]")
                Exit Sub
            End If
        End If
        TextBox1.WriteLine("Do nothing on clipboard")
    End Sub
    Sub OnHotKey(ByRef m As Message)
        If m.WParam.ToInt32 = HotKey_ID1 Then
            Dim hWnd As IntPtr = Form1.Handle
            If WMsize = SIZE_MINIMIZED Then
                Dim s As Int32
                If Previous_WMsize >= SIZE_MAXIMIZED Then
                    s = SW_SHOWMAXIMIZED
                Else
                    s = SW_RESTORE
                End If
                ShowWindow(hWnd, s)
            End If
            'SetFocus_To_Specified_hWnd(hWnd) 'AppActivate("Form1")
            SetFocus_To_Specified_hWnd(DeleteBlankLines.Handle)
        ElseIf m.WParam.ToInt32 = HotKey_ID2 Then
            TextBox1.WriteLine(NotifyStrings.ToString)
            AppendLineScroll += count_Notify
        End If
    End Sub
    Enum NotifyEvent As UInt16
        CreateWindow = WM_CREATE
        DestroyWindow = WM_DESTROY
        MiddleBnDown = WM_MBUTTONDOWN
        LeftBnDown = WM_LBUTTONDOWN
        RighrBnDown = WM_RBUTTONDOWN
    End Enum
    Sub OnParentNotify(ByRef m As Message)
        NotifyStrings.Append($"{count_Notify,4}:")
        Dim LoWord As UInt16 = CUShort(m.WParam.ToInt32 And &HFFFF)
        NotifyStrings.Append($"{CType(LoWord, NotifyEvent),-16}")
        Select Case LoWord
            Case WM_CREATE, WM_DESTROY
                Dim HiWord As UInt16 = CUShort((m.WParam.ToInt32 >> 16) And &HFFFF)
                NotifyStrings.Append($" id={HiWord,-7:X} ")
                Dim ptr_classname = Marshal.AllocHGlobal(1000)
                GetClassName(m.LParam, ptr_classname, 500)
                NotifyStrings.Append(Marshal.PtrToStringUni(ptr_classname))
                Marshal.FreeHGlobal(ptr_classname)
            Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
                NotifyStrings.Append(
        $" (X={(m.LParam.ToInt64 And &HFFFF),4},Y={(m.LParam.ToInt64 >> 16),4})")
        End Select
        NotifyStrings.AppendLine()
        count_Notify += 1
    End Sub
    Sub Application_Idle(sender As Object, e As EventArgs)
        RemoveHandler Application.Idle, AddressOf Application_Idle
        TextBox1.WriteLine("Application_Idle")
        MyCode_put_in_This_module.SetMyWindowPlacement(Form1.Handle)
        SetFocus_To_Specified_hWnd(DeleteBlankLines.Handle)
    End Sub
    Sub OnPaint(ByRef m As Message, Color_rgb_brush As UInt32)
        Const X_Max As Int32 = 180 - 1, Y_max As Int32 = 30 + (30 + edge) - 1

        Dim ptr_Rect As IntPtr = Marshal.AllocHGlobal(100)
        Dim ptr_PS As IntPtr = Marshal.AllocHGlobal(1000)
        Dim hdc As IntPtr = BeginPaint(m.HWnd, ptr_PS)

        SelectObject(hdc, GetStockObject(DC_PEN))
        SelectObject(hdc, GetStockObject(DC_BRUSH))
        Dim color_pen As UInt32 = SetDCPenColor(hdc, RGB(255, 0, 0))
        Dim color_Brush As UInt32 = SetDCBrushColor(hdc, Color_rgb_brush)
        Rectangle(hdc, 2, 2, X_Max - 1, Y_max - 1)
        SetDCPenColor(hdc, color_pen)
        SetDCBrushColor(hdc, color_Brush)

        Dim ctext As UInt32 = SetTextColor(hdc, &HFF00FF)
        Dim cbk As UInt32 = SetBkColor(hdc, &HFF0000)
        Dim rect As New Rect With {.left = 1, .top = 1, .right = X_Max - 1, .bottom = Y_max - 1}
        Marshal.StructureToPtr(Of Rect)(rect, ptr_Rect, False)
        Dim pOldFont As IntPtr = SelectObject(hdc, DeleteBlankLines.NewFont.ToHfont)
        Const BN_Name As String = "Delete blank lines"
        ExtTextOut(hdc, 6, 20, ETO_CLIPPED, ptr_Rect, BN_Name, CUInt(BN_Name.Length), Nothing)
        SelectObject(hdc, pOldFont)
        SetBkColor(hdc, cbk)
        SetTextColor(hdc, ctext)

        MoveToEx(hdc, 0, 0, NULL)
        LineTo(hdc, 0, Y_max)
        LineTo(hdc, X_Max, Y_max)
        LineTo(hdc, X_Max, 0)
        LineTo(hdc, 0, 0)

        EndPaint(m.HWnd, ptr_PS)
        Marshal.FreeHGlobal(ptr_PS)
        Marshal.FreeHGlobal(ptr_Rect)
    End Sub
    Class Delete_Blank_Lines
        Inherits NativeWindow
        Implements IDisposable
        Protected Overrides Sub WndProc(ByRef m As Message)
            Select Case m.Msg
                Case WM_PAINT
                    If bSetFocus Then
                        OnPaint(m, color_rgb_Brush)
                        m.Result = NULL
                        Exit Sub
                    End If
                Case WM_MOUSELEAVE
                    If bSetFocus Then
                        Me.color_rgb_Brush = RGB(10, 100, 200)
                        RedrawWindow(DeleteBlankLines.Handle, NULL, NULL, RDW_INVALIDATE)
                        m.Result = NULL
                        Exit Sub
                    End If
                Case WM_MOUSEMOVE
                    If bSetFocus Then
                        Me.color_rgb_Brush = RGB(0, 255, 0)
                        RedrawWindow(DeleteBlankLines.Handle, NULL, NULL, RDW_INVALIDATE)
                        m.Result = NULL
                        SetMouseEvent(TME_HOVER, 500)
                        SetMouseEvent(TME_LEAVE, 10)
                        Exit Sub
                    End If
                Case WM_MOUSEHOVER
                    If bSetFocus Then
                        Me.color_rgb_Brush = RGB(WhiteToDark, WhiteToDark, WhiteToDark)
                        RedrawWindow(DeleteBlankLines.Handle, NULL, NULL, RDW_INVALIDATE)
                        m.Result = NULL
                        SetMouseEvent(TME_HOVER, 200)
                        If WhiteToDark > 20 Then
                            WhiteToDark -= 20
                        Else
                            WhiteToDark = 255
                        End If
                        Exit Sub
                    End If
                Case WM_KEYDOWN
                    If m.WParam.ToInt32 = Keys.Return Then DeleteBlankLines_method()
                    m.Result = NULL
                    Exit Sub
                Case WM_LBUTTONDOWN
                    DeleteBlankLines_method()
                    SetFocus_To_Specified_hWnd(DeleteBlankLines.Handle)
                    m.Result = NULL
                    Exit Sub
                Case WM_SETFOCUS
                    bSetFocus = True : WhiteToDark = 255
                    Me.color_rgb_Brush = RGB(10, 100, 200)
                    RedrawWindow(DeleteBlankLines.Handle, NULL, NULL, RDW_INVALIDATE)
                    SetMouseEvent(TME_HOVER, 500)
                    m.Result = NULL
                    Exit Sub
                Case WM_KILLFOCUS
                    bSetFocus = False
                    RedrawWindow(DeleteBlankLines.Handle, NULL, NULL, RDW_INVALIDATE)
                    m.Result = NULL
                    Exit Sub
                Case WM_DROPFILES
                    Dim CountOfFile As UInt32 = DragQueryFile(m.WParam, &HFFFFFFFFUI, NULL, 0)
                    Dim index As UInt32 = 0
                    ' TextBox1.WriteLine($"Total Drop Files is {CountOfFile}")
                    Dim ptr_files As IntPtr = Marshal.AllocHGlobal(2000)
                    For index = 0 To CountOfFile - 1UI
                        DragQueryFile(m.WParam, index, ptr_files, 1000UI)
                        Dim filename As String = Marshal.PtrToStringUni(ptr_files)
                        TextBox1.WriteLine($"DropFile({index})={filename}")
                    Next
                    Marshal.FreeHGlobal(ptr_files)
                    DragFinish(m.WParam)
            End Select
            MyBase.WndProc(m)
        End Sub
        Sub SetMouseEvent(Flags As UInt32, Time As UInt32)
            Dim ptr_TME As IntPtr = Marshal.AllocHGlobal(200)
            Dim TME As New TRACK_MOUSEEVENT With {
                   .DWORD_cbSize = Marshal.SizeOf(Of TRACK_MOUSEEVENT)(),
                   .HWND_hwndTrack = Handle,
                   .DWORD_dwFlags = Flags,
                   .DWORD_dwHoverTime = Time}
            Marshal.StructureToPtr(Of TRACK_MOUSEEVENT)(TME, ptr_TME, False)
            If Not TrackMouseEvent(ptr_TME) Then
                MsgBox($"Error:TrackMouseEvent with flags {Flags}")
            End If
            Marshal.FreeHGlobal(ptr_TME)
        End Sub
        Public Sub New(hWnd_Parent As IntPtr)
            AddHandler Application.Idle, AddressOf Application_Idle
            For Each name As String In NewFontFamilyNames
                Try
                    Dim [FontFamily] As FontFamily
                    [FontFamily] = New System.Drawing.FontFamily(name)
                    If [FontFamily] IsNot Nothing Then
                        NewFont = New Drawing.Font([FontFamily], 18,
                           FontStyle.Regular, GraphicsUnit.World)
                        Exit For
                    End If
                Catch ex As Exception
                End Try
            Next
            NotifyStrings = New Text.StringBuilder(4 << 20)
            NotifyStrings.AppendLine(
             "List ParentNotify messages of childwindows in Form1 except 'DeleteBlankLines'")
            count_Notify = 1

            Dim cp As New CreateParams With {
              .Parent = hWnd_Parent,
              .Caption = "Delete blank lines",
              .ClassName = "BUTTON",
              .Style = WS_CHILD Or WS_VISIBLE Or WS_TABSTOP,
              .ExStyle = WS_EX_NOPARENTNOTIFY Or WS_EX_ACCEPTFILES,
              .X = edge, .Y = 2 * (30 + edge) + edge,
              .Width = 180, .Height = 30 + (30 + edge)}
            CreateHandle(cp)
        End Sub
        Public NewFont As Font
        Public bSetFocus As Boolean
        Dim WhiteToDark As UInt16
        Dim color_rgb_Brush As UInt32
        Public ReadOnly NewFontFamilyNames() As String = {
          "微軟正黑體", "標楷體", "細明體-ExtB", "Candara", "Consolas", "Ink Free",
          "Lucida Console", "Times New Roman", "Microsoft Sans Serif"}

        Private disposedValue As Boolean
        Protected Overridable Sub Dispose(disposing As Boolean)
            If Not disposedValue Then
                If disposing Then
                    NewFont.Dispose()
                End If
                DestroyHandle()
                disposedValue = True
            End If
        End Sub
        Protected Overrides Sub Finalize()
            Dispose(disposing:=False)
            MyBase.Finalize()
        End Sub
        Public Sub Dispose() Implements IDisposable.Dispose
            Dispose(disposing:=True)
            GC.SuppressFinalize(Me)
        End Sub
    End Class
    Public DeleteBlankLines As Delete_Blank_Lines
    Public NotifyStrings As Text.StringBuilder
    Public count_Notify As Int32
    Public Const WinPL_Len As Int32 = &H2C
    Public Const HotKey_ID1 As Int32 = 1
    Public Const HotKey_ID2 As Int32 = 2
    Public WMsize, Previous_WMsize As Int32
    ReadOnly NewLine As String = Environment.NewLine

    Public Const MOD_ALT As UInt32 = &H1
    Public Const MOD_NOREPEAT As UInt32 = &H4000
    Public Const WM_CREATE As UInt32 = &H1
    Public Const WM_DESTROY As UInt32 = &H2
    Public Const WM_HOTKEY As UInt32 = &H312
    Public Const WM_PAINT As UInt32 = &HF
    Public Const WM_KEYDOWN As UInt32 = &H100
    Public Const WM_PARENTNOTIFY As UInt32 = &H210
    Public Const WM_RBUTTONDOWN As UInt32 = &H204
    Public Const WM_MBUTTONDOWN As UInt32 = &H207
    Public Const WM_MOUSEHOVER As UInt32 = &H2A1
    Public Const WM_MOUSELEAVE As UInt32 = &H2A3
    Public Const WM_MOUSEMOVE As UInt32 = &H200

    Public Const DC_BRUSH As Int32 = 18
    Public Const DC_PEN As Int32 = 19
    Public Const ETO_CLIPPED As UInt32 = &H4
    Public Const WS_EX_NOPARENTNOTIFY As UInt32 = &H4L
    Public Const WS_EX_ACCEPTFILES As UInt32 = &H10L
    Public Const WM_DROPFILES As UInt32 = &H233
    Public Const SW_HIDE As Int32 = 0
    Public Const SW_SHOWNORMAL As Int32 = 1
    Public Const SW_NORMAL As Int32 = 1
    Public Const SW_SHOWMINIMIZED As Int32 = 2
    Public Const SW_SHOWMAXIMIZED As Int32 = 3
    Public Const SW_MAXIMIZE As Int32 = 3
    Public Const SW_SHOWNOACTIVATE As Int32 = 4
    Public Const SW_SHOW As Int32 = 5
    Public Const SW_MINIMIZE As Int32 = 6
    Public Const SW_SHOWMINNOACTIVE As Int32 = 7
    Public Const SW_SHOWNA As Int32 = 8
    Public Const SW_RESTORE As Int32 = 9
    Public Const SW_SHOWDEFAULT As Int32 = 10
    Public Const SW_FORCEMINIMIZE As Int32 = 11
    Public Const WM_SIZE As UInt32 = &H5
    Public Const SIZE_RESTORED As Int32 = 0
    Public Const SIZE_MINIMIZED As Int32 = 1
    Public Const SIZE_MAXIMIZED As Int32 = 2
    Public Const SIZE_MAXSHOW As Int32 = 3
    Public Const SIZE_MAXHIDE As Int32 = 4
    Public Const WS_TABSTOP As UInt32 = &H10000L
    Public Const RDW_INVALIDATE As UInt32 = &H1

    Public Const TME_HOVER As UInt32 = &H1
    Public Const TME_LEAVE As UInt32 = &H2
    Public Const TME_NONCLIENT As UInt32 = &H10
    Public Const TME_QUERY As UInt32 = &H40000000
    Public Const TME_CANCEL As UInt32 = &H80000000UI
    Public Const HOVER_DEFAULT As UInt32 = &HFFFFFFFFUI

    Structure Rect
        Public left As Int32
        Public top As Int32
        Public right As Int32
        Public bottom As Int32
    End Structure
    Structure TRACK_MOUSEEVENT
        Public DWORD_cbSize As UInt32
        Public DWORD_dwFlags As UInt32
        Public HWND_hwndTrack As IntPtr
        Public DWORD_dwHoverTime As UInt32
    End Structure

    Declare Unicode Function TrackMouseEvent Lib "User32" (
            _Inout_LPTRACKMOUSEEVENT_lpEventTrack As IntPtr) As Boolean

    Declare Unicode Function GetClassName Lib "user32.dll" Alias "GetClassNameW" (
             _In_HWND_hWnd As IntPtr,
             _Out_writes_to_nMaxCount_return_LPWSTR_lpClassName As IntPtr,
             _In__int_nMaxCount As Int32) As Int32
    Declare Unicode Function RegisterHotKey Lib "User32" (
             _In_opt_HWND_hWnd As IntPtr,
             _In_int_id As Int32,
             _In_UINT_fsModifiers As UInt32,
             _In_UINT_vk As UInt32) As Boolean
    Declare Unicode Function UnregisterHotKey Lib "User32" (
             _In_opt_HWND_hWnd As IntPtr,
             _In_int_id As Int32) As Boolean
    Declare Unicode Function Rectangle Lib "Gdi32" (
             _In_HDC_hdc As IntPtr, _In_int_left As Int32,
             _In_int_top As Int32, _In_int_right As Int32,
             _In_int_bottom As Int32) As Boolean
    Declare Unicode Function LineTo Lib "Gdi32" (
            _In_HDC_hdc As IntPtr,
            _In_int_x As Int32,
            _In_int_y As Int32) As Boolean
    Declare Unicode Function MoveToEx Lib "Gdi32" (
            _In_HDC_hdc As IntPtr,
            _In_int_x As Int32,
            _In_int_y As Int32,
            _Out_opt_LPPOINT_lppt As IntPtr) As Boolean
    Declare Unicode Function SetDCBrushColor Lib "Gdi32.dll" (
             _In_HDC_hdc As IntPtr,
            _In_COLORREF_color As UInt32) As UInt32
    Declare Unicode Function SetDCPenColor Lib "Gdi32.dll" (
             _In_HDC_hdc As IntPtr,
             _In_COLORREF_color As UInt32) As UInt32
    Declare Unicode Function SetTextColor Lib "Gdi32" (
            _In_HDC_hdc As IntPtr, _In_COLORREF_color As UInt32) As UInt32
    Declare Unicode Function ExtTextOut Lib "Gdi32" Alias "ExtTextOutW" (
            _In_HDC_hdc As IntPtr,
            _In_int_x As Int32,
            _In_int_y As Int32,
            _In_UINT_options As UInt32,
            _In_opt__Const_RECT_lprect As IntPtr,
            _In_reads_opt_c_LPCWSTR_lpString As String,
            _In_UINT_c As UInt32,
            _In_reads_opt_c_Const_INT_lpDx As IntPtr) As Boolean
    Declare Unicode Function SetBkColor Lib "Gdi32.dll" (
            _In_HDC_hdc As IntPtr,
            _In_COLORREF_color As UInt32) As UInt32
    Declare Unicode Function SelectObject Lib "Gdi32" (
            _In_HDC_hdc As IntPtr,
            _In_HGDIOBJ_h As IntPtr) As IntPtr
    Declare Unicode Function GetStockObject Lib "Gdi32" (
            _In_int_i As Int32) As IntPtr
    Declare Unicode Function BeginPaint Lib "User32" (
            _In_HWND_hWnd As IntPtr,
            _Out_LPPAINTSTRUCT_lpPaint As IntPtr) As IntPtr
    Declare Unicode Function EndPaint Lib "User32" (
            _In_HWND_hWnd As IntPtr,
            _In_Const_PAINTSTRUCT_Ptr_lpPaint As IntPtr) As Boolean
    Declare Unicode Function GetWindowPlacement Lib "User32" (
            _In_HWND_hWnd As IntPtr,
            _Inout_WINDOWPLACEMENT_lpwndpl As IntPtr) As Boolean
    Declare Unicode Function SetWindowPlacement Lib "User32" (
            _In_HWND_hWnd As IntPtr,
            _In_Const_WINDOWPLACEMENT_lpwndpl As IntPtr) As Boolean
    Declare Unicode Function DragQueryFile Lib "Shell32" Alias "DragQueryFileW" (
            _In_HDROP_hDrop As IntPtr,
            _In_UINT_iFile As UInt32,
            _Out_writes_opt_cch_LPWSTR_lpszFile As IntPtr,
            _In_UINT_cch As UInt32) As UInt32 '_Success_(return != 0) SHSTDAPI_(UINT)
    Declare Unicode Sub DragFinish Lib "Shell32" (_In_HDROP_hDrop As IntPtr)
    Declare Unicode Function ShowWindow Lib "User32" (
             _In_HWND_hWnd As IntPtr,
             _In_int_nCmdShow As Int32) As Boolean
    Declare Unicode Function RedrawWindow Lib "User32" (
               _In_opt_HWND_hWnd As IntPtr,
               _In_opt_Const_RECT_lprcUpdate As IntPtr,
               _In_opt_HRGN_hrgnUpdate As IntPtr,
               _In_UINT_flags As UInt32) As Boolean
    Public Function RGB(r As UInt32, g As UInt32, b As UInt32) As UInt32
        Return CByte(r) Or (CUInt(CByte(g)) << 8) Or (CUInt(CByte(b)) << 16)
    End Function
End Module
Picture 3
Picture 4



留言

這個網誌中的熱門文章

Marshalling

Calling a C# WPF library from C++

Marshalling II