关于NorthArrowSelector指北针不出现，快要哭了！！

<P>下面这段代码运行后怎么不弹出Selector？？？

Dim m_pStyleSelector As IStyleSelector
Set m_pStyleSelector = New NorthArrowSelector
m_bOK = m_pStyleSelector.DoModal(PageLayoutControl1.hWnd)
If Not m_bOK Then Exit Sub

m_bOK为false，为什么这样呢？ ：（</P>
<P>各位高手指点一下啊！！！万分感激！！！！！
</P><img src="images/post/smile/dvbbs/em02.gif" />

装了arcgis吗？

当然装了啊，要不怎么能用ao呢，自带的例子都实现不了，以前的帖子里似乎有类似的问题，可是仍没人解决哦，都快疯了！<img src="images/post/smile/dvbbs/em02.gif" />

各位高手帮忙哦！万分感激了！这个没实现专题图制作模块就不好往下做了！<img src="images/post/smile/dvbbs/em01.gif" /><img src="images/post/smile/dvbbs/em02.gif" />

<P>这个功能和自定义符号，我是自己开发的，毕竟AE不支持这个对话框！</P><P>用imagelist控件的add方法，加载符号库中的符号</P><P>然后在listitem中设置icon为imagelist</P><P>用到了两个重要的函数</P><P>
Public Function CreatePictureFromSymbol(ByVal hDCOld As Long, ByRef hBmpNew As Long, ByVal pSymbol As ISymbol, ByVal lWidth As Long, ByVal lHeight As Long, Optional lGap As Long = 0) As IPictureDisp
  On Error GoTo errH
  
  Dim hDCNew As Long, hBmpOld As Long
  hDCNew = CreateCompatibleDC(hDCOld)
  hBmpNew = CreateCompatibleBitmap(hDCOld, lWidth, lHeight)
  hBmpOld = SelectObject(hDCNew, hBmpNew)
  
  ' Draw the symbol to the new device context.
  Dim lResult As Long
  lResult = DrawToPicDC(hDCNew, lWidth, lHeight, pSymbol, lGap)
  
  hBmpNew = SelectObject(hDCNew, hBmpOld)
  DeleteDC hDCNew</P><P>  ' Return the Bitmap as an OLE Picture.
  Set CreatePictureFromSymbol = CreatePictureFromBitmap(hBmpNew)</P><P>Exit Function
errH:
  If Err.Number <> 0 Then
    If Not pSymbol Is Nothing Then
      pSymbol.ResetDC
      If hBmpNew <> 0 And hDCNew <> 0 And hBmpOld <> 0 Then
        hBmpNew = SelectObject(hDCNew, hBmpOld)
        DeleteDC hDCNew
      End If
    End If
  End If
End Function</P><P>Public Function DrawToDC(ByVal hdc As OLE_HANDLE, lWidth As Long, lHeight As Long, ByVal pSymbol As ISymbol, Optional lGap As Long = 0) As Boolean
  On Error GoTo errH
  
  DrawToDC = False
  
  If hdc <> 0 Then
  
    ' First clear the existing device context. 设置背景色
    If Not Clear(hdc, ;HC8D0D4, 0, 0, lWidth, lHeight) Then
      Err.Raise vbObjectError + 7002, "basDrawSymbol.DrawToDC", "Could not clear the Device Context."
      Exit Function
    End If
            
    ' Create the Transformation and Geometry required by ISymbol::Draw.
    Dim pEnvelope As IEnvelope, pTransformation As ITransformation, pGeom As IGeometry
    Set pEnvelope = New Envelope
    pEnvelope.PutCoords lGap, lGap, lWidth - lGap, lHeight - lGap
    Set pTransformation = CreateTransFromDC(hdc, lWidth, lHeight)
    Set pGeom = CreateSymShape(pSymbol, pEnvelope)
    
    ' Perform the Draw operation.
    If Not pTransformation Is Nothing And Not pGeom Is Nothing Then
      pSymbol.SetupDC hdc, pTransformation
      pSymbol.Draw pGeom
      pSymbol.ResetDC
      DrawToDC = True
    Else
      Err.Raise vbObjectError + 7008, "basDrawSymbol.DrawToDC", "Could not create required Transformation or Geometry for this draw operation."
    End If
  End If</P><P>Exit Function
errH:
  If Err.Number <> 0 Then
    If Not pSymbol Is Nothing Then
      pSymbol.ResetDC
    End If
  End If
End Function</P>

<P>Public m_bOK As Boolean
Public m_pSymbol As IMarkerSymbol</P><P>Private Sub DrawSymbol()
    lvNorthArrow.ListItems.Clear
    Set lvNorthArrow.Icons = Nothing
    imlStyle.ListImages.Clear
        
    Dim lGap As Long
    lGap = 2
        
    Dim pSymbol As ISymbol
    Dim symIndex As Long
    For symIndex = 1 To 93
        Set pSymbol = MakeNorthArrowSymbol(symIndex + 32)
        Dim hBmpNew As Long
        imlStyle.ListImages.Add symIndex, , CreatePictureFromSymbol(picMem.hdc, hBmpNew, pSymbol, picMem.ScaleWidth, picMem.ScaleHeight, lGap)
        DeleteObject hBmpNew
    Next
        
    Set lvNorthArrow.Icons = imlStyle
    For symIndex = 1 To 93
        lvNorthArrow.ListItems.Add symIndex, , "Esri North " ; symIndex, symIndex
    Next
End Sub</P><P>Private Sub cmdCancle_Click()
    Unload Me
End Sub</P><P>Private Sub cmdOK_Click()
      m_bOK = True
      
      Unload Me
End Sub</P><P>Private Sub Form_Load()
    basMakeSymbols.m_dSize = 50
    DrawSymbol
      
    m_bOK = False
End Sub</P><P>Private Sub lvNorthArrow_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Set m_pSymbol = MakeNewCharacterMarkerSymbol(Item.Index + 32)</P><P>    Dim lResult As Boolean, lGap As Long
    lGap = 2</P><P>    lResult = DrawToDC(picPreview.hdc, picPreview.ScaleWidth, picPreview.ScaleHeight, m_pSymbol, lGap)
End Sub
</P><P>以上代码应该就可以实现这个功能了</P>

希望各位把自己的好东东共享，一起进步！

? MakeNorthArrowSymbol是怎样定义呢？<img src="images/post/smile/dvbbs/em05.gif" /><img src="images/post/smile/dvbbs/em05.gif" />

???basMakeSymbols是什么东东？<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />