пользовательские символы

Question

Как создать свои символы, например для обозначения болота, граница пунктирная, заливка прозрачная со значками ввиде веточек?

Answer 1

Разобрался.

Вот код класса, если кому интересно...

' ~~~~~~~~~~~~~~~~~~~~ Манакбаев У.  от  19.05.2005 23:23:38
'  Ползовательская (т.е. моя :) кисть...

Option Explicit
Implements AFCustom.ICustomFill

Dim g_hOldPen As Long
Dim g_hPen As Long
Dim g_hOldBrush As Long
Dim g_hBrush As Long

Private Declare Function PolyPolygon Lib "gdi32" (ByVal hDC As Long, lppt As Long, lpdwPolyPoints As Long, ByVal cCount As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

' -----------------------------------
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" (lpPackedDIB As Any, ByVal iUsage As Long) As Long
Private Declare Function CreateDIBPatternBrush Lib "gdi32" (ByVal hPackedDIB As Long, ByVal wUsage As Long) As Long
' -----------------------------------

Private Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type
Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long

' -----------------------------------
Private Const BS_SOLID = 0
Private Const PS_COSMETIC = &H0
Private Const PS_GEOMETRIC = &H10000
Private Const PS_DASHDOT = 3         &nbsp ;       '  _._._._
Private Const NULL_BRUSH = 5
Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Long) As Long
' -----------------------------------
Private hBrush As LOGBRUSH

Private PenStyle As Long, PenColor As Long, PenSize As Long, _
   BrushStyle As Long, BrushColor As Long
' -----------------------------------

Public Sub SetBrush(lbStyle As Long, lbColor As Long, lbHatch As Long)
   hBrush.lbColor = lbColor
   hBrush.lbHatch = lbHatch
   hBrush.lbStyle = lbStyle
End Sub

Public Sub SetPenBrush(lPenStyle As Long, lPenColor As Long, lPenSize As Long, _
   lBrushStyle As Long, lBrushColor As Long)
   PenStyle = lPenStyle
   PenColor = lPenColor
   PenSize = lPenSize
   BrushStyle = lBrushStyle
   If BrushStyle < 0 Then BrushStyle = 0
   If BrushStyle > 7 Then BrushStyle = 0
   BrushColor = lBrushColor
End Sub

Public Sub ICustomFill_Draw(ByVal hDC As Long, points As Long, partCounts As Long, ByVal numParts As Long)
  PolyPolygon hDC, points, partCounts, numParts
End Sub

Public Sub ICustomFill_ResetDC(ByVal hDC As Long)
  If Not g_hPen = 0 Then
    SelectObject hDC, g_hOldPen
    DeleteObject g_hPen
    g_hPen = 0
  End If
  If Not g_hBrush = 0 Then
    SelectObject hDC, g_hOldBrush
    DeleteObject g_hBrush
    g_hBrush = 0
  End If
End Sub

Public Sub ICustomFill_SetupDC(ByVal hDC As Long, ByVal dpi As Double, ByVal pBaseSym As Object)
   g_hPen = CreatePen(PenStyle, PenSize, PenColor)
   g_hOldPen = SelectObject(hDC, g_hPen)
   Select Case BrushStyle
      Case 0: g_hBrush = CreateSolidBrush(BrushColor)
      Case 1: g_hBrush = GetStockObject(NULL_BRUSH)
      Case Else: g_hBrush = CreateHatchBrush(BrushStyle - 2, BrushColor)
   End Select
   g_hOldBrush = SelectObject(hDC, g_hBrush)
End Sub