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 Dieser Tipp wurde bereits 4.767 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! |
||||||||||||||||
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. |