Just wondering if anyone know's how to remove scroll bars from a listbox in VB 6.0? As I want to add a 'global' scroll bar for multiple listboxes. I have searched online, but all of the solutions require the code to be placed in the click event of the list box.
You can hide the scrollbars using the Windows API. Here's a sample project to get you started. Add a ListBox (List1) to a form and add the following code:
Private Declare Function ShowScrollBar Lib "user32" _
(ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_VERT = 1
Private Sub HideVertScrollBar(LB As ListBox)
Call ShowScrollBar(LB.hwnd, SB_VERT, 0&)
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 25
List1.AddItem "Item " & i
Next
HideVertScrollBar List1
End Sub
Private Sub List1_Click()
HideVertScrollBar List1
End Sub
If you only call HideVertScrollBar in Form_Load, when you manually scroll (using the arrow keys), the scrollbar shows up again. We fix this by calling HideVertScrollBar in List1_Click as well.
Related
I'm attempting to create a VB6 executable (not sure of the proper syntax) that will toggle the X-Mouse option in Tweak UI under Windows 98SE. Ideally, I would like to have two scripts - one that turns it off (regardless of its state) and one that turns it on (again, regardless of its state).
I have been able to open the TweakUI control panel with the code below.
Private Sub Form_Load()
Call Shell("rundll32.exe shell32.dll,Control_RunDLL tweakui.cpl", vbNormalFocus)
End Sub
If possible, I would like it to do it without opening the TweakUI control panel.
As far as I can tell, changing the registry setting doesn't work as I would have to reboot the computer for that to take effect.
I have Registry Monitor 7.04 running. It captures the following:
Path: C:\WINDOWS\RUNDLL32.EXE
Command Line: "C:\WINDOWS\RUNDLL32.EXE" "C:\WINDOWS\SYSTEM\TWEAKUI.CPL", Tweak UI
Other: hKey: 0xC2A066F0
Honestly, I'm not sure how to move forward.
Not sure the best way to show progress on this, I'll just edit.
This code is very close.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
'Click on this button to Activate XMouse
Private Sub Command1_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, True, 0
End Sub
'Click on this button to Deactivate XMouse
Private Sub Command2_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, False, 0
End Sub
Button 1 works correctly and Activates XMouse. But button two does not deactivate it.
SPI_SETACTIVEWINDOWTRACKING is the parameter that does this.
systemparametersinfo is the function call that gets or sets settings like this. See https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-systemparametersinfoa
There is sample code using systemparametersinfo that changes the wallpaper. https://winsourcecode.blogspot.com/2019/06/changewallpaper.html
Thank you to all of the input. I was able to solve this problem.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Boolean, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Private Sub Command1_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, True, 0)
End Sub
Private Sub Command2_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, False, 0)
End Sub
In addition to the help here, I stumbled upon a few gems that gave me what I needed.
Control the mouse speed under Windows 98 / 2000
and
Controling Active Window Tracking
A couple things of note. I had to include this or else nothing happened:
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Also, the 3rd parameter was
ByRef lpvParam As Boolean
Instead of
ByVal lpvParam As Boolean
I was passing a pointer to a pointer instead of a pointer to a value
Hi I would like to ask if it's possible to map the KeyDown for keyboards in Visual Basic 6 to turn the state of a graphical Command Button on the form to the "Down State" while keyboard key is pressed then back to raised when released? Thanks
I am aware of the problem here, because I did somewhat similar in the past and ended up by using an array of PictureBoxes instead of graphical CommandButtons.
Anyway, a simple workaround with CommandButtons is to keep the focus away by adding to the Form another control which can act as focus target. Remember: when a Form goes activated, it will place the focus to the first focusable control inside itself.
As You haven't specified in Your question what kind of keyboard state You need, below is a simple example with the a s d f keys. You will need less than 5 minutes to get it up and running.
Step 0:
Copy and paste following declarations to Your VB Form:
Option Explicit
Option Base 0
Const BM_SETSTATE = &HF3
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Target(254) As Long
Step 1:
Add to Your Form an array of CommandButtons called, for instance, Button(0), Button(1), Button(2), Button(3) and so on.
Set the properties which You need (Picture, DownPicture, etc.) and set also:
TabStop: False
Double-click one of this CommandButtons. You can see, You have just one entry point for the whole array of Controls. Choose GotFocus from the event drop-down and put this piece of code:
Private Sub Button_GotFocus(Index As Integer)
PicFocus.SetFocus
End Sub
Step 2:
On Your VB Form, set this property:
KeyPreview: True
Double-click the Form, choose Load from the event drop-down and set Your desired mapping between a KeyCode and the corresponding CommandButton:
Private Sub Form_Load()
Target(65) = Button(0).hwnd ' 65: KeyCode for "a"
Target(83) = Button(1).hwnd ' 83: KeyCode for "s"
Target(68) = Button(2).hwnd ' 68: KeyCode for "d"
Target(70) = Button(3).hwnd ' 70: KeyCode for "f"
End Sub
Choose KeyDown and KeyUp from the event drop-down and put inside the two global keyboard event handlers this piece of code - respectively -1 for the down-state and 0 for the up-state:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' Debug.Print KeyCode
Call PostMessage(Target(KeyCode), BM_SETSTATE, -1&, 0&)
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Call PostMessage(Target(KeyCode), BM_SETSTATE, 0&, 0&)
End Sub
Step 3:
Lastly, add to the same VB Form the PictureBox mentioned above and set following properties:
Name: PicFocus
Appearance: 0-Flat
BorderStyle: 0-None
HasDC: False
TabIndex: 0
TabStop: False
Width: 255
Left: -1000
Press Ctrl+F5 and test if this is what You need.
The CommandButton control has mouse and keyboard down and up events:
Private Sub Command1_Click()
Debug.Print "click"
End Sub
Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
Debug.Print "keydown"
End Sub
Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)
Debug.Print "keyup"
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "mousedown"
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "mouseup"
End Sub
I am developing simple app in visual basic and what I want to do is:
On load whole DataGridView1 is ReadOnly
Next if user will double click on cell, then it turns edit mode for that cell
I try to do this by:
Private Sub CellDouble(ByVal sender As Object,
ByVal e As DataGridViewCellEventArgs) _
Handles DataGridView1.CellDoubleClick
DataGridView1(e.ColumnIndex, e.RowIndex).ReadOnly = False
DataGridView1.BeginEdit(e.RowIndex)
End Sub
But it doesnt even react. (function is triggered but code not working)
Final step is to Set Read only back to that cell after edit
I simply did:
Private Sub CellDouble(ByVal sender As Object,
ByVal e As DataGridViewCellEventArgs) _
Handles DataGridView1.CellDoubleClick
DataGridView1.BeginEdit()
End Sub
and it's working fine...
The Problem
Call a procedure whenever the Main Excel Window is resized.
First attempt:
Sub Workbook_WindowResize(ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
The sub routine is called whenever the 'inner' workbook window is resized but not when the application window is resized. I.E. occcurs on resize of the Multiple Document Interface child containing the application instance.
Second attempt
Dim WithEvents App As Application
Private Sub App_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window)
Debug.Print Wn.Width & "x" & Wn.Height
End Sub
Results:
Oddly, the same thing that happened before occurs, which definitely surprised me. The event only occurs when the workbook window is resized instead of the application window.
For this reason I started looking into using the windows API.
There are many examples of setting SystemWide keyboard and mouse hooks using the windows APIs. This is along the same lines:
Public Enum enHookTypes
WH_CALLWNDPROC = 4
WH_CALLWNDPROCRET = 12
WH_CBT = 5
WH_DEBUG = 9
WH_FOREGROUNDIDLE = 11
WH_GETMESSAGE = 3
WH_HARDWARE = 8
WH_JOURNALPLAYBACK = 1
WH_JOURNALRECORD = 0
WH_MOUSE = 7
WH_MSGFILTER = (-1)
WH_SHELL = 10
WH_SYSMSGFILTER = 6
WH_KEYBOARD_LL = 13
WH_MOUSE_LL = 14
WH_KEYBOARD = 2
End Enum
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As LongPtr
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
'Ensure that your hook procedure does not interfere with the normal operation of other hook procedures
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public hndl As Long
Sub HookWindow()
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
Debug.Print hndl & "~~" & GetLastError()
End Sub
Sub unhookWindow()
ret = UnhookWindowsHookEx(hndl)
Debug.Print ret
End Sub
Public Sub measureWindow(code As Long, wParam As Long, lParam As Long)
If code > 0 Then
Debug.Print ThisWorkbook.Windows(1).Width & "x" & ThisWorkbook.Windows(1).Height
Else
ret = CallNextHookEx(measureWindow, code, wParam, lParam)
End If
End Sub
Results:
If I replace the WH_CALLWNDPROC in:
hndl = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf measureWindow, Application.Hinstance, 0&)
with WH_KEYBOARD_LL the sub-routine is called whenever a key is pressed. Similarly, if I replace it with WH_MOUSE_LL the sub-routine is called whenever the mouse is moved or a mouse button pressed.
The problem is that when I try to hook the sub-routine to WH_CALLWNDPROC nothing happens?
Why?
I'm still not sure, but the same is true for all ENUMS in enHookTypes except WH_MOUSE_LL and WH_KEYBOARD_LL. Looking through the WinAPI documentation I read that you can use GetLastError from Kernel32.dll do get some indication of why the operation failed.
The error numbers I have got so far are (in decimal) error 5 (for JOURNAL hooks) and error 1428 for the rest.
Ultimately this also failed.
Application.Windows is a collection of window objects of Worbooks opened within the Application. The WindowResize event is raised when a non-maximized window changes size. The Workbook_WindowResize(ByVal Wn As Window) is exposed within the workbook object itself. The Application_WindowResize(ByVal Wb as Workbook, ByVal Wn As Window) event has to do with ANY/ALL of the workbooks within the Application when a non-maximized workbook's window changes size. Hence the difference in references passed in by the events. It is just a Window in the first case, of the workbook that raised the event, within the workbook object, and there is no question here which window it is (it's the "Me" workbook's window). It is both the Workbook and that workbook's window when it is raised at the Application level since the workbook the event relates to needs identification :) And no, Excel does not have a "Resize" event for the App window itself and you would need to go to APIs for that.
With the later Excel versions (past the 2010), there is ONE workbook per Excel Application window, the workbook's window is always maximized in the old sense, and both Workbook and Application events refer to the same workbook and would work just as you would want them to.
Solution , create a timer event that checks and compares the width every few seconds...
Sub my_ONTIME()
application.OnTime Now + TimeValue("00:00:2"), "my_TIMEREVENT"
End Sub
Sub my_TIMEREVENT()
If application.Width <> EWIDTHR Then ESCREENRESIZE
my_ONTIME
End Sub
Sub ESCREENRESIZE()
Dim EWIDTH As Single
Dim ESIDE As Single
Dim EMID As Single
EWIDTH = application.Width
EWIDTHR = EWIDTH
If EWIDTH < 500 Then
EWIDTH = 500
application.Width = 500
End If
EMID = 80 * 5.41
ESIDE = ((EWIDTH - EMID) / 2) / 5.41
Sheet1.Columns("A:A").ColumnWidth = ESIDE
Sheet1.Columns("C:C").ColumnWidth = ESIDE
End Sub
Hi is there any way I can change the mouse cursor in Visio programmatically?
I went through all the Automation classes in Visio SDK and could not find any related property, method, event....
-- Edit: Even while you can programmatically change the cursor, it seems that Visio (2003 in my computer) continuously restores the original cursor. I've tried it and, if I don't move the mouse, I can get a different cursor (like the hand) until I move the mouse, then it goes back to the arrow.
So, for now, my answer is: you can't change the cursor.
Maybe it is possible for other Visio versions.
You can use Windows API calls from your VBA code to change the cursor.
There is an example here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=929
A better example, which I have got to work in Visio: http://www.tek-tips.com/viewthread.cfm?qid=1700789
And below, the code I have used for the testing environment:
First, create a "modCursor" module:
Option Explicit
'Declare Windows API Constants for Windows System cursors.
Public Const IDC_APPSTARTING = 32650& 'Standard arrow and small hourglass.
Public Const IDC_ARROW = 32512& 'Standard arrow.
Public Const IDC_CROSS = 32515 'Crosshair.
Public Const IDC_HAND = 32649 'Hand.
Public Const IDC_HELP = 32651 'Arrow and question mark.
Public Const IDC_IBEAM = 32513& 'Text I-beam.
Public Const IDC_ICON = 32641& 'Windows NT only: Empty icon.
Public Const IDC_NO = 32648& 'Slashed circle.
Public Const IDC_SIZE = 32640& 'Windows NT only: Four-pointed arrow.
Public Const IDC_SIZEALL = 32646& 'Four-pointed arrow pointing north, south, east, and west.
Public Const IDC_SIZENESW = 32643& 'Double-pointed arrow pointing northeast and southwest.
Public Const IDC_SIZENS = 32645& 'Double-pointed arrow pointing north and south.
Public Const IDC_SIZENWSE = 32642& 'Double-pointed arrow pointing northwest and southeast.
Public Const IDC_SIZEWE = 32644& 'Double-pointed arrow pointing west and east.
Public Const IDC_UPARROW = 32516& 'Vertical arrow.
Public Const IDC_WAIT = 32514& 'Hourglass.
'Declarations for API Functions.
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
'Declare handles for cursor.
Private hOldCursor As Long
Private hNewCursor As Long
'The UseCursor function will load and set a system cursor or a cursor from file to a
'controls event property.
Public Function UseCursor(ByVal NewCursor As Variant)
'Load new cursor.
Select Case TypeName(NewCursor)
Case "String" 'Custom cursor from file.
hNewCursor = LoadCursorFromFile(NewCursor)
Case "Long", "Integer" 'System cursor.
hNewCursor = LoadCursor(ByVal 0&, NewCursor)
Case Else 'Do nothing
End Select
'If successful set new cursor.
If (hNewCursor > 0) Then
hOldCursor = SetCursor(hNewCursor)
End If
'Clean up.
hOldCursor = DestroyCursor(hNewCursor)
hNewCursor = DestroyCursor(hOldCursor)
End Function
Second, create a Class Module, "MouseListener":
Option Explicit
Dim WithEvents vsoWindow As Window
Private Sub Class_Initialize()
Set vsoWindow = ActiveWindow
End Sub
Private Sub Class_Terminate()
Set vsoWindow = Nothing
End Sub
Private Sub vsoWindow_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
If Button = 1 Then
Debug.Print "Left mouse button clicked"
ElseIf Button = 2 Then
Debug.Print "Right mouse button clicked"
ElseIf Button = 16 Then
Debug.Print "Center mouse button clicked"
End If
End Sub
Private Sub vsoWindow_MouseMove(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
Debug.Print "x-position is "; x
Debug.Print "y-position is "; y
modCursor.UseCursor modCursor.IDC_HAND
End Sub
Private Sub vsoWindow_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)
If Button = 1 Then
Debug.Print "Left mouse button released"
modCursor.UseCursor modCursor.IDC_HAND
ElseIf Button = 2 Then
Debug.Print "Right mouse button released"
modCursor.UseCursor modCursor.IDC_ARROW
ElseIf Button = 16 Then
Debug.Print "Center mouse button released"
End If
End Sub
Third, insert the following code into the "ThisDocument" module:
Private myMouseListener As MouseListener
Private Sub Document_DocumentSaved(ByVal doc As IVDocument)
Set myMouseListener = New MouseListener
End Sub
Private Sub Document_BeforeDocumentClose(ByVal doc As IVDocument)
Set myMouseListener = Nothing
End Sub
Now, by moving the mouse and clicking the buttons you get some information in the immediate window.
If you click the left button, the cursor changes to the hand, but when you move the mouse again, the cursor changes back. The only explanation I can think of is that Visio's events are changing the cursor icon depending on the (visual) context.
Regards,