In my application I have two picture boxes. Picture1 is aligned to bottom. When I press the mouse button and move the Picture2, the height of Picture1 will change accordingly. Its working fine.
My problem is when I resize the form Picture1 and Picture2 are in different position. Picture2 is not exactly in the top position of Picture1.
Private Sub Form_Resize()
Picture2.Width = Me.ScaleWidth
Picture2.Top = Picture1.Height + Picture1.Top
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Screen.MousePointer = 7
If Button = 1 Then
Picture2.Top = Picture2.Top + (Y)
Picture1.Height = Me.Height - Picture2.Top - 720
End If
End Sub
I am not sure what are you trying to accomplish. It seems to me that Picture1
is aligned to top, not bottom.
Anyway. Did you mean this?
Private Sub Form_Resize()
Picture2.Width = ScaleWidth
Picture2.Top = Picture1.Top + Picture1.Height
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Screen.MousePointer = 7
If Button = 1 Then
Picture2.Top = Picture2.Top + (Y)
Picture1.Height = Picture2.Top
End If
End Sub
The picture boxes should stay in the same position wheather you resize the form or not. As #ota milink said, I do not know what you are truly one to accomplish.
Related
How can I show the title bar of a form only if the mouse is at the top of the form like on Windows Media Player 9? I already implemented this but it is awkward and the controls/elements and the window moves down a little if I use my code while WMP 9/10's window stays at the current position.
Private Sub Timer1_Timer()
Dim pos as coord 'my type, has x as long and y as long
GetCursorPos pos
If pos.y * 15 > Me.Top - 500 And pos.y * 15 < Me.Top + 300 And pos.x * 15 > Me.Left And pos.x * 15 < Me.Left + Me.Width Then
Me.BorderStyle = 2
Me.Caption = Me.Caption
Else
Me.BorderStyle = 0
Me.Caption = Me.Caption
End If
End Sub
so i have developed this game in visual basic 6.0,a maze game in which i want my mouse cursor to be set on the start label on the form with maze and once the form is activated and gets focus!
Dim label1 As New label=Start
I've done similar tasks in the past using the Windows API. In the following example, a Form contains a Label named 'Label1' that is positioned somewhere on the Form. When the Form is Activated, the cursor will be centered on 'Label1':
Option Explicit
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Sub Form_Activate()
Dim wr As RECT
Dim tb As Long
Dim le As Long
Dim x As Long
Dim y As Long
'calculate coordinates
Call GetWindowRect(Me.hwnd, wr) 'window coordinates
tb = (Me.Height - Me.ScaleHeight) - (Me.Width - Me.ScaleWidth) / 2 'title bar height
le = (Me.Width - Me.ScaleWidth) * 0.5 'left edge of client area
'calculate center of label
x = wr.Left + ScaleX(le + Label1.Left + Label1.Width * 0.5, Me.ScaleMode, vbPixels)
y = wr.Top + ScaleY(tb + Label1.Top + Label1.Height * 0.5, Me.ScaleMode, vbPixels)
SetCursorPos x, y
End Sub
lblRoom is control array of labels and brdrRoom is control array of shapes, On double click over each label, we can drag it with mouse. When one label move slowly over others there is no problem, it moves smooth, but when mouse move fast and when reach on center of other labels it gets moves and selected label goes stationary.
Code segment for MouseMove is given as:
Private Sub lblRoom_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
SelectedItemIndex = Index
XPos = lblRoom(SelectedItemIndex).Left + X
YPos = lblRoom(SelectedItemIndex).Top + Y
If DragItem = True Then
lblRoom(SelectedItemIndex).Left = XPos - lblRoom(SelectedItemIndex).Width / 2
lblRoom(SelectedItemIndex).Top = YPos - lblRoom(SelectedItemIndex).Height / 2
brdrRoom(SelectedItemIndex).Left = XPos - brdrRoom(SelectedItemIndex).Width / 2
brdrRoom(SelectedItemIndex).Top = YPos - brdrRoom(SelectedItemIndex).Height / 2
End If
End Sub
What is the problem ? Help me :)
When you move overtop another label, it's getting MouseMove() events as well and so your procedure is presumably switching the SelectedItemIndex between your two labels.
To fix this, you should ignore mouse events from other labels besides the one you're dragging. For example:
Private m_intDragIndex As Long
Private Sub lblRoom_DblClick(Index As Integer)
m_intDragIndex = Index
End Sub
Private Sub lblRoom_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
' Only process events from the label that was double-clicked...
If Index <> m_intDragIndex Then Exit Sub
...
End Sub
You haven't said when the drag should stop, but whatever you're doing to end the drag, make sure to set m_intDragIndex = -1 or some other "invalid" value.
i have used loads of websites for this but none worked so i am hoping i could get a correct answer
i have tried this could any one tell me whats wrong with it:
Private sub Picture1_mouseDown
x = picture1.currentx
y = picture1.currenty
End sub
Private sub Picture1_MouseMove
If button = 1 then
line (picture1.currentx,picture1.currenty)-(x,y), _
QBColor(0)
End if
End sub
i have cut the Private sub Picture1_MouseMove,Mousedown() bits off because i am in a rush to finish
This one will draw a line, only slightly different from kurniliya's solution which draws points
Option Explicit
Private lastX As Single
Private lastY As Single
Private Sub Form_Load()
' no need to set this every time we move the mouse inside Picture1
Picture1.DrawWidth = 5
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture1.Line (lastX, lastY)-(X, Y), vbBlue
End If
lastX = X
lastY = Y
End Sub
You draw a line on PictureBox control using its Line method:
Sub Line(Flags As Integer, X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, Color As Long)
Member of VB.PictureBox
Draws lines and rectangles on an object.
There isn't much to say about it, and it has already been covered in How do you draw a line dynamically in vb6?
You seem to have trouble with writing event handlers though. If you don't know/remember the signature, IDE is always there to assist. Check out Assigning Code to a Control to Respond to an Event in VB6 tutorial.
There is the code to help you get started with drawing. Picture1 is PictureBox control. Blue line will be drawn when you move your mouse over the picture box holding left mouse button down.
Option Explicit
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture1.DrawWidth = 5
Picture1.Line (X, Y)-(X, Y), vbBlue
End If
End Sub
How i can to Draw Original diameter in form, with Pset method?
i want to draw a line like this : see image
thanks.
Open a new vb project (Standard Executable) and copy/paste this code.
Option Explicit
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
End Sub
Private Sub DrawLine()
Dim i As Single
Dim Angle As Single
Cls
If Me.ScaleHeight = 0 Then
Exit Sub
End If
If Me.WindowState = vbMinimized Then
Exit Sub
End If
Angle = Atn(Me.ScaleWidth / Me.ScaleHeight)
For i = 0 To Sqr(Me.ScaleWidth * Me.ScaleWidth + Me.ScaleHeight * Me.ScaleHeight)
PSet (i * Sin(Angle), i * Cos(Angle))
Next
End Sub
Private Sub Form_Resize()
Call DrawLine
End Sub
Private Sub circleRoutine(aX As Single, aY As Single, Radius As Single, Steps As Single)
Dim currAngleX As Single
Dim i As Integer
aX = aX - Radius * 1 / Steps
For currAngleX = 0 To Rad(360) Step Steps
aX = aX + Radius * Sin(currAngleX)
aY = aY + Radius * Cos(currAngleX)
Me.PSet (aX, aY)
Next currAngleX
End Sub
Private Sub DrawCircle(ByVal X As Single, ByVal Y As Single, ByVal Diameter As Single, ByVal PointsToDraw As Long)
Dim Angle As Single
For Angle = 0 To 2 * 3.14159 Step (2 * 3.14159) / PointsToDraw
Me.PSet (X + Diameter * Sin(Angle) / 2, Y + Diameter * Cos(Angle) / 2), vbRed
Next
End Sub
You should be aware that there is a Circle function that you can use instead. The code above could be replaced with:
Me.Circle (X,Y), Diameter / 2, vbRed
PSet is a relatively slow way to draw graphics, especially when there is already a built-in function you can use instead.