Transparent Gadgets

Everything else that doesn't fall into one of the other PB categories.
Killswitch
Enthusiast
Enthusiast
Posts: 731
Joined: Wed Apr 21, 2004 7:12 pm

Transparent Gadgets

Post by Killswitch »

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~
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

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.

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
Shannara
Addict
Addict
Posts: 1808
Joined: Thu Oct 30, 2003 11:19 pm
Location: Emerald Cove, Unformed

Post by Shannara »

Hate to bring this up, but ... where is hBrush1 set?
We can do something like ...

Code: Select all

Global hBrush.l = GetStockObject_(#HOLLOW_BRUSH) 
However, how would I go about showing the transparency whenever something changes in the gadget? such as new text and such.
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

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

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
* Edited to remove some un-necessary code *
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
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Wow. Very impressive.

Another 3 pointer for Sparkie.

cheers
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

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 :evil:
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
Dare2
Moderator
Moderator
Posts: 3321
Joined: Sat Dec 27, 2003 3:55 am
Location: Great Southern Land

Post by Dare2 »

Blooming scrollbars! :D

Awesome Sparkie. You're the best!
@}--`--,-- A rose by any other name ..
va!n
Addict
Addict
Posts: 1104
Joined: Wed Apr 20, 2005 12:48 pm

Post by va!n »

wow, awesome! very nice example!
va!n aka Thorsten

Intel i7-980X Extreme Edition, 12 GB DDR3, Radeon 5870 2GB, Windows7 x64,
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

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
dell_jockey
Enthusiast
Enthusiast
Posts: 767
Joined: Sat Jan 24, 2004 6:56 pm

Post by dell_jockey »

works like a charm! On an XP-pro client, no flicker visible. Great work, thanks for sharing, Sparkie!
cheers,
dell_jockey
________
http://blog.forex-trading-ideas.com
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

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. :)

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
User avatar
flaith
Enthusiast
Enthusiast
Posts: 704
Joined: Mon Apr 25, 2005 9:28 pm
Location: $300:20 58 FC 60 - Rennes
Contact:

Post by flaith »

nice piece of code, thanks for sharing, i only found a little issue, when i use pageUp/pageDown keys, there is no refresh ! :wink:
“Fear is a reaction. Courage is a decision.” - WC
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Thanks flaith :)

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
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:

Post by Joakim Christiansen »

Indeed, very nice Sparkie, but here it looks ugly after i resized the window.
I like logic, hence I dislike humans but love computers.
MikeB
Enthusiast
Enthusiast
Posts: 183
Joined: Sun Apr 27, 2003 8:39 pm
Location: Cornwall UK

Post by MikeB »

Works great for me!

As far as the resize problem goes, either use a repeating pattern or remove the resize flag in the openwindow().
Mike.
(I'm never going to catch up with the improvements to this program)
Post Reply