Projects

Gateway Multi-function Keyboard Utility

November 19, 2002 by Java

Browsing Utility/EditBoxMod.bas (4.57 KB)

Attribute VB_Name = "EditBoxMod"

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessageL Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, wParam As Long, lParam As Any) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Const EM_GETSEL = &HB0
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2

Private Const MB_ICONASTERISK = &H40&
Private Const MB_ICONINFORMATION = MB_ICONASTERISK

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE

Public Sub OutdentEditBoxText()
On Error GoTo ErrHandler
Dim Wnd As Long
Dim StartPos As Long
Dim EndPos As Long
Dim Text As String
Dim TextArray() As String
Dim i As Long
    Wnd = GetMouseOverWnd
    Text = GetSelectedText(Wnd, StartPos, EndPos)
    TextArray = Split(Text, vbCrLf)
    Text = ""
    For i = 0 To UBound(TextArray)
        If Left(TextArray(i), 2) = "  " Then TextArray(i) = Mid(TextArray(i), 3)
        Text = Text + TextArray(i) + IIf(i < UBound(TextArray), vbCrLf, "")
    Next i
    EndPos = StartPos + Len(Text)
    If Text <> "" Then SetSelectedText Wnd, Text, StartPos, EndPos
ErrHandler:
End Sub

Private Function GetCaption(ByVal hWnd As Long) As String
Dim CaptionLength As Long
Dim Caption As String
    CaptionLength = SendMessage(hWnd, WM_GETTEXTLENGTH, 0&, 0&)
    Caption = String(CaptionLength, 0&)
    SendMessageByString hWnd, WM_GETTEXT, CaptionLength + 1, Caption
    GetCaption = Caption
End Function

Private Function GetMouseOverWnd() As Long
Dim CursorPos As POINTAPI
    GetCursorPos CursorPos
    GetMouseOverWnd = WindowFromPoint(CursorPos.X, CursorPos.Y)
End Function


Private Function GetSelectedText(hWnd As Long, Optional iStartPos As Long, Optional iEndPos As Long) As String
Dim StartPos As Long
Dim EndPos As Long
Dim Caption As String
    If SendMessageL(hWnd, EM_GETSEL, StartPos, EndPos) Then
        If StartPos = EndPos Then Exit Function
        Caption = GetCaption(hWnd)
        If Caption <> "" Then GetSelectedText = Mid(Caption, StartPos + 1, EndPos - StartPos)
        iStartPos = StartPos
        iEndPos = EndPos
    End If
End Function

Public Sub IndentEditBoxText()
On Error GoTo ErrHandler
Dim Wnd As Long
Dim StartPos As Long
Dim EndPos As Long
Dim Text As String
Dim TextArray() As String
Dim i As Long
    Wnd = GetMouseOverWnd
    Text = GetSelectedText(Wnd, StartPos, EndPos)
    TextArray = Split(Text, vbCrLf)
    Text = ""
    For i = 0 To UBound(TextArray)
        Text = Text + "  " + TextArray(i) + IIf(i < UBound(TextArray), vbCrLf, "")
    Next i
    EndPos = StartPos + Len(Text)
    If Text <> "" Then SetSelectedText Wnd, Text, StartPos, EndPos
ErrHandler:
End Sub

Public Sub LowerCaseEditBox()
Dim Wnd As Long
Dim StartPos As Long
Dim EndPos As Long
Dim Text As String
    Wnd = GetMouseOverWnd
    Text = GetSelectedText(Wnd, StartPos, EndPos)
    If Text <> "" Then SetSelectedText Wnd, LCase(Text), StartPos, EndPos
End Sub


Private Function SetSelectedText(hWnd As Long, Text As String, Optional iStartPos As Long, Optional iEndPos As Long) As Long
    SetSelectedText = SendMessage(hWnd, EM_REPLACESEL, ByVal 1&, ByVal Text)
    If Not IsMissing(iStartPos) Or Not IsMissing(iEndPos) Then SendMessage hWnd, EM_SETSEL, ByVal iStartPos, ByVal iEndPos
End Function

Public Sub ShowSelectionCount()
Dim Wnd As Long
Dim Text As String
Dim TextLen As Variant
    Wnd = GetMouseOverWnd
    Text = GetSelectedText(Wnd)
    TextLen = Len(Text)
    If TextLen > 0 Then MessageBox 0&, "Selection Length: " & TextLen & " character" + IIf(TextLen = 1, "", "s"), "Keyboard Utility", MB_ICONINFORMATION
End Sub

Public Sub UpperCaseEditBox()
Dim Wnd As Long
Dim StartPos As Long
Dim EndPos As Long
Dim Text As String
    Wnd = GetMouseOverWnd
    Text = GetSelectedText(Wnd, StartPos, EndPos)
    If Text <> "" Then SetSelectedText Wnd, UCase(Text), StartPos, EndPos
End Sub

Download Utility/EditBoxMod.bas

Back to file list

---

Back to project page