Drawing Rectangles

Created:1/15/1999
Description:

Use this subroutine to draw a Rectangle on the screen. With this example the rectangle will not persist on the screen; it will disappear when the screen next refreshes. See the Buffer Polygons sample for an example showing how drawings can be persisted on the display.

How to use:
  1. Add a new UITool control onto any toolbar.
  2. Paste the code below into its OnMouseDown event.
  3. Mind the name of the control, the sample assumes it is called UIToolControl1.
  4. Completely close down VBA so mouse events will fire.
  5. Select this tool, drag a rectangle on the map.
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  Dim pMxDoc As IMxDocument
  Dim pActiveView As IActiveView
  Dim pScreenDisplay As IScreenDisplay
  Dim pRubberEnv As IRubberBand
  Dim pFillSymbol As ISimpleFillSymbol
  Dim pRgbColor As IRgbColor
  Dim pEnvelope As IEnvelope

  Set pMxDoc = Application.Document
  Set pActiveView = pMxDoc.FocusMap
  Set pScreenDisplay = pActiveView.ScreenDisplay
  Set pRubberEnv = New RubberEnvelope
  
  Set pFillSymbol = New SimpleFillSymbol
  Set pRgbColor = New RgbColor
  pRgbColor.Red = 255
  pFillSymbol.Color = pRgbColor
  
  Set pEnvelope = pRubberEnv.TrackNew(pScreenDisplay, pFillSymbol)
  
  With pScreenDisplay
    .StartDrawing pScreenDisplay.hdc, esriNoScreenCache
    .SetSymbol pFillSymbol
    .DrawRectangle pEnvelope
    .FinishDrawing
  End With
End Sub