PureBasic

Salut tous le monde, quelqu'un à déjà essayer de créer ces propre gadgets ? J'aimerais pouvoir me créer mon propre ListeIcone Gadget pour l’harmoniser avec l'interface de mon future logiciel mais je ne sais pas par ou commencer. J'ai bien une idée grâce aux canvas de PB, mais si quelqu'un à déjà fait ca ça m'éviterais de réinventer la roue.

Bonjour

As tu regardé dans les programmes et codes de thorsten ? Il y a tout un tas de codes et de programmes.

Code : Tout sélectionner

https://u.pcloud.link/publink/show?code=kZdBKYkZqACcD4wGG0B6NmwH88oyJQ56HXg7

En plus, le code est très pro !

Phil

Merci Philippe je vais regarder. Voici un premier jet à retravailler j'ai un problème de redimensionnement sur Mac.

Code : Tout sélectionner

; ======================================================================
;  CanvasListIcon - 100% CanvasGadget - THEME SOMBRE + RESIZE AUTO
;  - Tri par en-tête, sélection, redimension de colonnes, molette, scrollbar
;  - Canvas remplit la fenêtre, colonnes auto-ajustées à la largeur
;  By MetalOS
; ======================================================================

EnableExplicit

#HeaderHeight      = 30
#RowHeight         = 24
#ScrollbarWidth    = 14
#ResizeGrip        = 5
#MinColumnWidth    = 50

; Couleurs (ARGB) - Thème sombre
#Col_Background     = $FF0F1114
#Col_HeaderBgTop    = $FF1C1F24
#Col_HeaderBgBot    = $FF15181C
#Col_HeaderText     = $FFFFFFFF
#Col_Text           = $FFEFEFEF
#Col_TextMuted      = $FFB8C0CC

#Col_Grid           = $FF2B3138
#Col_RowOdd         = $FF12151A
#Col_RowEven        = $FF151A20
#Col_RowHover       = $FF1E2530
#Col_RowSelected    = $FF233044

#Col_ScrollTrack    = $FF1A1F26
#Col_ScrollThumb    = $FF3B4450
#Col_ScrollThumbHot = $FF485360
#Col_Resizer        = $FF394049

