Lock workstation II
 |
| Picture 1 |
be created,and then the following code can be
added in.
 |
| Picture 2 |
 |
| Picture 3 |
Imports System.Globalization
Imports System.Runtime.InteropServices
Imports System.Text
Partial Public Class Form1
Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
MyCode_put_in_This_module.Form1Resize(CType(sender, Control))
End Sub
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
MyCode_put_in_This_module.Form1Paint(e.Graphics)
End Sub
Private Sub Form1_GotFocus(sender As Object, e As EventArgs) Handles Me.GotFocus
MyCode_put_in_This_module.MyGroupGotFocus = True
MyCode_put_in_This_module.WhichOneGotFocus = Me
TextBox1.WriteLine("Form1_GotFocus<--------")
Me.Invalidate()
End Sub
Private Sub Form1_LostFocus(sender As Object, e As EventArgs) Handles Me.LostFocus
MyCode_put_in_This_module.MyGroupGotFocus = False
Me.Invalidate()
End Sub
Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
If e.Button = MouseButtons.Left Then
AppActivate("Form1")
End If
End Sub
End Class
Partial Module MyCode_put_in_This_module
Public ReadOnly FontFamilyNames() As String = {
"宋体", "細明體", "Courier New", "Cascadia Mono"}
Public ReadOnly NULL As IntPtr = IntPtr.Zero
Public PictureBox1 As PictureBox
Public TextBox1 As NativeWindow_TextBox
Public WhichOneGotFocus As Object
Public MyGroupGotFocus As Boolean
Dim Font As System.Drawing.Font
Dim Ptr_Start, Ptr_TextBox1, Ptr_Int As IntPtr
Dim Rectangle_TextBox1, Rectangle_Form1, Rectangle_Picture1 As Rectangle
Dim Client_Size As Drawing.Size
Dim LineNo As Int32 = 1
Sub SetFocus_To_Specified_hWnd(hWnd As IntPtr)
Marshal.WriteInt32(Ptr_Int, 0)
AttachThreadInput(0, GetWindowThreadProcessId(hWnd, Ptr_Int), True)
SetForegroundWindow(hWnd)
SetFocus(hWnd)
AttachThreadInput(0, GetWindowThreadProcessId(hWnd, Ptr_Int), False)
End Sub
Sub Form1Paint(Graphics As Graphics)
Const width As Single = 5
If MyGroupGotFocus Then
If WhichOneGotFocus Is TextBox1 Then
Form1.BackColor = Form1.DefaultBackColor
Graphics.DrawRectangle(New Pen(Color.Green, width), Rectangle_TextBox1)
ElseIf WhichOneGotFocus Is Form1 Then
Form1.BackColor = Color.LightYellow
Graphics.DrawRectangle(New Pen(Color.Red, width), Rectangle_Form1)
ElseIf WhichOneGotFocus Is PictureBox1 Then
Form1.BackColor = Form1.DefaultBackColor
Graphics.DrawRectangle(New Pen(Color.Green, width), Rectangle_Picture1)
End If
End If
End Sub
Dim AppendLineScroll As Int32
Sub Form1Resize(MyClient As Control)
Client_Size = MyClient.ClientSize
Rectangle_Form1.Width = Client_Size.Width - 1
Rectangle_Form1.Height = Client_Size.Height - 1
If TextBox1 IsNot Nothing Then
TextBox1.DestroyHandle()
TextBox1 = New NativeWindow_TextBox(Form1.Handle)
Form1.Invalidate()
SendMessage(TextBox1.Handle, WM_SETTEXT, NULL, Ptr_TextBox1)
SendMessage(TextBox1.Handle, EM_LINESCROLL, NULL, New IntPtr(LineNo + AppendLineScroll))
UpdateWindow(TextBox1.Handle)
End If
End Sub
Public Class NativeWindow_TextBox
Inherits NativeWindow
Implements IDisposable
Public Sub WriteLine(Str2 As String)
Static Recursion As Int32 = 0
If Recursion > 1 OrElse Ptr_Start = NULL Then Exit Sub
Recursion += 1
Dim UnicodeBytes() As Byte = Text.Encoding.Unicode.GetBytes(
Str2 & Environment.NewLine & LineNo.ToString("00 "))
Marshal.Copy(UnicodeBytes, 0, Ptr_Start, UnicodeBytes.Length)
Ptr_Start += UnicodeBytes.Length
SendMessage(Handle, WM_SETTEXT, NULL, Ptr_TextBox1)
SendMessage(Handle, EM_LINESCROLL, NULL, New IntPtr(LineNo + AppendLineScroll))
UpdateWindow(Handle)
LineNo += 1
Recursion -= 1
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_SETFOCUS
MyGroupGotFocus = True
WhichOneGotFocus = TextBox1
TextBox1.WriteLine("--------->TextBox1 GotFocus")
Form1.Invalidate()
m.Result = NULL
Case WM_KILLFOCUS
MyGroupGotFocus = False
Form1.Invalidate()
m.Result = NULL
Case WM_LBUTTONDOWN
SetFocus_To_Specified_hWnd(TextBox1.Handle)
m.Result = NULL
Case Else
MyBase.WndProc(m)
End Select
End Sub
Public Sub New(Parent_hWnd As IntPtr)
Dim cp As New CreateParams With {
.Parent = Parent_hWnd,
.ClassName = "Edit",
.Style = WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or
ES_LEFT Or ES_MULTILINE Or ES_AUTOVSCROLL Or
ES_AUTOHSCROLL Or ES_READONLY,
.X = 180 + edge * 2,
.Y = edge,
.Width = Client_Size.Width - .X - edge,
.Height = Client_Size.Height - .Y - edge
}
CreateHandle(cp)
SendMessage(Handle, WM_SETFONT, Font?.ToHfont, NULL)
Rectangle_TextBox1.X = cp.X - 1
Rectangle_TextBox1.Y = cp.Y - 1
Rectangle_TextBox1.Width = Client_Size.Width - cp.X - edge + 1
Rectangle_TextBox1.Height = Client_Size.Height - cp.Y - edge + 1
End Sub
Private disposedValue As Boolean
Protected Overridable Sub Dispose(disposing As Boolean)
If Not disposedValue Then
If disposing Then
End If
Me.DestroyHandle() ' Me.ReleaseHandle() is a fault
disposedValue = True
End If
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(disposing:=True)
GC.SuppressFinalize(Me)
End Sub
End Class
Private Sub Initialize2()
For Each name As String In FontFamilyNames
Try
Dim [FontFamily] As FontFamily
[FontFamily] = New System.Drawing.FontFamily(name)
If [FontFamily] IsNot Nothing Then
Font = New Drawing.Font([FontFamily], 44,
FontStyle.Regular, GraphicsUnit.World)
Exit For
End If
Catch ex As Exception
End Try
Next
Ptr_TextBox1 = Marshal.AllocHGlobal((4 << 20) + 64)
Ptr_Int = Ptr_TextBox1 + (4 << 20)
Ptr_Start = Ptr_TextBox1
TextBox1 = New NativeWindow_TextBox(Form1.Handle)
SendMessage(TextBox1.Handle, EM_SETLIMITTEXT, New IntPtr(4 << 20), NULL)
TextBox1.WriteLine($"==== Here is TextBox1 ====")
PictureBox1 = New PictureBox() With { '.ImageLocation = "..\..\image1.jpg",
.Location = New Drawing.Point(edge, 30 + edge * 2),
.Size = New Drawing.Size(180, 30),
.BackColor = Color.DarkKhaki
}
AddHandler PictureBox1.MouseClick, AddressOf Picture1_MouseClick
AddHandler PictureBox1.GotFocus, AddressOf Picture1_GotFocus
AddHandler PictureBox1.LostFocus, AddressOf Picture1_LostFocus
AddHandler PictureBox1.PreviewKeyDown, AddressOf Picture1_PreviewKeyDown
Form1.Controls.Add(PictureBox1)
Rectangle_Form1.X = 0
Rectangle_Form1.Y = 0
Rectangle_Form1.Width = Client_Size.Width - 1
Rectangle_Form1.Height = Client_Size.Height - 1
Rectangle_Picture1.X = edge - 1
Rectangle_Picture1.Y = 30 + edge * 2 - 1
Rectangle_Picture1.Width = 180 + 1
Rectangle_Picture1.Height = 30 + 1
End Sub
Sub Picture1_MouseClick(sender As Object, e As MouseEventArgs)
Static RightClicks As UInt32 = 0
If e.Button = MouseButtons.Left Then
SetFocus_To_Specified_hWnd(PictureBox1.Handle)
ElseIf e.Button = MouseButtons.Right Then
RightClicks += 1
If RightClicks And 1 Then
Dim num As UInt32 = 1
Dim ListFontFamily As New StringBuilder("List font families")
ListFontFamily.AppendLine()
For Each f As FontFamily In FontFamily.Families
ListFontFamily.AppendLine($"{num,9} {f}")
num += 1
Next
AppendLineScroll += num
TextBox1.WriteLine(ListFontFamily.ToString)
Else
Dim num As UInt32 = 1
Dim listChineseCulture As New StringBuilder("List Culture about Chinese")
listChineseCulture.AppendLine()
Dim ci As CultureInfo
For Each ci In CultureInfo.GetCultures(CultureTypes.AllCultures)
If ci.TwoLetterISOLanguageName = "zh" Then
Dim neutral As String =
If(ci.IsNeutralCulture, "neutral ", "specific")
listChineseCulture.AppendLine(
$"{num,5} {neutral} {ci.Name,-14}{ci.EnglishName,-40}{ci.DisplayName}")
num += 1
End If
Next
AppendLineScroll += num
TextBox1.WriteLine(listChineseCulture.ToString)
End If
End If
End Sub
Private Sub Picture1_GotFocus(sender As Object, e As EventArgs)
MyGroupGotFocus = True
WhichOneGotFocus = PictureBox1
TextBox1.WriteLine("Picture1_GotFocus<--------")
Form1.Invalidate()
End Sub
Private Sub Picture1_LostFocus(sender As Object, e As EventArgs)
MyGroupGotFocus = False
Form1.Invalidate()
End Sub
Private Sub Picture1_PreviewKeyDown(sender As Object, e As PreviewKeyDownEventArgs)
TextBox1.WriteLine($"{e.KeyData}")
End Sub
Private Sub CloseModule2()
TextBox1.Dispose()
Marshal.FreeHGlobal(Ptr_TextBox1)
Ptr_Start = NULL
Font.Dispose()
End Sub
Public Const WM_SETTEXT As UInt32 = &HC
Public Const WM_SETFONT As UInt32 = &H30
Public Const WM_SETFOCUS As UInt32 = &H7
Public Const WM_KILLFOCUS As UInt32 = &H8
Public Const WS_VSCROLL As UInt32 = &H200000L
Public Const ES_LEFT As UInt32 = &H0L
Public Const ES_READONLY As UInt32 = &H800L
Public Const ES_AUTOVSCROLL As UInt32 = &H40L
Public Const ES_AUTOHSCROLL As UInt32 = &H80L
Public Const ES_MULTILINE As UInt32 = &H4L
Public Const EM_LINESCROLL As UInt32 = &HB6
Public Const EM_LIMITTEXT As UInt32 = &HC5
Public Const EM_SETLIMITTEXT As UInt32 = EM_LIMITTEXT
Declare Unicode Function AttachThreadInput Lib "User32.dll" (
_In_DWORD_idAttach As UInt32,
_In_DWORD_idAttachTo As UInt32,
_In_BOOL_fAttach As Boolean) As Boolean
Declare Unicode Function GetWindowThreadProcessId Lib "User32.dll" (
_In_HWND_hWnd As IntPtr,
_Out_opt_LPDWORD_lpdwProcessId As IntPtr) As UInt32
Declare Unicode Function SetForegroundWindow Lib "User32.dll" (
_In_HWND_hWnd As IntPtr) As Boolean
Declare Unicode Function SetFocus Lib "User32.dll" (
_In_opt_HWND_hWnd As IntPtr) As IntPtr
Declare Unicode Function SendMessage Lib "user32.dll" Alias "SendMessageW" (
_In__HWND_hWnd As IntPtr,
_In__UINT_Msg As UInt32,
_Pre_maybenull_Post_valid_WPARAM_wParam As IntPtr,
_Pre_maybenull_Post_valid_LPARAM_lParam As IntPtr) As IntPtr
Declare Unicode Function UpdateWindow Lib "User32.dll" (
_In_HWND_hWnd As IntPtr) As Boolean
End Module
 |
| Picture 4 content of code I |
 |
| Picture 5 content of code II |
 |
| Picture 6 Where is SetFocus_To_Specified_hWnd from |
留言
張貼留言