Daten im Form-Icon anzeigen II Diese Erweiterung besteht darin, dass die Anzeige von Daten optional auch in einem farbigen Kreis erfolgen kann.
Autor:   Dietrich Herrmann	Bewertung:	Views:  4.778
ohne Homepage	System:  Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Die Erweiterung des genannten Tipps besteht in einer modifizierten Funktion. Hier der Code:

''' <summary>
''' Text in Icon schreiben
''' </summary>
''' <param name="ico">das betreffende Icon</param>
''' <param name="theFont">der Font</param>
''' <param name="theBGColor">die Hintergrundfarbe</param>
''' <param name="theBorderColor">die Randfarbe, ist gleichzeitig Textfarbe</param>
''' <param name="theBorderWidth">die Randbreite</param>
''' <param name="theValue">der Wert, Text</param>
''' <param name="theRectAlign">die Position des Ausgaberechtecks</param>
''' <param name="theCircleFlag">soll Kreis gezeichnet werden oder nicht</param>
Public Function ChangeAppIcon(ico As Icon, theFont As Font, theBGColor As Color, _
  theBorderColor As Color, theBorderWidth As Short, _
  theValue As Short, Optional theRectAlign As String = "ul", _
  Optional theCircleFlag As Boolean = False) As Icon
 
  ' das Form-Icon als Bitmap
  Dim bmpIco As Bitmap = ico.ToBitmap
  Dim gr As Graphics = Graphics.FromImage(bmpIco)
 
  ' Textgröße messen
  Dim fs As Size = TextRenderer.MeasureText(theValue.ToString, theFont)
  fs = New Size(fs.Width + theBorderWidth * 2, fs.Height + theBorderWidth * 2)
 
  ' Rechteck des Texts festlegen
  Dim tRect As New Rectangle(New Point(0, 0), fs)
  ' Rechteck des Icons
  Dim bRect As New Rectangle(New Point(0, 0), New Size(bmpIco.Size))
  ' passt Ausgaberechteck ins Icon-Rechteck?
  Dim b As Boolean = bRect.Contains(tRect)
 
  If Not b Then Exit Function
  If theCircleFlag Then tRect.Inflate(theBorderWidth, theBorderWidth)
 
  ' Stift für den Rand definieren
  Dim pen As New Pen(theBorderColor, theBorderWidth)
  pen.Alignment = PenAlignment.Inset
 
 ' Ausrichtung des Texts
  Dim sf As New StringFormat
  sf.LineAlignment = StringAlignment.Center
  sf.Alignment = StringAlignment.Center
 
  ' das Ausgaberechteck postionieren
  tRect.Location = CalcNewPositionPoint(bRect, tRect, theRectAlign)
 
  With gr
    If theCircleFlag Then
      ' Kreis ausfüllen mit Hintergrundfarbe
      .FillEllipse(New SolidBrush(theBGColor), tRect)
      ' Kreis-Rand zeichnen
      If theBorderWidth > 0 Then .DrawEllipse(pen, tRect)
    Else
      ' Rechteck ausfüllen mit Hintergrundfarbe
      .FillRectangle(New SolidBrush(theBGColor), tRect)
      ' Rechteck-Rand zeichnen
      If theBorderWidth > 0 Then .DrawRectangle(pen, tRect)
    End If
    ' den Text ins Rechteck schreiben
    .DrawString(Trim(theValue.ToString), theFont, New SolidBrush(theBorderColor), tRect, sf)
  End With
 
  ' neues Form-Icon speichern
  Return ConvBMPtoICO(bmpIco, bmpIco.Size) 
End Function

''' <summary>
''' Positionieren eines Rechtecks auf einem 'Hintergrund'-Rechteck
''' </summary>
''' <param name="theOrigCoords">die Koordinaten des Hintergrundrechtecks</param>
''' <param name="theObjCoords">die Koordinaten des zu positionierenden Rechtecks</param>
''' <param name="theAlignment">die Ausrichtung des zu pos. Rechtecks</param>
''' <returns>die neue Location des zu pos. Rechtecks</returns>
Private Function CalcNewPositionPoint(ByVal theOrigCoords As Rectangle, _
  ByVal theObjCoords As Rectangle, ByVal theAlignment As String) As Point
  Dim x As Short = theOrigCoords.X
  Dim y As Short = theOrigCoords.Y
  ' Position (Koordinaten) ermitteln
  With theObjCoords
    Select Case theAlignment
      Case "z" ' zentrieren
        x = theOrigCoords.Left + (theOrigCoords.Width - .Width) / 2
        y = theOrigCoords.Top + (theOrigCoords.Height - .Height) / 2
      Case "ol"   ' oben links
        x = theOrigCoords.Left
        y = theOrigCoords.Top
      Case "or"  ' oben rechts
        x = theOrigCoords.Right - .Width
        y = theOrigCoords.Top
      Case "ul"   ' unten links
        x = theOrigCoords.Left
        y = theOrigCoords.Bottom - .Height
      Case "ur"  ' unten rechts
        x = theOrigCoords.Right - .Width
        y = theOrigCoords.Bottom - .Height
    End Select
    ' Rechteck neu positionieren
    .Location = New Point(x, y)
  End With
  Return theObjCoords.Location
End Function
 
''' <summary>
''' Konvertieren Bitmap in Icon
''' </summary>
''' <param name="theBMP">die Original-Bitmap</param>
''' <param name="theSize">die neue Größe des Icon</param>
''' <returns>das Icon</returns>
Public Function ConvBMPtoICO(ByVal theBMP As Image, ByVal theSize As Size) As Icon
  Dim bitmap As New Bitmap(theSize.Width, theSize.Height)
  bitmap = theBMP
  Return Icon.FromHandle(bitmap.GetHicon())
End Function

Der Aufruf der Funktion kann also optional mit dem Boolean-Wert für 'theCircleFlag' erfolgen.

Noch eine kleine Ergänzung:
Wenn man es dem Zufall überlassen möchte, ob Kreis oder Rechteck, kann man es folgendermaßen realisieren:

Vereinbarung:

Dim rng As New Random()
Dim circleFlag As Boolean

Dann im Programm an geeigneter Stelle:

circleFlag = rng.[Next](0, 2) > 0

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.