Is it possible in visual basic to have a button that you can move with a mouse drag, which stays on the same horizontal line and only moves a certain distance each way. Something like the balance control on the sound for a computer
Here's a simple example to drag a button named Command1. To limit the distance it can move, just add some conditions to the DragOver event:
Dim blnDrag As Boolean
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not blnDrag Then
blnDrag = True
Command1.Drag
End If
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.DragMode = vbnone
blnDrag = False
End Sub
Private Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
Command1.Left = X
End Sub
Private Sub Form_Load()
Command1.DragMode = vbManual
End Sub
Related
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
how to get the event Form1_MouseMove from module, i tried the following in my module but don't works.
Public sub Form1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'CODE'
End Sub
In Form1
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Module1.Form1_MouseMove Button, Shift, X, Y
end sub
In Module1
Public Sub Form1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'CODE'
End Sub
I'm trying to use a web-style button on my form, using some pictures(ok-off button, ok-pressed button and ok button)
I'm tryin to do the same as in a website. change button color when rolling over the mouse and change color again when click.
But I'm missing something here. I have achieved to change the button imagen when mouse is over it, but when i click on it, only change the picture(by procedure MouseMove), but when I release mouse button, event can't go to mouseUp event. WHat am I missing?
Private Sub okpress_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If okpress.Visible = True Then
okoff.Visible = False
okpress.Visible = True
ok.Visible = False
End If
MsgBox "ha entrado", vbOKOnly, "Prueba"
End Sub
Private Sub okoff_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If okoff.Visible = True Or okpress.Visible = True Then
okoff.Visible = False
okpress.Visible = False
ok.Visible = True
End If
End Sub
Private Sub ok_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If okpress.Visible = False Then
okoff.Visible = False
okpress.Visible = True
ok.Visible = False
End If
Dim a As Integer, b As Index, c As Single, d As Single
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ok.Visible = False
okpress.Visible = False
okoff.Visible = True
End Sub
The MouseUP event occurs after a MouseDOWN on the same form, and not where the mouse is. And when you hide the form, you also stop the event chain.
A solution for your case would be, instead of hiding the button, just show the other one in front of it.. So the MouseUP event will still occur when you release the mouse, and the result will be the same.
--
Place the buttons/images from back to front in this order: ok(c1), off(c2), press(c3)
Code:
Private Sub c1_Click()
c1.Visible = False
c2.Visible = True
End Sub
Private Sub c1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
c3.Visible = True
End Sub
Private Sub c1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
c3.Visible = False
End Sub
Private Sub c2_Click()
c1.Visible = True
c2.Visible = False
End Sub
Private Sub c2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
c3.Visible = True
End Sub
Private Sub c2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
c3.Visible = False
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
c1.Visible = False
c3.Visible = False
c2.Visible = True
End Sub
when run time, i need add many image On my picture box, i have many image and wish to connect it by picture1.line.
but i need know the actual coordinate on start point to end point(in run time).
Any example or any idea about this how to read/show coordinate of mouse pointer?
In VB6 you can do it this way. Create a new form and add the following code:
Option Explicit
Private Type POINTAPI 'Type to hold coordinates
X As Long
Y As Long
End Type
'Function that gets current position
Private Declare Sub GetCursorPos Lib "User32" (lpPoint As POINTAPI)
'On mouse move, update form
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rect As POINTAPI
'Get position
GetCursorPos rect
'Print coordinates
Me.Cls
Print "Current X = " & rect.X
Print "Current Y = " & rect.Y
End Sub
I am just novice and I tried to make a simple program in Visual Basic 6. The code is almost equivalent to that in the textbook. It was meant to be a kind of a paint program. Surprisingly, it couldn't be compiled with the error given in the title of this question.
This is the code:
Option Explicit
Dim Col As Long
Private Sub Form_Load()
AutoRedraw = True
BackColor = vbWhite
Col = vbBlack
DrawWidth = 3
End Sub
Private Sub Command1_Click()
CommonDialog1.ShowOpen
Form1.Picture = LoadPicture(CommonDialog1.FileName)
End Sub
Private Sub Command2_Click()
CommonDialog1.ShowSave
SavePicture Image, CommonDialog1.FileName
End Sub
Private Sub Command3_Click()
CommonDialog1.ShowColor
Col = CommonDialog1.Color
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
PSet (X, Y), Col
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "Line1"
DrawWidth = 3
Case "Line2"
DrawWidth = 20
End Select
End Sub
The application crashes on the following line:
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
With the error:
procedure declaration does not match description of event or procedure
having the same name
The problem is here:
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Ok, since you are coding in VB6, you get to learn some of the tricks in the VB6 playbook. Temporarily rename the method to something else like qqToolbar_ButtonClick, then go to the designer and click the button in the toolbar to regenerate the event in the code.
In the event that the signature has been mistyped, it will regenerate from the designer correctly and you might see the issue.
Another check is to see if the ToolBar1 was added to a control array? In that case, the method signature needs to look like this:
Private Sub Toolbar1_ButtonClick(ByVal Index as Integer, ByVal Button As MSComctlLib.Button)
I hope one of these helps solve the issue for you.