Зміна іконки у форми Ms Access

Даний приклад показує як змінити стандартну іконку форми на свою іконку (ico) або бмпешку (bmp)
Public Declare Function SendMessage Lib “user32” _
Alias “SendMessageA” _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function DestroyIcon Lib “user32” _
(ByVal hIcon As Long) As Long
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
Declare Function DestroyIcon Lib “user32” (ByVal hIcon As Long) As Long
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const IMAGE_ICON = 1
Public Const LR_LOADFROMFILE = &H10
Private Sub Form_Open(Cancel As Integer)
SendMessage Me.hwnd, WM_SETICON, ICON_SMALL, _
LoadImage(0, “C:TEST.ICO”, IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
End Sub
Private Sub Form_Close()
Dim hIcon As Long
hIcon = SendMessage(hwnd, WM_SETICON, ICON_SMALL, 0)
If hIcon <> 0 Then DestroyIcon hIcon
End Sub

Нижче наведено приклад модуля форми, який встановлює в заголовок 16-тіцветний бмпешку розміром 16х16 крапок. Прозорим кольором у вихідному bmp-файл вважається білий.

Option Compare Database
Option Explicit
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const IMAGE_BITMAP = 0
Private Const LR_LOADFROMFILE = &H10
Private Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Declare Function CreateCompatibleDC Lib “gdi32” _
(ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib “gdi32” _
(ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib “gdi32” _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib “gdi32” _
(ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib “gdi32” _
(ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function CreateIconIndirect Lib “user32” _
(piconinfo As ICONINFO) As Long
Private Declare Function DestroyIcon Lib “user32” _
(ByVal hIcon As Long) As Long
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 GetPixel Lib “gdi32” _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib “gdi32” _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal crColor As Long) As Long
Private Declare Function SendMessage Lib “user32” _
Alias “SendMessageA” _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Sub Form_Close()
Dim hIcon As Long
hIcon = SendMessage(hwnd, WM_SETICON, ICON_SMALL, 0)
If hIcon <> 0 Then DestroyIcon hIcon
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim hIcon As Long, ii As ICONINFO
Dim hBmpMask As Long, hBmpColor As Long, ob As Long, ob1 As Long
Dim hDCMask As Long, hDCColor As Long
Dim x As Long, y As Long
hDCColor = CreateCompatibleDC(0)
hDCMask = CreateCompatibleDC(0)”Файл test.bmp – 16-тіцветний картинка розміром 16х16
hBmpColor = LoadImage(0, “c: est.bmp”, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
hBmpMask = CreateBitmap(16, 16, 1, 1, 0)
ob = SelectObject(hDCColor, hBmpColor)
ob1 = SelectObject(hDCMask, hBmpMask)”Робимо маску
For y = 0 To 15: For x = 0 To 15
If GetPixel(hDCColor, x, y) = &HFFFFFF Then
SetPixel hDCColor, x, y, 0: SetPixel hDCMask, x, y, &HFFFFFF
Else
SetPixel hDCMask, x, y, 0
End If
Next: Next
ii.hbmColor = SelectObject(hDCColor, ob)
ii.hbmMask = SelectObject(hDCMask, ob1)
ii.fIcon = 1
ii.xHotspot = 8: ii.yHotspot = 8
hIcon = CreateIconIndirect(ii)
SendMessage hwnd, WM_SETICON, ICON_SMALL, hIcon
DeleteObject hBmpColor
DeleteObject hBmpMask
DeleteDC hDCColor
DeleteDC hDCMask
End Sub

Схожі статті:


Сподобалася стаття? Ви можете залишити відгук або підписатися на RSS , щоб автоматично отримувати інформацію про нові статтях.

Коментарів поки що немає.

Ваш отзыв

Поділ на параграфи відбувається автоматично, адреса електронної пошти ніколи не буде опублікований, допустимий HTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

*

*