Subformular farbig

[crystal]

Hallo,
folgendes Szenario: zu einer Haupt-Tabelle speichere ich Sub-Daten, die ich in einem Unterformular darstellen möchte.
In jedem Sub-Datensatz ist eine Farbe gespeichert; diese Farbe möchte ich als Background-Farbe des UFos benutzen.

Das geht irgendwie nicht, denn ich müsste die Farbe ja im "Current-Event" dem UFo-Background zuweisen - und somit erhalten dann alle "UFo-Instanzen" den Farbwert.

Meine Idee ist nun, im UFo ein Bild-Element zu platzieren, in den Hintergrund zu schicken und als Datenquelle ein entspr. Feld meiner Sub-Tabelle anzugeben.

Dazu müsste ich beim Anlegen der Sub-Datensätze z. B. eine Farbe auswählen und dann eine 1-Pixel-große Grafik-Datei z. B. in "\Farben" mit sinnvollem Namen, z. B. "rrrgggbbb.GIF" anlegen und diesen Pfad speichern.

Dann könnte ich doch im UFo auf ein solches Bild (also Daten-Eintrag in der Sub-Tabelle) verweisen und so je "UFo-Instanz" einen eigenen Farb-Hintergrund erzeugen (Bild erweitern, Größe anpassen).

Wie kann ich nun mit VBA ein solches minimales 1-Pixel-Bild erstellen??? Welches Grafik-Format sollte ich dazu nutzen - jpg, gif, png? Jede dieser Datei-Typen enthält ja neben den Eigenschaften des Pixels auch andere binäre Daten (Header, Farbtabellen und was weiß ich noch).


Oder gibt es eine andere Möglichkeit, die in den Sub-Datensätzen gespeicherte "Farb-Information" in einem UFo korrekt darzustellen? Ein Browser-Control zu nutzen und meine Farbe als HTML-Code zu speichern, erscheint mir etwas zu übertrieben. Mit einem Rich-Text-Control ist das vielleicht etwas "schlanker", aber ich müsste "ausreichend viele Leerzeichen speichern", um diese mit dem Attribut "Hintergrund-Farbe" darstellen zu können, so dass mein Text-Control auch den gesamten Bereich des UFos betrifft.

Hat jemand eine Idee?

Grüße,
crystal

[PhilS]

Wenn du nur relativ wenige verschiedene Farben benötigst, ist der Klassiker FAQ 4.1 Verschiedene Farben im Endlosformular vielleicht die Lösung.

Wenn das nicht reicht, ist deine Idee mit dem Bild im Hintergrund gar nicht schlecht. Wenn du alle möglichen Farben vordefinieren kannst, wäre es wahrscheinlich einfacher die Bilder manuell in Paint o.ä. zu erstellen und dann in einem Verzeichnis oder in der DB (bei wenigen Bildern ist das OK) zu speichern.

Ansonsten gibt es API-Codebeispiele, um eine Bitmap mit VBA zu erzeugen. Für das PNG- (oder JPG-)Format bräuchtest du GDI+.

[crystal]

@PhilS

Wenn das nicht reicht, ist deine Idee mit dem Bild im Hintergrund gar nicht schlecht. Wenn du alle möglichen Farben vordefinieren kannst, wäre es wahrscheinlich einfacher die Bilder manuell in Paint o.ä. zu erstellen und dann in einem Verzeichnis oder in der DB (bei wenigen Bildern ist das OK) zu speichern.

Danke für diese Antwort.

...Jetzt wüsste ich nur noch gern, wie ich per Programm x solcher Farb-Dateien (1-Pixel-Dateien) erstellen kann.

Ich werde mal ein paar solcher verschieden farbiger Pixel-Dateien mit Irfanview anlegen und binär vergleichen. Irgendwo finde ich vielleicht die eindeutige Sequenz für die RGB-Farbe - den Rest könnte ich dann per Data hinzufügen und so meine Dummy-Dateien zur Laufzeit nach User-Wunsch erzeugen - ein paar wenige aus über 16 Millionen möglichen... (Eine solche BMP-Datei ist 58 Byte groß, JPG 290 Byte...)

