贡献一个画图时显示鼠标痕迹的简单方法，希望能对大家有所帮助

[locket]

以前用VB做过三个月的图形，但是一个很简单的问题始终没有解决，就是在用鼠标选择的时候如何能显示鼠标所选择的区域痕迹？起初使用画线和檫除的方法，但是效果不理想，一个是抖动，另一个是原图有些也被檫了。
今天又要解决这个难题了，想用DrawMode，可不行。但下面的一个Shape引起了我的注意。
后来采用Shape控件来解决这个问题，希望能对大家有所帮助。
2004/10/27 By Locket

1，在PICTURE BOX上放一个SHAP控件shp，在FORM_LOAD里设置shp.visible = false
2，在picture_mousedown里
shp.visible = true
shp.width = 0
shp.height = 0
记录下x和y，保存在m_OldX 和 m_OldY里
3，在picture_mousemove里调用
Private Sub ShowDrawShap(x, y)
'四个方向 用shp.move 也可以实现
If (x >= m_OldX) And (y >= m_OldY) Then '右下方
shp.Top = m_OldY
shp.Left = m_OldX
ElseIf (x >= m_OldX) And (y < m_OldY) Then '右上方
shp.Top = y
shp.Left = m_OldX
ElseIf (x < m_OldX) And (y < m_OldY) Then '左上方
shp.Top = y
shp.Left = x
ElseIf (x < m_OldX) And (y >= m_OldY) Then '左下方
shp.Top = m_OldY
shp.Left = x
End If
shp.Width = Abs(x - m_OldX)
shp.Height = Abs(y - m_OldY)
End Sub
4，在picture_mouseup里
shp.visible = false
shp.width = 0
shp.height = 0

[AprilSong]

写了个短点的～
但Shape始终是一闪一闪的
加个 Shape1.BorderStyle = 3 会好点……


Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static StartX As Single, StartY As Single

Dim ShapeLeft As Single, ShapeTop As Single
If Button = 1 And Shape1.Visible = False Then
StartX = X
StartY = Y
End If

Shape1.Move IIf(StartX < X, StartX, X), IIf(StartY < Y, StartY, Y), Abs(StartX - X), Abs(StartY - Y)
Shape1.Visible = (Button = vbLeftButton)
End Sub

[AprilSong]

啊～
Dim ShapeLeft As Single, ShapeTop As Single
这行忘了删……

[henryluo1118]

呵呵，看看微软的办法。修改一下效果更好。

Knowledge Base

How to Create Rubber-Band Lines/Boxes in Visual BasicPSS ID Number: 71488

Article Last Modified on 11/18/2003


--------------------------------------------------------------------------------
The information in this article applies to:


Microsoft Visual Basic Standard Edition for Windows 3.0
Microsoft Visual Basic Professional Edition for Windows 3.0
Microsoft Visual Basic Standard Edition for Windows 1.0

--------------------------------------------------------------------------------

This article was previously published under Q71488
SUMMARY
Creating rubber bands within Visual Basic can be done using the DrawMode property. Rubber bands are lines that stretch as you move the mouse cursor from a specified point to a new location. This can be very useful in graphics programs and when defining sections of the screen for clipping routines.
MORE INFORMATION
The theory of drawing a rubber-band box is as follows:
Draw a line from the initial point to the location of the mouse cursor using:
[form].DrawMode = 6. {INVERT}


Move the mouse cursor.
Save the DrawMode.
Set the [form].DrawMode to 6. {INVERT}
Draw the same line that was drawn in step 1. This will restore the image underneath the line.
Set the [form].DrawMode back to the initial DrawMode saved in step 3.
Repeat the cycle again.
DrawMode equal to INVERT allows the line to be created using the inverse of the background color. This allows the line to be always displayed on all colors.

The sample below will demonstrate the rubber-band line and the rubber-band box. Clicking the command buttons will allow the user to select between rubber-band line or a rubber-band box. The user will also be able to select a solid line or a dashed line.

Create and set the following controls and properties:

Control Name Caption Picture
------------------------------------------------
Form1 Form1 c:\windows\chess.bmp
Command1 RubberBand
Command2 RubberBox
Command3 Dotted
Command4 Solid


In the general section of your code, define the following constants:

Const INVERSE = 6 '*Characteristic of DrawMode property(XOR).
Const SOLID = 0 '*Characteristic of DrawStyle property.
Const DOT = 2 '*Characteristic of DrawStyle property.
Const TRUE = -1
Const FALSE = 0
Dim DrawBox As Integer '*Boolean-whether drawing Box or Line
Dim OldX, OldY, StartX, StartY As Single '* Mouse locations


In the appropriate procedures, add the following code:

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As
Single, Y As Single)
'* Store the initial start of the line to draw.
StartX = X
StartY = Y

'* Make the last location equal the starting location
OldX = StartX
OldY = StartY
End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As
Single, Y As Single)
'* If the button is depressed then...
If Button Then
'* Erase the previous line.
Call DrawLine(StartX, StartY, OldX, OldY)

'* Draw the new line.
Call DrawLine(StartX, StartY, X, Y)

'* Save the coordinates for the next call.
OldX = X
OldY = Y
End If
End Sub

Sub DrawLine (X1, Y1, X2, Y2 As Single)
'* Save the current mode so that you can reset it on
'* exit from this sub routine. Not needed in the sample
'* but would need it if you are not sure what the
'* DrawMode was on entry to this procedure.
SavedMode% = DrawMode

'* Set to XOR
DrawMode = INVERSE

'*Draw a box or line
If DrawBox Then
Line (X1, Y1)-(X2, Y2), , B
Else
Line (X1, Y1)-(X2, Y2)
End If

'* Reset the DrawMode
DrawMode = SavedMode%
End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single,
Y As Single)
'* Stop drawing lines/boxes.
StartEvent = FALSE
End Sub

Sub Command2_Click ()
'* Boolean value to determine whether to draw a line or box.
DrawBox = TRUE
End Sub

Sub Command1_Click ()
'* Boolean value to determine whether to draw a line or box.
DrawBox = FALSE
End Sub

Sub Command3_Click ()
'* Create a dotted line
Form1.DrawStyle = DOT
End Sub

Sub Command4_Click ()
'* Create a solid line.
Form1.DrawStyle = SOLID
End Sub



Additional query words: 2.00 3.00

Keywords: KB71488
Technology: kbAudDeveloper kbVB300 kbVB300Search kbVBSearch kbZNotKeyword2 kbZNotKeyword6

[locket]

TO AprilSong(X) 在MOUSEMOVE中不要去判断VISIBLE可能会好点，或者换一种方法：设置SHAPE的VISIBLE=TRUE，在MOVE结束后设置LEFT<0 AND TOP<0

TO henryluo1118() 非常感谢，这种方法以前用过，可能有些属性没设好吧，总觉得效果不太好，会破坏图形。有时间再试一次。

这个只是一个小想法，大家有什么更好的方法都可以写出来。非常欢迎大家指正。