; Police
#FontHeader = 0
#FontRow    = 1

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  LoadFont(#FontHeader, "Segoe UI", 10, #PB_Font_Bold)
  LoadFont(#FontRow,    "Segoe UI", 10)
CompilerElse
  LoadFont(#FontHeader, "Arial", 10, #PB_Font_Bold)
  LoadFont(#FontRow,    "Arial", 10)
CompilerEndIf

Structure Row
  id.i
  nom.s
  ville.s
  age.i
EndStructure

Global NewList rows.Row()

; Colonnes
#Col_ID   = 0
#Col_Nom  = 1
#Col_Ville= 2
#Col_Age  = 3
#ColCount = 4

Global Dim ColTitles.s(#ColCount-1)
ColTitles(#Col_ID)    = "ID"
ColTitles(#Col_Nom)   = "Nom"
ColTitles(#Col_Ville) = "Ville"
ColTitles(#Col_Age)   = "Âge"

Global Dim ColWidth.i(#ColCount-1)
ColWidth(#Col_ID)    = 70
ColWidth(#Col_Nom)   = 180
ColWidth(#Col_Ville) = 160
ColWidth(#Col_Age)   = 70

Global Dim ColRight.i(#ColCount-1)

; Tri
Global SortCol = #Col_ID
Global SortAsc = #True

; État UI
Global SelectedRow = -1
Global HoverRow    = -1
Global TopIndex    = 0
Global ResizingCol = -1
Global ResizeStartX.i, ResizeStartW.i

; Scrollbar state (drag)
Global SB_Drag = #False
Global SB_DragStartY.i, SB_DragStartTopIndex.i
Global SB_ThumbY.i, SB_ThumbH.i, SB_TrackY.i, SB_TrackH.i

; Mémorisation taille fenêtre (safeguard)
Global LastWinW.i, LastWinH.i

; Gadgets + Timer
Enumeration 100
  #Win
  #Cv
  #TmrResize
EndEnumeration

Procedure FillVerticalGradient(x, y, w, h, colTop, colBot)
  Protected i, denom, a, r, g, b
  Protected cTopA = Alpha(colTop), cTopR = Red(colTop), cTopG = Green(colTop), cTopB = Blue(colTop)
  Protected cBotA = Alpha(colBot), cBotR = Red(colBot), cBotG = Green(colBot), cBotB = Blue(colBot)
  denom = h - 1

  Protected oldMode = DrawingMode(#PB_2DDrawing_AlphaBlend)
  For i = 0 To h-1
    Protected t.f
    If denom = 0
      t = 0
    Else
      t = i / denom
    EndIf
    a = Int((1-t)*cTopA + t*cBotA)
    r = Int((1-t)*cTopR + t*cBotR)
    g = Int((1-t)*cTopG + t*cBotG)
    b = Int((1-t)*cTopB + t*cBotB)
    LineXY(x, y+i, x+w, y+i, RGBA(r,g,b,a))
  Next
  DrawingMode(oldMode)
EndProcedure

; Ajustement colonnes à la largeur dispo
Procedure ReflowColumnsToWindow()
  Define w.i = GadgetWidth(#Cv)
  Define targetW.i = w - #ScrollbarWidth
  If targetW < 1 : targetW = 1 : EndIf

  Define totalW.i = 0, i.i
  For i=0 To #ColCount-1
    totalW + ColWidth(i)
  Next
  If totalW <= 0
    Define eq.i = targetW / #ColCount
    If eq < #MinColumnWidth : eq = #MinColumnWidth : EndIf
    For i=0 To #ColCount-1 : ColWidth(i) = eq : Next
    totalW = eq * #ColCount
  EndIf

  For i=0 To #ColCount-1
    ColWidth(i) = Int(ColWidth(i) * targetW / totalW)
    If ColWidth(i) < #MinColumnWidth : ColWidth(i) = #MinColumnWidth : EndIf
  Next

  Define sumW.i = 0
  For i=0 To #ColCount-1 : sumW + ColWidth(i) : Next
  Define diff.i = targetW - sumW

  If diff <> 0
    ColWidth(#ColCount-1) + diff
    If ColWidth(#ColCount-1) < #MinColumnWidth
      diff = ColWidth(#ColCount-1) - #MinColumnWidth
      ColWidth(#ColCount-1) = #MinColumnWidth
    Else
      diff = 0
    EndIf
    If diff < 0
      For i = #ColCount-2 To 0 Step -1
        If diff = 0 : Break : EndIf
        Define room.i = ColWidth(i) - #MinColumnWidth
        If room > 0
          Define take.i = room
          If take < -diff : take = -diff : EndIf
          ColWidth(i) - take
          diff + take
        EndIf
      Next
    EndIf
  EndIf
EndProcedure

Procedure SortRows(col, asc)
  SortCol = col
  SortAsc = asc

  Protected n = ListSize(rows())
  If n <= 1 : ProcedureReturn : EndIf

  Protected Dim tmp.Row(n-1)
  Protected Dim idx.i(n-1)
  Protected i, j, k, gap, a, b, cond.i
  Protected sa.s, sb.s

  i = 0
  ForEach rows()
    tmp(i) = rows()
    idx(i) = i
    i + 1
  Next

  gap = n / 2 : If gap < 1 : gap = 1 : EndIf
  While gap > 0
    For i = gap To n-1
      j = i - gap
      While j >= 0
        a = idx(j) : b = idx(j+gap)
        cond = 0

        Select SortCol
          Case #Col_ID
            If SortAsc
              If tmp(a)\id > tmp(b)\id : cond = 1 : EndIf
            Else
              If tmp(a)\id < tmp(b)\id : cond = 1 : EndIf
            EndIf

          Case #Col_Nom
            sa = LCase(tmp(a)\nom) : sb = LCase(tmp(b)\nom)
            If SortAsc
              If sa > sb : cond = 1 : EndIf
            Else
              If sa < sb : cond = 1 : EndIf
            EndIf

          Case #Col_Ville
            sa = LCase(tmp(a)\ville) : sb = LCase(tmp(b)\ville)
            If SortAsc
              If sa > sb : cond = 1 : EndIf
            Else
              If sa < sb : cond = 1 : EndIf
            EndIf

          Case #Col_Age
            If SortAsc
              If tmp(a)\age > tmp(b)\age : cond = 1 : EndIf
            Else
              If tmp(a)\age < tmp(b)\age : cond = 1 : EndIf
            EndIf
        EndSelect

        If cond
          k = idx(j) : idx(j) = idx(j+gap) : idx(j+gap) = k
          j - gap
        Else
          Break
        EndIf
      Wend
    Next
    gap / 2
  Wend

  ClearList(rows())
  For i = 0 To n-1
    AddElement(rows())
    rows() = tmp(idx(i))
  Next
EndProcedure

Procedure PopulateDemoData(count = 200)
  ClearList(rows())
  Protected Dim noms.s(9)
  noms(0)="Martin":noms(1)="Bernard":noms(2)="Dubois":noms(3)="Durand":noms(4)="Moreau"
  noms(5)="Simon":noms(6)="Laurent":noms(7)="Lefebvre":noms(8)="Michel":noms(9)="Garcia"

  Protected Dim villes.s(9)
  villes(0)="Paris":villes(1)="Lyon":villes(2)="Marseille":villes(3)="Toulouse":villes(4)="Nice"
  villes(5)="Nantes":villes(6)="Strasbourg":villes(7)="Montpellier":villes(8)="Bordeaux":villes(9)="Lille"

  Protected i
  RandomSeed(12345)
  For i=1 To count
    AddElement(rows())
    rows()\id    = i
    rows()\nom   = noms(Random(ArraySize(noms())))
    rows()\ville = villes(Random(ArraySize(villes())))
    rows()\age   = 18 + Random(47)
  Next
  SortRows(SortCol, SortAsc)
EndProcedure

Procedure DrawList()
  Protected w = GadgetWidth(#Cv)
  Protected h = GadgetHeight(#Cv)
  Protected rowsAreaW = w - #ScrollbarWidth
  Protected rowsAreaH = h - #HeaderHeight
  If rowsAreaH < 0 : rowsAreaH = 0 : EndIf

  If StartDrawing(CanvasOutput(#Cv))
    ; Fond
    DrawingMode(#PB_2DDrawing_Default)
    Box(0,0,w,h, #Col_Background)

    ; Header
    FillVerticalGradient(0,0,w,#HeaderHeight, #Col_HeaderBgTop, #Col_HeaderBgBot)
    Box(0,#HeaderHeight-1,w,1,#Col_Grid)

    ; Colonnes
    Protected x=0, c
    DrawingFont(FontID(#FontHeader))
    DrawingMode(#PB_2DDrawing_Transparent)
    For c=0 To #ColCount-1
      ColRight(c) = x + ColWidth(c)

      Protected title.s = ColTitles(c)
      If c = SortCol
        If SortAsc : title + " ▲" : Else : title + " ▼" : EndIf
      EndIf
      Protected tx = x + 8
      Protected ty = ( #HeaderHeight - TextHeight(title) )/2
      DrawText(tx, ty, title, #Col_HeaderText)

      ; séparateur de colonne
      DrawingMode(#PB_2DDrawing_Default)
      Box(ColRight(c)-1, 0, 1, #HeaderHeight, #Col_Resizer)
      DrawingMode(#PB_2DDrawing_Transparent)

      x = ColRight(c)
    Next

    ; Zone lignes
    ClipOutput(0, #HeaderHeight, rowsAreaW, rowsAreaH)

    Protected visible = rowsAreaH / #RowHeight
    Protected y = #HeaderHeight
    Protected i, idx, rColor, baseline
    Protected s.s

    For i=0 To visible
      idx = TopIndex + i
      If idx > ListSize(rows())-1 : Break : EndIf

      SelectElement(rows(), idx)

      If (i % 2) = 0 : rColor = #Col_RowEven : Else : rColor = #Col_RowOdd : EndIf
      If idx = SelectedRow
        rColor = #Col_RowSelected
      ElseIf idx = HoverRow
        rColor = #Col_RowHover
      EndIf

      DrawingMode(#PB_2DDrawing_Default)
      Box(0, y, rowsAreaW, #RowHeight, rColor)

      ; cellules
      x = 0
      DrawingFont(FontID(#FontRow))
      baseline = y + (#RowHeight - TextHeight("Ag"))/2

      DrawingMode(#PB_2DDrawing_Transparent)
      ; ID (droite)
      s = Str(rows()\id)
      DrawText(x + ColWidth(#Col_ID) - 8 - TextWidth(s), baseline, s, #Col_Text)
      x = ColRight(#Col_ID)

      ; NOM (gauche)
      s = rows()\nom
      DrawText(x + 8, baseline, s, #Col_Text)
      x = ColRight(#Col_Nom)

      ; VILLE (gauche, plus doux)
      s = rows()\ville
      DrawText(x + 8, baseline, s, #Col_TextMuted)
      x = ColRight(#Col_Ville)

      ; ÂGE (droite)
      s = Str(rows()\age)
      DrawText(x + ColWidth(#Col_Age) - 8 - TextWidth(s), baseline, s, #Col_Text)

      ; grille horizontale
      DrawingMode(#PB_2DDrawing_Default)
      Box(0, y + #RowHeight - 1, rowsAreaW, 1, #Col_Grid)
      y + #RowHeight
    Next

    ; Traits verticaux
    x=0
    For c=0 To #ColCount-1
      Box(ColRight(c)-1, #HeaderHeight, 1, rowsAreaH, #Col_Grid)
      x = ColRight(c)
    Next

    ; Fin clip
    ClipOutput(0,0,0,0)

    ;----------------- Scrollbar (verticale) -----------------
    Protected trackX.i, trackY.i, trackW.i, trackH.i
    Protected totalRows.i, visibleRows.i, maxTop.i
    Protected thumbH.i, thumbY.i, thumbCol.i

    trackX = w - #ScrollbarWidth
    trackY = #HeaderHeight + 2
    trackW = #ScrollbarWidth - 4
    trackH = rowsAreaH - 4

    ; fond du track
    DrawingMode(#PB_2DDrawing_Default)
    Box(trackX+2, trackY, trackW, trackH, #Col_ScrollTrack)

    totalRows   = ListSize(rows())
    visibleRows = rowsAreaH / #RowHeight
    If visibleRows < 1 : visibleRows = 1 : EndIf

    maxTop = totalRows - visibleRows
    If maxTop < 0 : maxTop = 0 : EndIf

    SB_TrackY = trackY : SB_TrackH = trackH

    If totalRows > visibleRows And trackH > 0
      thumbH = Int(trackH * visibleRows / totalRows)
      If thumbH < 30 : thumbH = 30 : EndIf
      If thumbH > trackH : thumbH = trackH : EndIf

      If maxTop = 0
        thumbY = trackY
      Else
        thumbY = trackY + Int( (trackH - thumbH) * TopIndex / maxTop )
      EndIf

      SB_ThumbY = thumbY : SB_ThumbH = thumbH

      thumbCol = #Col_ScrollThumb
      If SB_Drag : thumbCol = #Col_ScrollThumbHot : EndIf

      Box(trackX+2, thumbY, trackW, thumbH, thumbCol)
      Box(trackX+2, thumbY, trackW, 1, $40FFFFFF)
      Box(trackX+2, thumbY+thumbH-1, trackW, 1, $40222A33)
    Else
      SB_ThumbY = -1 : SB_ThumbH = 0
    EndIf

    StopDrawing()
  EndIf
EndProcedure

Procedure.i HitHeaderColumn(mx, my)
  If my < 0 Or my > #HeaderHeight : ProcedureReturn -1 : EndIf
  Protected x=0, c
  For c=0 To #ColCount-1
    If mx >= x And mx < ColRight(c) : ProcedureReturn c : EndIf
    x = ColRight(c)
  Next
  ProcedureReturn -1
EndProcedure

Procedure.i NearColumnSeparator(mx, my)
  If my > #HeaderHeight : ProcedureReturn -1 : EndIf
  Protected c
  For c=0 To #ColCount-2
    If Abs(mx - ColRight(c)) <= #ResizeGrip
      ProcedureReturn c
    EndIf
  Next
  ProcedureReturn -1
EndProcedure

Procedure.i HitRowIndex(mx, my)
  If my < #HeaderHeight : ProcedureReturn -1 : EndIf
  Protected y = my - #HeaderHeight
  Protected i = y / #RowHeight
  Protected idx = TopIndex + i
  If idx >= 0 And idx < ListSize(rows())
    ProcedureReturn idx
  EndIf
  ProcedureReturn -1
EndProcedure

Procedure.i InScrollThumb(mx, my)
  Protected w = GadgetWidth(#Cv)
  If mx < w - #ScrollbarWidth Or mx > w : ProcedureReturn #False : EndIf
  If SB_ThumbY >= 0
    If my >= SB_ThumbY And my < SB_ThumbY + SB_ThumbH
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure ScrollBy(delta)
  Protected h.i, rowsAreaH.i
  Protected visibleRows.i, maxTop.i

  h = GadgetHeight(#Cv)
  rowsAreaH = h - #HeaderHeight
  If rowsAreaH < 0 : rowsAreaH = 0 : EndIf

  visibleRows = rowsAreaH / #RowHeight
  If visibleRows < 1 : visibleRows = 1 : EndIf

  maxTop = ListSize(rows()) - visibleRows
  If maxTop < 0 : maxTop = 0 : EndIf

  TopIndex = TopIndex + delta
  If TopIndex < 0 : TopIndex = 0 : EndIf
  If TopIndex > maxTop : TopIndex = maxTop : EndIf
EndProcedure

Procedure HandleCanvasEvent()
  Protected et = EventType()
  Protected mx = GetGadgetAttribute(#Cv, #PB_Canvas_MouseX)
  Protected my = GetGadgetAttribute(#Cv, #PB_Canvas_MouseY)
  Protected wheel = GetGadgetAttribute(#Cv, #PB_Canvas_WheelDelta)

  Select et
    Case #PB_EventType_MouseWheel
      If wheel > 0 : ScrollBy(-3) : ElseIf wheel < 0 : ScrollBy(3) : EndIf
      DrawList()

    Case #PB_EventType_MouseMove
      If ResizingCol >= 0
        Protected dx.i = mx - ResizeStartX
        Protected newW.i = ResizeStartW + dx
        If newW < #MinColumnWidth : newW = #MinColumnWidth : EndIf
        ColWidth(ResizingCol) = newW
        ReflowColumnsToWindow()
        DrawList()
      ElseIf SB_Drag
        Protected dy.i = my - SB_DragStartY
        Protected h.i = GadgetHeight(#Cv)
        Protected rowsAreaH.i = h - #HeaderHeight
        If rowsAreaH < 0 : rowsAreaH = 0 : EndIf

        Protected visibleRows.i = rowsAreaH / #RowHeight
        If visibleRows < 1 : visibleRows = 1 : EndIf
        Protected maxTop.i = ListSize(rows()) - visibleRows
        If maxTop < 0 : maxTop = 0 : EndIf

        If SB_TrackH - SB_ThumbH > 0
          TopIndex = SB_DragStartTopIndex + dy * maxTop / (SB_TrackH - SB_ThumbH)
          If TopIndex < 0 : TopIndex = 0 : EndIf
          If TopIndex > maxTop : TopIndex = maxTop : EndIf
        EndIf
        DrawList()
      Else
        Protected idx = HitRowIndex(mx, my)
        If idx <> HoverRow
          HoverRow = idx
          DrawList()
        EndIf
      EndIf

    Case #PB_EventType_LeftButtonDown
      Protected colSep = NearColumnSeparator(mx, my)
      If colSep >= 0
        ResizingCol   = colSep
        ResizeStartX  = mx
        ResizeStartW  = ColWidth(ResizingCol)
        ProcedureReturn
      EndIf

      If InScrollThumb(mx, my)
        SB_Drag = #True
        SB_DragStartY = my
        SB_DragStartTopIndex = TopIndex
        ProcedureReturn
      EndIf

      Protected idx2 = HitRowIndex(mx, my)
      If idx2 >= 0
        SelectedRow = idx2
        DrawList()
      EndIf

    Case #PB_EventType_LeftButtonUp
      If ResizingCol >= 0
        ResizingCol = -1
        DrawList()
      EndIf
      If SB_Drag
        SB_Drag = #False
        DrawList()
      EndIf

      If my <= #HeaderHeight And NearColumnSeparator(mx,my) = -1
        Protected hc = HitHeaderColumn(mx,my)
        If hc >= 0
          If SortCol = hc
            SortAsc = 1 - SortAsc
          Else
            SortCol = hc : SortAsc = #True
          EndIf
          SortRows(SortCol, SortAsc)
          DrawList()
        EndIf
      EndIf

    Case #PB_EventType_LeftDoubleClick
      Protected idx3 = HitRowIndex(mx, my)
      If idx3 >= 0
        SelectElement(rows(), idx3)
        Protected txt.s = "Double-clic: ID=" + Str(rows()\id) + " | " + rows()\nom + " | " + rows()\ville + " | Âge " + Str(rows()\age)
        SetWindowTitle(#Win, txt)
      EndIf

    Case #PB_EventType_LostFocus
      ResizingCol = -1
      SB_Drag     = #False
  EndSelect
EndProcedure

;---------------------------------------------------------
; Gestion du redimensionnement (BindEvent + Timer)
;---------------------------------------------------------
Procedure OnResize()
  If EventWindow() = #Win
    ResizeGadget(#Cv, 0, 0, WindowWidth(#Win), WindowHeight(#Win))
    ReflowColumnsToWindow()
    DrawList()
  EndIf
EndProcedure

Procedure OnResizeTimer()
  Protected curW = WindowWidth(#Win)
  Protected curH = WindowHeight(#Win)
  If curW <> LastWinW Or curH <> LastWinH
    LastWinW = curW : LastWinH = curH
    ResizeGadget(#Cv, 0, 0, curW, curH)
    ReflowColumnsToWindow()
    DrawList()
  EndIf
EndProcedure

;---------------------------------------------------------
; Programme principal
;---------------------------------------------------------
If OpenWindow(#Win, 100, 100, 720, 420, "Canvas ListIcon - Thème sombre", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
  CanvasGadget(#Cv, 0, 0, WindowWidth(#Win), WindowHeight(#Win), #PB_Canvas_Keyboard)

  LastWinW = WindowWidth(#Win) : LastWinH = WindowHeight(#Win)
  
  BindEvent(#PB_Event_SizeWindow, @OnResize(), #Win)
  AddWindowTimer(#Win, #TmrResize, 50) 

  ReflowColumnsToWindow()
  PopulateDemoData(250)
  DrawList()

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        If EventGadget() = #Cv
          HandleCanvasEvent()
        EndIf

      Case #PB_Event_Timer
        If EventTimer() = #TmrResize
          OnResizeTimer()
        EndIf

      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
EndIf
End

Il y a aussi un souci de redimensionnement de colonne sous windows. Quand je cherche à redimensionner la première colonne, la dernière subit aussi le redimensionnement.
Sinon j'aime beaucoup.

C'est très joli, mais on voit que ça a été bien réfléchi. Beau travail !

Je me demande une chose (cinsérement !) : A quoi cela peux servir ?

Je ne vois pas. Ou alors, c'est pour une application hyper niche...

PS : mais, bravo quand même. Je ne saurais pas le faire, alors !!...

PureBasic

ListIconeGadget perso

ListIconeGadget perso

Re: ListIconeGadget perso

Re: ListIconeGadget perso

Re: ListIconeGadget perso

Re: ListIconeGadget perso

Re: ListIconeGadget perso