Замена иконки формы (API)По материалам: http://www.mvps.org Не существует прямого способа заменить иконку, но можно это сделать, загружая ICO файл в память и назначая значок на форму (посылаем WM_SETICON сообщение окну). Private Sub Form_Load() Dim b As Boolean Dim sIconFilePath As String sIconFilePath = "d:\Temp\Application002.ico" b = SetFormIcon(Me.hWnd, sIconFilePath) If b = False Then Debug.Print "Установить иконку: " & sIconFilePath & " - установить не удалось :(" End Sub
Option Compare Database Option Explicit '-------------------------------------------------------------------- ' Module : modFormsChangeIcon ' Author : Code courtesy of Klaus H. Probst ' Date : ??.??.2001 ' Purpose : Замена иконки формы '-------------------------------------------------------------------- ' '// 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 '-------------------------------------------------------------------- On Error GoTo SetFormIcon_Err 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 SetFormIcon_Bye: Exit Function SetFormIcon_Err: MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _ "in procedure SetFormIcon", vbCritical, "Error!" Resume SetFormIcon_Bye End Function |
|||
L.E. 29.11.2024 |