Каталог статей

синию хрень. Когда вы будете ее стирать, стирание будет незаметно, и для этого нужно выключить оригинал слоя вот так, чтобы не было глаза около него и его не было видно. Нажимаем на слой-дубликат. Делаем слой-оригинал активным Затем идем в Image-Adjustments-Hue\Saturation или нажимаем Ctrl+U. Ставим галочку около colorize и, меняя ползунки, изменяем цвет кнопки. После каждого изменения сохраням разные варианты кнопок. У меня получилось так:

Закончив визуальную часть, приступаем к программной. Открываем VB и сразу же делаем форму невидимой, поменяв свойство Visible на противоположное. Так же при желании ее можно программно добавить в автозапуск, но по этой теме уже были уроки. Добавляем на форму 2 таймера. Первый переименую на tmrPaint. А затем вставляем вот такой код.

Dim n As String, x As Byte

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Const SRCCOPY = &HCC0020

Dim hwndTB As Long ' handle taskbar'а

Dim hWndSB As Long ' handle окна кнопки ПУСК

Dim hDcSB As Long ' handle содержимого кнопки ПУСК

Dim mRect As RECT ' координаты кнопки ПУСК

Dim hDcTmp As Long ' handle новой картинки

Dim hBmpTmp As Long ' временная картинка

Dim hBmpTmp2 As Long ' временная картинка

Dim nWidth As Long ' ширина кнопки ПУСК

Dim nHeight As Long ' высота кнопки ПУСК

Dim sPath As String ' путь к картинке

Private Sub Form_Load()

x = 1 ' задаем начальное положение счетчика

' получить handle taskbar и кнопки ПУСК

hwndTB = FindWindow("Shell_TrayWnd", "")

hWndSB = FindWindowEx(hwndTB, 0, "button", vbNullString)

' получить dc кнопки ПУСК

hDcSB = GetWindowDC(hWndSB)

' получить координаты кнопки ПУСК

Call GetWindowRect(hWndSB, mRect)

' ширина и высота

nWidth = mRect.Right - mRect.Left

nHeight = mRect.Bottom - mRect.Top

hDcTmp = CreateCompatibleDC(hDcSB)

hBmpTmp = CreateCompatibleBitmap(hDcTmp, nWidth, nHeight)

End Sub

Private Sub Timer1_Timer()

Select Case x

Case 1

n = "1.bmp"

x = 2

Case 2

n = "2.bmp"

x = 3

Case 3

n = "3.bmp"

x = 4

Case 4

n = "4.bmp"

x = 1

End Select

' установить путь для загрузки картинки

sPath = n

hBmpTmp2 = SelectObject(hDcTmp, LoadPicture(sPath))

End Sub

Private Sub tmrPaint_Timer()

' рисовать кнопку ПУСК

Call BitBlt(hDcSB, 0, 0, nWidth, nHeight, hDcTmp, 0, 0, SRCCOPY)

End Sub

Private Sub Form_Unload(Cancel As Integer)

' очистить кнопку ПУСК

hBmpTmp = SelectObject(hDcTmp, hBmpTmp2)

DeleteObject hBmpTmp

DeleteDC hDcTmp

End Sub

ВАЖНО! Наши кнопки «Пуск» должны лежать рядом с программой.