Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1449

Clear Immediate Window

$
0
0
This has probably been posted before, but I thought I'd do "my version" of this.

Compile the Add-In and save the DLL to wherever your Add-Ins are, and then load it (via your Add-Ins Manager) and you'll get a small button in the top-left of your desktop. If you move that form, it'll return to where you positioned it the next time.

If you close that form, the whole Add-In is unloaded. Just re-load it to get the form/button back. It's your choice as to whether you keep it loaded.

Also, I specifically look for the window titled "Immediate". Basically, this makes it work only when the IDE is set for English. You'll have to patch this if you want it for another language.

I've tried hard to make sure it ONLY deletes the Immediate window. Here's the code (all in the form except for actually loading the form), but please just use the project. I'm showing it here so you can peruse the primary code to do this:

Code:


Option Explicit
'
Private Type RECT
    Left  As Long
    Top  As Long
    Right As Long ' This is +1 (right - left = width)
    Bottom As Long ' This is +1 (bottom - top = height)
End Type
Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type
Private Type KeyboardInput
    dwType As Long
    wVK As Integer
    wScan As Integer
    dwFlags As Long
    dwTime As Long
    dwExtraInfo As Long
    dwPadding As Currency
End Type
'
Private Declare Function SendInput Lib "user32" (ByVal nInputs As Long, pInputs As Any, ByVal cbSize As Long) As Long
Private Declare Function EbMode Lib "vba6" () As Long ' 0=Design, 1=Run, 2=Break.
Private Declare Function GetFocus Lib "user32" () As Long ' Retrieves the handle to the window that has the keyboard focus, if the window is attached to the calling thread's message queue.
Private Declare Function GetWindowTextLengthW Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowTextW Lib "user32" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFO) As Long
'
Public AppInst      As VBIDE.VBE
Public AddInInst    As VBIDE.AddIn
'

Private Sub Form_Load()
    '
    ' Scrub off the width that the IDE wouldn't let us scrub off.
    Me.Width = Me.Width - 285!
    '
    ' Put position where it last was.
    Me.Top = GetSetting(App.Title, "Settings", "ClearImmediateTop", 60)
    Me.Left = GetSetting(App.Title, "Settings", "ClearImmediateLeft", 60)
    If Not FormIsFullyOnMonitor Then
        Me.Top = 60!
        Me.Left = 60!
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If EbMode <> 0& Then
        MsgBox "Sorry, but you can't unload this Add-In unless you're in design-mode.", vbInformation
        Cancel = True
        Exit Sub
    End If
    '
    ' Save our position for next time.
    SaveSetting App.Title, "Settings", "ClearImmediateTop", Me.Top
    SaveSetting App.Title, "Settings", "ClearImmediateLeft", Me.Left
    '
    ' We just unload the Add-In so it can be re-loaded (and show this form again) if desired.
    AddInInst.Connect = False
    '
    ' Make sure COM object is uninstantiated.
    Set frmClearImmediateWindow = Nothing
End Sub

Private Sub cmdClearImmediate_Click()
    '
    ' Make sure the IDE isn't running the code.
    If EbMode = 1& Then ' EbMode actually works as expected in Add-Ins.
        MsgBox "You can't clear ""Immediate"" window while running your code!  It can only be cleared while in design-mode or while in break-mode.", vbInformation
        Exit Sub
    End If
    '
    ' Get reference to Immediate window.
    Dim TheWindow As VBIDE.Window
    Set TheWindow = AppInst.Windows("Immediate")
    '
    ' Make sure we found it.
    If TheWindow Is Nothing Then Exit Sub
    '
    ' Make sure it's visible.
    If Not TheWindow.Visible Then TheWindow.Visible = True
    '
    ' Make sure it's got the focus.
    TheWindow.SetFocus
    Dim sTitle As String
    sTitle = WindowText(GetFocus)
    If sTitle <> "Immediate" Then
        MsgBox "For some reason, the focus of the ""Immediate"" window couldn't be set, so this ""Clear"" operation can't be performed.  You may possibly be set to another language.", vbInformation
        Exit Sub
    End If
    '
    ' We're ready to clear.
    SendKeysSpecial "^{HOME}"
    SendKeysSpecial "^+{END}"
    SendKeysSpecial "{DEL}"
End Sub

