定制Pan/Zoom工具条1－－－Fixedzoomin

<P>我先说明一下：例子中的代码都是自己写的，运行是没问题的！就是写的不好！</P>
<P>今天先贴最简单的 Fixedzoomin：它实现的功能：成一定比例的放大地图！和我们平常的拉一个矩形放大是不一样的，以后我会贴关于拉矩形放大的代码！</P>
<P>同时要说一下，我这里的代码与Ao的帮助中的还是稍微不同的！</P>
<P>具体功能：鼠标在地图上按下后，以这点为中心地图放大两倍！</P>
<P>新建一个UIcontrol叫fixedzoomin</P>
<P>Private Sub fixedzoomin_MouseDown(ByVal button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim mxdoc As IMxDocument                         'zoomin clickpoint center,same as zoomout
Dim pa As IActiveView
Dim pMap As IMap
Set mxdoc = Application.Document
Set pa = mxdoc.FocusMap
Set pMap = mxdoc.FocusMap</P>
<P>Dim pev As IEnvelope
Dim pp As IPoint
Set pp = pa.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)</P>
<P>Set pev = pa.Extent
If CDbl(pp.x) <= pev.XMin + pev.Width / 2 And CDbl(pp.y) <= pev.YMin + pev.Height / 2 Then
    pev.Width = 2 * (pp.x - pev.XMin)
    pev.Height = 2 * (pp.y - pev.YMin)
ElseIf CDbl(pp.x) < pev.XMin + pev.Width / 2 And CDbl(pp.y) > pev.YMin + pev.Height / 2 Then
    pev.Width = 2 * (pp.x - pev.XMin)
    pev.Height = 2 * (pev.YMax - pp.y)
ElseIf CDbl(pp.x) > pev.XMin + pev.Width / 2 And CDbl(pp.y) > pev.YMin + pev.Height / 2 Then
    pev.Width = 2 * (pev.XMax - pp.x)
    pev.Height = 2 * (pev.YMax - pp.y)
ElseIf CDbl(pp.x) > pev.XMin + pev.Width / 2 And CDbl(pp.y) < pev.YMin + pev.Height / 2 Then
     pev.Width = 2 * (pev.XMax - pp.x)
     pev.Height = 2 * (pp.y - pev.YMin)
End If
pev.CenterAt pp</P>
<P>pa.Extent = pev
pa.Refresh</P>
<P>End Sub</P>
<P>OK！大家可以自己实现一下Fixedzoomout</P>

<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em01.gif" />