Кнопки с иконками и стилем Windows XP

[bon818]

Непонятно почему ты манифест невидеш ? всё стандартно лежит где положено

[ger_kar]

есть там манифест!

Однако он странный этот манифест. Я так и не понял в чем прикол, но исследовав файл ресурса в редакторе ресурсов манифеста обнаружить не смог, как не пытался, как впрочем и исследования в Hex редакторе мало чем помогло в обнаружении оного. Если он там есть, а стили XP косвенно на это указывают, то в каком виде он там содержится? Явно что не в стандартном.

[ger_kar]

Вот собственно скрины:

Рес1.jpg (27.5 Кб) Просмотров: 989

Рес2.jpg (27.56 Кб) Просмотров: 989

[bon818]

вот манифест в картинках в нормальном редакторе

[BV]

ger_kar, лови мою кнопку (не помню, возможно, где-то и тут на форуме есть): http://forum.sources.ru/index.php?showt ... &p=2510447
Поддерживает иконки, рисуется как кастомными градиентами, как и скином текущего системного стиля

[ger_kar]

Скачал, кнопка отличная, и удобная в применении. Спасибо.

[ark]

Код: Выделить всё

Option Explicit

Enum BUTTON_IMAGELIST_ALIGN
   ALIGN_LEFT = 0
   ALIGN_RIGHT = 1
   ALIGN_TOP = 2
   ALIGN_BOTTOM = 3
   ALIGN_CENTER = 4
End Enum

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type BUTTON_IMAGELIST
   hIml As Long
   rc As RECT
   uAlign As Long
End Type

Private Type tagInitCommonControlsEx
   lngSize As Long
   lngICC As Long
End Type

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
Private Declare Function InitCommonControls Lib "comctl32.dll" () As Boolean
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const BM_SETIMAGE = &HF7&
Private Const BCM_SETIMAGELIST = &H1602&
Private Const ICC_USEREX_CLASSES = &H200
Private Const GWL_STYLE As Long = -16&

Public Function InitCommonControlsVB() As Boolean
   On Error Resume Next
   Dim iccex As tagInitCommonControlsEx
   With iccex
       .lngSize = LenB(iccex)
       .lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   If Err Then
      InitCommonControlsVB = InitCommonControls
   Else
      InitCommonControlsVB = True
   End If
   On Error GoTo 0
End Function

Public Sub SetButtonXPIcon(btn As CommandButton, il As ImageList, _
           Optional align As BUTTON_IMAGELIST_ALIGN = ALIGN_CENTER, _
           Optional leftMargin As Long, Optional topMargin As Long, _
           Optional rightMargin As Long, Optional bottomMargin As Long)
   Dim bi As BUTTON_IMAGELIST
   Dim sPic As StdPicture
   bi.uAlign = align
   bi.rc.Left = leftMargin
   bi.rc.Top = topMargin
   bi.rc.Right = rightMargin
   bi.rc.Bottom = bottomMargin
   bi.hIml = il.hImageList
   If SendMessage(btn.hWnd, BCM_SETIMAGELIST, 0, bi) = 0 Then 'не ХР или манифеста нету
      'If btn.Caption = "" Then
         Set sPic = il.ListImages(1).ExtractIcon
        'Меняем стиль на графический и рисуем картинку (текст пропадает)
         SetWindowLong btn.hWnd, GWL_STYLE, GetWindowLong(btn.hWnd, GWL_STYLE) Or (2 - (sPic.Type - 1) / 2) * &H40&
         SendMessage btn.hWnd, BM_SETIMAGE, (sPic.Type - 1) / 2, ByVal sPic.Handle
         If il.Parent.BackColor <> vbButtonFace Then il.Parent.BackColor = vbButtonFace
      'End If
   End If
   Set sPic = Nothing
End Sub

Вызов:

Код: Выделить всё

Private Sub Command1_Click()
   InitCommonControlsVB
    SetButtonXPIcon Command1, ImageList1, ALIGN_LEFT
End Sub

Manifest.zip

А это для добавления манифеста к экзешнику в ресурсы

(15.41 Кб) Скачиваний: 63

[VBTerminator]

Код: Выделить всё

If il.Parent.BackColor <> vbButtonFace Then il.Parent.BackColor = vbButtonFace

А зачем надо сбрасывать цвет фона родителя кнопки?

[Qwertiy]

А зачем надо сбрасывать цвет фона родителя кнопки?

Думаю, из-за

'Меняем стиль на графический и рисуем картинку (текст пропадает)

Т. к. если стиль не графический, то цвет фона игнорируется

Или прозрачность...

[ark]

Пардон, дернул из старой программы без комментов. У меня в il MaskColor в ButoonFace установлен

[ger_kar]

Спасибо, вот только сейчас прочитал пост ark и этот вариант мне понравился, спасибо.

[Qwertiy]

А я сначала подумал про прозрачность, потом решил, что странно использовать для этого зависимый от системы цвет, поэтому решил, что всё-таки что-то другое.