Categories
Access Edanamo icons images MS Access olelib.tlb

Putting an icon on Access application

Access can put an icon onto the top left corner of a database which you build. This is done through the Tools | Startup dialog. In there you specify the path to the icon file. This can be a pain if you are distributing the database to multiple users as their path could (it most definitely will) vary from user to user.

One way to get around this issue to to modify the icon path in the startup macro autoexec. In this macro add a RunCode item and set it to run a function eg: setIconPath(). In this function you would add something like this:


Const Main_Icon_name As String = "myicon"

Public Function SetStartupOptions(propertyname As String, _
propertytype As Variant, propertyvalue As Variant) _
As Boolean
Dim dbs As Object
Dim prp As Object
Set dbs = Application.CurrentDb
On Error Resume Next
dbs.Properties(propertyname) = propertyvalue
If Err.Number = 3270 Then
Set prp = dbs.CreateProperty(propertyname, _
propertytype, propertyvalue)
dbs.Properties.Append prp
Application.RefreshTitleBar
Else
SetStartupOptions = False
End If
Set dbs = Nothing
Set prp = Nothing
End Function

Public Function setIconPath()
Dim fs As New FileSystemObject
Dim sNewFilePath As String


sNewFilePath = fs.BuildPath(CurrentProject.PATH, Main_Icon_name & ".ico")

SetStartupOptions "AppIcon", dbText, sNewFilePath
SetStartupOptions "UseAppIconForFrmRpt", dbBoolean, vbTrue
Application.RefreshTitleBar
End Function

This function obtains the path where Access is running then adds on the icon name and sets the options to enable the icon for reports and forms. Lastly it refreshes the application window so the icon will be visible. Simple enough.

But what if you want to distribute the application without its icon file, or the icon will be different depending on security, if you have a really advanced applications? Then this code can be modified to select the icon as necessary. (credit http://www.access-programmers.co.uk/forums/).


'place this sub in each forms "Load" event
Private Sub Form_Load()

SetFormIcon Me.hWnd, Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & “\myicon.ico"
‘if the icon file is stored in the same directory as the db
‘or
SetFormIcon Me.hWnd, "C:\Icons\Icon1.ico" 'Location of icon file

End Sub

‘copy below code in a new public module


Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long

Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)
End Function

You can even get fancier than this by storing the icons in the database and extracting them our
when you need to. How do you that you ask? You’ll need a couple of bits from the internet, but its all pretty easy.

First download Eduardo Morcillio’s OLE Lib TLB file from here http://www.mvps.org/emorcillo/en/code/vb6/index.shtml which is a popular library to play some Windows features. This will need to installed using the regtlib.exe utility. If you are lucky this will already be on your machine.

To extract the file out from the table code similar to this is needed:


Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Const PictureID = &H746C&

Private Type PictureHeader
Magic As Long
Size As Long
End Type

Public Function Array2Picture(aBytes() As Byte) As StdPicture
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader

Set Array2Picture = New StdPicture ' Create a new empty picture object
Set oIPS = Array2Picture ' Get the IPersistStream interface
lSize = UBound(aBytes) - LBound(aBytes) + 1 ' Calculate the array size
hGlobal = GlobalAlloc(GHND, lSize + Len(Hdr)) ' Allocate global memory
If hGlobal Then
lPtr = GlobalLock(hGlobal) ' Get a pointer to the memory
Hdr.Magic = PictureID ' Initialize the header
Hdr.Size = lSize
CopyMemory ByVal lPtr, Hdr, Len(Hdr) ' Write the header
CopyMemory ByVal lPtr + Len(Hdr), aBytes(0), lSize ' Copy the byte array to the global memory
GlobalUnlock hGlobal ' Release the pointer
Set oStream = CreateStreamOnHGlobal(hGlobal, True) ' Create a IStream object with the global memory
oIPS.Load oStream ' Load the picture from the stream
Set oStream = Nothing ' Release the IStream object
End If
End Function

Public Sub Get_Icon_into_File(n_id As Integer, sfile_base As String)
Dim ADO_RS As New ADODB.Recordset
Dim oPicture As New StdPicture
Dim bytedata() As Byte
Dim vvalue As Variant
Dim chunk As Long

ADO_RS.Open "select IMG_BLOB from ICONS where ID=" & n_id, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
ADO_RS.MoveFirst
vvalue = ADO_RS(0).Value
chunk = LenB(vvalue)
bytedata() = ADO_RS(0).GetChunk(chunk)
Set oPicture = Array2Picture(bytedata)

SavePicture oPicture, CurrentProject.PATH & "\" & sfile_base & ".ico"

End Sub

Whew! So what’s going on here. First we read the data out of the ICONS table in the IMG_BLOB column which is a OLEObject type. You notice that we are not stored a OLE object in it however. This saves us a lot of space. We then have to convert this to a picture object (Array2Picture) and then save it to the file.

In the next blog I’ll get into how we get the icons into the table in the first place!