INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Form Basics

Icon on forms A2K/AXP(A97) by hermanlaksko
Posted: 15 Sep 04 (Edited 27 Mar 06)

I have tested this code on A2K and AXP but not on A97, however it should also work there.

The code was org. written by Klaus, I have modifyed the function to enable 1 icon file for all forms "the easy way".

Also I have added the option to auto add the icon to the app itself in the function "SetAppIcon" this can be called from an autoexec macro or any function or sub.

Here is the link to where I org. got the code:

http://www.mvps.org/access/api/api0043.htm

Option Compare Database
' This code was originally written by Klaus Probst.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Klaus Probst
'
'// Place all this in a module
Public 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
   
Public 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 Const WM_GETICON = &H7F
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const ICON_BIG = 1

'// LoadImage() image types
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1
Public Const IMAGE_CURSOR = 2
Public Const IMAGE_ENHMETAFILE = 3

'// LoadImage() flags
Public Const LR_DEFAULTCOLOR = &H0
Public Const LR_MONOCHROME = &H1
Public Const LR_COLOR = &H2
Public Const LR_COPYRETURNORG = &H4
Public Const LR_COPYDELETEORG = &H8
Public Const LR_LOADFROMFILE = &H10
Public Const LR_LOADTRANSPARENT = &H20
Public Const LR_DEFAULTSIZE = &H40
Public Const LR_LOADMAP3DCOLORS = &H1000
Public Const LR_CREATEDIBHeader = &H2000
Public Const LR_COPYFROMRESOURCE = &H4000
Public Const LR_SHARED = &H8000
Public Function SetFormIcon(hwnd As Long, IconPath As String) As Boolean
Dim hIcon As Long
'In Form OnLoad event: SetFormIcon Me.hWnd, ""
If IconPath = "" Then
    IconPath = CurrentDb.Name
    IconPath = Left(IconPath, Len(IconPath) - (Len(IconPath) - InStrRev(IconPath, "\"))) & "YrFile.ico"
End If
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)

'// wParam = 0; Setting small icon. wParam = 1; setting large icon
If hIcon <> 0 Then
   Call SendMessage(hwnd, WM_SETICON, 0, ByVal hIcon)
   SetFormIcon = True
End If
End Function
Public Function SetAppIcon() As Boolean
On Error GoTo Fejl
Dim hIcon As Long, DB As DAO.Database
Set DB = DBEngine(0)(0)

If IconPath = "" Then IconPath = Left(DB.Name, Len(DB.Name) - (Len(DB.Name) - InStrRev(DB.Name, "\"))) & "YrFile.ico"
hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)

If hIcon <> 0 Then
    DB.Properties!AppIcon = IconPath
    Application.RefreshTitleBar
End If
FejlExit:
    Exit Function
Fejl:
    MsgBox Err.Description, , "YrAppName"
    Resume FejlExit
End Function

Back to Microsoft: Access Forms FAQ Index
Back to Microsoft: Access Forms Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close