vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

http://www.vbarchiv.net
Rubrik: Grafik und Font · Bilder und Icons   |   VB-Versionen: VB2010 - VB201518.09.17
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 HerrmannBewertung:  Views:  356 
ohne HomepageSystem:  Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Neue Version! sevEingabe 3.0 (für VB6 und VBA)
Das Eingabe-Control der Superlative! Noch besser und noch leistungsfähiger!
Jetzt zum Einführungspreis       - Aktionspreis nur für kurze Zeit gültig -

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



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2017 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.