<\/p>\n
Im Beitrag „Icons in Access-Formularen und Berichten“ (www.access-im-unternehmen.de\/1235) haben wir schon einmal eine Möglichkeit aufgezeigt, wie man Formulare und Berichte in Access mit individuellen Icons ausstatten kann. So kann man beispielsweise ein Formular zum Bearbeiten eines Kunden mit dem gleichen Icon ausstatten, das man auch für die Schaltfläche zum Öffnen dieses Formulars im Ribbon untergebracht hat. Der Benutzer kann so noch besser erkennen, worum es im Formular geht. In der vorherigen Fassung der Lösung hatten wir allerdings noch das Problem, dass wir die Icons, die links oben in Formularen und Berichten erscheinen sollten, noch im Dateisystem speichern mussten. Das kann aus diversen Gründen zu Problem führen und daher sind wir froh, hier den nächsten Schritt gehen zu können: Das direkte Einlesen der Icons aus der Tabelle „MSysResources“ und anschließendes Anzeigen in Formulare und Berichten.<\/b><\/p>\nZiel: Formular-Icons ohne externe Dateien<\/h2>\n
Wie bereits erwähnt, sind wir bereits in der Lage, Formulare mit einem eigenen Icon auszustatten (siehe Bild 1). Das Problem ist jedoch bisher gewesen, dass die entsprechende Icon-Datei sich auf der Festplatte befinden muss, damit wir diese laden und per API dem Formular als Icon zuweisen konnten. Damit wir nicht für jede Anwendung einen eigenen Ordner bereitstellen mussten, der die benötigten Icon-Dateien enthält oder sogar die Icon-Dateien lose im Verzeichnis der Access-Datenbank gespeichert haben, befanden sich die .ico<\/b>-Dateien bis zur Verwendung in der Tabelle USysResources <\/b>und wurden erst dann zur Anwendung exportiert.<\/p>\n
![\"Formular](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_001.png\")
<\/p>\n
Bild 1: Formular mit individuellem Icon<\/span><\/b><\/p>\n Nunmehr haben wir den noch fehlenden Schritt realisiert: Wir können nun die Icon-Dateien direkt aus dem Anlagefeld der Ressourcen-Tabelle auslesen und dem jeweiligen Formular zuweisen. Wie das gelingt, lesen Sie in diesem Beitrag.<\/p>\n Der Code sieht im Wesentlichen wie in Listing 1 aus. Im oberen Teil finden wir einige Konstanten-Deklarationen, die wir im weiteren Verlauf benötigen.<\/p>\n Listing 1: Code zum Bereitstellen von Icons in Formularen und Berichten<\/span><\/b><\/p>\n Darunter sehen wir die Deklaration von zwei API-Funktionen, die uns in der folgenden Prozedur unterstützen.<\/p>\n Schließlich folgt die Funktion SetFormIconFromMSysResources<\/b>, welche die eigentliche Arbeit übernimmt. Die Funktion hat zwei Parameter:<\/p>\n Die Funktion verwendet die folgenden Variablen:<\/p>\n Die Funktion setzt den Index für das aus der .ico<\/b>-Datei zu verwendende Icon mit lngIndex <\/b>auf 0<\/b>. Der Parameter strIconName <\/b>der Funktion liefert den Wert des Feldes Name <\/b>der Tabelle MSysResources<\/b>, dessen Anlage aus dem Feld Data <\/b>als Icon verwendet werden soll.<\/p>\n Die Funktion holt per DLookup <\/b>den Wert des Feldes id <\/b>für diesen Datensatz und speichert diesen in der Variablen lngID<\/b>.<\/p>\n Die folgende If…Then<\/b>-Bedingung prüft, ob der gesuchte Datensatz gefunden werden konnte, anderenfalls erscheint eine entsprechende Meldung.<\/p>\n Anschließend folgt die Extraktion der Icon-Daten aus dem Feld Data<\/b>. Das erledigen wir mit einem Aufruf der Funktion BLOB2Binary0710<\/b> aus dem Modul mdlImages<\/b>, der wir den Namen der Tabelle, das Anlagefeld, das Feld mit dem Primärschlüssel und den Primärschlüsselwert übergeben. Die Icon-Daten landen danach in einem Byte<\/b>-Array namens bData<\/b>. Für dieses Array ermitteln wir nun die Größe und das Offset im Speicher und speichern beides in den Variablen dwSize <\/b>und dwOffset<\/b>.<\/p>\n Schließlich folgt der Einsatz der API-Funktionen. Die erste heißt CreateIconFromResourceEx <\/b>und liefert uns ein Handle auf das Icon. Dieses Handle setzen wir schließlich mit der Funktion SendMessage <\/b>als Icon des Formulars oder Berichts mit dem Handle aus hWnd <\/b>ein.<\/p>\n Den Aufruf der Funktion SetFormIconFromMSysResources <\/b>fügen wir nun in die Ereignisprozedur Form_Load <\/b>des Formulars oder Berichts ein, der ein Icon aus der Tabelle MSysResources <\/b>anzeigen soll. Das sieht beispielsweise wie folgt aus:<\/p>\n Dazu muss nun nur noch die Tabelle MSysResources <\/b>einen Datensatz enthalten, der für das Feld Name <\/b>den Wert alarmclock <\/b>aufweist und dessen Feld data <\/b>eine entsprechende .ico<\/b>-Datei enthält. Das ist in unserer Datenbank der Fall (siehe Bild 2).<\/p>\n Bild 2: Das anzuzeigende Icon in der Tabelle MSysResources<\/span><\/b><\/p>\n Nun sind allerdings leider nicht alle .ico<\/b>-Dateien für die Anzeige als Icon eines Formulars oder Berichts geeignet. Wir benötigen eine bestimmte Auflösung, sonst wird das Icon nicht korrekt angezeigt. Dazu gehören beispielsweise Auflösungen mit 8- oder 24-Bit. 4-Bit reichen nicht aus.<\/p>\n Leider können wir die .ico<\/b>-Dateien nicht auf die gleiche einfache Weise wie .png<\/b>-Dateien zur Tabelle MSysResources <\/b>hinzufügen. Dazu brauchten wir einfach nur ein Formular in der Entwurfsansicht zu öffnen und dann ein Bild zum Formular oder zu einer Schaltfläche hinzuzufügen.<\/p>\n Die dabei ausgewählten Dateien werden automatisch als .png<\/b>-Dateien in der Tabelle MSysResources <\/b>hinterlegt und können dann in den entsprechenden Eigenschaften der Steuerelemente ausgewählt werden. Wenn wir hier .ico<\/b>-Dateien auswählen, werden diese als .png<\/b>-Dateien importiert. .png<\/b>-Dateien können wir leider nicht als Icon von Formularen und Berichten einsetzen.<\/p>\n Also haben wir zwei Möglichkeiten. Die erste ist, die .ico<\/b>-Dateien manuell zur Tabelle MSysResources <\/b>hinzuzufügen. Das gelingt mit den folgenden Schritten:<\/p>\n Danach können wir die Funktion SetFormIconFromMSysResources <\/b>für dieses Icon aufrufen:<\/p>\n Diese Vorgehensweise ist allerdings nicht besonders komfortabel, wenn wir mehrere .ico<\/b>-Dateien zur Tabelle MSysResources <\/b>hinzufügen wollen. Also schreiben wir uns schnell Code, um den Vorgang zu automatisieren.<\/p>\n Was benötigen wir dazu als Erstes? Einen Dateiauswahl-Dialog, mit dem wir mehrere Dateien aus einem Verzeichnis auswählen können. Die notwendigen Elemente finden wir in der Office-Bibliothek, die wir wie in Bild 3 per Verweis referenzieren.<\/p>\n Bild 3: Verweis auf die Office-Bibliothek<\/span><\/b><\/p>\n Danach können wir uns eine Funktion namens SelectICOFiles<\/b> wie in Listing 2 zusammenstellen. Diese nimmt mit dem Parameter strFolder <\/b>ein Verzeichnis entgegen, das als Startverzeichnis des Dateiauswahl-Dialogs verwendet wird. Zuerst werden das Objekt objFiledialog <\/b>und zwei Variablen für die Verarbeitung der Pfade zu den .ico<\/b>-Dateien deklariert. Mit der Variablen objFiledialog <\/b>referenzieren wir den Dateiauswahl-Dialog, den wir mit der Methode Filedialog <\/b>des Application<\/b>-Objekts initialisieren. Dabei übergeben wir den Wert msoFileDialogFilePicker <\/b>als Parameter.<\/p>\n Listing 2: Funktion zum Auswählen der .ico-Dateien<\/span><\/b><\/p>\n Für den Dialog legen wir mit AllowMultiSelect <\/b>fest, das mehrere Dateien gleichzeitig ausgewählt werden können. Außerdem stellen wir den Startordner mit InitialFileName <\/b>ein. Wir leeren die Filter mit der Clear<\/b>-Methode der Filters<\/b>-Auflistung und fügen einen neuen Filter für .ico<\/b>-Dateien hinzu. Dann zeigen wir den Dialog mit der Show<\/b>-Methode an. Liefert diese den Wert True <\/b>zurück, hat der Benutzer den Dialog geschlossen und wir werten die gewählten Einträge in einer For Each<\/b>-Schleife über die Elemente der Auflistung SelectedItems<\/b> aus.<\/p>\n Dabei stellen wir in strFilenames <\/b>eine durch Semikola getrennte Liste von Elementen zusammen und geben diese als Funktionsergebnis zurück.<\/p>\n Damit können wir nun .ico<\/b>-Dateien wie in Bild 4 auswählen.<\/p>\n Bild 4: Auswahldialog für .ico-Dateien<\/span><\/b><\/p>\n Danach verwenden wir eine Prozedur namens ICOToMSysResources<\/b>, um die mit dem Dateiauswahl-Dialog selektierten Dateien in die Tabelle MSysResources <\/b>einzulesen (siehe Listing 3).<\/p>\n Listing 3: Prozedur zum Einlesen von .ico-Dateien in die Tabelle MSysResources<\/span><\/b><\/p>\n Die Prozedur hat einen Parameter namens bolOverwrite<\/b>. Mit diesem legen wir fest, ob vorhandene Elemente, die den gleichen Namen im Feld Name aufweisen, überschrieben werden sollen.<\/p>\n Neben der Variablen db <\/b>zum Referenzieren des aktuellen Database<\/b>-Objekts verwenden wir zwei Recordset<\/b>-Variablen. Die Erste namens rst <\/b>referenziert ganz normal die Tabelle MSysResources<\/b>.<\/p>\n Die zweite heißt rstData <\/b>und zollt der Tatsache Tribut, dass Anlagefelder intern eine eigene Tabelle zum Speichern der Anlagen aufweisen und wir diese interne Tabelle als Recordset referenzieren wollen.<\/p>\n Die Prozedur ermittelt zunächst mit der Funktion SelectICOFiles <\/b>die zu importierenden .ico<\/b>-Dateien und speichert die Liste in der Variablen strFileList<\/b>. Hat diese eine Länge größer 0<\/b>, spalten wir die einzelnen, durch Semikola getrennten Einträge, mit der Split<\/b>-Funktion in ein Array auf, das wir mit der Variablen strFiles <\/b>referenzieren.<\/p>\n Dann erstellen wir das erste Recordset mit Bezug auf die Tabelle MSysResources<\/b> und durchlaufen in einer For…Next<\/b>-Schleife alle Elemente des Arrays strFiles<\/b>. Innerhalb der Schleife schreiben wir die aktuell einzulesende .ico<\/b>-Datei in die Variable strFile<\/b>.<\/p>\n Daraus ermitteln wir den reinen Dateinamen, indem wir den Teil hinter dem letzten Backslash ermitteln und in die Variable strName <\/b>schreiben.<\/p>\n Wir nehmen auch noch die Dateiendung samt Punkt weg (.ico<\/b>) und erhalten so einen Ausdruck, den wir in das Feld Name <\/b>eintragen können.<\/p>\n Danach versuchen wir, mit rst.FindFirst <\/b>einen Datensatz zu finden, der den Wert von strName <\/b>im Feld Name <\/b>enthält. Haben wir keinen solchen gefunden oder soll dieser ohnehin überschrieben werden (wenn der Parameter bolOverwrite <\/b>den Wert True <\/b>aufweist), prüfen wir nochmals, ob bereits ein entsprechender Datensatz vorhanden ist.<\/p>\n Falls nicht, legen wir mit der AddNew<\/b>-Methode einen neuen Datensatz an, sonst versetzen wir den mit FindFirst <\/b>gefundenen mit der Edit<\/b>-Methode in den Bearbeiten-Zustand. Wir tragen die Werte für die Felder Name<\/b>, Extension <\/b>und Type <\/b>ein.<\/p>\n Dann referenzieren wir die im Feld Data <\/b>enthaltene Tabelle über die Value<\/b>-Eigenschaft mit dem Recordset<\/b>-Objekt rstData<\/b>.<\/p>\n Wir löschen den eventuell bereits vorhandenen Eintrag und fügen einen neuen hinzu.<\/p>\n Für diesen lesen wir mit der Methode LoadFromFile <\/b>die Datei aus strFile <\/b>in das Feld FileData <\/b>ein und aktualisieren dann die beiden Recordsets. Die gleichen Schritte führen wir für alle hinzuzufügenden Dateien durch.<\/p>\n Damit wir die Icons, die der Anwendung für den Einsatz in Formularen zur Verfügung stehen, ansehen und testen können und außerdem eine Schaltfläche zum Hinzufügen von Icons unterbringen können, erstellen wir ein Formular.<\/p>\n Dieses soll wie in Bild 5 aussehen.<\/p>\n Bild 5: Formular zum Verwalten und Testen der Icons<\/span><\/b><\/p>\n Mit der Schaltfläche .ico<\/b>-Dateien hinzufügen rufen wir die Prozedur ICOToMSysResources <\/b>auf und aktualisieren danach die Anzeige der ico<\/b>-Dateien der Tabelle MSysResources<\/b>:<\/p>\n Das Unterformular enthält die Abfrage aus Bild 6 als Datensatzquelle und zeigt alle Felder in der Datenblattansicht an.<\/p>\n Bild 6: Datensatzquelle des Unterformulars<\/span><\/b><\/p>\n Dabei filtert sie nach der Dateinamenerweiterung und sortiert nach dem Namen des Icons.<\/p>\n Das Formular selbst ist aus Haupt- und Unterformular aufgebaut (siehe Bild 7). Für das Unterformular-Steuerelement haben wir die beiden Eigenschaften Horizontaler Anker <\/b>und Vertikaler Anker <\/b>auf den Wert True <\/b>eingestellt, damit dieses vergrößert wird, wenn der Benutzer die Größe des Hauptformulars anpasst.<\/p>\n Bild 7: Entwurf des Formulars<\/span><\/b><\/p>\n Für das Textfeld txtSearch <\/b>haben wir eine Ereignisprozedur für das Ereignis Bei Änderung <\/b>hinterlegt. Diese soll bei Eingabe eines jeden Zeichens das Unterformular filtern (siehe Listing 4).<\/p>\n Listing 4: Prozedur zum Filtern der .ico-Dateien<\/span><\/b><\/p>\nCode zum Anzeigen eines Formularicons<\/h2>\n
Option Compare Database<\/span>\r\nOption Explicit<\/span>\r\nPublic <\/span>Const C_IMAGE_ICON = 1\r\nPublic <\/span>Const C_LR_LOADFROMFILE = &H10\r\nPublic <\/span>Const C_WM_SETICON = &H80\r\nPublic <\/span>Const ICRESVER As Long<\/span> = &H30000\r\nPublic <\/span>Const LR_DEFAULTSIZE As Long<\/span> = &H40\r\nPublic <\/span>Const WM_SETICON As Long<\/span> = &H80\r\nPublic <\/span>Const ICON_SMALL As Long<\/span> = 0\r\nPublic <\/span>Declare PtrSafe Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hWnd As Long<\/span>Ptr, _\r\n ByVal wMsg As Long<\/span>, ByVal wParam As Long<\/span>Ptr, lParam As <\/span>Any) As Long<\/span>Ptr\r\nPublic <\/span>Declare PtrSafe Function CreateIconFromResourceEx Lib \"user32.dll\" (presbits As <\/span>Any, dwResSize As <\/span>Any, _\r\n ByVal fIcon As Long<\/span>, ByVal dwVer As Long<\/span>, ByVal cxDesired As Long<\/span>, ByVal cyDesired As Long<\/span>, _\r\n ByVal flags As Long<\/span>) As Long<\/span>Ptr\r\nPublic Function <\/span>SetFormIconFromMSysResources(ByVal hWnd As Long<\/span>, ByVal strIconName As String<\/span>) As Boolean<\/span>\r\n Dim <\/span>hIcon As Long<\/span>Ptr\r\n Dim <\/span>bData() As Byte<\/span>\r\n Dim <\/span>dwOffset As Long<\/span>Ptr\r\n Dim <\/span>dwSize As Long<\/span>Ptr\r\n Dim <\/span>lngIndex As Long<\/span>\r\n Dim <\/span>lngID As Long<\/span>\r\n lngIndex = 0\r\n lngID = Nz(DLookup(\"id\", \"MSysResources\", \"name=''\" & strIconName & \"''\"), 0)\r\n If <\/span>Not<\/span> lngID = 0 Then<\/span>\r\n bData() = BLOB2Binary0710(\"MSysResources\", \"Data\", \"Id\", lngID, True<\/span>)\r\n dwSize = VarPtr(bData(16& * lngIndex + 14&)) \r\n dwOffset = VarPtr(bData(bData(16& * lngIndex + 18&))) \r\n hIcon = CreateIconFromResourceEx(ByVal dwOffset, ByVal dwSize, 1, ICRESVER, 0&, 0&, LR_DEFAULTSIZE)\r\n If <\/span>hIcon Then<\/span>\r\n SendMessage hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon\r\n End If<\/span>\r\n Else<\/span>\r\n MsgBox<\/span> \"Icon ''\" & strIconName & \"'' fehlt in der Tabelle MSysResources\", vbExclamation + vbOKOnly, \"Icon fehlt\"\r\n End If<\/span>\r\nEnd Function<\/span><\/pre>\n\n
\n
Einsatz der Funktion<\/h2>\n
Private Sub <\/span>Form_Open(Cancel As Integer<\/span>)\r\n Call<\/span> SetFormIconFromMSysResources(Me.hWnd, \"alarmclock\")\r\nEnd Sub<\/span><\/pre>\n![\"Das](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_002.png\")
<\/p>\nVoraussetzungen für die .ico-Dateien<\/h2>\n
Hinzufügen der .ico-Dateien<\/h2>\n
.ico-Dateien manuell hinzufügen<\/h2>\n
\n
Call<\/span> SetFormIconFromMSysResources(Me.hWnd, \"apple\")<\/pre>\nMehrere .ico-Dateien gleichzeitig in die Tabelle MSysResources einlesen<\/h2>\n
![\"Verweis](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_003.png\")
<\/p>\n.ico-Dateien auswählen<\/h2>\n
Public Function <\/span>SelectICOFiles(Optional<\/span> strFolder As String<\/span>) As String<\/span>\r\n Dim <\/span>objFiledialog As <\/span>Office.FileDialog\r\n Dim <\/span>varFilename As Variant<\/span>\r\n Dim <\/span>strFilenames As String<\/span>\r\n Set<\/span> objFiledialog = Application.FileDialog(msoFileDialogFilePicker)\r\n objFiledialog.AllowMultiSelect = True<\/span>\r\n objFiledialog.InitialFileName = strFolder\r\n objFiledialog.Filters.Clear\r\n objFiledialog.Filters.Add \"Icon-Files\", \"*.ico\"\r\n If <\/span>objFiledialog.Show = True<\/span> Then<\/span>\r\n For Each varFilename In objFiledialog.SelectedItems\r\n strFilenames = strFilenames & \";\" & varFilename\r\n Next<\/span> varFilename\r\n If <\/span>Len<\/span>(strFilenames) > 0 Then<\/span>\r\n strFilenames = Mid<\/span>(strFilenames, 2)\r\n End If<\/span>\r\n End If<\/span>\r\n SelectICOFiles = strFilenames\r\nEnd Function<\/span><\/pre>\n![\"Auswahldialog](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_004.png\")
<\/p>\n.ico-Dateien einlesen<\/h2>\n
Public Sub <\/span>ICOToMSysResources(Optional<\/span> bolOverwrite As Boolean<\/span>)\r\n Dim <\/span>db As <\/span>DAO.Database\r\n Dim <\/span>rst As <\/span>DAO.Recordset\r\n Dim <\/span>rstData As <\/span>DAO.Recordset\r\n Dim <\/span>strFileList As String<\/span>\r\n Dim <\/span>strFiles() As String<\/span>\r\n Dim <\/span>strFile As String<\/span>\r\n Dim <\/span>strName As String<\/span>\r\n Dim <\/span>i As Integer<\/span>\r\n Set<\/span> db = CurrentDb\r\n strFileList = SelectICOFiles(CurrentProject.Path)\r\n If <\/span>Len<\/span>(strFileList) > 0 Then<\/span>\r\n strFiles = Split<\/span>(strFileList, \";\")\r\n Set<\/span> rst = db.OpenRecordset(\"SELECT * FROM MSysResources\", dbOpenDynaset)\r\n For i = LBound<\/span>(strFiles) To UBound<\/span>(strFiles)\r\n strFile = strFiles(i)\r\n strName = Mid<\/span>(strFile, InStrRev<\/span>(strFile, \"\\\") + 1)\r\n strName = Replace<\/span>(strName, \".ico\", \"\")\r\n rst.FindFirst \"Name = ''\" & strName & \"''\"\r\n If <\/span>Not<\/span> (rst.NoMatch = False<\/span> And bolOverwrite = False<\/span>) Then<\/span>\r\n If <\/span>rst.NoMatch = True<\/span> Then<\/span>\r\n rst.AddNew<\/span>\r\n Else<\/span>\r\n rst.Edit\r\n End If<\/span>\r\n rst!Name = strName\r\n rst!Extension = \"ico\"\r\n rst!Type = \"img\"\r\n Set<\/span> rstData = rst(\"Data\").Value\r\n On Error Resume Next<\/span>\r\n rstData.Delete\r\n On Error Goto 0\r\n rstData.AddNew<\/span>\r\n rstData(\"FileData\").LoadFromFile strFile\r\n rstData.Update\r\n rst.Update\r\n End If<\/span>\r\n Next<\/span> i\r\n End If<\/span>\r\nEnd Sub<\/span><\/pre>\nVerwalten und Testen der Icons<\/h2>\n
![\"Formular](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_005.png\")
<\/p>\nPrivate Sub <\/span>cmdAddIcons_Click()\r\n ICOToMSysResources True<\/span>\r\n Me!sfmIcons.Form.Requery\r\nEnd Sub<\/span><\/pre>\n![\"Datensatzquelle](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_006.png\")
<\/p>\n![\"Entwurf](\"..\/fileadmin\/_temp_\/2024_02\/pic_1476_007.png\")
<\/p>\nPrivate Sub <\/span>txtSearch_Change()\r\n Dim <\/span>strSearch As String<\/span>\r\n strSearch = Me!txtSearch.Text\r\n If <\/span>Not<\/span> Len<\/span>(strSearch) = 0 Then<\/span>\r\n If <\/span>Left<\/span>(strSearch, 1) = \" \" Then<\/span>\r\n Me!sfmIcons.Form.Filter = \"Name LIKE ''\" & Trim<\/span>(strSearch) & \"*''\"\r\n Else<\/span>If Right<\/span>(strSearch, 1) = \" \" Then\r\n Me!sfmIcons.Form.Filter = \"Name LIKE ''*\" & Trim<\/span>(strSearch) & \"''\"\r\n Else<\/span>\r\n Me!sfmIcons.Form.Filter = \"Name LIKE ''*\" & Me!txtSearch.Text & \"*''\"\r\n End If<\/span>\r\n Me!sfmIcons.Form.FilterOn = True<\/span>\r\n Else<\/span>\r\n Me!sfmIcons.Form.FilterOn = False<\/span>\r\n End If<\/span>\r\nEnd Sub<\/span><\/pre>\n