Rank: Member
Groups: Member
Joined: 7/11/2005(UTC) Posts: 4
|
PLEASE HELP I've prepared a form on wich I grab an image an then take some measurements. Everything went Ok until I put this form into an MDI form. The line used to trace the measurament no longer is erased, worst it's drawn two times, one about one pixel from the other and some times several pixels from the cursor position. Reading the forum i've used BitmapViewer1_ImageMouse on the original form. Below is the code used to draw the line(mido, norte as boolean) and also to draw a small bitmap (that part isn't presented) Code:Private Sub BitmapViewer1_ImageMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal Y As Long)
If mido Or norte Then
blnMouseDown =
True
'Set start coordinate of the shape to draw
lngStartX = x
lngStartY = Y
'Set end coordinate of the shape to draw
lngEndX = x
lngEndY = Y
'FastRefresh method will fire DoubleBufferPaint event. Here we can
'redraw the shape
BitmapViewer1.FastRefresh
End If
End Sub
Private Sub BitmapViewer1_ImageMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal Y As Long)
If blnMouseDown Then
'Set end coordinate of drawn shape
lngEndX = x
lngEndY = Y
Label1.Caption = "Suelte el boton para marcar el final"
'FastRefresh method will fire DoubleBufferPaint event. Here we can
'redraw the shape
BitmapViewer1.FastRefresh
End If
End Sub
Private Sub BitmapViewer1_ImageMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal Y As Long)
If mido Then
'Convert start and end coordinates from control coordinate system to bitmap one
BitmapViewer1.ControlToBitmapCoords lngStartX, lngStartY, lngStartX, lngStartY
BitmapViewer1.ControlToBitmapCoords lngEndX, lngEndY, lngEndX, lngEndY
blnMouseDown = False
BitmapViewer1.Bitmap.Graphics.Pen.ForeColor = lngPenColor
'Draw line on bitmap
BitmapViewer1.Bitmap.Graphics.DrawLine lngStartX, lngStartY, lngEndX, lngEndY
Command1(9).Visible = True
Command1(9).Enabled = True
Text1.Enabled = True
Text1.Visible = True
Text1.SetFocus
Label1.Caption = "¿Cual es la dimensión en metros del segmento?"
'BitmapViewer1.Bitmap.LoadFromFile imagen
Command1(6).Enabled = False
End If
If señalo Then
'obtengo las coordenadas del centro de la planta en pixeles
'x,y son independientes del zoom
BitmapViewer1.ControlToBitmapCoords locaX, locaY, x, Y
instalax = locaX
instalay = locaY
Command1(7).Enabled = False
Command1(8).Enabled = True
Label1.Caption = "Ahora traze un segmento de Sur a Norte"
instala
End If
If norte Then
'Convert start and end coordinates from control coordinate system to bitmap one
BitmapViewer1.ControlToBitmapCoords lngStartX, lngStartY, lngStartX, lngStartY
BitmapViewer1.ControlToBitmapCoords lngEndX, lngEndY, lngEndX, lngEndY
locaX = (lngEndX - lngStartX)
'debido al manejo de coordenadas del contenedor hay que invertir el signo de Y
locaY = (lngEndY - lngStartY) * -1
a = 0
norte = False
blnMouseDown = False
On Error Resume Next
a = (180 / 3.141596) * Atn(Abs(locaY) / Abs(locaX))
If locaX > 3 And locaY < -3 And a > 1 And a < 91 Then a = a + 90
If locaX < -3 And locaY < -3 And a > 1 And a < 91 Then a = a + 180
If locaX < -3 And locaY > 3 And a > 1 And a < 91 Then a = a + 270
If a > 88 And a < 92 And locaX < 3 And locaX > -3 And locaY > 3 Then a = 0
If a > -2 And a < 2 And locaY > -3 And locaX > 3 And locaY < 3 Then a = 90
If a > 88 And a < 92 And locaX < 3 And locaX > -3 And locaY < -3 Then a = 180
If a > -2 And a < 2 And locaX < -3 And locaY > -3 And locaY < 3 Then a = 270
On Error GoTo 0
'Creas el objeto Bitmap
Dim objSmallBitmap As New Bitmap
'Cargas la imagen a sobreponer
'la ruta en camino, cambiar al integrar al ERA
objSmallBitmap.LoadFromFile camino + "imagenes\Norte2.jpg"
'Conviertes al mismo formato de la imagen base
objSmallBitmap.Data.ConvertTo24bppRgb True
objSmallBitmap.Transforms.Rotate a, InterpolationModeMediumQuality, &HFFFFFFFF
objSmallBitmap.DrawOnBitmap BitmapViewer1.Bitmap, (ancho - 50), 1, , , , , , , CombineModeCopy 'CombineModeIfLighter
BitmapViewer1.FastRefresh
Command1(8).Enabled = False
Label1.Caption = ""
End If
If BitmapViewer1.MousePointer = MousePointerCrosshair Then BitmapViewer1.MouseMode = MouseModeNone
End Sub
Private Sub BitmapViewer1_DoubleBufferPaint(ByVal hdc As stdole.OLE_HANDLE)
If mido Or norte Then
'Attach Graphics to the temporary DC (control's double buffer)
objGraphics.hdc = hdc
'Adjust pen and brush
objGraphics.Brush.PrimaryColor = lngBrushColor
objGraphics.Pen.ForeColor = lngPenColor
'Scale pen weight proportionally to zoom
objGraphics.Pen.Weight = lngPenWeight * BitmapViewer1.Zoom
'Set clip area
Dim lngClipTop As Long, lngClipLeft As Long, lngClipRight As Long, lngClipBottom As Long
BitmapViewer1.BitmapToControlCoords 0, 0, lngClipLeft, lngClipTop
BitmapViewer1.BitmapToControlCoords BitmapViewer1.Bitmap.Data.Width, BitmapViewer1.Bitmap.Data.Height, lngClipRight, lngClipBottom
Dim hRgn As Long
hRgn = CreateRectRgn(lngClipLeft, lngClipTop, lngClipRight, lngClipBottom)
SelectClipRgn hdc, hRgn
'Draw line on control
objGraphics.DrawLine lngStartX, lngStartY, lngEndX, lngEndY
Debug.Print lngStartX; lngStartY; lngEndX; lngEndY
DeleteObject hRgn
End If
End Sub
The labels and some indications are in spanish if you need a translation I gladly will provide it. :'( :'( Edited by user Sunday, December 23, 2007 5:49:01 PM(UTC)
| Reason: Not specified
|