PureBoard

Code: Alles auswählen

#LVS_EX_LABELTIP = $4000 

Structure myLVGadget
 idstrg.s{10} ;nur für Testinfo
 flags.i      ;nur im Quellcode ändern, ListIconflags
 pb.i         ;intern PB Nr
 id.i         ;intern GadgetID()
 hwnd.i       ;intern WindowID() Parentwindow = hwnd vom Hauptfenster
 header.i     ;intern HeaderID   
 hdtheme.i    ; -> kann verändert werden, Header Theme abschalten
 bkcolor.i    ; -> kann verändert werden, Hintergrundfarbe
 
 fontid1.i    ; -> kann verändert werden, Font 
 fontid2.i    ; -> kann verändert werden, Font
 fonthh1.i    ;nur im Quellcode ändern
 fonthh2.i    ;nur im Quellcode ändern
 
 lvhh.i       ;nur im Quellcode ändern
 lvimglist.i  ;intern 
 lvlabeltip.i ; -> kann verändert werden, 0 oder 1
 
 cbhh.i       ;nur im Quellcode ändern
 cbimglist.i  ;intern

 cbhh1.i      ;nur im Quellcode ändern
 cbhh2.i      ;nur im Quellcode ändern
 cbimg1.i     ; -> kann verändert werden, Image
 cbimg2.i     ; -> kann verändert werden, Image
 cbimgID.i    ;intern
 cbframe.i    ; -> kann verändert werden, 1 = Rahmen, 0 = kein Rahmen
 cbcolor1.i   ; -> kann verändert werden, Buttonfarbe
 cbcolor2.i   ; -> kann verändert werden, Buttonfarbe
 cbnormal.i
 
 lvoldproc.i  ;intern
 hdoldproc.i  ;intern
 hdhh.i       ;nur im Quellcode ändern
 hdflag.i     ; -> kann verändert werden, Headerbreite ändern ja/nein
 hdsort.i     ; -> kann verändert werden, Sortieren
 hdCDraw.i    ; -> kann verändert werden, Header farbig
 hdbrush1.i
 hdbrush2.i
 hdbkclr1.i
 hdbkclr2.i
 hdtxtclr1.i
 hdtxtclr2.i
 hdicons.i[22]  ;für 0 - 21 Spalten nur Icons, keine BMPs
 
EndStructure


Procedure LV_WinProc(hWnd, Msg, wParam, lParam) 
;aus dem englischen Forum, etwas abgeändert

;hwnd ist hier die ListIconGadget idnr
    
