Как закрасить область?

[Matew]

Как мне закрасить область(она замыкается), описанную набором точек? Вот так я ее рисую:

Код: Выделить всё

for x1=1 to KolvoTochek
y1=f(x1)
h = frmD.hdc
hPen = CreatePen(PS_SOLID, 5 , 0)
hOldPen = SelectObject(h, hPen)
retval = MoveToEx(h, x1, y1, pt)
retval = LineTo(h, p, r)
retval = SelectObject(h, hOldPen)
retval = DeleteObject(hPen)
x1 = p
y1 = r
next x1
[quote]
F(x) это Function.
Я знаю, что область замыкается, но не знаю как ее закрасить!
В QBasic-е был оператор Paint, а VB6 его нет!
Подскажиет что-нибудь! Плиз![/quote]

[Cyrax]

Дорогой Джон, как...
Быстро нарисовать многоугольник?

Метод Line позволяет соединить последовательность точек прямыми линиями и вернутся в начальную точку, в результате чего образуется замкнутый многоугольник. Но API-функция Polygon работает быстрее и обладает тем преимуществом, что умеет эффективно закрышивать внутреннюю область многоугольника. Класс Poligon значительно упрощает рисование многоугольников, инкапсулируя эту API-функцию и необходимые ей данные.

Код: Выделить всё

' POLYGON.CLS
Option Explicit

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Declare Function Polygon _
Lib "gdi32" ( _
  ByVal hdc As Long, _
  lpPoint As POINTAPI, _
  ByVal nCount As Long _
) As Long

' закрытые переменные уровня модуля
Private mobjDevice As Object
Private mfSX1 As Single
Private mfSY1 As Single
Private mfXRatio As Single
Private mfYRatio As Single
Private mPointArray() As POINTAPI

' ~~~ Device (свойство)
Property Set Device(objDevice As Object)
  Dim fSX2 As Single
  Dim fSY2 As Single
  Dim fPX2 As Single
  Dim fPY2 As Single
  Dim nScaleMode As Integer
  Set mobjDevice = objDevice

  With mobjDevice
    ' получаем параметры, определяющие текущий масштаб
    nScaleMode = .ScaleMode
    mfSX1 = .ScaleLeft
    mfSY1 = .ScaleTop
    fSX2 = mfSX1 + .ScaleWidth
    fSY2 = mfSY1 + .ScaleHeight
    ' временно устанавливаем пиксельный режим
    .ScaleMode = vbPixels
    ' получаем параметры, определяющие текущий масштаб
    ' для пиксельного режима
    fPX2 = .ScaleMode
    fPY2 = .ScaleHeight
    ' восстанавливаем исходный масштаб
    If nScaleMode = 0 Then
      mobjDevase.Scale (mfSX1, mfSY1)-(fSX2, fSY2)
    Else
      mobjDevice.ScaleMode = nScaleMode
    End If
    ' вычисляем масштабные коэффициенты
    mfXRatio = fPX2 / (fSX2 - mfSX1)
    mfYRatio = fPY2 / (fSY2 - mfSY1)
  End With
End Property

' ~~~Point X, Y (метод)
Public Sub Point (fX As Single, fY As Single)
  Dim lN As Long
  lN = UBound(mPointArray) +1
  ReDim Preserve mPointArray(lN)
  mPointArray(lN).x = XtoP(fX)
  mPointArray(lN).y = YtoP(fY)
End Sub

' ~~~Draw (метод)
Public Sub Draw()
  Polygon mobjDevice.hdc, mPointArray(1), UBound(mPointArray)
  ReDim mPointArray(0)
End Sub

' выражает X-координату в пикселях
Private Function XtoP(fX As Single) As Long
  XtoP = (fX - mfSX1) * mfXRatio
End Function

' выражает Y-координату в пикселях
Private Function YtoP(fY As Single) As Long
  YtoP = (fY - mfSY1) * mfRatio
End Function

' инициализация
Private Sub Class_Initialize()
  ReDim mPointArray(0)
End Sub

Следующий код демонстрирует работу с объектом Polygon в программе. В данном примере создается многоугольник случайной формы с 17 вершинами; он закрашивается цветом, выбираемым тоже случайно. Чтобы проверить это на практике, введите показанный ниже код в модуль новой формы и добавьте на нее элемент управления PictureBox с именем picTest. (У модуля класса должно быть имя Polygon.) Запустите программу и щелкните окно рисунка.

Код: Выделить всё

' POLYTEST.FRM
Option Explicit

Dim polyTest As New Polygon

Private Sub Form_Load()
  ' каждый раз создаем уникальный многоугольник
  Randomize
  ' можно использовать любые единицы и параметры GDC
  With picTest
    .Move 0, 0, ScaleWidth, ScaleHeight
    .SclaeMode = vbInches
    .FillStyle = vbSolid
  End With
End Sub

Private Sub picTest_Click()
  Dim nI As Integer
  ' указываем элемент PictureBox как устройство,
  ' на которое выводится многоугольник
  Set polyTest.Device = picTest
  With picTest
    ' при каждом щелчке очищаем окно рисунка
    .Cls
    ' формируем случайный многоугольник с 17 вершинами
    For nI = 1 To 17
      polyTest.Point Rnd * .ScaleWidth, Rnd * .ScaleHeight
    Next nI
    ' выбираем цвет по случайному закону
    .FillColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
    ' рисуем многоугольник и закрашиваем его
    polyTest.Draw
  End With
End Sub

[GM]

Если не ошибаюсь то

Код: Выделить всё

Declare Function FloodFill Lib "gdi32" Alias "FloodFill" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

[A.A.Z.]

Абсолютно правильно! А еще лучше, ExtFloodFill - там поддерживаются разные кисти

Код: Выделить всё

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long
Const FLOODFILLBORDER = 0 ' Fill until crColor& color encountered.
Const FLOODFILLSURFACE = 1 ' Fill surface until crColor& color not encountered.
Const crNewColor = vbRed
Dim mBrush As Long
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'Create a solid brush
    mBrush = CreateSolidBrush(crNewColor)
    'Select the brush into the PictureBox' device context
    SelectObject Picture1.hdc, mBrush
    'API uses pixels
    Picture1.ScaleMode = vbPixels
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Delete our new brush
    DeleteObject mBrush
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Floodfill...
    ExtFloodFill Picture1.hdc, X, Y, GetPixel(Picture1.hdc, X, Y), FLOODFILLSURFACE
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then Picture1.PSet (X, Y)
End Sub

[Matew]

Спасибо! Я сделал через Екстфлуфид!