Natürlich sollten die Hintergrund-Farben nicht zu "knallig" sein.

Oder ich mache es wie du vorschlägst und lege eine "Palette" ausgesuchter Farben manuell an. Da könnte ich dann auch schöne Namen vergeben (lassen): himmelblau, kirschrot, grinchgrün...

Übrigens: den Trick mit Chr(219) (spacing blank) hatte ich auch schon im Visier, aber eher als Datei-Variante im RTF-Format...

Mal sehn, ob ich es dann auch irgendwie hinkriege, diese Farben in einem Auswahl-Dialog oder gar einer Kombobox darzustellen...

Einstweilen vielen Dank,
crystal

[PhilS]

...Jetzt wüsste ich nur noch gern, wie ich per Programm x solcher Farb-Dateien (1-Pixel-Dateien) erstellen kann.

Das erste Suchergebnis bei Google: Create BMP image with VBA
Ich finde das sieht schon sehr gut aus. Anpassungsaufwand dürfe minimal sein.

[crystal]

Hallo PhilS,
habe natürlich auch selbst probiert...
Hier ist die vielleicht kürzeste Variante, um eine 1-Pixel-BMP zu erzeugen:

Code [Auswählen] Erweitern

Dim varBMP As Variant
varBMP = Array(66, 77, 58, 0, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, 1, 0, 0, 0, 1, 0, 24, _
    0, 0, 0, 0, 4, 0, 0, 0, 196, 14, 0, 0, 196, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _
    65, 166, 67, 0)

Dieses Array muss man dann nur noch binär als BMP speichern; die letzten 4 Zahlen sind hier nur als Demo angegeben und erzeugen ein grünliches Pixel. Die letzte Null ist konstant, davor stehen die dezimalen Werte für R, G und B (hier 65, 166 und 67). Die ersten 3 Zeichen lesen sich als "BM:" - was zumindest Access richtig interpretiert und die entspr. Farbe als Bild-Element (Größenanpassung: Dehnen) richtig darstellt.

Hurra!

Sorry - hab es noch nicht wirklich getestet, diese BMPs zu erzeugen. Die obige Zahlen-Sequenz habe ich manuell aus Notepad++ abgetippt. Ich will nicht ausschließen dass da vielleicht eine NULL fehlt. Ich teste das in den nächsten Tagen.
Aber das Prinzip funktioniert!
Nur noch schöne Dateinamen erzeugen (z. B. 065166067.bmp) und man kann den Verweis auf eine solche Datei "z. B. \Farben\065166067.bmp" in/unter seinem Access-Verzeichnis speichern und in einer Subform als Background-Farbe (mit dem Bild-Trick mit gebundener Datenquelle) verwenden!

Schöne Sache.

[PhilS]

Hier ist die vielleicht kürzeste Variante, um eine 1-Pixel-BMP zu erzeugen:

Hmm...
Das mag zwar der kürzeste Weg sein und für deinen konkreten Fall auch ausreichen, aber ich würde trotzdem lieber die vollständige Deklaration der Header-Typen verwenden und diese in die Datei schreiben. - Ich habe den Verdacht, dass sich da schon der ein oder andere Fehler in deine Byte-Sequenz eingeschlichen hat.

[crystal]

Hallo,
nach einer längeren Pause hier nun der korrigierte Code zur Erstellung von 1-Pixel-BMP-Dateien.

Code [Auswählen] Erweitern