Private Function WindowText(hWndOfInterest As Long) As String
    WindowText = Space$(GetWindowTextLengthW(hWndOfInterest))
    WindowText = Left$(WindowText, GetWindowTextW(hWndOfInterest, StrPtr(WindowText), Len(WindowText) + 1&))
End Function

Private Sub SendKeysSpecial(Data As String)
    Dim KeyEvents()  As KeyboardInput
    ReDim KeyEvents(15&)
    Dim DatPtr As Long
    Dim EvtPtr As Long
    Do While DatPtr < Len(Data)
        DoNextChr Data, DatPtr, EvtPtr, KeyEvents
    Loop
    '
    SendInput EvtPtr, KeyEvents(0&), Len(KeyEvents(0&))
End Sub

Private Sub DoNextChr(Data As String, DatPtr As Long, EvtPtr As Long, KeyEvents() As KeyboardInput)
    Const INPUT_KEYBOARD          As Long = 1&
    Const KEYEVENTF_EXTENDEDKEY    As Long = 1&
    Const KEYEVENTF_KEYUP          As Long = 2&
    '
    DatPtr = DatPtr + 1&
    Dim This As String
    This = Mid$(Data, DatPtr, 1&)
    '
    Select Case This
    Case "+", "^"
        Select Case This
        Case "+":  KeyEvents(EvtPtr).wVK = vbKeyShift
        Case "^":  KeyEvents(EvtPtr).wVK = vbKeyControl
        End Select
        KeyEvents(EvtPtr).dwType = INPUT_KEYBOARD
        EvtPtr = EvtPtr + 1&
        '
        DoNextChr Data, DatPtr, EvtPtr, KeyEvents  ' Recursion.
        '
        Select Case This
        Case "+":  KeyEvents(EvtPtr).wVK = vbKeyShift
        Case "^":  KeyEvents(EvtPtr).wVK = vbKeyControl
        End Select
        KeyEvents(EvtPtr).dwFlags = KEYEVENTF_KEYUP
        KeyEvents(EvtPtr).dwType = INPUT_KEYBOARD
        EvtPtr = EvtPtr + 1&
    Case "{"
        Dim EndPtr As Long
        EndPtr = InStr(DatPtr, Data, "}")
        '
        Dim vk As Integer
        Select Case Mid$(Data, DatPtr + 1&, EndPtr - DatPtr - 1&)
        Case "DEL":    vk = vbKeyDelete
        Case "END":    vk = vbKeyEnd
        Case "HOME":    vk = vbKeyHome
        End Select
        '
        KeyEvents(EvtPtr).wVK = vk
        KeyEvents(EvtPtr).dwFlags = KEYEVENTF_EXTENDEDKEY
        KeyEvents(EvtPtr).dwType = INPUT_KEYBOARD
        EvtPtr = EvtPtr + 1&
        '
        KeyEvents(EvtPtr).wVK = vk
        KeyEvents(EvtPtr).dwFlags = KEYEVENTF_KEYUP
        KeyEvents(EvtPtr).dwType = INPUT_KEYBOARD
        EvtPtr = EvtPtr + 1&
        '
        DatPtr = EndPtr
    End Select
End Sub

Private Function FormIsFullyOnMonitor() As Boolean
    ' This tells us whether or not form is FULLY visible on its monitor.
    '
    Dim r1 As RECT
    Dim r2 As RECT
    Dim uMonInfo As MONITORINFO
    '
    GetWindowRect Me.hWnd, r1
    uMonInfo.cbSize = LenB(uMonInfo)
    GetMonitorInfo MonitorFromWindow(Me.hWnd, 0&), uMonInfo
    r2 = uMonInfo.rcWork
    '
    FormIsFullyOnMonitor = (r1.Top >= r2.Top) And (r1.Left >= r2.Left) And (r1.Bottom <= r2.Bottom) And (r1.Right <= r2.Right)
End Function



Two points, one I knew and one I discovered:

  • You can't clear the Immediate window while running in the IDE. You must either be in design-mode or break-mode.
  • You can't unload an Add-In unless you're in design-mode.


Enjoy

ALSO: Before someone requests it, I thought about a toolbar button, but I don't like the fact that the clipboard gets deleted/corrupted when you do that. I sometimes have stuff in my clipboard before I fire up the IDE. So, if you want this, you're on your own.

Viewing all articles
Browse latest Browse all 1449

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>