|
阅读：1573回复：1
鹰眼图在VB+MapObjects2.3中的实现(下)
<P>下面是类模块的代码，类模块名称为DragDLL.CLs</P>
<P>将上下结合使用就能实现完满的鹰眼图</P> <P>'Map2指鹰眼窗口<BR>' WinAPI函数定义<BR>'hdc 设备,hwnd 表示窗体,这里指Map2<BR>'GetDC 获的设备<BR>'ReleaseDC '释放设备<BR>'GdiRectangle 绘制矩形窗体<BR>'GdiRectangle 设置指定设备场景的绘图模式。这里指Map2</P> <P><BR>Private Declare Function GdiRectangle Lib "gdi32" Alias "Rectangle" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long<BR>Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long<BR>Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long<BR>Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long</P> <P>'设置绘制的样式为反色，反色呈透明状,R2_NOTXORPEN是nDrawMode的一种方式<BR>Private Const R2_NOTXORPEN = 10 </P> <P>'地图对象的定义<BR>Dim map_map As MapObjects2.Map</P> <P>'下面变量的作用是动态标示红色矩形的位置<BR>Dim map_hDC As Long '绘制的设备句柄<BR>Dim map_hWnd As Long '绘制的窗体句柄<BR>Dim map_xMin As Integer, map_yMin As Integer ' 动态标示说绘制矩形坐标<BR>Dim map_xMax As Integer, map_yMax As Integer ' 动态标示说绘制矩形坐标<BR>Dim map_xPrev As Integer ' 记录点击位置<BR>Dim map_yPrev As Integer ' 记录点击位置<BR>Dim xNext As Integer ' 记录后一点击Ｘ位置<BR>Dim yNext As Integer ' 记录后一点击Ｙ位置</P> <P>Function DragFinish(x As Single, y As Single) As MapObjects2.Rectangle</P> <P><BR> GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax<BR> ReleaseDC map_hWnd, map_hDC<BR> <BR> '返回说绘制的矩形<BR> Dim r As New MapObjects2.Rectangle<BR> PixelsRectToMap map_xMin, map_yMin, map_xMax, map_yMax, r<BR> Set DragFinish = r<BR>End Function</P> <P>Sub DragMove(x As Single, y As Single)<BR>' 记录所点击的后一位置并转化为窗体坐标<BR> xNext = map_map.Parent.ScaleX(x, vbTwips, vbPixels)<BR> yNext = map_map.Parent.ScaleY(y, vbTwips, vbPixels)<BR> <BR> <BR> GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax<BR> <BR> '找出拖动后鼠标的位置，并画出矩形<BR> map_xMin = map_xMin + (xNext - map_xPrev)<BR> map_xMax = map_xMax + (xNext - map_xPrev)<BR> map_yMin = map_yMin + (yNext - map_yPrev)<BR> map_yMax = map_yMax + (yNext - map_yPrev)<BR> <BR> GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax<BR> <BR> '记录所点击的前一位置并转化为窗体坐标<BR> map_xPrev = xNext<BR> map_yPrev = yNext<BR>End Sub</P> <P>Sub DragStart(rect As MapObjects2.Rectangle, Map As MapObjects2.Map, x As Single, y As Single)<BR> Set map_map = Map<BR> ' 初始化 hwnd 和 hdc 变量<BR> map_hWnd = map_map.hwnd '获得Map2的窗体的句柄<BR> map_hDC = GetDC(map_hWnd)<BR> SetROP2 map_hDC, R2_NOTXORPEN '在拖动红色矩形框色，Map2会重新绘制</P> <P> '将Map中的坐标转换为窗体坐标,目的是为了绘制矩形窗体<BR> MapRectToPixels rect, map_xMin, map_yMin, map_xMax, map_yMax<BR> <BR> ' 绘制矩形窗体<BR> GdiRectangle map_hDC, map_xMin, map_yMin, map_xMax, map_yMax<BR> <BR> ' 记录所点击的前一位置并转化为窗体坐标<BR> map_xPrev = map_map.Parent.ScaleX(x, vbTwips, vbPixels)<BR> map_yPrev = map_map.Parent.ScaleY(y, vbTwips, vbPixels)<BR>End Sub</P> <P>'将Map中的坐标转换为窗体坐标<BR>Private Sub MapRectToPixels(r As MapObjects2.Rectangle, xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer)<BR> Dim p As New MapObjects2.Point<BR> Dim xc As Single, yc As Single<BR> <BR> p.x = r.Left<BR> p.y = r.Top<BR> map_map.FromMapPoint p, xc, yc<BR> <BR> ' 转化为像素（左上角坐标）<BR> xMin = map_map.Parent.ScaleX(xc, vbTwips, vbPixels)<BR> yMin = map_map.Parent.ScaleY(yc, vbTwips, vbPixels)</P> <P> p.x = r.Right<BR> p.y = r.Bottom<BR> map_map.FromMapPoint p, xc, yc<BR> <BR> ' 转化为像素（右下角坐标）<BR> xMax = map_map.Parent.ScaleX(xc, vbTwips, vbPixels)<BR> yMax = map_map.Parent.ScaleY(yc, vbTwips, vbPixels)<BR>End Sub</P> <P>Sub PixelsRectToMap(xMin As Integer, yMin As Integer, xMax As Integer, yMax As Integer, r As MapObjects2.Rectangle)<BR> Dim xc As Single, yc As Single<BR> <BR> ' 将左上角窗体坐标转换为地图坐标<BR> xc = map_map.Parent.ScaleX(xMin, vbPixels, vbTwips)<BR> yc = map_map.Parent.ScaleY(yMin, vbPixels, vbTwips)<BR> <BR> Set p = map_map.ToMapPoint(xc, yc)<BR> r.Left = p.x<BR> r.Top = p.y</P> <P> ' 将右下角窗体坐标转换为地图坐标<BR> xc = map_map.Parent.ScaleX(xMax, vbPixels, vbTwips)<BR> yc = map_map.Parent.ScaleY(yMax, vbPixels, vbTwips)<BR> Set p = map_map.ToMapPoint(xc, yc)<BR> r.Right = p.x<BR> r.Bottom = p.y<BR>End Sub</P> |
|
|
1楼#
发布于：2007-06-15 19:51
<STRONG>vb+Mapinfo开发</STRONG><img src="images/post/smile/dvbbs/em02.gif" />
|
|
