Kreis mit Farbverlauf zeichnen Kreis mit einem frei definierbaren Farbverlauf gefüllt zeichnen
Autor:   Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  15.382
ohne Homepage	System:  Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 16 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.2 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Um einen Farbverlauf in einem Kreis zu erstellen, würde man spontan der Idee folgen, konzentrische Kreise um den Mittelpunkt zu zeichnen - beginnend vom Radius 1 bis zum Kreisradius.

In der Praxis enstehen dabei aber meist 'Muster', weil die konzentrischen Kreislinien die Kreis-Fläche nicht gleichmäßig und vollständig auffüllen.

Um das zu vermeiden, durchläuft man die Pixel-Punkte eines umschließenden Rechtecks und

• prüft, ob eine bestimmte Punkt-Position innerhalb der Zeichenfläche und innerhalb des Kreises liegt;
• bestimmt die Distanz des Punktes vom Zentrum des Farb-Gradienten;
• und berechnet die Farbwerte, die der Distanz entsprechen

Auf diese Weise 'erwischt' man zuverlässig jeden Pixel des Kreises. Das Zentrum des Gradienten braucht bei dieser Vorgehensweise nicht identisch mit dem Kreismittelpunbkt zu sein.

Solange die Kreise nicht zu groß sind, reicht die begrenzte Effizienz der 'SetPixel'-Methode des Bitmap-Objekts (im Namespace: System.Drawing) völlig aus.

Die Routine 'Kreis_mit Farbverlauf' benötigt als Parameter die Bitmap, in die gezeichnet werden soll (eingestellt für 32-Bit-ARGB-Farben).

Als nächste Parameter werden der gewünschte Kreismittelpunkt und der -radius übergeben. Es folgt die Angabe der Position des Gradientenzentrums (das innerhalb des Kreises liegen sollte).

Der Farb-Verlauf wird durch die Angabe der ARGB-Werte des Kreisrandes und des Kreiszentrums definiert. Gezeichnet werden lineare Verläufe.

Aufruf-Beispiele:

Dim bmp As New System.Drawing.Bitmap(400, 400)
 
' Grauer Kreis mit hellem Fleck rechts unten
Kreis_mit_Farbverlauf(bmp, 200, 100, 100, 240, 140, _
  255, 180, 180, 180, _
  255, 240, 240, 240)
 
' Gelb-Grüner Kreis mit Gradientenzentrum links unten
Kreis_mit_Farbverlauf(bmp, 200, 100, 100, 160, 160, _
  255, 250, 200, 0, _
  255, 200, 250, 0)
 
' Roter Kreis mit fallendem Alpha-Wert im Zentrum
Kreis_mit_Farbverlauf(bmp, 200, 100, 100, 200, 100, _
  100, 250, 0, 0, _
  30, 250, 0, 0)
 
' Verwendung vordefinierter Farben
Kreis_mit_Farbverlauf(bmp, 200, 100, 100, 230, 50, _
  Color.AliceBlue.A, _
  Color.AliceBlue.R, _
  Color.AliceBlue.G, _
  Color.AliceBlue.B, _
  Color.BlueViolet.A, _
  Color.BlueViolet.R, _
  Color.BlueViolet.G, _
  Color.BlueViolet.B)

Hinweis für VB6-Umsteiger:
Wenn Sie sich wundern, liegen Sie richtig.
Die Zeichenmethode 'Circle' oder 'PSet' und all die anderen VB6-Zeichenmethoden sind nicht mehr verfügbar. Statt dessen gibt es jetzt das wesentlich umfangreichere - aber kein bißchen kompatible - Graphics-Objekt.

Die Umstellung von Programmen, die umfangreiche Graphiken erstellen, ist deshalb meist schwierig. In Extremfällen wird es erforderlich, eine Klasse zu erstellen, die ein Bitmap-Objekt kapselt und die Methoden enthält, die die VB6-Graphikaufrufe für die Verwendung des Graphics-Objekts umsetzen. Dabei ist im Einzelfall auch zu berücksichtigen, dass die VB6-Methoden die Eígenschaften 'ScaleMode' und 'CurrentX/Y' einbeziehen.
Das VB6-Skalierungsmodell wird in VB.Net nicht mehr unterstützt.

Es gibt eine Notlösung.
Nachdem der Namespace "Microsoft.VisualBasic.PowerPacks.Printing.Compatibility.VB6" importiert worden ist, kann an eine Instanz des Printer-Objekts erstellen. (Ein Projekt-Verweis auf die MS-Powerpacks ist erforderlich).

Dieses Objekt stellt die aus VB6 bekannten Methoden zum Zeichnen zur Verfügung. Dabei sind lediglich die eigentümlichen BASIC-Aufrufe des Typs 'Line (x1,y1) - (x2,y2)' durch reguläre Parameterlisten ersetzt worden.Um die Graphikanweisungen aus dem VB6-Code direkt weiterzuverwenden, muss die Instanz des VB2008-Printers den gleichen Namen erhalten, wie die VB6-Picturebox.

Um die Graphik auf dem Bildschirm anzuzeigen, ist die 'PrintAction'-Eigenschaft des Printer-Objects auf den Wert 'PrintToPreview' einzustellen. Man erhält ein Fenster, das das Blättern. Zoomen und Ausdrucken der erstellten Graphik ermöglicht, sobald die Fertigstellung der Zeichnung durch Aufruf der (einzufügenden) Methode 'EndDoc' signalisiert worden ist.

Quellcode zu Kreis_mit_Farbverlauf

