Rubrik: Grafik und Font · Bilder und Icons | VB-Versionen: VB2008, VB2010, VB2012 | 03.03.15 |
Erstellen einer ImageList aus Bitmaps mit gleicher Größe und nur einer Farbe Es wird eine Funktion mit Hilfsfunktion gezeigt, die eine gewisse Menge von rechteckigen Bitmaps erzeugt und dann in einer Imagelist speichert. | ||
Autor: Dietrich Herrmann | Bewertung: | Views: 9.378 |
ohne Homepage | System: Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Ich denke, eine gewisse Anzahl von 'kleinen' Bildern (Images), die nur eine bestimmte Farbe präsentieren, kann man schon manchmal brauchen. Vorteil dieser Methode ist, dass man solche Bitmaps nicht mittels Paint- oder anderem Zeichen-Programm erzeugen muss. Sie stehen dann in einer Imagelist zur Verfügung.
Aufruf:
Dim iList As ImageList = CreateImageList(New Size(48, 24), col)
mit
Dim col() As Color = {Color.Red, _ Color.Green, Color.Blue, Color.Gold, Color.Brown}
Dies bedeutet, dass eine Imagelist erzeugt wird, die Bilder der Größe 48x24 (Breite x Höhe) mit den im Color-Feld enthaltenen Farben enthalten wird. Das Color-Feld ist hier ziemlich klein, man kann natürlich wesentlich mehr Farben angeben.
Hier die Funktion:
''' <summary> ''' Erstellen einer ImageList aus Bitmaps mit gleicher Größe und nur einer Farbe ''' </summary> ''' <param name="pSize">die Größe der Bitmaps</param> ''' <param name="theColors">ein Feld der gewünschten Farben</param> ''' <returns>eine Imagelist</returns> Private Function CreateImageList(pSize As Size, theColors As Array) As ImageList Dim il As ImageList, pb As PictureBox il = New ImageList With il .ImageSize = New Size(pSize.Width, pSize.Height) .ColorDepth = ColorDepth.Depth24Bit End With pb = New PictureBox For i As Short = 0 To theColors.Length - 1 pb.Image = setbitmp(theColors(i), pSize) il.Images.Add(i, pb.Image) Next Return il End Function
Hilfsfunktion:
''' <summary> ''' Erzeugen einer Bitmap mit einer bestimmten Größe und nur einer Farbe ''' </summary> ''' <param name="c">die füllende Farbe</param> ''' <param name="bSize">die Größe der Bitmap</param> ''' <returns>eine Bitmap</returns> Private Function setbitmp(c As Color, bSize As Size) As Bitmap Dim bmp As Bitmap bmp = New Bitmap(bSize.Width, bSize.Height) With bmp For i As Short = 0 To bmp.Width - 1 For j As Short = 0 To bmp.Height - 1 .SetPixel(i, j, c) Next Next End With Return bmp End Function