ジオメトリの一時的な描画

'*********************************************************************
' 定義   ：fncDisplayGeometry(pGeometry As IGeometry, Rgb As Long)
' 概要   ：ジオメトリタイプに応じてジオメトリを一時描画
' 第1引数：IGeometry    描画対象のジオメトリ
' 第2引数：Long         描画色（VBAで色の定数及び値を指定）
' 戻り値 ：なし
'*********************************************************************
Public Function fncDisplayGeometry(pGeometry As IGeometry, Rgb As Long)
     
    'RgbColorオブジェクトの作成
    Dim pRgbColor As IRgbColor
    Set pRgbColor = New RgbColor
    pRgbColor.Rgb = Rgb
     
    vbRed
     
    Dim pSymbol As ISymbol
     
    Select Case pGeometry.GeometryType
        Case esriGeometryPoint                              'Point
            Dim pSimpleMarkerSymbol As ISimpleMarkerSymbol
            Set pSimpleMarkerSymbol = New SimpleMarkerSymbol
            pSimpleMarkerSymbol.Color = pRgbColor
            pSimpleMarkerSymbol.Style = esriSMSCircle
            Set pSymbol = pSimpleMarkerSymbol
             
        Case esriGeometryMultipoint                              'MultiPoint
            Dim pMSimpleMarkerSymbol As ISimpleMarkerSymbol
            Set pMSimpleMarkerSymbol = New SimpleMarkerSymbol
            pMSimpleMarkerSymbol.Color = pRgbColor
            pMSimpleMarkerSymbol.Style = esriSMSCircle
            Set pSymbol = pMSimpleMarkerSymbol
             
        Case esriGeometryPolyline                           'Polyline
            Dim pSimpleLineSymbol As ISimpleLineSymbol
            Set pSimpleLineSymbol = New SimpleLineSymbol
            pSimpleLineSymbol.Color = pRgbColor
            pSimpleLineSymbol.Style = esriSLSSolid
            Set pSymbol = pSimpleLineSymbol
             
        Case esriGeometryPolygon                            'Polygon
            Dim pSimpleFillSymbol As ISimpleFillSymbol
            Set pSimpleFillSymbol = New SimpleFillSymbol
            pSimpleFillSymbol.Color = pRgbColor
            pSimpleFillSymbol.Style = esriSFSSolid
            Set pSymbol = pSimpleFillSymbol
             
    End Select
     
    'Applicationの取得
    Dim pMxApplication As IMxApplication
    Set pMxApplication = Application
     
    'AppDisplayの取得
    Dim pDisplay As IDisplay
    Set pDisplay = pMxApplication.Display
     
    With pDisplay
        .StartDrawing pDisplay.hDC, esriNoScreenCache '描画開始
        .SetSymbol pSymbol  'シンボルの設定
         
        'ジオメトリタイプに応じて描画
        Select Case pGeometry.GeometryType
            Case esriGeometryPoint
                .DrawPoint pGeometry
         
            Case esriGeometryMultipoint
                .DrawMultipoint pGeometry
                 
            Case esriGeometryPolyline
                .DrawPolyline pGeometry
             
            Case esriGeometryPolygon
                .DrawPolygon pGeometry
             
        End Select
 
       
        .FinishDrawing  '描画終了
         
    End With
 
 
End Function