| |
Option Compare Database Option Explicit
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(MyIcon As String, Optional frm As String) As Boolean 'Place un icon dans le menu de l'application ou dans un formulaire Dim hIcon As Long Dim hwnd As Long Dim IconPath As String IconPath = CurrentDBDir() & MyIcon If Len(Dir(IconPath)) = 0 Then SetFormIcon = False Exit Function Else If frm = "" Then hwnd = Application.hWndAccessApp Else hwnd = Forms(frm).hwnd 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 If
End Function | | |