''' <summary>
''' Kreis mit Farbverlauf in eine Bitmap zeichnen
''' </summary>
''' <param name="bmp">Bitmap in die gezeichnet werden soll</param>
''' <param name="x">Kreiszentrum Horizontalachse</param>
''' <param name="y">Kreiszentrum Vertikalachse</param>
''' <param name="Radius">Kreisradius (in Pixel)</param>
''' <param name="xg">Gradientenzentrum (Horizontal)</param>
''' <param name="yg">Gradientenzentrum (Vertikal)</param>
''' <param name="Alpha_Rand">Alpha-Wert am Kreisrand (0-255)</param>
''' <param name="Rot_Rand">Rot-Wert am Kreisrand (0-255)</param>
''' <param name="Gruen_Rand">Grün-Wert am Kreisrand (0-255)</param>
''' <param name="Blau_Rand">Blau-Wert am Kreisrand (0-255)</param>
''' <param name="Alpha_Zentrum">Alpha-Wert im Gradientenzentrum</param>
''' <param name="Rot_Zentrum">Rot-Wert im Gradientenzentrum</param>
''' <param name="Gruen_Zentrum">Grün-Wert im Gradientenzentrum</param>
''' <param name="Blau_Zentrum">Blau-Wert im Gradientenzentrum</param>
''' <returns>Alles OK?</returns>
Private Function Kreis_mit_Farbverlauf( _
  ByRef bmp As System.Drawing.Bitmap, _
  ByVal x As Integer, _
  ByVal y As Integer, _
  ByVal Radius As Integer, _
  ByVal xg As Integer, _
  ByVal yg As Integer, _
  ByVal Alpha_Rand As Byte, _
  ByVal Rot_Rand As Byte, _
  ByVal Gruen_Rand As Byte, _
  ByVal Blau_Rand As Byte, _
  ByVal Alpha_Zentrum As Byte, _
  ByVal Rot_Zentrum As Byte, _
  ByVal Gruen_Zentrum As Byte, _
  ByVal Blau_Zentrum As Byte) _
  As Boolean
 
  Dim d As Integer
  Dim color As System.Drawing.Color
 
  Dim MaxDis As Integer = Radius + Distanz(x, y, xg, yg)
 
  For i As Integer = x - Radius To x + Radius
    For k As Integer = y - Radius To y + Radius
      If Position_in_Bitmap(bmp.Width, bmp.Height, i, k) Then
        If Position_Im_Kreis(x, y, Radius, i, k) Then
          d = Distanz(xg, yg, i, k)
          color = color.FromArgb( _
          Skalenwert(Alpha_Zentrum, Alpha_Rand, MaxDis, d), _
          Skalenwert(Rot_Zentrum, Rot_Rand, MaxDis, d), _
          Skalenwert(Gruen_Zentrum, Gruen_Rand, MaxDis, d), _
          Skalenwert(Blau_Zentrum, Blau_Rand, MaxDis, d))
          bmp.SetPixel(i, k, color)
        End If
      End If
    Next k
  Next i
  Return True
End Function

Private Function Skalenwert(ByVal Skalenwert_Zentrum As Byte, _
  ByVal Skalenwert_Rand As Byte, _
  ByVal MaxDistanz As Integer, _
  ByVal Distanz As Integer) As Byte
 
  ' Lineare Umrechnung: Distanz --> 
  ' ByteWert auf einer ARGB-Farbskala
 
  If Skalenwert_Rand = Skalenwert_Zentrum Then
    Return Skalenwert_Rand
  End If
 
  If Distanz > MaxDistanz Then Distanz = MaxDistanz
  If Distanz < 0 Then Distanz = 0
 
  Dim SkalenLänge As Integer = _
  Math.Abs(CInt(Skalenwert_Rand) - Skalenwert_Zentrum)
  Dim sk As Integer = _
  CInt(SkalenLänge / MaxDistanz * Distanz)
  If Skalenwert_Zentrum > Skalenwert_Rand Then
    Return CByte(Skalenwert_Zentrum - sk)
  Else
    ' Skala umkehren
    Return CByte(sk + Skalenwert_Zentrum)
  End If
End Function

Private Function Position_in_Bitmap( _
  ByVal bmp_width As Integer, _
  ByVal bmp_height As Integer, _
  ByVal punkt_x As Integer, _
  ByVal punkt_y As Integer) As Boolean
 
   If punkt_x < 1 Or punkt_x > bmp_width-1 Then Return False
   If punkt_y < 1 Or punkt_y > bmp_height-1 Then Return False
  Return True
End Function

Private Function Position_Im_Kreis( _
  ByVal Zentrum_x As Integer, _
  ByVal Zentrum_y As Integer, _
  ByVal Radius As Integer, _
  ByVal Punkt_x As Integer, _
  ByVal Punkt_Y As Integer) As Boolean
 
  ' Liegt eine Punktposition im Kreis
  ' Zentrum_x, Zentrum_y: Kreismittelpunkt
  ' Punkt_x, Punkt_y: Koordinaten des Punktes, dessen 
  ' Distanz zum Mittelpunkt geprüft werden soll
 
  ' Rückgabe: true, falls Punkt innerhalb des Kreises liegt
 
  Return Radius > Distanz( _
  Zentrum_x, Zentrum_y, Punkt_x, Punkt_Y)
End Function

Private Function Distanz(ByVal x1 As Integer, _
  ByVal y1 As Integer, _
  ByVal x2 As Integer, _
  ByVal y2 As Integer) As Integer
 
  ' Distanz im 2D-Raum 
  Dim xd As Integer = Math.Abs(x1 - x2)
  xd *= xd ' schnelles Quadrieren
  Dim yd As Integer = Math.Abs(y1 - y2)
  yd *= yd
  Return CInt(Math.Sqrt(xd + yd))
End Function