Tipp 0204 Polygone zeichnen
Autor/Einsender:
Datum:
  Michael Werner
28.02.2002
Entwicklungsumgebung:   VB 5
Regelmäßige und unregelmäßige Polygone werden mit Hilfe der Api-Funktion Polygon gezeichnet, wobei die Funktionalität in zwei Sub-Routinen gepackt wurde, die den schnellen Einbau in eigene Programme erleichtern.
 
Option Explicit

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

Private Type POINTAPI
  x As Long
  y As Long
End Type

Dim Figure() As POINTAPI
Dim Pi As Double
Dim maxEdges As Integer

Private Sub Form_Load()
  Pi = Atn(1) * 4

  With Picture1
    .ScaleMode = 3
  End With

  With HScroll1
    .Min = 3
    .Max = 30
    .Value = .Max
    Label1.Caption = "3 bis " & CStr(.Value)
  End With

  Check1.Value = vbChecked
End Sub

Private Sub Check2_Click()
  If Check2.Value Then
    Label1.Caption = CStr(maxEdges)
  Else
    Label1.Caption = "3 bis " & CStr(maxEdges)
  End If
End Sub

Private Sub Command1_Click()
  Static i As Integer

  If Check2.Value = vbChecked Then
    i = maxEdges
  Else
    i = i + 1
    If i < 3 Then i = 3
    If i > maxEdges Then i = 3
  End If

  Label2.Caption = "Ecken " & CStr(i)

  Call RegelPolygonEcken(Picture1, i, Picture1.ScaleWidth / 2, _
        Picture1.ScaleHeight / 2, Picture1.ScaleWidth / 3)
End Sub

Private Sub Command2_Click()
  Dim i As Integer

  If Check2.Value = vbChecked Then
    i = maxEdges
  Else
    Randomize Timer
    i = Int((maxEdges - 3 + 1) * Rnd + 3)
  End If

  Label2.Caption = "Ecken " & CStr(i)

  Call UnregelPolygonEcken(Picture1, i, Picture1.ScaleWidth / 2, _
        Picture1.ScaleHeight / 2, Picture1.ScaleWidth / 3)
End Sub

Private Sub HScroll1_Change()
  maxEdges = HScroll1.Value
  If Check2.Value = vbChecked Then
    Label1.Caption = CStr(maxEdges)
  Else
    Label1.Caption = "3 bis " & CStr(maxEdges)
  End If
End Sub

Private Sub RegelPolygonEcken(obj As Object, edges As Integer, _
      x As Single, y As Single, d As Integer)
  Dim i As Integer
  
  With obj
    If Check1.Value = vbChecked Then
      .FillStyle = 0
      Randomize Timer
      .FillColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
      .ForeColor = 0
    Else
      .FillStyle = 1
    End If

    .Cls
  End With

  obj.PSet (x, y)

  ReDim Figure(edges)

  For i = 0 To edges - 1
    Figure(i).x = x + d * Cos(i * 2 * Pi / edges)
    Figure(i).y = y + d * Sin(i * 2 * Pi / edges)
  Next i

  Polygon obj.hdc, Figure(0), edges
End Sub

Private Sub UnregelPolygonEcken(obj As Object, edges As Integer, _
      x As Single, y As Single, d As Integer)
  Dim i As Integer

  With obj
    If Check1.Value = vbChecked Then
      .FillStyle = 0
      Randomize Timer
      .FillColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
      .ForeColor = 0
    Else
      .FillStyle = 1
    End If

    .Cls
  End With

  obj.PSet (x, y)
  ReDim Figure(edges)

  For i = 0 To edges - 1
    Figure(i).x = _
          x + x * (0.5 + 0.5 * Rnd) * Sin(2 * Pi * i / edges)
    Figure(i).y = _
          y + y * (0.5 + 0.5 * Rnd) * Cos(2 * Pi * i / edges)
  Next i

  Polygon obj.hdc, Figure(0), edges
End Sub
 
Weitere Links zum Thema
3D-Würfel-Rotation
Kreise und Linien zeichnen
Objekte zeichnen und verschieben
Polygone zeichnen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3 kB) Downloads bisher: [ 2251 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 27. September 2011