Private Sub Befehl9_Click()
Dim lngColor As Long
Dim intR As Integer
Dim intG As Integer
Dim intB As Integer
Dim strBMP As String
Dim varBMP As Variant
Dim i As Integer

    varBMP = Array(66, 77, 58, 0, 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, 40, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 24, _
                    0, 0, 0, 0, 0, 4, 0, 0, 0, 196, 14, 0, 0, 196, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
                '  67, 166, 65, 0)
               
    lngColor = FarbWert
    lngColor = GetColorDialog(lngColor)
    If lngColor >= 0 Then
        FarbWert = lngColor
        strBMP = strLongToRGB(lngColor, intR, intG, intB)

        FarbDatei = "..\farben\" & strBMP & ".bmp"

        Open FarbDatei For Output As 1

        For i = LBound(varBMP) To UBound(varBMP)
            Print #1, Chr(varBMP(i));
        Next
        Print #1, Chr(intB);
        Print #1, Chr(intG);
        Print #1, Chr(intR);
        Print #1, Chr(0);
        Close #1
        Bild10.Picture = FarbDatei
    End If
End Sub

Hinweise:
1. Ich habe eine Beispiel-BMP mit IrfanView erstellt und sie dann eingelesen und daraus das varBMP-Array erstellt.
2. Pixel-Informationen werden in BMPs nicht als R-G-B, sondern als B-G-R gespeichert.
3. Je nach Einstellung ergeben sich in Bild10 zwei Effekte:
3a. vollflächige Darstellung (Bild nebeneinander= ja und Zoomen); wirkt etwas poppig
3b. Farbverlauf bis weiß bzw. Form-Hintergrund (Bild nebeneinander= nein); wirkt eher dezent; Effekt kann zusätzlich durch die Bildausrichtung gesteuert werden (Mitte, Ecke oben/unten rechts/links)
4. Den Dateinamen speichere ich hier komplett als relativen Pfad, so dass er einfach und direkt als Datenquelle im Formular angegeben werden kann. Man könnte auch nur den reinen Namen speichern und Pfad und Endung im Selekt-Statement dazu basteln...
5. den Datei-Namen bastel ich so zusammeen:

Code [Auswählen] Erweitern

Public Function strLongToRGB(lngCol As Long, intR As Integer, intG As Integer, intB As Integer) As String

    intR = lngCol Mod 256
    intG = (lngCol \ 256) Mod 256
    intB = (lngCol \ 256 \ 256) Mod 256

    strLongToRGB = Right(Str(1000 + intR), 3) & "-" & Right(Str(1000 + intG), 3) & "-" & Right(Str(1000 + intB), 3)
     
End Function
Die Funktion liefert neben dem Rückgabe-String RRR-GGG-BBB auch R, G und B als Integer (nicht weiter verwendet).

Und so sieht's aus (siehe Anhang).

Nachtrag:
seit dem jüngsten Microsoft-365-Update vor wenigen Tagen funktioniert der relative Pfad NICHT mehr!!!
Ich habe den Code deshalb so geändert:

Code [Auswählen] Erweitern

        FarbDatei = Application.CurrentProject.Path & "\farben\" & strBMP & ".bmp"


[crystal]

Hallo nochmal.
Zur Ergänzung...
Inzwischen speichere ich in meiner Tabelle nur noch den reinen Farb-Datei-Namen ab.
Zur Laufzeit setze ich dann den Pfad davor und den Typ dahinter. Das geschieht in einem Modul:

Code [Auswählen] Erweitern

Public Function BuildName(strFile As String) As String
   
    BuildName = Application.CurrentProject.Path & "\farben\" & strFile & ".bmp"

End Function

(Hier könnte natürlich noch etwas an Prüfung eingebaut werden...)
Nun kann ich diese Funktion entweder im SQL-Select einsetzen, z. B.

Code [Auswählen] Erweitern

select blabla, BuildName([FarbDatei]) as FarbDateiKomplett from  blabla

und
"FarbDateiKomplett" dann dem Bild-Element direkt zuordnen

oder im Formular dem Bild-Element zuweisen:

Code [Auswählen] Erweitern

        Bild10.Picture = BuildName(FarbDatei)

Hier noch das Beispiel mit dem dezenteren Farb-Verlauf.

Gruß,
crystal
Sie dürfen in diesem Board keine Dateianhänge sehen.

[Xoar]

Interessant, danke für den Lösungsweg.