ListView background image.

[srod]

Hi,

I've attacked some excellent code of Sparkie's in which he showed one way of constructing a transparent ListView:

http://www.purebasic.fr/english/viewtop ... ound+image

He basically paints the gadget onto an off-screen image and then BitBlit's it back as appropriate to produce a beautifully flicker-free gadget.

The same method is easily adapted to give a ListView gadget a background image (something which, unlike a ListIcon, Window's does not support natively). I wrote this after misunderstanding someone's request in the coding forum! :roll:

Anyhow, I thought I'd post the code (with Sparkie's blessing!) Someone might find it useful.

Code: Select all

;**BACKGROUND IMAGE IN LIST-VIEW GADGET**
;This code is based on code written by that genius Sparkie:
;  (http://www.purebasic.fr/english/viewtopic.php?t=13623&highlight=background+image)
;and adapted by srod to show a background image in a list view gadget.


;/========================================================= 
;/ Code       : Background image in ListViewgadget 
;               (based upon 'Transparent ListViewgadget' by Sparkie).
;/ Author     : Adapted by srod.
;/ Rel Date   : 03/06/06 
;/ PB Version : PB 4.00 
;/ OS Support : Windows
;/========================================================= 

;/=============================================== 
;/ Globals 
;/=============================================== 
Global oldCallback

#Window_Main=0
#ListView_1=0

Enumeration
  #lv_image
  #back_image
EndEnumeration

;/=============================================== 
;/ Image
;/=============================================== 
UseJPEGImageDecoder() 
UsePNGImageDecoder() 
LoadImage(#back_image, "katie.jpg") ;Include your own image here.


;/=============================================== 
;/ Procedure: SizeBackImage
;/=============================================== 
Procedure.l SizeBackImage(hwnd, *rc.RECT)
  Protected hdc, dc 
  If IsImage(#lv_image)
    ResizeImage(#lv_image, *rc\right-*rc\left, *rc\bottom-*rc\top)
  Else
    CreateImage(#lv_image, *rc\right-*rc\left, *rc\bottom-*rc\top)
  EndIf
  hdc=StartDrawing(ImageOutput(#lv_image))
    dc = CreateCompatibleDC_(hdc)
    If dc
      SelectObject_(dc,ImageID(#back_image))
      StretchBlt_(hdc, 0,0,*rc\right-*rc\left, *rc\bottom-*rc\top,dc,0,0,ImageWidth(#back_image),ImageHeight(#back_image),#SRCCOPY) 
      DeleteDC_(dc)
      result=1
    Else
      result=0
    EndIf
  StopDrawing()
  ProcedureReturn result
EndProcedure
;/=============================================== 
;/ Procedure: Do Painting of ListViewGadget 
;/=============================================== 
Procedure PaintIt(hwnd) 
  Protected gadRc.RECT, lvDc, bgDc, gadId, firstItem, totalItems, isBorder, i, itemRc.RECT
  Protected itemText$, itemState, si.SCROLLINFO
  Static previousScrollPos 
  ;...Get client rect for ListViewGadget 
  GetClientRect_(hwnd, gadRc) 
  SizeBackImage(hwnd, gadRc)
  ;...Get ListView DC 
  lvDc = GetDC_(hwnd) 
  ;...Get image DC 
  bgDc = StartDrawing(ImageOutput(#lv_image)) 
  ;...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 
  ;...Determine border size 
  isBorder = GetWindowLong_(GadgetID(gadId), #GWL_EXSTYLE) & #WS_EX_CLIENTEDGE 
  If isBorder 
    border = GetSystemMetrics_(#SM_CYEDGE) 
  Else 
    border = 0 
  EndIf 
      ;...Set drawing mode for text and focus rect 
      DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent) 
  ;...Draw new text if visible 
  For i = firstItem To totalItems 
    SendMessage_(hwnd, #LB_GETITEMRECT, i, itemRc) 
    If itemRc\bottom <= gadRc\bottom 
      ;...Get item text and state 
      itemText$ = GetGadgetItemText(gadId, i, 0) 
      itemState = GetGadgetItemState(gadId, i) 
      If itemState = 0 
        itemRc\left + 5 
        ;...Draw selected text 
        DrawText(itemRc\left, itemRc\top, itemText$, #Black) 
      Else 
        ;...Create a 5 px left margin 
        itemRc\left + 5 
        ;...Draw selected text 
        DrawText(itemRc\left, itemRc\top, itemText$, #Black) 
        ;...Reset margin 
        itemRc\left - 5 
        ;...Draw our focus rect 
        Box(itemRc\left, itemRc\top, itemRc\right - itemRc\left, itemRc\bottom - itemRc\top, #Black) 
      EndIf 
    Else 
      Break 
    EndIf 
  Next i 
  ;...Copy our background image onto ListViewGadget DC 
  BitBlt_(lvDc, 0, 0, gadRc\right - gadRc\left, gadRc\bottom - gadRc\top, bgDc, 0, 0, #SRCCOPY) 
  ;...Clean up 
  ReleaseDC_(hwnd, lvDc) 
  StopDrawing() 
  ;...Redraw scrollbar position as needed 
  si\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 
If OpenWindow(#Window_Main, 0, 0, 640, 450, "image in ListViewGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(#Window_Main)) 
  ;...Ownerdraw our ListViewGadget 
  ListViewGadget(#ListView_1, 20, 20, 200, 400, #PB_ListView_Multiselect|#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 
  ;...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()) 
  Repeat 
    event = WaitWindowEvent() 
  Until event = #PB_Event_CloseWindow 
  ;...Clean-up 
  FreeImage(#back_image)
  If IsImage(#lv_image) : FreeImage(#lv_image) : EndIf
EndIf 
End

There are other ways of supporting background images in ListView's, but as I say, this one is essentially without flicker!

[Kwai chang caine]

Hello SROD

I want to mix two excelent code.

The code of SPARKIE :

Code: Select all

;**BACKGROUND IMAGE IN LIST-VIEW GADGET** 
;This code is based on code written by that genius Sparkie: 
;  (http://www.purebasic.fr/english/viewtopic.php?t=13623&highlight=background+image) 
;and adapted by srod to show a background image in a list view gadget. 


;/========================================================= 
;/ Code       : Background image in ListViewgadget 
;               (based upon 'Transparent ListViewgadget' by Sparkie). 
;/ Author     : Adapted by srod. 
;/ Rel Date   : 03/06/06 
;/ PB Version : PB 4.00 
;/ OS Support : Windows 
;/========================================================= 

;/=============================================== 
;/ Globals 
;/=============================================== 
Global oldCallback 

#Window_Main=0 
#ListView_1=0 

Enumeration 
  #lv_image 
  #back_image 
EndEnumeration 

;/=============================================== 
;/ Image 
;/=============================================== 
UseJPEGImageDecoder() 
UsePNGImageDecoder() 
LoadImage(#back_image, "image.jpg") ;Include your own image here. 


;/=============================================== 
;/ Procedure: SizeBackImage 
;/=============================================== 
Procedure.l SizeBackImage(hwnd, *rc.RECT) 
  Protected hdc, dc 
  If IsImage(#lv_image) 
    ResizeImage(#lv_image, *rc\right-*rc\left, *rc\bottom-*rc\top) 
  Else 
    CreateImage(#lv_image, *rc\right-*rc\left, *rc\bottom-*rc\top) 
  EndIf 
  hdc=StartDrawing(ImageOutput(#lv_image)) 
    dc = CreateCompatibleDC_(hdc) 
    If dc 
      SelectObject_(dc,ImageID(#back_image)) 
      StretchBlt_(hdc, 0,0,*rc\right-*rc\left, *rc\bottom-*rc\top,dc,0,0,ImageWidth(#back_image),ImageHeight(#back_image),#SRCCOPY) 
      DeleteDC_(dc) 
      result=1 
    Else 
      result=0 
    EndIf 
  StopDrawing() 
  ProcedureReturn result 
EndProcedure 
;/=============================================== 
;/ Procedure: Do Painting of ListViewGadget 
;/=============================================== 
Procedure PaintIt(hwnd) 
  Protected gadRc.RECT, lvDc, bgDc, gadId, firstItem, totalItems, isBorder, i, itemRc.RECT 
  Protected itemText$, itemState, si.SCROLLINFO 
  Static previousScrollPos 
  ;...Get client rect for ListViewGadget 
  GetClientRect_(hwnd, gadRc) 
  SizeBackImage(hwnd, gadRc) 
  ;...Get ListView DC 
  lvDc = GetDC_(hwnd) 
  ;...Get image DC 
  bgDc = StartDrawing(ImageOutput(#lv_image)) 
  ;...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 
  ;...Determine border size 
  isBorder = GetWindowLong_(GadgetID(gadId), #GWL_EXSTYLE) & #WS_EX_CLIENTEDGE 
  If isBorder 
    border = GetSystemMetrics_(#SM_CYEDGE) 
  Else 
    border = 0 
  EndIf 
      ;...Set drawing mode for text and focus rect 
      DrawingMode(#PB_2DDrawing_Outlined | #PB_2DDrawing_Transparent) 
  ;...Draw new text if visible 
  For i = firstItem To totalItems 
    SendMessage_(hwnd, #LB_GETITEMRECT, i, itemRc) 
    If itemRc\bottom <= gadRc\bottom 
      ;...Get item text and state 
      itemText$ = GetGadgetItemText(gadId, i, 0) 
      itemState = GetGadgetItemState(gadId, i) 
      If itemState = 0 
        itemRc\left + 5 
        ;...Draw selected text 
        DrawText(itemRc\left, itemRc\top, itemText$, #Black) 
      Else 
        ;...Create a 5 px left margin 
        itemRc\left + 5 
        ;...Draw selected text 
        DrawText(itemRc\left, itemRc\top, itemText$, #Black) 
        ;...Reset margin 
        itemRc\left - 5 
        ;...Draw our focus rect 
        Box(itemRc\left, itemRc\top, itemRc\right - itemRc\left, itemRc\bottom - itemRc\top, #Black) 
      EndIf 
    Else 
      Break 
    EndIf 
  Next i 
  ;...Copy our background image onto ListViewGadget DC 
  BitBlt_(lvDc, 0, 0, gadRc\right - gadRc\left, gadRc\bottom - gadRc\top, bgDc, 0, 0, #SRCCOPY) 
  ;...Clean up 
  ReleaseDC_(hwnd, lvDc) 
  StopDrawing() 
  ;...Redraw scrollbar position as needed 
  si\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 
If OpenWindow(#Window_Main, 0, 0, 640, 450, "image in ListViewGadget", #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(#Window_Main)) 
  ;...Ownerdraw our ListViewGadget 
  ListViewGadget(#ListView_1, 20, 20, 200, 400, #PB_ListView_Multiselect|#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 
  ;...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()) 
  Repeat 
    event = WaitWindowEvent() 
  Until event = #PB_Event_CloseWindow 
  ;...Clean-up 
  FreeImage(#back_image) 
  If IsImage(#lv_image) : FreeImage(#lv_image) : EndIf 
EndIf 
End 

And the code of CHRIS

Code: Select all

; Coded by CHRIS
#Win = 0 
#List = 0 

Global FlagSelect = 0 

Macro ListView_AutoSelect(ListView) 
  #LB_ITEMFROMPOINT = $1A9 
  
  x = WindowMouseX(ListView) : y = WindowMouseY(ListView) 
  
  Gx = GadgetX(ListView) : Gw = GadgetX(ListView) + GadgetWidth(ListView) 
  Gy = GadgetY(ListView) : Gh = GadgetY(ListView) + GadgetHeight(ListView) 
  
  If x >= Gx And x <= Gw And y >= Gy And y <= Gh 
    If FlagSelect = 0 
      h = SendMessage_(GadgetID(ListView), #LB_GETITEMHEIGHT, 0, 0) 
      y - (Round((h / 4) *3, 1)) 
      Index = SendMessage_(GadgetID(ListView), #LB_ITEMFROMPOINT, 0, x + (y<<16)) & $FFFF 
      If Index > -1 
        SendMessage_(GadgetID(ListView), #LB_SETCURSEL, Index, 0) 
      EndIf 
    EndIf 
  Else 
    FlagSelect = 0 
  EndIf 
EndMacro 


; °°°° Début du programme °°°° 
If OpenWindow(#Win,0,0,270,200,"ListViewGadget",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
  If CreateGadgetList(WindowID(#Win)) 
    ListViewGadget(#List,10,10,250,180) 
    
    For a=1 To 40 
      AddGadgetItem (#List, -1, "Elément "+Str(a)+" de la boîte de liste")   ; défini le contenu de la boîte de liste 
    Next 
    
    SetGadgetColor(#List, #PB_Gadget_BackColor, $00C8D0D4) 
  EndIf 
  
  
  Repeat 
    ListView_AutoSelect(#List) ; <-- Appel de la macro à chaque boucle 
    
    Select WaitWindowEvent() 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case #List 
            If EventType() = #PB_EventType_LeftClick 
              SetWindowTitle(#Win, GetGadgetItemText(#List, GetGadgetState(#List), 0)) 
              FlagSelect = 1 
            EndIf 
            
        EndSelect 
        
      Case #PB_Event_CloseWindow : Quit = #True 
    EndSelect 
  Until Quit 
EndIf 

But it's don't work
The code of CHRIS is canceled by the code of SPARKIE.
I' don't know why ?

Somebody knows where is my mistake

Code: Select all

; ListViewGadget à fond d'image et préselection au survol 
; Réalisé avec l'aide des codes de CHRIS et SPARKIE 

LargeurFenetre = 240 
HauteurFenetre = 240 

#Fenetre = 0 

#ListBox = 10 

#Text_Display = 20 

#Image_Lv = 30 
#Image_Win = 31 


Global oldCallback, hWinBrush ; Fond image 
Global FlagSelect = 0 ; Selection au survol 

UseJPEGImageDecoder() 

Procedure ListView_AutoSelect(Fenetre, ListView) 

 #LB_ITEMFROMPOINT = $1A9 
 x = WindowMouseX(#Fenetre) : y = WindowMouseY(#Fenetre) 
  
 Gx = GadgetX(ListView) : Gw = GadgetX(ListView) + GadgetWidth(ListView) 
 Gy = GadgetY(ListView) : Gh = GadgetY(ListView) + GadgetHeight(ListView) 
  
 If x >= Gx And x <= Gw And y >= Gy And y <= Gh 
  
  If FlagSelect = 0 
  
   h = SendMessage_(GadgetID(ListView), #LB_GETITEMHEIGHT, 0, 0) 
   y - (Round((h / 4) *3, 1)) 
   Index = SendMessage_(GadgetID(ListView), #LB_ITEMFROMPOINT, 0, x + (y<<16)) & $FFFF 
  
   If Index > -1 
    SendMessage_(GadgetID(ListView), #LB_SETCURSEL, Index, 0) 
   EndIf 
  
  EndIf 
  
 Else 
  
  FlagSelect = 0 
  
 EndIf 

EndProcedure 

Procedure.l ImageSizer(imageIs.l, imgW.f, imgH.f)  ; Procedure pour le fond image de la ListView 
  
 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$)  ; Procedure pour le fond image de la ListView 
  
 ;...Load our selected image for window background 
 bgImage = CatchImage(#Image_Win, ?ImageData) 
  
 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 PaintIt(hwnd) ; Procedure pour le fond image de la ListView 
  
 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 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 

OpenWindow(#Fenetre, x - 10, y - 10, LargeurFenetre, 250,"REclic",#PB_Window_BorderLess|#PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(#Fenetre)) 
ListViewGadget(#ListBox, 0, 0, LargeurFenetre, HauteurFenetre, #LBS_OWNERDRAWFIXED) 

For a=1 To 40 
 AddGadgetItem (#ListBox, -1, "Elément "+Str(a)+" de la boîte de liste")   ; défini le contenu de la boîte de liste 
Next 

hWinBrush = CreateWindowBrush("") 
GetClientRect_(GadgetID(#ListBox), @lvRc.RECT) 
CreateImage(#Image_Lv, lvRc\right - lvRc\left, lvRc\bottom - lvRc\top) 
SendMessage_(GadgetID(#ListBox), #WM_SETREDRAW, 0, 0) 
oldCallback = SetWindowLong_(GadgetID(#ListBox), #GWL_WNDPROC, @LVcallback()) ;...Subclass the ListViewGadget 
  
Repeat 
  
 Evenement = WaitWindowEvent () 
 ListView_AutoSelect(#Fenetre, #ListBox) 
    
 Select Evenement 
      
  Case #WM_RBUTTONDOWN 
  
   Break 
    
  Case #PB_Event_Gadget 
  
   If EventGadget() = #ListBox And EventType() = #PB_EventType_LeftClick 
    SetWindowTitle(#Fenetre, GetGadgetItemText(#ListBox, GetGadgetState(#ListBox), 0)) 
    FlagSelect = 1 
   EndIf 
      
  Default 
    
   Delay(1) 
  
 EndSelect 
        
ForEver 

If hWinBrush 
 DeleteObject_(hWinBrush) 
EndIf 

Delay(200) 
End 


DataSection 

 ImageData : 
 ;********* 

 IncludeBinary "c:\Picture.bmp" 

EndDataSection 

Thanks for your precious help

[Rook Zimbabwe]

Srod... see I knew this was possible! You are the man!

[netmaestro]

I'll toss a few lines in for fun, I confess I'm not sure what if anything we're supposed to be accomplishing:

Best with this: http://www.greatlakescode.com/kylie-5.jpg

Code: Select all

UseJPEGImageDecoder()
LoadImage(0, "kylie-5.jpg")
Global hBrush = CreatePatternBrush_(ImageID(0))
Global selBrush = CreateSolidBrush_(RGB(0,0,160))

Procedure ResetSelection(uID, uMsg, dwUser, dw1, dw2)
  hwnd = dwUser
  GetCursorPos_(@cp.POINT)
  If GetGadgetState(GetDlgCtrlID_(hwnd)) <> LBItemFromPt_(hwnd,cp\x,cp\y,0)
    SetGadgetState(GetDlgCtrlID_(hwnd), LBItemFromPt_(hwnd,cp\x,cp\y,0))
  EndIf
EndProcedure

Procedure LVProc(hwnd, msg, wparam, lparam)
  Select msg
    Case #WM_VSCROLL
      InvalidateRect_(hwnd,0,1)
    Case #WM_MOUSEWHEEL
      timeSetEvent_(10,15,@ResetSelection(),hwnd,#TIME_ONESHOT)
      InvalidateRect_(hwnd,0,1)
    Case #WM_MOUSEMOVE
      GetCursorPos_(@cp.POINT)
      GetWindowRect_(hwnd, @wr.RECT)
      If wr\bottom - cp\y <16
        InvalidateRect_(hwnd,0,1)
      EndIf
      If GetGadgetState(GetDlgCtrlID_(hwnd)) <> LBItemFromPt_(hwnd,cp\x,cp\y,0)
        SetGadgetState(GetDlgCtrlID_(hwnd), LBItemFromPt_(hwnd,cp\x,cp\y,0))
      EndIf
    Case #WM_NCDESTROY
      RemoveProp_(hwnd, "oldproc")
  EndSelect 
  ProcedureReturn CallWindowProc_(GetProp_(hwnd, "oldproc"), hwnd, msg, wparam, lparam)
EndProcedure

Procedure WinProc(hwnd, msg, wparam, lparam)
  Select msg
    Case #WM_DRAWITEM  
      *d.drawitemstruct = lParam 
      If *d\itemID <> -1 
        text.s=Space(255) 
        If *d\itemAction = #ODA_FOCUS And *d\itemID=GetGadgetState(1) 
          SelectObject_(*d\hdc, selBrush)
          Rectangle_(*d\hdc, *d\rcItem\left, *d\rcItem\top, *d\rcItem\right, *d\rcItem\bottom)
          SetTextColor_(*d\hdc, #White)
        Else 
          hdc=StartDrawing(ImageOutput(0))
            BitBlt_(*d\hdc,*d\rcItem\left, *d\rcItem\top,*d\rcItem\right-*d\rcItem\left,*d\rcItem\bottom-*d\rcItem\top,hdc,*d\rcItem\left+2,*d\rcItem\top+2,#SRCCOPY)
          StopDrawing()
          SetTextColor_(*d\hdc, #Black)
        EndIf
        SetBkMode_(*d\hdc,#TRANSPARENT) 
        SendMessage_(GadgetID(1), #LB_GETTEXT, *d\itemID, @text) 
        TextOut_(*d\hdc,*d\rcItem\left+2, *d\rcItem\top + 2, @text, Len(text)) 
        ProcedureReturn #True 
      EndIf 
    Case #WM_CTLCOLORLISTBOX
       SetBkMode_(wparam, #TRANSPARENT)
       ProcedureReturn hBrush
  EndSelect
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure

OpenWindow(0,0,0,320,400,"Custom Listview",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
ContainerGadget(0,60,0,200,268)
ListViewGadget (1,0,0,200,268,#LBS_OWNERDRAWFIXED|#LBS_HASSTRINGS)
CloseGadgetList()
SetProp_(GadgetID(1), "Oldproc", SetWindowLong_(GadgetID(1),#GWL_WNDPROC,@LVProc()))
SetWindowCallback(@WinProc())

For i=0 To 200
  AddGadgetItem(1,-1,"Item "+Str(i))
Next
SetActiveGadget(1)

Repeat : Until WaitWindowEvent() = #WM_CLOSE

[vertexfire]

hmmm....nice cool code !!! fun yehaaa

[Kwai chang caine]

@NETMAESTRO

My hero
It's exactly what i want.

Your code is short and powerful (as usual )

My kingdom for a very small part of your knowledge

Thanks again.
I wish you a very good day, master

[electrochrisso]

The Master Strikes Again.

[Rook Zimbabwe]

Its purpose is to add more coolness to apps that are developed by PB Nutz like us!!!

[Kwai chang caine]

@NETMAESTRO

It's exactly what i want.

I am ashamed

Is it possible to change the height of font ?

[netmaestro]

Sure Grasshopper, it isn't difficult. You just need to add two lines immediately following the line which creates the gadget:

Code: Select all

SendMessage_(GadgetID(1), #LB_SETITEMHEIGHT, 0, 18) 
SetGadgetFont(1, FontID(LoadFont(#PB_Any,"Courier New",12)))

You can experiment with choosing a good height for the font and size you want, it needs to be several px larger.

[Kwai chang caine]

You are my cavalery


My zorro :


In one word.......my hero :


I don't know what is GRASSHOPPER
I ask the question to wiki, and i see i'm a CRIKET
http://en.wikipedia.org/wiki/Grasshopper
I'am your food

Be careful, i'am there big, You will never eat me at once
Fortunately you have healthy teeth

Thanks a lot again for your precious help

[LuCiFeR[SD]]

hmmmm, 1970's TV series Kung Fu Strikes again LOL

[Kwai chang caine]

I have sometimes an error "Array index out of bound"

at the line :

Code: Select all

ProcedureReturn CallWindowProc_(GetProp_(hwnd, "oldproc"), hwnd, msg, wparam, lparam) 

Someone know how i can protect me of this error ?

[superadnim]

there are no array calls in that line, are you sure about this?.

[Kwai chang caine]

You are right.
I have fixed several bug in my code.
They are no error for the moment

Excuse me for have disturb you