-
Apr 5th, 2021, 06:19 AM
#1
Thread Starter
PowerPoster
how to transparency Button like Listbox by vb6?
.net framework,it's cool
https://www.vbforums.com/showthread....r-a-picturebox
Code:
Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lppt As Any) As Long
Private Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Const TRANSPARENT As Long = 1
Private Const WM_CTLCOLORLISTBOX As Long = &H134
Private Const WM_CTLCOLORSTATIC As Long = &H138
Private Const WM_VSCROLL As Long = &H115
Dim WithEvents WndProc As clsTrickSubclass ' Объект для сабклассинга формы
Dim WithEvents lstProc As clsTrickSubclass ' Объект для сабклассинга списка
Dim hBackBrush As Long ' Фоновая кисть
Private Sub list1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
SendMessage List1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
List1.Refresh
End If
End Sub
Private Sub Form_Load()
'Set a larger background image test.jpg for the form, and move the text box to see the transparency effect
Me.Picture = LoadPicture(App.Path & "\test.jpg")
' Создаем кисть для отрисовки фона на основе фонового изображения формы
hBackBrush = CreatePatternBrush(Me.Picture.Handle)
' Сабклассинг формы
Set WndProc = New clsTrickSubclass
Set lstProc = New clsTrickSubclass
WndProc.Hook Me.hwnd
lstProc.Hook List1.hwnd
' Добавляем в список тестовые значения
Do While List1.ListCount < 100
List1.AddItem Format(List1.ListCount, "ITE\M 00")
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Удаляем кисть
DeleteObject hBackBrush
End Sub
' Оконная процедура списка
Private Sub lstProc_wndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
Select Case Msg
' При прокрутке списка
Case WM_VSCROLL
' Объявляем всю область списка недействительной и требующей перерисовки
InvalidateRect hwnd, ByVal 0&, 0
End Select
' Вызов по умолчанию
DefCall = True
End Sub
' Оконная процедура формы
Private Sub wndProc_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
Select Case Msg
' При запросе кисти фона списка или слайдера
Case WM_CTLCOLORSTATIC, WM_CTLCOLORLISTBOX
Dim pts(1) As Long
' Получаем координаты элемента
MapWindowPoints lParam, Me.hwnd, pts(0), 1
' Сдвигаем точку отсчета координат кисти, чтобы она совпадала с фоновом изображением под контролом
SetBrushOrgEx wParam, -pts(0), -pts(1), ByVal 0&
' Если это список
If lParam = List1.hwnd Then
' Устанавливаем прозрачный фон для текста
SetBkMode wParam, TRANSPARENT
' Устанавливаем цвет текста
SetTextColor wParam, vbWhite
End If
' Возвращаем кисть
Ret = hBackBrush
Case Else: DefCall = True ' Остальное оставляем без изменений
End Select
End Sub
clsTrickSubclass.cls
https://www.vbforums.com/showthread....sTrickSubclass
https://www.vbforums.com/attachment....1&d=1423662614
by vb.net
Code:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.EmbedButtonInPictureBox(Me.Button1, Me.PictureBox1)
Me.EmbedButtonInPictureBox(Me.Button2, Me.PictureBox1)
Me.EmbedButtonInPictureBox(Me.Button3, Me.PictureBox1)
End Sub
Private Sub EmbedButtonInPictureBox(ByVal btn As Button, ByVal pbx As PictureBox)
Dim buttonLocation As Point = pbx.PointToClient(Me.PointToScreen(btn.Location))
btn.Parent = pbx
btn.Location = buttonLocation
Dim buttonBackground As New Bitmap(btn.Width, btn.Height)
Using g As Graphics = Graphics.FromImage(buttonBackground)
g.DrawImage(pbx.Image, _
New Rectangle(0, _
0, _
buttonBackground.Width, _
buttonBackground.Height), _
btn.Bounds, _
GraphicsUnit.Pixel)
End Using
btn.BackgroundImage = buttonBackground
End Sub
Last edited by xiaoyao; Apr 6th, 2021 at 03:18 AM.
-
Apr 5th, 2021, 09:27 AM
#2
Hyperactive Member
Re: how to transparency Button like Listbox by vb6?
good contribution.
With the mouse wheel it works badly.
regards
-
Apr 5th, 2021, 12:47 PM
#3
Lively Member
Re: how to transparency Button like Listbox by vb6?
Originally Posted by xiaoyao
Code:
Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lppt As Any) As Long
Private Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Const TRANSPARENT As Long = 1
Private Const WM_CTLCOLORLISTBOX As Long = &H134
Private Const WM_CTLCOLORSTATIC As Long = &H138
Private Const WM_VSCROLL As Long = &H115
Dim WithEvents WndProc As clsTrickSubclass ' Объект для сабклассинга формы
Dim WithEvents lstProc As clsTrickSubclass ' Объект для сабклассинга списка
Dim hBackBrush As Long ' Фоновая кисть
Private Sub list1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Call ReleaseCapture
SendMessage List1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
List1.Refresh
End If
End Sub
Private Sub Form_Load()
'Set a larger background image test.jpg for the form, and move the text box to see the transparency effect
Me.Picture = LoadPicture(App.Path & "\test.jpg")
' Создаем кисть для отрисовки фона на основе фонового изображения формы
hBackBrush = CreatePatternBrush(Me.Picture.Handle)
' Сабклассинг формы
Set WndProc = New clsTrickSubclass
Set lstProc = New clsTrickSubclass
WndProc.Hook Me.hwnd
lstProc.Hook List1.hwnd
' Добавляем в список тестовые значения
Do While List1.ListCount < 100
List1.AddItem Format(List1.ListCount, "ITE\M 00")
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Удаляем кисть
DeleteObject hBackBrush
End Sub
' Оконная процедура списка
Private Sub lstProc_wndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
Select Case Msg
' При прокрутке списка
Case WM_VSCROLL
' Объявляем всю область списка недействительной и требующей перерисовки
InvalidateRect hwnd, ByVal 0&, 0
End Select
' Вызов по умолчанию
DefCall = True
End Sub
' Оконная процедура формы
Private Sub wndProc_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
Select Case Msg
' При запросе кисти фона списка или слайдера
Case WM_CTLCOLORSTATIC, WM_CTLCOLORLISTBOX
Dim pts(1) As Long
' Получаем координаты элемента
MapWindowPoints lParam, Me.hwnd, pts(0), 1
' Сдвигаем точку отсчета координат кисти, чтобы она совпадала с фоновом изображением под контролом
SetBrushOrgEx wParam, -pts(0), -pts(1), ByVal 0&
' Если это список
If lParam = List1.hwnd Then
' Устанавливаем прозрачный фон для текста
SetBkMode wParam, TRANSPARENT
' Устанавливаем цвет текста
SetTextColor wParam, vbWhite
End If
' Возвращаем кисть
Ret = hBackBrush
Case Else: DefCall = True ' Остальное оставляем без изменений
End Select
End Sub
It is reasonable to translate comments in code into English. I am a native russian speaker too, but if you do share your code in community - try your best to make everything "english-compatible".
Moreover - what is "clsTrickSubclass" ? Where is the code of it?
Btw, here is a proper way to subclass almost safe - https://bitbucket.org/hwoarang84/vbc...r/Subclass.bas. Original code is not mine (can't find source and author), but I made few adjustments and bugfixes.
Last edited by hwoarang; Apr 5th, 2021 at 12:52 PM.
-
Apr 5th, 2021, 01:31 PM
#4
Re: how to transparency Button like Listbox by vb6?
Last edited by The trick; Apr 5th, 2021 at 01:36 PM.
-
Apr 5th, 2021, 07:00 PM
#5
Thread Starter
PowerPoster
Re: how to transparency Button like Listbox by vb6?
If the form has a background image, place a text box or list box on it, along with a picture box control. You can use a variety of different methods to achieve a more perfect transparency effect.
But if the controls overlap. The transparency becomes just for the background image. It does not see the controls below it.In fact, each of the different up and down order of the control, it corresponds to the background image is to make up their own.
If there is a label control behind the list box, the data is updated three times per second. Then we need to take a screenshot of all the controls behind the list box.The most efficient way to do this is to take only the portion of the text that changes and superimpose it on the background image handle of the text box.
You might hook the GDI function (GDI _ DraWtext).I feel that VB.NET is not dealing with real transparency.
-
Apr 5th, 2021, 07:16 PM
#6
Thread Starter
PowerPoster
Re: how to transparency Button like Listbox by vb6?
Originally Posted by The trick
i have a test, The button is not really transparent, once clicked, the picture on the button disappears
Last edited by xiaoyao; Apr 6th, 2021 at 03:28 AM.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|