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 |




留言
張貼留言