PureBasic Forums - English

Code: Select all

;············································································
;· Module: ListIconGadget_ownerdrawn.pbi
;· Description: Testing some features related to ListIconGadget... 
;· Status: experimental 
;· Author: Axolotl 
;· Copyright by Axolotl -- All rights reserved. 
;············································································
;· Read this:
;·   WARNING! THE CODE IS PROVIDED "AS IS" with NO GUARANTEES OF ANY KIND!
;·   USE THIS AT YOUR OWN RISK - YOU ARE THE ONLY PERSON RESPONSIBLE for
;·   ANY DAMAGE THIS CODE MAY CAUSE - YOU HAVE BEEN WARNED!
;············································································
EnableExplicit

Enumeration
  #WndMain
  #LbFiles
  #BtnSmall
  #BtnBig
EndEnumeration

;' System Brushes
Global G_hbrushSelected = GetSysColorBrush_(#COLOR_HIGHLIGHT)
Global G_hBrushDefault  = GetSysColorBrush_(#COLOR_WINDOW)

Global G_LbFiles_TileMargin = 4
Global G_LbFiles_ImageDefaultID

;'@TODO: change to your needs....
Global G_LbFiles_BaseDir$ = "C:\Users\Andreas\AHsoft\temp\images\BMPs\"  ;' The base directory ... 
  
;'@TODO: change to your needs....
Macro MakeFilename(Index)
  "Image"+Right("0"+Str(Index), 2)+".bmp"
EndMacro


;··· Macros ·································································

Macro LOWORD(LongValue)
  (LongValue & $FFFF)
EndMacro

Macro HIWORD(LongValue)
  ((LongValue >> 16) & $FFFF)
EndMacro

Macro MAKELONG(CX, CY)
  (CX | (CY << 16))
EndMacro

Macro Rect2Str(rtRect)
  "Rect = "+Str(rtRect\left)+","+Str(rtRect\top)+","+Str(rtRect\right)+","+Str(rtRect\bottom)+" | W="+Str(rtRect\right-rtRect\left)+", H="+Str(rtRect\bottom-rtRect\top)
EndMacro

Macro ValidRect(rtRect)
  Bool((rtRect\right-rtRect\left) > 0 And (rtRect\bottom-rtRect\top) > 0)
EndMacro


; ; ; Debug "-CDIS-"
; ; ; Debug Hex(#CDIS_SELECTED)          ;' $0001    ;: Result$ = ""
; ; ; Debug Hex(#CDIS_GRAYED)            ;' $0002    ;: Result$ = ""
; ; ; Debug Hex(#CDIS_DISABLED)          ;' $0004    ;: Result$ = "Disabled" ;The item is disabled.
; ; ; Debug Hex(#CDIS_CHECKED)           ;' $0008
; ; ; Debug Hex(#CDIS_FOCUS)             ;' $0010    ;: Result$ = "" ;The item is in focus.
; ; ; Debug Hex(#CDIS_DEFAULT)           ;' $0020    ;: Result$ = "Default" ;The item is in its Default state.
; ; ; Debug Hex(#CDIS_HOT)               ;' $0040    ;: Result$ = ""
; ; ; Debug Hex(#CDIS_MARKED)            ;' $0080    ;: Result$ = ""
; ; ; Debug Hex(#CDIS_INDETERMINATE)     ;' $0100    ;: Result$ = ""
; ; ; Debug Hex(#CDIS_SHOWKEYBOARDCUES)  ;' $0200    ;: Result$ = ""
; ; ; Debug "--"


Procedure.s ItemState2Str(ItemState)
  Protected Result$

  Result$ = ""
  If ItemState & #CDIS_CHECKED          : Result$ + "Checked "            : EndIf
  If ItemState & #CDIS_DEFAULT          : Result$ + "Default "            : EndIf
  If ItemState & #CDIS_DISABLED         : Result$ + "Disabled "           : EndIf
  If ItemState & #CDIS_FOCUS            : Result$ + "Focus "              : EndIf
  If ItemState & #CDIS_GRAYED           : Result$ + "Grayed "             : EndIf
  If ItemState & #CDIS_HOT              : Result$ + "Hot "                : EndIf  ;' The item is currently under the pointer ("hot").
  If ItemState & #CDIS_INDETERMINATE    : Result$ + "Indeterminate "      : EndIf  ;' The item is in an indeterminate state.
  If ItemState & #CDIS_MARKED           : Result$ + "Marked "             : EndIf  ;' The item is marked. The meaning of this is determined by the implementation.
  If ItemState & #CDIS_SELECTED         : Result$ + "Selected "           : EndIf  ;' The item is selected.
;Note  This flag does Not work correctly For owner-drawn List-view controls that have the LVS_SHOWSELALWAYS style. For these controls, you can determine whether an item is selected by using LVM_GETITEMSTATE (Or ListView_GetItemState) And checking For the LVIS_SELECTED flag.
  If ItemState & #CDIS_SHOWKEYBOARDCUES : Result$ + "Show Keyboard Cues " : EndIf

    ;Version 6.0.The item is showing its keyboard cues.
    ;Note that Comctl32 version 6 is Not redistributable. operating systems. To use Comctl32.dll version 6, specify it in the manifest. For more information on manifests, see Enabling Visual Styles.
  ;Case #CDIS_NEARHOT: Result$ = "" ;The item is part of a control that is currently under the mouse pointer ("hot"), but the item is Not "hot" itself. The meaning of this is determined by the implementation.
  ;Case #CDIS_OTHERSIDEHOT: Result$ = ""  ;The item is part of a splitbutton that is currently under the mouse pointer ("hot"), but the item is Not "hot" itself. The meaning of this is determined by the implementation.
  ;Case #CDIS_DROPHILITED: Result$ = "" ;drop target of a drag-and-drop operation 

  If Result$ <> ""
    Result$ = "ItemState = '"+ReplaceString(Trim(Result$), " ", "+")+"' == "+Str(ItemState)+", 0x"+Hex(ItemState)
  EndIf
  ProcedureReturn Result$
EndProcedure


;{ NMLVCUSTOMDRAW structure 
;'···········································································
;' typedef struct tagNMLVCUSTOMDRAW {
;'   NMCUSTOMDRAW nmcd;
;'   COLORREF     clrText;
;'   COLORREF     clrTextBk;
;' #if (_WIN32_IE >= 0x0400)
;'   int          iSubItem;
;' #endif 
;' #if (_WIN32_IE >= 0x0560)  ;' manifest ???
;'   DWORD        dwItemType;
;'   COLORREF     clrFace;
;'   int          iIconEffect;
;'   int          iIconPhase;
;'   int          iPartId;
;'   int          iStateId;
;'   RECT         rcText;
;'   UINT         uAlign;
;' #endif 
;' } NMLVCUSTOMDRAW, *LPNMLVCUSTOMDRAW;
;'···········································································
;}


;··· Dummy Image ····························································
Procedure MakeDummyImage(IconWidth, IconHeight)
  Protected ZeroImgID
  ZeroImgID = CreateImage(#PB_Any, IconWidth, IconHeight)
  StartDrawing(ImageOutput(ZeroImgID))
    Box(0, 0, IconWidth, IconHeight, RGB(80, 80, 80))
    Box(2, 2, IconWidth-4, IconHeight-4, #Blue)
    Box(4, 4, IconWidth-8, IconHeight-8, #White)
  StopDrawing()
  G_LbFiles_ImageDefaultID = ZeroImgID
EndProcedure

MakeDummyImage(32, 32)


;'···········································································

Global G_TextTooltip${80}="Image Tooltip "


Procedure MainWindowCallbackProc(hwnd, msg, wParam, lParam)
  Protected *lvCD.NMLVCUSTOMDRAW 
  Protected *lvIT.NMLVGETINFOTIP
  Protected *lvIA.NMITEMACTIVATE
  Protected result, index, sz.SIZE, fname$, textline$, imgID, itemState, fw.f, fh.f
  Protected x, y, w, h, tx, ty, tw, th, iw, ih, hdcMem, hbmpOld, dtFlags, currentBrush, currentTextColor

  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_NOTIFY
      ;*nmhdr.NMHEADER = lParam  ;Debug "iItem "+Str(*nmhdr\iItem)  ;' zero based index of the header item 

      *lvCD.NMLVCUSTOMDRAW = lParam  ;' set to structure
;#LVN_GETINFOTIP
      *lvIT.NMLVGETINFOTIP = lParam
      *lvIA.NMITEMACTIVATE = lParam

      If *lvIT\hdr\hwndFrom = GadgetID(#LbFiles) And *lvIT\hdr\code = #LVN_GETINFOTIP
Debug "....Get Infotip...  dwFlags="+Str(*lvIT\dwFlags) ;;;#LVGIT_UNFOLDED)
        ;If *lvIT\dwFlags = 0
        *lvIT\pszText = @G_TextTooltip$
        *lvIT\cchTextMax = Len(G_TextTooltip$)+1
        ;result = #True
      EndIf
;'--> LVN_ITEMACTIVATE notification code

      If *lvIA\hdr\hwndFrom = GadgetID(#LbFiles) And *lvIA\hdr\code = #LVN_ITEMACTIVATE
Debug "....Item activate ..."
      EndIf


      If *lvCD\nmcd\hdr\hwndFrom = GadgetID(#LbFiles) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
        Select *lvCD\nmcd\dwDrawStage
          Case #CDDS_PREPAINT                   ;:Debug "CDDS_PREPAINT"  ;:Debug " "+Rect2Str(*lvCD\nmcd\rc)
            result = #CDRF_NOTIFYITEMDRAW

          Case #CDDS_ITEMPREPAINT              ;:Debug "CDDS_ITEMPREPAINT: SubItem="+Str(*lvCD\iSubItem)+", ItemSpec="+Str(*lvCD\nmcd\dwItemSpec)
            If ValidRect(*lvCD\nmcd\rc)        :Debug "CDDS_ITEMPREPAINT"
              index     = *lvCD\nmcd\dwItemSpec
              fname$    = GetGadgetItemText(#LbFiles, *lvCD\nmcd\dwItemSpec)
              itemState = *lvCD\nmcd\uItemState  ;' get the itemstate 
              itemState & $FF                    ;' remove the higher Value like Show Keyboard Cue, (because it makes no sense without manifest!!!) 

              If GetPathPart(fname$) = ""
                fname$ = G_LbFiles_BaseDir$+fname$
              EndIf
              If FileSize(fname$) > 0
                imgID = LoadImage(#PB_Any, fname$)     ;:Debug "Load image: '"+fname$+"'" 
              Else
                imgID = G_LbFiles_ImageDefaultID               ;' image file is removed by user, or anything 
              EndIf

              dtFlags = #DT_LEFT|#DT_WORDBREAK|#DT_END_ELLIPSIS
              currentTextColor = GetSysColor_(#COLOR_WINDOWTEXT)
              currentBrush = G_hBrushDefault
              FillRect_(*lvCD\nmcd\hdc, *lvCD\nmcd\rc, G_hBrushDefault)              ;' clear item rect
              
              Select itemState
                Case #CDIS_FOCUS :Debug "Focus"
                  ;*lvCD\nmcd\rc\bottom - 13  :Debug *lvCD\nmcd\rc\bottom

                Case #CDIS_SELECTED :Debug "Selected"
                  currentBrush = G_hbrushSelected
                  ;*lvCD\nmcd\rc\bottom - 13  :Debug *lvCD\nmcd\rc\bottom

                Case #CDIS_SELECTED|#CDIS_FOCUS :Debug "Selected|Focus"
                  currentBrush = G_hbrushSelected
                  ;*lvCD\nmcd\rc\bottom - 13  ;:Debug *lvCD\nmcd\rc\bottom

              EndSelect

              Debug " "+Rect2Str(*lvCD\nmcd\rc)
              Debug " "+ItemState2Str(*lvCD\nmcd\uItemState & $FF)

;:........Draw the bitmap..........
              If IsImage(imgId)
                iw = ImageWidth(imgId)
                ih = ImageHeight(imgId)                           ;:Debug "Image: "+Str(iw)+","+Str(ih)
                If imgId <> G_LbFiles_ImageDefaultID
                  textline$ = GetFilePart(fname$)+" ("+Str(iw)+"x"+Str(ih)+")"
                Else
                  textline$ = GetFilePart(fname$)
                  If textline$ = "" : textline$ + "Image" : EndIf
                  textline$ + " not found! ("+Str(iw)+"x"+Str(ih)+")"
                EndIf
                GetTextExtentPoint_(*lvCD\nmcd\hdc, textline$, Len(textline$), sz) ;' get text height...

                hdcMem = CreateCompatibleDC_(*lvCD\nmcd\hdc)  
                hbmpOld = SelectObject_(hdcMem, ImageID(imgId))

                x = *lvCD\nmcd\rc\left+G_LbFiles_TileMargin
                y = *lvCD\nmcd\rc\top+G_LbFiles_TileMargin
                w = *lvCD\nmcd\rc\right-*lvCD\nmcd\rc\left-(G_LbFiles_TileMargin*2)
                h = *lvCD\nmcd\rc\bottom-*lvCD\nmcd\rc\top-sz\cy-(G_LbFiles_TileMargin*2)     ;:Debug "Start: "+Str(x)+","+Str(y)+","+Str(w)+","+Str(h)
            
                If iw > w Or ih > h  ;:Debug "smaller"
                  fw = iw / w                                      ;:Debug " f(w) = " + StrF(fw)
                  fh = ih / h                                      ;:Debug " f(h) = " + StrF(fh)
                  If fw > fh : fh = fw : EndIf
                  tw = iw / fh
                  th = ih / fh
                Else                 ;:Debug "bigger"
                  tw = iw
                  th = ih
                EndIf
                tx = x+(w-tw)/2
                ty = y+(h-th)/2
                StretchBlt_(*lvCD\nmcd\hdc, tx, ty, tw, th, hdcMem, 0, 0, iw, ih, #SRCCOPY)  ;:Debug "Draw: "+Str(tx)+","+Str(ty)+","+Str(tw)+","+Str(th)
                SelectObject_(hdcMem, hbmpOld);  
                DeleteDC_(hdcMem)  
                If imgId <> G_LbFiles_ImageDefaultID
                  FreeImage(imgId)
                EndIf
              EndIf

;:........Draw the textline..........
              FrameRect_(*lvCD\nmcd\hdc, *lvCD\nmcd\rc, currentBrush)
              SetBkMode_(*lvCD\nmcd\hdc, #TRANSPARENT)  
              SetTextColor_(*lvCD\nmcd\hdc, currentTextColor)  
              *lvCD\nmcd\rc\left + G_LbFiles_TileMargin
              *lvCD\nmcd\rc\top = *lvCD\nmcd\rc\bottom-sz\cy-1
              DrawText_(*lvCD\nmcd\hdc, textline$, Len(textline$), *lvCD\nmcd\rc, dtFlags)
            EndIf ;' if ValidRect() 

            ;result = #CDRF_NOTIFYSUBITEMDRAW  ;' in lvs_report 
            result = #CDRF_SKIPDEFAULT        ;' draw the item by myself ... 

        EndSelect
      EndIf
  EndSelect
  ProcedureReturn result
EndProcedure


Procedure Listbox_Create(GadID, X, Y, W, H, ImageW, ImageH)
  Protected result, hGad, hNewIL, hOldIL, nn
  
  hNewIL = ImageList_Create_(ImageW, ImageH, #ILC_COLOR32|#ILC_MASK, 0, 1)
  result = ListIconGadget(GadID, X, Y, W, H, "", 0) ;, #PB_ListIcon_AlwaysShowSelection)
  If GadID = #PB_Any
    GadID = result
  EndIf
  SetGadgetAttribute(GadID, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
  hGad = GadgetID(GadID)

  ;nn = SendMessage_(hGad, #LVM_GETITEMSPACING, 0, 0)  :Debug "GetItemspacing: "+Str(LOWORD(nn))+"  "+Str(HIWORD(nn))
  ;SendMessage_(hGad, #LVM_SETICONSPACING, 0, MAKELONG(80, 42))
  ;nn = SendMessage_(hGad, #LVM_GETITEMSPACING, 0, 0)  :Debug "GetItemspacing: "+Str(LOWORD(nn))+"  "+Str(HIWORD(nn))
  ;SendMessage_(hGad, #LVM_SETICONSPACING, 0, MAKELONG(-1, -1)) ;' reset 
 
  hOldIL = SendMessage_(hGad, #LVM_GETIMAGELIST, #LVSIL_NORMAL, 0)
  SendMessage_(hGad, #LVM_SETIMAGELIST, #LVSIL_NORMAL, hNewIL)
  ImageList_Destroy_(hOldIL)

;' #LVS_EX_AUTOAUTOARRANGE --> works 
  SendMessage_(hGad, #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_AUTOAUTOARRANGE, #LVS_EX_AUTOAUTOARRANGE)

;' LVS_EX_FLATSB --> ???
  SendMessage_(hGad, #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_FLATSB, #LVS_EX_FLATSB)

;' LVS_EX_INFOTIP --> ???
  SendMessage_(hGad, #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_INFOTIP|#LVS_EX_LABELTIP, #LVS_EX_INFOTIP|#LVS_EX_LABELTIP)

;' LVS_EX_ONECLICKACTIVATE | LVS_EX_TRACKSELECT --> works
;'--> LVN_ITEMACTIVATE notification code
  SendMessage_(hGad, #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_ONECLICKACTIVATE|#LVS_EX_TRACKSELECT, #LVS_EX_ONECLICKACTIVATE|#LVS_EX_TRACKSELECT)

;' LVM_SETHOVERTIME --> works 
;    Sets the amount of time which the mouse cursor must hover over an item before it is selected. You can send this message explicitly Or use the ListView_SetHoverTime Macro.
; Parameters
;   wParam ... Must be zero.
;   lParam ... The new amount of time, in milliseconds, that the mouse cursor must hover over an item before it is selected. If this value is (DWORD)-1, then the hover time is set To the Default hover time.
; Return value 
;   Returns the previous hover time. 
  nn = SendMessage_(hGad, #LVM_SETHOVERTIME, 0, 800)  :Debug "Previous Hover time = "+Str(nn)

  Global G_LbFiles_zz_hImageList = hNewIL
  Global G_LbFiles_zz_ImageW = ImageW 
  Global G_LbFiles_zz_ImageH = ImageH

  ProcedureReturn result
EndProcedure


Procedure Listbox_SetImageSize(GadID, ImageW, ImageH)
  If ImageList_SetIconSize_(G_LbFiles_zz_hImageList, ImageW, ImageH) ;' set new size for all, removes all images from the list...
    SendMessage_(GadgetID(GadID), #LVM_SETIMAGELIST, #LVSIL_NORMAL, G_LbFiles_zz_hImageList)
    G_LbFiles_zz_ImageW = ImageW 
    G_LbFiles_zz_ImageH = ImageH
  EndIf
EndProcedure

Procedure Main()
  Protected nn, fname$

  If OpenWindow(#WndMain, #PB_Any, #PB_Any, 620, 240, "ListIconGadget OwnerDrawn Window", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_SizeGadget)
    SetWindowCallback(@MainWindowCallbackProc(), #WndMain)

    ButtonGadget(#BtnSmall, 2, 2, 76, 20, "Small")
    ButtonGadget(#BtnBig, 80, 2, 76, 20, "Big")

    Listbox_Create(#LbFiles, 2, 22, 616, 214, 96, 96)
Debug "#WndMain: "+Str(WindowID(#WndMain))
Debug "#LbError: "+Str(GadgetID(#LbFiles))
         
    For nn = 0 To 15
      fname$ = MakeFilename(nn)
      ;fname$ = G_LbFiles_BaseDir$+fname$
      AddGadgetItem(#LbFiles, -1, fname$)
    Next nn

    HideWindow(#WndMain, 0)
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_CloseWindow
          CloseWindow(#WndMain)
          Break
        Case #PB_Event_SizeWindow
          ResizeGadget(#LbFiles, #PB_Ignore, #PB_Ignore, WindowWidth(#WndMain)-4, WindowHeight(#WndMain)-22-4)
          ;SendMessage_(GadgetID(#LbFiles), #LVM_ARRANGE, #LVA_DEFAULT, 0)  ;' see #LVM_EX_AUTOAUTOARRANGE ... 
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #BtnSmall  : Listbox_SetImageSize(#LbFiles, 64, 64)
            Case #BtnBig    : Listbox_SetImageSize(#LbFiles, 120, 120)
          EndSelect
      EndSelect
    ForEver
  EndIf
  ProcedureReturn 0
EndProcedure
End Main()
;' Bottom of File