*this.myLVGadget = GetWindowLong_(hWnd,#GWL_USERDATA) 

oldproc = *this\lvoldproc 
result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 
      
If Msg = #WM_NOTIFY 
        *pnmh.NMHDR = lparam 
        ; --> Get handle to ListIcon header control 
        If *pnmh\code = #NM_CUSTOMDRAW 
            *pnmcd.NMCUSTOMDRAW = lparam 
            ; --> Determine drawing stage 
            Select *pnmcd\dwDrawStage 
              Case #CDDS_PREPAINT: result = #CDRF_NOTIFYITEMDRAW 
              Case #CDDS_ITEMPREPAINT 
                  ;Get header text. 
                  ;text$=GetGadgetItemText(GetDlgCtrlID_(hWnd),-1,*pnmcd\dwItemSpec) 
                  text$=GetGadgetItemText(*this\pb,-1,*pnmcd\dwItemSpec) 
                  ;Check button state. 
                  If *pnmcd\uItemState & #CDIS_SELECTED 
                     DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH|#DFCS_PUSHED) 
                     ;Offset text because of the selected button. 
                     InflateRect_(*pnmcd\rc,-1,-1)  ;Text bewegt sich, wenn Button gedrückt 
                  Else 
                     DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH) 
                  EndIf 
                  ;Draw background. 
                  *pnmcd\rc\bottom-2 : *pnmcd\rc\right-2 
                  SetBkMode_(*pnmcd\hdc,#TRANSPARENT) 
                  If *pnmcd\dwItemSpec & 1 
                     FillRect_(*pnmcd\hdc, *pnmcd\rc, *this\hdbrush1)
                     SetTextColor_(*pnmcd\hdc, *this\hdtxtclr1) 
                  Else 
                     FillRect_(*pnmcd\hdc, *pnmcd\rc, *this\hdbrush2) 
                     SetTextColor_(*pnmcd\hdc, *this\hdtxtclr2) 
                  EndIf 
                  
                  ;Icon links
                  x = *pnmcd\rc\left+2
                  y = *pnmcd\rc\top+3
                  hh = *pnmcd\rc\bottom - *pnmcd\rc\top - 6
                  col = *pnmcd\dwItemSpec
                  DrawIconEx_(*pnmcd\hdc,x,y,*this\hdicons[col],hh,hh,0,0,#DI_NORMAL)
                  
                  ;anstatt Text vielleicht Icon in die Mitte oder was weiß ich
                  
                  ;Text in die Mitte, wenn Text neben dem Icon = *pnmcd\rc\left-hh+1 und #DT_CENTER weg
                  *pnmcd\rc\top+2 
                  InflateRect_(*pnmcd\rc,-5,0) 
                  If *pnmcd\rc\right > *pnmcd\rc\left 
                     DrawText_(*pnmcd\hdc, @text$, -1, *pnmcd\rc, #DT_CENTER|#DT_VCENTER|#DT_END_ELLIPSIS) 
                  EndIf 
                  result = #CDRF_SKIPDEFAULT 
            EndSelect 
      EndIf 
EndIf

ProcedureReturn result 
EndProcedure 
Procedure LV_HeaderWinProc(hWnd, Msg, wParam, lParam) 
;hwnd ist hier die header idnr
;result muß hier in jeder Funktion/Abfrage gesetzt werden, sonst geht nix richtig
    
*this.myLVGadget = GetWindowLong_(hWnd,#GWL_USERDATA) 
;in *this\hdhh steht die Headerhöhe

oldproc = *this\hdoldproc 
result  = 0 
 
Select Msg 
       
       Case #HDM_LAYOUT 
    
            result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 

            If *this\hdhh
                *hdlayout.HD_LAYOUT = lParam 
                If *hdlayout\prc <> 0 
                    *rect.RECT = *hdlayout\prc 
                    *rect\top = *this\hdhh 
                EndIf 
                If *hdlayout\pwpos <> 0 
                    *windowpos.WINDOWPOS = *hdlayout\pwpos 
                    *windowpos\cy = *this\hdhh 
                EndIf
            EndIf 
       
       Case #WM_LBUTTONDOWN  ;513        ; linke Maustaste
    
            ;wo wurde im Header geklickt        
            hit.HD_HITTESTINFO 
            hit\pt\x = lParam & $FFFF             : Debug hit\pt\x
            hit\pt\y = (lParam >> 16) & $FFFF     : Debug hit\pt\y
            SendMessage_(hwnd,#HDM_HITTEST,0,hit) : Debug hit\flags
                                                  : Debug "----"
            ;wenn Trennbalken = Divider zum verschieben angeklickt
            If (hit\flags & #HHT_ONDIVIDER ) = #HHT_ONDIVIDER 
                ;wenn hdflag = 0 verschieben verboten
                ;wenn 1 verschieben erlaubt, z.B. wegen Autobreite
                If *this\hdflag   
                    Debug "verschieben erlaubt"
                    result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)    
                Else
                    Debug "verboten"
                    result = 0  ;dann tue nix = verschieben nicht möglich
                EndIf    
 
            ;wenn im Header geklickt wurde
            ElseIf (hit\flags & #HHT_ONHEADER ) = #HHT_ONHEADER 
                If *this\hdsort
                    ;ListView_Sort(*this\pb, hit\iitem)
                    Debug "Jetzt wird sortiert nach Spalte "+Str(hit\iitem)+" in "+*this\idstrg
                Else
                    Debug "Sortieren verboten in "+*this\idstrg
                EndIf
                result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 
                       
            ;normal weiter
            Else
                result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)    
            EndIf 
               
       Default: result = CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam) 

EndSelect 

ProcedureReturn result 
EndProcedure 

Procedure NewCheckboxes(*lv.myLVGadget)
; --> in einem Bild werden beide Checkboxen gemalt

;Angaben für Höhe sollten durch 2 ohne Rest teilbar sein
;Höhe ist auch gleichzeitig Breite

;cbhh   = höhe = breite, dies ist der gleiche Wert wie bei ImageList_Create_
;cbhh1  = höhe imgage 1, gleicher Wert wie cbhh oder kleiner 
;cbhh2  = höhe imgage 2, 
;cbimg1 = unchecked
;cbimg2 = checked
;cbframe= Rahmen malen

With *lv
    
img = CreateImage(#PB_Any, \cbhh*2, \cbhh) 
 dc = StartDrawing(ImageOutput(img)) 
      
      ;für beide CBs 
      Box(0, 0, 2 * \cbhh, \cbhh, \bkcolor)  
            
      ;unchecked zentriert
      If \cbhh1 > \cbhh: \cbhh1 = \cbhh: EndIf
      x =(\cbhh - \cbhh1) / 2: y = (\cbhh - \cbhh1) / 2: z = \cbhh1
      
      If \cbframe
          Box(x, y, z, z, #Gray)   ;Rahmenfarbe
          x+1: y+1: z-2            ;x+1 dann z-2, x+2 dann z-4 usw.
      EndIf
      If \cbimg1
          Box(x, y, z, z, \bkcolor) 
          x+1: y+1:z-2
          DrawImage(\cbimg1,x,y,z,z)
      Else
          color = \cbcolor1
          Repeat
            Box(x, y, z, z, color)
            x+1: y+1: z-2
            If color < $eeeeee: color + $111100: EndIf
          Until z < 0      
      EndIf      
       

      ;checked zentriert
      If \cbhh2 > \cbhh: \cbhh2 = \cbhh: EndIf
      x = \cbhh + ((\cbhh - \cbhh2) / 2): y = (\cbhh - \cbhh2) / 2: z = \cbhh2
      
      If \cbframe
          Box(x, y, z, z, #Gray)  ;Rahmenfarbe          
          x+1: y+1: z-2
      EndIf
      If \cbimg2
          Box(x, y, z, z, \bkcolor)  
          x+1: y+1: z-2
          DrawImage(\cbimg2,x,y,z,z)
      Else
          color = \cbcolor2
          Repeat
            Box(x, y, z, z, color)
            x+1: y+1: z-2
            If color < $eeeeee: color + $111100: EndIf
          Until z < 0      
      EndIf      

  StopDrawing() 

  \cbimgID = ImageID(img)
  
EndWith

ProcedureReturn img
EndProcedure
Procedure myListIconGadget(*lv.myLVGadget, x, y, br, hh, col$, colbr, flags=0)

;#LVS_EX_LABELTIP = $4000 

With *lv

;bei Bedarf Vorgaben festlegen     
  ;\hdsort = 1      ;Sortieren
  ;\hdflag = 1      ;Col-Breite ändern 
  ;\hdCDraw = 1
  ;\cbframe = 1     ;
  ;\lvlabeltip = 1  ;

  \flags = #PB_ListIcon_GridLines|#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection
  If flags 
     \flags | flags  ;in der Regel kommt #PB_ListIcon_CheckBoxes dazu
  EndIf
  
  \pb = ListIconGadget(#PB_Any, x, y, br, hh, col$, colbr, \flags) 
  
  \id = GadgetID(\pb)
  \hwnd = GetParent_(\id) 
  \header = SendMessage_(\id, #LVM_GETHEADER, 0, 0)  
  
  ;classname.s{255}
  ;Debug GetClassName_(\header,@classname,255): Debug classname
  
  If \lvlabeltip
     exstyle = SendMessage_(\id, #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
     SendMessage_(\id, #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, exstyle | #LVS_EX_LABELTIP) 
  EndIf
  
;das Einfärben des Headers bedeutet Ownerdraw, und dann muß man alles selbst machen 
;bei Bedarf Theme nur für den Header einfach abschalten und dann ist Header grau
  If \hdtheme
     SetWindowTheme_(\header, @null.w, @null.w)
  EndIf   
  If \bkcolor = 0: \bkcolor = $FaFDFD: EndIf   ;#White
  SetGadgetColor(\pb, #PB_Gadget_BackColor, \bkcolor)

;Font für Liste 
  If \fontid2 = 0
     \fontid2 = FontID(LoadFont(#PB_Any, "Courier", 10))
  EndIf
  dc = GetDC_(hwnd) 
  SelectObject_(dc,\fontID2) 
  GetTextMetrics_(dc,TM.textmetric) 
  \fonthh2 = TM\tmHeight  ;dies ist die wirkliche Höhe 
  SetGadgetFont(\pb, \fontID2)
  
;Font für Header 
  If \fontid1 = 0
     \fontid1 = FontID(LoadFont(#PB_Any, "Ariel", 14))
  EndIf
  SelectObject_(dc,\fontID1) 
  GetTextMetrics_(dc,TM.textmetric) 
  \fonthh1 = TM\tmHeight  ;dies ist die wirkliche Höhe 
  SendMessage_(\header, #WM_SETFONT, \FontID1, 1) 

;div Vorgaben 
  \hdhh = \fonthh1 + \fonthh1/4  
  \lvhh = \fonthh2 + \fonthh2/2  ;wenn Checkbox, sollte lvhh = cbhh sein, muß aber nicht
  \cbhh = \lvhh                  ;max Höhe der Checkbox 
  \cbhh1 = \fonthh2 + 2          ;wirkliche Höhe der Checkboxen
  \cbhh2 = \fonthh2 + 4 
  \cbcolor1 = #Gray              ;wenn kein Image = Buttonfarbe
  \cbcolor2 = #Red               ;wenn kein Image = Buttonfarbe

; --> Create imagelist für Icon in Zeile vom ListIconGadget 
;bestimmt indirekt die Zeilenhöhe
;wenn man auf diese Imagelist verzichtet, wird die Höhe der Zeilen
;durch den Font bzw. die Checkbox bestimmt, die erste Null steht für
;die Breite der nicht vorhandenen Icons. Wird bei AddGadgetItem ein
;Image angegeben ist alles für die Katz und PB macht seinen eigenen Mist
  
  \lvimglist = ImageList_Create_(0, \lvhh, #ILC_COLORDDB, 0, 0) 
  SendMessage_(\id, #LVM_SETIMAGELIST, #LVSIL_SMALL, \lvimglist) 
  
; --> Create imagelist für Checkbox ListIconGadget 
  If \flags & #PB_ListIcon_CheckBoxes
      If \cbnormal  ;Originale laden
         \cbimglist = SendMessage_(\id, #LVM_GETIMAGELIST, #LVSIL_STATE, 0) 
         If \cbimg1 = 0
            \cbimg1 = ImageList_GetIcon_(\cbimglist,0,#ILD_NORMAL)
         EndIf
         If \cbimg2 = 0
            \cbimg2 = ImageList_GetIcon_(\cbimglist,1,#ILD_NORMAL)
         EndIf
         \cbframe = 1
      EndIf
      NewCheckboxes(*lv)  ;erstellt Image \cbimgID
      \cbimglist = ImageList_Create_(\cbhh, \cbhh, #ILC_MASK|#ILC_COLORDDB, 0, 2) 
      ImageList_Add_(\cbimglist, \cbimgID, 0)  
      SendMessage_(\id, #LVM_SETIMAGELIST, #LVSIL_STATE, \cbimglist) 
  EndIf
  
;HeaderFarben   
  If \hdbrush1 And \hdbrush2 ; zwei BMP wurden angegeben
      \hdbrush1 = CreatePatternBrush_(\hdbrush1)
      \hdbrush2 = CreatePatternBrush_(\hdbrush2)
  ElseIf \hdbrush1
      \hdbrush1 = CreatePatternBrush_(\hdbrush1)
      \hdbrush2 = \hdbrush1
  ElseIf \hdbrush2
      \hdbrush2 = CreatePatternBrush_(\hdbrush2)
      \hdbrush1 = \hdbrush2
  Else
      If \hdbkclr1 = 0: \hdbkclr1 = #Yellow: EndIf
      If \hdbkclr2 = 0: \hdbkclr2 = #Red: EndIf
      \hdbrush1 = CreateSolidBrush_(\hdbkclr1) 
      \hdbrush2 = CreateSolidBrush_(\hdbkclr2) 
  EndIf
  If \hdtxtclr1 = 0: \hdtxtclr1 = #Black: EndIf
  If \hdtxtclr2 = 0: \hdtxtclr2 = #Blue: EndIf
  
;SubClassing Header    
  \hdoldproc = SetWindowLong_(\header, #GWL_WNDPROC, @LV_HeaderWinProc()) 
  SetWindowLong_(\header, #GWL_USERDATA, *lv)

;SubClassing ListIconGadget für Header farbig
  If \hdCDraw
     \lvoldproc = SetWindowLong_(\id, #GWL_WNDPROC, @LV_WinProc()) 
     SetWindowLong_(\id, #GWL_USERDATA, *lv)
  EndIf
  
EndWith

EndProcedure

;==========================================================

icon1 = ImageID(CatchImage(#PB_Any, ?Logo1))
icon2 = ExtractIcon_(0,"Shell32.dll", 23)
icon3 = ExtractIcon_(0,"Shell32.dll", 160)
icon4 = LoadIcon_(0,#IDI_ASTERISK)     
icon5 = LoadIcon_(0,#IDI_EXCLAMATION) 
icon6 = LoadIcon_(0,#IDI_HAND)        
icon7 = LoadIcon_(0,#IDI_QUESTION)    

UseJPEGImageDecoder() 
bmpID1 = ImageID(CatchImage(#PB_Any, ?Logo2)) 
bmpID2 = ImageID(CatchImage(#PB_Any, ?Logo3)) 

;==========================================================

nr = OpenWindow(#PB_Any, 0, 0, 800, 600, "",#PB_Window_SystemMenu | 1) 
     CreateGadgetList(WindowID(nr)) 
  
     lv1.myLVGadget
     lv1\idstrg = "LV 1"  ;nur für Testzwecke               
     
     myListIconGadget(lv1, 10, 10, 350, 350, "Tage", 150, #PB_ListIcon_CheckBoxes)
       
     For a = 1 To 2 
        addtext$ = "Col" + Str(a)  
        AddGadgetColumn(lv1\pb, a, addtext$,90) 
     Next 
     
     ;vergrößert die letzte Column
     SendMessage_(lv1\id, #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER) 
 
     For a = 0 To 12 
        addtext$ = "LV 1 Item " + Str(a) + #LF$ + #LF$ + "Dies ist ein Text" 
        AddGadgetItem(lv1\pb, -1, addtext$) 
     Next
     
     ; ---------------------------------------------------
     
     lv2.myLVGadget
     lv2\idstrg = "LV 2"
     lv2\cbimg1 = icon6        
     lv2\cbimg2 = icon3       
     lv2\fontid1 = FontID(LoadFont(#PB_Any, "Times", 18))     
     lv2\fontid2 = FontID(LoadFont(#PB_Any, "Courier", 12))     
     lv2\cbframe = 1
     lv2\hdflag  = 1
     lv2\hdsort  = 1
     lv2\hdCDraw = 1
     lv2\hdbrush1  = bmpId1
     lv2\hdbrush2  = bmpId2
     lv2\lvlabeltip = 1
     lv2\hdicons[0] = icon1
     lv2\hdicons[1] = icon2
     lv2\hdicons[2] = icon4
     
     myListIconGadget(lv2, 400, 10, 350, 350, "Tage", 122, #PB_ListIcon_CheckBoxes)
       
     For a = 1 To 2 
        addtext$ = "Col" + Str(a)  
        AddGadgetColumn(lv2\pb, a, addtext$,142) 
     Next 

     For a = 0 To 12 
        addtext$ = "Item " + Str(a)  
        If a = 5: addtext$ + " dies ist ein Test": EndIf
        AddGadgetItem(lv2\pb, -1, addtext$) 
     Next 
     
     SetGadgetItemText(lv2\pb,3,"Hallo du bist hier",1)

     ; ---------------------------------------------------
     
     lv3.myLVGadget
     lv3\idstrg = "LV 3"  ;nur für Testzwecke               
     lv3\hdcdraw = 1
     lv3\lvlabeltip = 1
     lv3\cbnormal = 1
     lv3\cbimg2 = icon3
          
     myListIconGadget(lv3, 10, 380, 350, 200, "Tage", 150, #PB_ListIcon_CheckBoxes)
       
     For a = 1 To 2 
        addtext$ = "Col" + Str(a)  
        AddGadgetColumn(lv3\pb, a, addtext$,90) 
     Next 
     
     ;vergrößert die letzte Column
     SendMessage_(lv3\id, #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER) 
 
     For a = 0 To 12 
        addtext$ = "LV 1 Item " + Str(a) + #LF$ + #LF$ + "Dies ist ein Text" 
        AddGadgetItem(lv3\pb, -1, addtext$) 
     Next
     
     ;Testbilder
     ImageGadget(#PB_Any,400,400,0,0,lv1\cbimgID)
     ImageGadget(#PB_Any,400,440,0,0,lv2\cbimgID)
     ImageGadget(#PB_Any,400,480,0,0,lv3\cbimgID)
 
;==========================================================
  
Repeat 
    event = WaitWindowEvent() 
    Select event 
      Case #PB_Event_Gadget 
        Select EventGadget() 
          Case lv1\pb 

              x$ = ""
              For j = 0 To 12
               state = GetGadgetItemState(lv1\pb,j)
               x$ + Str(state)                            
              Next 
              Debug x$

        EndSelect 
    EndSelect 
Until event = #PB_Event_CloseWindow 

End 

IncludePath #PB_Compiler_Home + "Examples\Sources\Data\"
Logo1: IncludeBinary "cdplayer.ico"
Logo2: IncludeBinary "clouds.jpg"
Logo3: IncludeBinary "terrain_detail.jpg"