Transparent Gadgets
-
- Enthusiast
- Posts: 731
- Joined: Wed Apr 21, 2004 7:12 pm
Transparent Gadgets
Is there a method which will make any gadget transparent? I have seen examples for transparent text gadgets, but that code doesn't seem to work on Listview gadgets.
~I see one problem with your reasoning: the fact is thats not a chicken~
What do you want showing through behind the ListViewGadget? If nothing, then you can change the ListViewGadget background brush color to match the window color. If it's an image, then maybe use the image as the background brush. If you want transparency, then use a #HOLLOW_BRUSH. Keep in mind that with #HOLLOW_BRUSH, you'll have to redraw whatever is behind the ListViewGadget every time there is an item change.
Set up a WindowCallback, catch #WM_CTLCOLORLISTBOX messages, and return the background brush.
Set up a WindowCallback, catch #WM_CTLCOLORLISTBOX messages, and return the background brush.
Code: Select all
Procedure.l myWindowCallback(hwnd, msg, wparam, lparam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_CTLCOLORLISTBOX
Select lparam
Case GadgetID(LstViewGadgetID)
SetBkMode_(wparam, #TRANSPARENT)
SetTextColor_(wparam, RGB(0, 100, 255))
result = hBrush1
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
Hate to bring this up, but ... where is hBrush1 set?
We can do something like ...
However, how would I go about showing the transparency whenever something changes in the gadget? such as new text and such.
We can do something like ...
Code: Select all
Global hBrush.l = GetStockObject_(#HOLLOW_BRUSH)
This is by no means complete, but I'll post it to show you the basics for a transparent ListView. For this example, the image you choose for your background will be resized to be no bigger than 640 x 480. You may also need to change the text colors, depending on the image you selected. You can do so in lines 114, 118, and 120.
This code is comprised of bits and pieces of other code I have laying around. It is not very well commented nor is it structured as I would like it to be. I will work on this later when I have more time. Also, there are still some flickering problems that need to be addressed as well. Feel free to offer suggestions
@Shannara: I know you've been having problems using image backgrounds so l hope this works for you. I tested on Win XP Home SP2.
PB4 Beta9
* Edited to remove some un-necessary code *
This code is comprised of bits and pieces of other code I have laying around. It is not very well commented nor is it structured as I would like it to be. I will work on this later when I have more time. Also, there are still some flickering problems that need to be addressed as well. Feel free to offer suggestions

@Shannara: I know you've been having problems using image backgrounds so l hope this works for you. I tested on Win XP Home SP2.
PB4 Beta9
Code: Select all
Global oldCallback, hWinBrush, hLvBrush, imgW, imgH
UseJPEGImageDecoder()
UsePNGImageDecoder()
#Window_Main = 1
#ListView_1 = 1
Procedure.l ImageSizer(imageIs.l, imgW.f, imgH.f)
mainWidth.f = ImageWidth(imageIs)
mainHeight.f = ImageHeight(imageIs)
percentageW.f = mainWidth / imgW
percentageH.f = mainHeight /imgH
If percentageW > percentageH Or percentageW = percentageH
percentageWH.f = percentageW
ElseIf percentageH > percentageW
percentageWH.f = percentageH
EndIf
newWidth = mainWidth / percentageWH
newHeight = mainHeight / percentageWH
newImage = ResizeImage(imageIs, newWidth, newHeight)
ProcedureReturn newImage
EndProcedure
Procedure SetWindowBG(img$)
bgImage = LoadImage(#PB_Any, img$)
If bgImage
If ImageWidth(bgImage) > 640 Or ImageHeight(bgImage) > 480
sizedImage = ImageSizer(bgImage, 640, 480)
Else
sizedImage = ImageID(bgImage)
EndIf
hBrush = CreatePatternBrush_(sizedImage)
imgW = ImageWidth(bgImage)
;...Vars to use for window size
If imgW < 300
imgW = 500
EndIf
imgH = ImageHeight(bgImage)
If imgH < 200
imgH = 400
EndIf
FreeImage(bgImage)
If hBrush
result = hBrush
Else
MessageRequester("Error", "Could not create brush", #MB_ICONERROR)
result = 0
EndIf
Else
MessageRequester("Error", "Could not load image", #MB_ICONERROR)
result = 0
EndIf
ProcedureReturn result
EndProcedure
Procedure DoBg(gad)
result = 0
srcDC = GetDC_(WindowID(0))
If srcDC
destDC = CreateCompatibleDC_(srcDC)
If destDC
GetClientRect_(GadgetID(gad), @lvRc.RECT)
hBmp = CreateImage(#PB_Any, GadgetWidth(gad), GadgetHeight(gad))
If hBmp
SelectObject_(destDC, ImageID(hBmp))
BitBlt_(destDC, 0, 0, GadgetWidth(gad), GadgetHeight(gad), srcDC, lvRc\left+GadgetX(gad), lvRc\top+GadgetY(gad), #SRCCOPY)
hTransBrush = CreatePatternBrush_(ImageID(hBmp))
FreeImage(hBmp)
If hTransBrush
result = hTransBrush
EndIf
EndIf
DeleteDC_(destDC)
EndIf
ReleaseDC_(WindowID(0), srcDC)
EndIf
ProcedureReturn result
EndProcedure
Procedure GetBackground(win)
bgImage$ = OpenFileRequester("Choose Background Image", "C:\Documents and Settings\Owner\My Documents\My Pictures\", "Image Files (BMP, JPG, PNG)|*.bmp;*.jpg;*.png", 0)
If bgImage$
hWinBrush = SetWindowBG(bgImage$)
Else
;...No image selected. End
End
EndIf
ProcedureReturn hWinBrush
EndProcedure
Procedure LVcallback(hwnd, msg, wParam, lParam)
result = CallWindowProc_(oldCallback, hwnd, msg, wParam, lParam)
Select msg
Case #WM_VSCROLL
InvalidateRect_(hwnd, 0, 0)
GetClientRect_(hwnd, @lvRc.RECT)
hdc = GetDC_(hwnd)
FillRect_(hdc, @lvRc, hLvBrush)
ReleaseDC_(hwnd, hdc)
Case #WM_ERASEBKGND
GetClientRect_(hwnd, @lvRc.RECT)
FillRect_(wParam, @lvRc, hLvBrush)
result = 1
EndSelect
ProcedureReturn result
EndProcedure
Procedure.l WinCallback(hwnd, msg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_DRAWITEM
*lpdis.DRAWITEMSTRUCT=lParam
Select *lpdis\CtlType
Case #ODT_LISTBOX
lbText$ = GetGadgetItemText(#ListView_1, *lpdis\itemID, 0)
dtFlags = #DT_LEFT | #DT_VCENTER
currentBrush = hLvBrush
Select *lpdis\itemState
Case #ODS_SELECTED
currentTextColor = RGB(200, 200, 255)
;...Draw a focus rect to remove the default focus rect
drawFocus = #True
Case #ODS_SELECTED | #ODS_FOCUS
currentTextColor = RGB(0, 0, 255)
Case 0
currentTextColor = RGB(255, 0, 0)
EndSelect
FillRect_(*lpdis\hdc, *lpdis\rcItem, currentBrush)
SetBkMode_(*lpdis\hdc, #TRANSPARENT)
SetTextColor_(*lpdis\hdc, currentTextColor)
;...Move the text over 3 pixels
*lpdis\rcItem\left + 3
DrawText_(*lpdis\hdc, lbText$, Len(lbText$), *lpdis\rcItem, dtFlags)
;...Move *lpdis\rcItem\left back to original pos for focus rect
If drawFocus
*lpdis\rcItem\left - 3
DrawFocusRect_(*lpdis\hdc, *lpdis\rcItem)
EndIf
EndSelect
Case #WM_COMMAND
Select wParam >>16 &$FFFF
Case #LBN_SELCHANGE
InvalidateRect_(lParam, 0, 1)
EndSelect
Case #WM_CTLCOLORLISTBOX
Select lParam
Case GadgetID(1)
SetBkMode_(wParam, #TRANSPARENT)
SetTextColor_(wParam, RGB(0, 0, 255))
result = hLvBrush
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
hMainBrush = GetBackground(#Window_Main)
If OpenWindow(0, 0, 0, imgW, imgH, "Transparent ListViewGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
SetClassLong_(WindowID(win), #GCL_HBRBACKGROUND, hMainBrush)
SetWindowCallback(@WinCallback())
ListViewGadget(1, 20, 20, 200, 250, #LBS_OWNERDRAWFIXED)
SetWindowLong_(GadgetID(1), #GWL_EXSTYLE, GetWindowLong_(GadgetID(1), #GWL_EXSTYLE) & ~#WS_EX_CLIENTEDGE)
HideGadget(1, 1)
hLvBrush = DoBg(1)
HideGadget(1, 0)
SetClassLong_(GadgetID(1), #GCL_HBRBACKGROUND, hLvBrush)
oldCallback = SetWindowLong_(GadgetID(1), #GWL_WNDPROC, @LVcallback())
For a = 1 To 25
AddGadgetItem (1, -1, "Item " + Str(a) + " of the Listview")
Next
SetGadgetState(1, 9)
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
If hLvBrush
DeleteObject_(hLvBrush)
EndIf
If hMainBrush
DeleteObject_(hWinBrush)
EndIf
EndIf
End
Last edited by Sparkie on Fri Apr 07, 2006 3:19 pm, edited 1 time in total.
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
Thanks rsts 
I'm one step away from a flicker free transparent background. I just need to figure out why the scrollbar is not redrawing properly

I'm one step away from a flicker free transparent background. I just need to figure out why the scrollbar is not redrawing properly

Last edited by Sparkie on Tue Apr 11, 2006 12:53 am, edited 1 time in total.
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
Ok, here's what I have up to this point. I'd say this is 99% flicker free for me on WinXP with PB4 Beta9. I still have some more clean-up/optimizing to do, so I'll post the completed code later this week(end). Let me know if you see any room for improvement. 

Code: Select all
Global oldCallback, hWinBrush, hLvBrush, imgW, imgH, hBmp
UseJPEGImageDecoder()
UsePNGImageDecoder()
#Window_Main = 1
#ListView_1 = 1
#Image_BG = 1
Procedure.l ImageSizer(imageIs.l, imgW.f, imgH.f)
mainWidth.f = ImageWidth(imageIs)
mainHeight.f = ImageHeight(imageIs)
percentageW.f = mainWidth / imgW
percentageH.f = mainHeight /imgH
If percentageW > percentageH Or percentageW = percentageH
percentageWH.f = percentageW
ElseIf percentageH > percentageW
percentageWH.f = percentageH
EndIf
newWidth = mainWidth / percentageWH
newHeight = mainHeight / percentageWH
newImage = ResizeImage(imageIs, newWidth, newHeight)
ProcedureReturn newImage
EndProcedure
Procedure CreateWindowBrush(img$)
;...Load our selected image for window background
bgImage = LoadImage(#PB_Any, img$)
If bgImage
;...Resize image if it's too small for our use
If ImageWidth(bgImage) > 640 Or ImageHeight(bgImage) > 480
sizedImage = ImageSizer(bgImage, 640, 480)
Else
sizedImage = ImageID(bgImage)
EndIf
;...Create brush for window background
hBrush = CreatePatternBrush_(sizedImage)
imgW = ImageWidth(bgImage)
;...Vars to use for window size
If imgW < 300
imgW = 300
EndIf
imgH = ImageHeight(bgImage)
If imgH < 250
imgH = 250
EndIf
FreeImage(bgImage)
If hBrush
result = hBrush
Else
MessageRequester("Error", "Could not create brush", #MB_ICONERROR)
result = 0
EndIf
Else
MessageRequester("Error", "Could not load image", #MB_ICONERROR)
result = 0
EndIf
ProcedureReturn result
EndProcedure
Procedure GetImageBG()
bgImage$ = OpenFileRequester("Choose Background Image", "c:\Documents And Settings\Owner\My Documents\My Pictures\", "Image Files (BMP, JPG, PNG)|*.BMP;*.jpg;*.png", 0)
If bgImage$
hWinBrush = CreateWindowBrush(bgImage$)
Else
;...No image selected. End
End
EndIf
ProcedureReturn hWinBrush
EndProcedure
Procedure CreateListViewBrush(gad)
result = 0
srcDC = GetDC_(WindowID(#Window_Main))
If srcDC
destDC = CreateCompatibleDC_(srcDC)
If destDC
GetClientRect_(GadgetID(gad), @gadRc.RECT)
clientW = gadRc\right - gadRc\left
clientH = gadRc\bottom - gadRc\top
hBmp = CreateImage(#PB_Any, clientW, clientH)
If hBmp
SelectObject_(destDC, ImageID(hBmp))
BitBlt_(destDC, 0, 0, clientW, clientH, srcDC, GadgetX(gad), GadgetY(gad), #SRCCOPY)
result = CreatePatternBrush_(ImageID(hBmp))
FreeImage(hBmp)
EndIf
DeleteDC_(destDC)
EndIf
ReleaseDC_(WindowID(#Window_Main), srcDC)
EndIf
ProcedureReturn result
EndProcedure
Procedure LVcallback(hwnd, msg, wParam, lParam)
result = CallWindowProc_(oldCallback, hwnd, msg, wParam, lParam)
Select msg
Case #WM_ERASEBKGND
result = 1
Case #WM_PAINT
;...Override #WM_PAINT
;...Get ListView DC
lbDc = GetDC_(hwnd)
;...Get the DC for our background image
bgDc = StartDrawing(ImageOutput(#Image_BG))
;...Eliminate border
GetClientRect_(GadgetID(#ListView_1), @gadRc.RECT)
clientW = gadRc\right - gadRc\left
clientH = gadRc\bottom - gadRc\top
;...Copy our background image onto ListView DC
BitBlt_(lbDc, 0, 0, clientW, clientH, bgDc, 0, 0, #SRCCOPY)
;...Finsihed drawing
StopDrawing()
ReleaseDC_(hwnd, lbDc)
;...Return 0
result = 0
Case #WM_LBUTTONDOWN
RedrawWindow_(hwnd, 0, 0, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW)
Case #WM_VSCROLL
RedrawWindow_(hwnd, 0, 0, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW)
Case #WM_MOUSEWHEEL
RedrawWindow_(hwnd, 0, 0, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW)
Case #WM_MOUSEMOVE
If wParam <> 0
RedrawWindow_(hwnd, 0, 0, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW)
EndIf
EndSelect
ProcedureReturn result
EndProcedure
Procedure.l WinCallback(hwnd, msg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_DRAWITEM
;...Grab the DRAWITEMSTRUCT structure
*lpdis.DRAWITEMSTRUCT = lParam
;...Check if this is for a ListViewGadget
Select *lpdis\CtlType
Case #ODT_LISTBOX
;...Get current text for item to draw
Select *lpdis\hwndItem
Case GadgetID(#ListView_1)
lbText$ = GetGadgetItemText(#ListView_1, *lpdis\itemID, 0)
bgBrush = hLvBrush
EndSelect
;...Set DrawText flagd
dtFlags = #DT_LEFT | #DT_VCENTER | #DT_NOCLIP
Select *lpdis\itemState
Case #ODS_SELECTED
;...Set your selected item text color
currentTextColor = RGB(200, 200, 255)
;...Enable/Disablee focus rect to remove the default focus rect
drawFocus = #True
Case #ODS_SELECTED | #ODS_FOCUS
;...Set your selected+focused item text color
currentTextColor = RGB(0, 0, 255)
;...Enable/Disable focus rect to remove the default focus rect
drawFocus = #True
Case 0
;...Set your default item text color
currentTextColor = RGB(255, 0, 0)
;...Enable/Disable focus rect to remove the default focus rect
drawFocus = #False
EndSelect
mydc = StartDrawing(ImageOutput(#Image_BG))
;...Fill rect with our image brush
FillRect_(mydc, *lpdis\rcItem, bgBrush)
;...Move text to the right 5 pixels
*lpdis\rcItem\left + 5
;...Make text background transparent
DrawingMode(#PB_2DDrawing_Transparent)
;...Draw text onto our image background
DrawText(*lpdis\rcItem\left, *lpdis\rcItem\top, lbText$, currentTextColor)
;...Draw focus rect as needed
If drawFocus
;...Return to original left margin
*lpdis\rcItem\left - 5
*lpdis\rcItem\bottom + 1
DrawEdge_(mydc, *lpdis\rcItem, #EDGE_ETCHED, #BF_FLAT | #BF_RECT)
EndIf
StopDrawing()
EndSelect
Case #WM_COMMAND
Select wParam >>16 &$FFFF
;...Redraw on ListView selection change
Case #LBN_SELCHANGE
RedrawWindow_(lParam, 0, 0, #RDW_FRAME | #RDW_INVALIDATE | #RDW_UPDATENOW)
EndSelect
;...May not be necessary, but I'll leave it here for now
Case #WM_CTLCOLORLISTBOX
Select lParam
Case GadgetID(#ListView_1)
result = hLvBrush
EndSelect
EndSelect
ProcedureReturn result
EndProcedure
;...OpenFileRequester to get image to use for window background
hMainBrush = GetImageBG()
If OpenWindow(#Window_Main, 0, 0, imgW, imgH, "Transparent ListViewGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(#Window_Main))
;...Set our window background image
SetClassLong_(WindowID(#Window_Main), #GCL_HBRBACKGROUND, hMainBrush)
SetWindowCallback(@WinCallback())
;...Ownerdraw our ListViewGadget
ListViewGadget(#ListView_1, 20, 20, 200, 250, #LBS_OWNERDRAWFIXED)
;...Optional: Comment next line to keep the
;...ListView border and the set border to = 4
;SetWindowLong_(GadgetID(#ListView_1), #GWL_EXSTYLE, GetWindowLong_(GadgetID(#ListView_1), #GWL_EXSTYLE) & ~#WS_EX_CLIENTEDGE)
;border = 0
border = 4
;...Add some items
For i = 0 To 24
AddGadgetItem (#ListView_1, -1, "Item " + Str(i) + " of the Listview")
Next i
;...Get Item height
itemH = SendMessage_(GadgetID(#ListView_1), #LB_GETITEMHEIGHT, 0, 0)
;...Let's resize to show 15 items
lvHeight = itemH * 15
ResizeGadget(#ListView_1, GadgetX(#ListView_1), GadgetY(#ListView_1), 200, lvHeight + border)
;...Hide ListViewGadget
HideGadget(#ListView_1, 1)
;...Create our background brush
hLvBrush = CreateListViewBrush(#ListView_1)
;...Un-hide ListViewGadget
HideGadget(#ListView_1, 0)
;...Create our background image
CreateImage(#Image_BG, GadgetWidth(#ListView_1), GadgetHeight(#ListView_1))
;...Subclass ListViewGadget to override painting
oldCallback = SetWindowLong_(GadgetID(#ListView_1), #GWL_WNDPROC, @LVcallback())
SetGadgetState(#ListView_1, 1)
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
;...Clean-up
If hLvBrush
DeleteObject_(hLvBrush)
EndIf
If hMainBrush
DeleteObject_(hWinBrush)
EndIf
EndIf
End
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
-
- Enthusiast
- Posts: 767
- Joined: Sat Jan 24, 2004 6:56 pm
You are very welcome dell_jockey 
This code is 100% flicker free for me. I used a different approach here by handling more of the ListViewGadget redraw, which reduces the flicker as well as giving you better control for customizing the output.

This code is 100% flicker free for me. I used a different approach here by handling more of the ListViewGadget redraw, which reduces the flicker as well as giving you better control for customizing the output.

Code: Select all
;/=========================================================
;/ Code : Transparent ListViewgadget
;/ Author : Sparkie
;/ Rel Date : 04/16/06
;/ PB Version : PB 4.00 Beta10
;/ OS Support : Windows 98/NT/ME/2000/XP/Server 2003
;/=========================================================
;/===============================================
;/ Globals
;/===============================================
Global oldCallback, winW, winH
UseJPEGImageDecoder()
UsePNGImageDecoder()
;/===============================================
;/ Constants / Enumerations
;/===============================================
#Window_Main = 1
#ListView_1 = 1
#Text_Display = 2
#Image_Lv = 1
#Image_Win = 2
;/===============================================
;/ Procedure: Proportional image resizing
;/===============================================
Procedure.l ImageSizer(imageIs.l, imgW.f, imgH.f)
mainWidth.f = ImageWidth(imageIs)
mainHeight.f = ImageHeight(imageIs)
percentageW.f = mainWidth / imgW
percentageH.f = mainHeight /imgH
If percentageW > percentageH Or percentageW = percentageH
percentageWH.f = percentageW
ElseIf percentageH > percentageW
percentageWH.f = percentageH
EndIf
newWidth = mainWidth / percentageWH
newHeight = mainHeight / percentageWH
newImage = ResizeImage(imageIs, newWidth, newHeight)
ProcedureReturn newImage
EndProcedure
;/===============================================
;/ Procedure: Create Main window background brush
;/===============================================
Procedure CreateWindowBrush(img$)
;...Load our selected image for window background
bgImage = LoadImage(#Image_Win, img$)
If bgImage
;...Resize image if it's too small for our use
If ImageWidth(#Image_Win) > 640 Or ImageHeight(#Image_Win) > 480
sizedImage = ImageSizer(#Image_Win, 640, 480)
ElseIf ImageWidth(#Image_Win) < 320 Or ImageHeight(#Image_Win) > 240
sizedImage = ImageSizer(#Image_Win, 320, 240)
EndIf
;...Create brush for window background
hBrush = CreatePatternBrush_(sizedImage)
imgW = ImageWidth(#Image_Win)
;...Window size will = 300 if image size < 300
;...or else Window size will = image size if image size >= 300
If imgW < 300
winW = 300
Else
winW = ImageWidth(#Image_Win)
EndIf
imgH = ImageHeight(#Image_Win)
If imgH < 250
winH = 250
Else
winH = ImageHeight(#Image_Win)
EndIf
If hBrush
result = hBrush
Else
MessageRequester("Error", "Could not create brush", #MB_ICONERROR)
result = 0
EndIf
Else
MessageRequester("Error", "Could not load image", #MB_ICONERROR)
result = 0
EndIf
ProcedureReturn result
EndProcedure
;/===============================================
;/ Procedure: Create Main window background brush
;/===============================================
Procedure.l GetImageBG()
bgImage$ = OpenFileRequester("Choose Background Image", "c:\Documents And Settings\Owner\My Documents\My Pictures\", "Image Files (BMP, JPG, PNG)|*.BMP;*.jpg;*.png", 0)
;bgImage$ = "C:\Documents And Settings\Owner\My Documents\My Pictures\100_4753.JPG"
If bgImage$
hBrush = CreateWindowBrush(bgImage$)
Else
;...No image selected. End
End
EndIf
ProcedureReturn hBrush
EndProcedure
;/===============================================
;/ Procedure: Do Painting of ListViewGadget
;/===============================================
Procedure PaintIt(hwnd)
Static previousScrollPos
;...Get ListView DC
lvDc = GetDC_(hwnd)
;...Get image DC
bgDc = StartDrawing(ImageOutput(#Image_Lv))
;...Get gadget#
gadId = GetDlgCtrlID_(hwnd)
;...Get first visible item
firstItem = SendMessage_(hwnd, #LB_GETTOPINDEX, 0, 0)
;...Get total number of items
totalItems = SendMessage_(hwnd, #LB_GETCOUNT, 0, 0) - 1
;...Get client rect for ListViewGadget
GetClientRect_(hwnd, @gadRc.RECT)
;...Determine border size
isBorder = GetWindowLong_(GadgetID(gadId), #GWL_EXSTYLE) & #WS_EX_CLIENTEDGE
If isBorder
border = GetSystemMetrics_(#SM_CYEDGE)
Else
border = 0
EndIf
;...Draw fresh background, compensating for gadget x/y position
;...The source image is our window background image
DrawImage(ImageID(#Image_Win), 0 - GadgetX(gadId) - border, 0 - GadgetY(gadId) - border)
;...Draw new text if visible
For i = firstItem To totalItems
SendMessage_(hwnd, #LB_GETITEMRECT, i, @itemRc.RECT)
If itemRc\bottom <= gadRc\bottom
;...Get item text and state
itemText$ = GetGadgetItemText(gadId, i, 0)
itemState = GetGadgetItemState(gadId, i)
;...Set drawing mode for text and focus rect
DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent)
If itemState = 0
;...Text color for non-selected items
currentTextColor = RGB(255, 0, 0)
;...Create a 5 px left margin
itemRc\left + 5
;...Draw selected text
DrawText(itemRc\left, itemRc\top, itemText$, currentTextColor)
Else
;...Text color for selected items
currentTextColor = RGB(0, 0, 255)
;...Create a 5 px left margin
itemRc\left + 5
;...Draw selected text
DrawText(itemRc\left, itemRc\top, itemText$, currentTextColor)
;...Reset margin
itemRc\left - 5
;...Draw our focus rect
Box(itemRc\left, itemRc\top, itemRc\right - itemRc\left, itemRc\bottom - itemRc\top, #White)
EndIf
Else
Break
EndIf
Next i
;...Eliminate border and scrollbar area from BitBlt
clientW = gadRc\right - gadRc\left
clientH = gadRc\bottom - gadRc\top
;...Copy our background image onto ListViewGadget DC
BitBlt_(lvDc, 0, 0, clientW, clientH, bgDc, 0, 0, #SRCCOPY)
;...Clean up
ReleaseDC_(hwnd, lvDc)
StopDrawing()
;...Redraw scrollbar position as needed
si.SCROLLINFO\cbSize = SizeOf(SCROLLINFO)
si\fMask = #SIF_POS
GetScrollInfo_(hwnd, #SB_VERT, @si)
If si\nPos <> previousScrollPos
SetScrollInfo_(hwnd, #SB_VERT, @si, #True)
EndIf
previousScrollPos = si\nPos
EndProcedure
;/===============================================
;/ Procedure: ListViewGadget Callback
;/===============================================
Procedure LVcallback(hwnd, msg, wParam, lParam)
result = CallWindowProc_(oldCallback, hwnd, msg, wParam, lParam)
doPaint = #False
Select msg
Case #WM_KEYDOWN
If wParam = #VK_DOWN Or wParam = #VK_UP Or wParam = #VK_NEXT Or wParam = #VK_PRIOR Or wParam = #VK_HOME Or wParam = #VK_END
doPaint = #True
EndIf
Case #WM_LBUTTONDOWN
doPaint = #True
result = 0
Case #WM_MOUSEMOVE
If wParam <> 0
doPaint = #True
result = 0
EndIf
Case #WM_ERASEBKGND
doPaint = #True
result = 1
Case #WM_PAINT
doPaint = #False
result = 0
Case #WM_VSCROLL
doPaint = #True
result = 0
Case #WM_MOUSEWHEEL
doPaint = #True
result = 0
EndSelect
;...Redraw the ListViewGadget as needed
If doPaint
PaintIt(hwnd)
EndIf
ProcedureReturn result
EndProcedure
;/===============================================
;/ Create Main window and gadgets
;/===============================================
;...Get image to use for window background
hWinBrush = GetImageBG()
If OpenWindow(#Window_Main, 0, 0, winW, winH, "Transparent ListViewGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(#Window_Main))
;...Set our window background image
SetClassLong_(WindowID(#Window_Main), #GCL_HBRBACKGROUND, hWinBrush)
;...Ownerdraw our ListViewGadget
ListViewGadget(#ListView_1, 20, 20, 200, winH - 40, #LBS_OWNERDRAWFIXED)
;...Optional: Un-comment next line to remove the ListView border
;SetWindowLong_(GadgetID(#ListView_1), #GWL_EXSTYLE, GetWindowLong_(GadgetID(#ListView_1), #GWL_EXSTYLE) & ~#WS_EX_CLIENTEDGE)
;...Add some items
For i = 0 To 99
AddGadgetItem (#ListView_1, -1, "Item " + Str(i) + " of the Listview")
Next i
;...Create our ListView background image
GetClientRect_(GadgetID(#ListView_1), @lvRc.RECT)
CreateImage(#Image_Lv, lvRc\right - lvRc\left, lvRc\bottom - lvRc\top)
SetGadgetState(#ListView_1, 1)
;...Disable system drawing for ListViewGadget. We'll handle it ourselves.
SendMessage_(GadgetID(#ListView_1), #WM_SETREDRAW, 0, 0)
;...Subclass the ListViewGadget
oldCallback = SetWindowLong_(GadgetID(#ListView_1), #GWL_WNDPROC, @LVcallback())
;/===============================================
;/ Main window event loop
;/===============================================
previousWinWidth = WindowWidth(#Window_Main)
previousWinHeight = WindowHeight(#Window_Main)
Repeat
event = WaitWindowEvent()
If event = #PB_Event_SizeWindow
;...Resize ListViewGadget
sizeChangeW = WindowWidth(#Window_Main) - previousWinWidth
sizeChangeH = WindowHeight(#Window_Main) - previousWinHeight
gadWidth = GadgetWidth(#ListView_1) + sizeChangeW
gadHeight = GadgetHeight(#ListView_1) + sizeChangeH
ResizeGadget(#ListView_1, #PB_Ignore, #PB_Ignore, gadWidth, gadHeight)
;...Resize our background drawing image to match window size
ResizeImage(#Image_Lv, WindowWidth(#Window_Main), WindowHeight(#Window_Main))
previousWinWidth = WindowWidth(#Window_Main)
previousWinHeight = WindowHeight(#Window_Main)
EndIf
Until event = #PB_Event_CloseWindow
;...Clean-up
If hWinBrush
DeleteObject_(hWinBrush)
EndIf
EndIf
End
Last edited by Sparkie on Sun Apr 16, 2006 7:35 pm, edited 1 time in total.
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
Thanks flaith 
I edited the code above to include Page Up/Down as well as Home and End.

I edited the code above to include Page Up/Down as well as Home and End.
Code: Select all
Case #WM_KEYDOWN
If wParam = #VK_DOWN Or wParam = #VK_UP Or wParam = #VK_NEXT Or wParam = #VK_PRIOR Or wParam = #VK_HOME Or wParam = #VK_END
doPaint = #True
EndIf
What goes around comes around.
PB 5.21 LTS (x86) - Windows 8.1
PB 5.21 LTS (x86) - Windows 8.1
- Joakim Christiansen
- Addict
- Posts: 2452
- Joined: Wed Dec 22, 2004 4:12 pm
- Location: Norway
- Contact: