ジオメトリ タイプに応じてジオメトリを一時描画

'*********************************************************************
' 定義   ：fncDisplayGeometry(pGeometry As IGeometry, Rgb As Long)
' 概要   ：ジオメトリタイプに応じてジオメトリを一時描画
' 第1引数：IGeometry    描画対象のジオメトリ
' 第2引数：Long         描画色（VBAで色の定数及び値を指定）
' 第3引数：Integer      Styleの定数を数値で指定
' 戻り値 ：なし
'*********************************************************************
Public SubfncDisplayGeometry(pGeometry As IGeometry, Rgb As Long, Style As Integer)
     
    'RgbColorオブジェクトの作成
    Dim pRgbColor As IRgbColor
    Set pRgbColor = New RgbColor
    pRgbColor.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 = Style
            Set pSymbol = pSimpleMarkerSymbol
             
        Case esriGeometryMultipoint                              'MultiPoint
            Dim pMSimpleMarkerSymbol As ISimpleMarkerSymbol
            Set pMSimpleMarkerSymbol = New SimpleMarkerSymbol
            pMSimpleMarkerSymbol.Color = pRgbColor
            pMSimpleMarkerSymbol.Style = Style
            Set pSymbol = pMSimpleMarkerSymbol
             
        Case esriGeometryPolyline                           'Polyline
            Dim pSimpleLineSymbol As ISimpleLineSymbol
            Set pSimpleLineSymbol = New SimpleLineSymbol
            pSimpleLineSymbol.Color = pRgbColor
            pSimpleLineSymbol.Style = Style
            Set pSymbol = pSimpleLineSymbol
             
        Case esriGeometryPolygon                            'Polygon
            Dim pSimpleFillSymbol As ISimpleFillSymbol
            Set pSimpleFillSymbol = New SimpleFillSymbol
            pSimpleFillSymbol.Color = pRgbColor
            pSimpleFillSymbol.Style = Style
            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
            Case esriGeometryEnvelope
                .DrawRectangle pGeometry
             
        End Select
 
       
        .FinishDrawing  '描画終了
         
    End With
 
 
End Function