ListIcon Editable avec Tri Colonnes et Sauvegarde

[kernadec]

bonjour
voilà, j'avais besoin d'un Listicon Editable avec tri et sauvegarde.

Alors, avec le code d' Elchoni (CodeArchive), j'ai ajouté des Checkboxs
et profité pour adjoindre le code tri trouvé sur le forum English
réalisé par : utopiomania & Mickael Vogel and Lord (2007 2009)

Petit résumé pour l' utilisation
Sur la grille un pop menu est actif avec copier coller ajout suppression de lignes.
le tri des colonnes asc/des avec un clique dans son nom, de même modification du nom des colonnes,
mode drap drop pour permuter les colonnes. et l’édition de chaque cellule avec un double clique.
il suffit aussi d'utiliser la structure de la grille pour créer une boite de saisie de cellule indépendante.

code mis à jour pour PB521

cordialement

Code : Tout sélectionner

; English forum: et code archive
; Author: El Choni (updated for PB3.92+ by Andre, updated for PB4.00 by blbltheworm)
; Date: 09. May 2003
; OS: Windows
; Demo: No
;
; Adaptation de kernadec en janvier 2012 (PB 460) pour les checkboxs
; et aussi l'ajout du code de tri réalisé par: utopiomania & lord & Mickael Vogel (2007-2009)
; et modification du tri nombres pour tenir compte des nombres négatifs....
;

;-"Initialise listicon" 
;{

;  ASCII field separator for reading files = 59 ";"  standard
#SC=59   ;  code ASCII Separateur de champ pour la lecture des fichiers = 59 ";" standard
#SC1=59  ;  modifier le code ASCII pour écrire avec un nouveau séparateur de champ,  sinon identique
;  change the ASCII code for writing with a new field separator, or identical

#NM_CUSTOMDRAW = #NM_FIRST-12 

#CDDS_ITEM = $10000 
#CDDS_SUBITEM = $20000 
#CDDS_PREPAINT = $1 
#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT 
#CDRF_DODEFAULT = $0 
#CDRF_NEWFONT = $2 
#CDRF_NOTIFYITEMDRAW = $20 
#CDRF_NOTIFYSUBITEMDRAW = $20 

#LVM_SUBITEMHITTEST = #LVM_FIRST+57 
#LVM_GETSUBITEMRECT = #LVM_FIRST+56 

#CCM_SETVERSION = #CCM_FIRST+7 

Enumeration
  #Geo_Window
  #Geo_file  
  #Geo_ListGadget
  #Geo_GadgetText
  #Geo_bouton1
  #Geo_bouton2
  #Geo_bouton3
  #Geo_bouton4
  #Geo_PopMenu
  #Geo_WindowReq
EndEnumeration

Structure PB_ListIconItem
  UserData.l
EndStructure

Structure GadgetDataType
  DataValue.l
  DataPosition.l
EndStructure

Structure ODSBTEXT
  szText.l
  clrFront.l
  clrBack.l
EndStructure

Structure Label
  Cnom.s
  CWidth.l
EndStructure


Global Dim GadgetData.GadgetDataType(1000),Dim Colonne.label(100)

Global FontReg,FontBold,updown.l,lastcol.l,first.l,list_col$,chemingeo$,Tmptext$,linetext.l,coln.l,Colonne_defaut.l

Global ListGadget,OldLViewProc,OldEditProc,hEdit,rct.RECT,CellSelectOn,CurItem,CurSubItem,CurSelItem,CurSelSubItem 

Declare LoWord(value)
Declare HiWord(value)
Declare Width_text(t$)
Declare chargeformat()
Declare Capture_Listicon(linetext)
Declare Capture_Listicon2(linetext)
Declare Insert_Listicon(tmp$,u)
Declare ChargeListicon()
Declare ChargeListicon2()
Declare SauveListicon(typ,c)
Declare GetSubItem(hwnd)
Declare Full_Scrol(y) 
Declare copier_pressepapier(linetext)
Declare coller_pressepapier(v)
Declare Ligne_in_Titre(linetext)
Declare Titre_in_Ligne()
Declare efface_ligne(linetext) 
Declare.s InputRequesterOkCancel(Title$,Message$,DefaultString$)
Declare CompareFunc(*item1.PB_ListIconItem,*item2.PB_ListIconItem,lParamSort)
Declare CompareFunc_checkbox(*item1.PB_ListIconItem,*item2.PB_ListIconItem,lParamSort) 
Declare CompareFuncText(*item1.PB_ListIconItem,*item2.PB_ListIconItem,lParamSort)
Declare ShowItemData(coln)
Declare BackupItemData()
Declare RestoreItemData()
Declare KillFocus()
Declare DrawRectangle(hwnd, *rct.RECT) 
Declare EditProc(hwnd, uMsg, wParam, lParam) 
Declare LViewProc(hwnd, uMsg, wParam, lParam) 
Declare WndProc(hwnd, uMsg, wParam, lParam) 
Declare ajouteligne()
Declare paramlisticon()
Declare windows_listicon()

FontReg = LoadFont(1, "Tahoma", 9) 
FontBold = LoadFont(2, "Tahoma", 9, #PB_Font_Bold) 
chemingeo$= #PB_Compiler_Home + "Liste_Seismes.csv"
;}

Procedure LoWord(value) 
  ProcedureReturn value & $FFFF 
EndProcedure 

Procedure HiWord(value) 
  ProcedureReturn value >> 16 & $FFFF 
EndProcedure 

Procedure Width_text(t$)            ; calcul width colonne avec texte
  CreateImage(0, 50, 50 )
  StartDrawing(ImageOutput(0))
  z=TextWidth(t$)
  StopDrawing()
  FreeImage(0)
  ProcedureReturn z 
EndProcedure 

Procedure chargeformat()   ; calcul du nombre de colonne du fichier / calculating the number of file column 
  
  If ReadFile(#Geo_file,chemingeo$)<>0:         ; lecture du fichier de données : format - read file
    list_col$=ReadString(#Geo_file,#PB_Ascii)
    CloseFile(#Geo_file) 
    
    Colonne_defaut=CountString(list_col$,Chr(#SC))+1         ; compter les separateurs  de colonnes / account the column dividers
    Colonne(0)\cnom="#"                                    ; ajout du signe "#" pour marquer la colonne checkbox
    ; adding the "#" sign To mark the checkbox column
    Colonne(0)\CWidth=Width_text(Colonne(0)\cnom+Space(4)) ; largeur colonne "#" défault width
    list_col$=""
    For u=1 To Colonne_defaut 
      Colonne(u)\cnom=UCase(Chr(64+u))+Space(4)             ; names in columns A, B, C, D, etc ... 
      Colonne(u)\CWidth=Width_text(Colonne(u)\cnom)         ; largeur par default width
      list_col$+Chr(#SC)+Colonne(u)\cnom       ; conversion des colonnes en lignes pour listicon /converting columns to rows listicon
    Next u
    
  Else       ; new fichier.... default 
    
    Colonne_defaut=6                                     ; nombres de colonne / number of columns
    Colonne(0)\cnom="#": Colonne(0)\CWidth=Width_text(Colonne(0)\cnom+Space(4))          ; colonne 0 default
    For u=1 To Colonne_defaut
      Colonne(u)\cnom=Space(40)+UCase(Chr(65+u)): Colonne(u)\CWidth=Width_text(Colonne(u)\cnom)
      list_col$+Chr(#SC)+Colonne(u)\cnom
    Next u
    list_col$="#"+list_col$                     ; header mini
  EndIf 
  
EndProcedure

chargeformat()
; ########################  Formattage du gadget listicon  #################################

Procedure Capture_Listicon(linetext) ; capture line
  
  For w=1 To Colonne_defaut
    Tmp$+GetGadgetItemText(#Geo_ListGadget,linetext,w)+Chr(#LF)
  Next w
  If Left(tmp$,1)<>"#" ; "#" = no titre 
    Tmptext$=Left(Tmp$,Len(tmp$)-1)   
  EndIf
  
EndProcedure

; ################# écriture des données formattées dans    write the data formatted in listicon  ##########################


Procedure Insert_Listicon(tmp$,u)    ; constante "#SC" symbol ASCII 59 hex=$3B 
  
  ;Remplace le separateur "#SC" ";" par "#LF" pour etre compatible avec le gadget listicon 
  ;Replaces the separator "# SC" "," With "# LF" To be compatible With the gadget listicon
  
  Tmptext$=Right(ReplaceString(tmp$, Chr(#SC),Chr(#LF),1),Len(tmp$)-1) ; enleve le fin de ligne
  
  SetGadgetItemState(#Geo_ListGadget,u,Val(Left(Tmp$,1)))    ; active checkbox si = 2;
  
  AddGadgetItem(#Geo_ListGadget,-1,Tmptext$)    ; écriture dans header listicon, write
  
EndProcedure

Procedure chargefichier()
  
  If ReadFile(#Geo_file,chemingeo$)<>0:u=0          ; lecture du fichier de données- read file
    While Eof(#Geo_file)=0
      tmp$=ReadString(#Geo_file,#PB_Ascii)
      tmp$="0;"+tmp$                             ; ckeckbox a zero
      If Len(tmp$) => Colonne_defaut+1            ; test contenu des cellules
        Insert_Listicon(tmp$,u)
      EndIf
      u+1
    Wend  
    CloseFile(#Geo_file) 
  EndIf 
EndProcedure 

Procedure sauvefichier(typ)
  
  If typ=0
    chemingeo$=ReplaceString(chemingeo$,".txt",".csv") 
  Else
    chemingeo$=ReplaceString(chemingeo$,".csv",".txt")
  EndIf
  CreateFile(#Geo_file,chemingeo$)
  
  For u=0 To CountGadgetItems(#Geo_ListGadget)
    Capture_Listicon(u)
    Tmp$=ReplaceString(Tmptext$, Chr(#LF),Chr(#SC1),1)
    If Len(tmp$) => Colonne_defaut+1                     ; test contenu des cellules
      WriteStringN(#Geo_file,Tmp$)
    EndIf
  Next u     
  
  CloseFile(#Geo_file)
  
EndProcedure 

Procedure GetSubItem(hwnd)       
  Static pInfo.LVHITTESTINFO
  GetCursorPos_(@p.POINT)
  ScreenToClient_(hwnd, p)
  pInfo\pt\x = p\x
  pInfo\pt\y = p\y
  SendMessage_(hwnd,#LVM_SUBITEMHITTEST,0,@pInfo)
  ProcedureReturn @pInfo
EndProcedure

Procedure Full_Scrol(y)
  
  KillFocus() 
  SendMessage_(ListGadget,#LVM_GETITEMRECT,0,rc.Rect)
  If y=1
    SendMessage_(ListGadget,#LVM_SCROLL,0,((rc\bottom - rc\top)*(CountGadgetItems(#Geo_ListGadget)+1)))
  Else
    SendMessage_(ListGadget,#LVM_SCROLL,0,y-((rc\bottom - rc\top)*(CountGadgetItems(#Geo_ListGadget)+1)))
  EndIf
  
EndProcedure

Procedure copier_pressepapier(linetext)
  
  Capture_Listicon(linetext)
  SetClipboardText(Tmptext$)        ; line listicon to clipboard  include séparator 
  
EndProcedure

Procedure coller_pressepapier(v)
  
  Tmp$="0"+Chr(#LF)+GetClipboardText()           ; clipboard to listicon
  If v=0                                                      ;copy en home
    SetGadgetItemState(#Geo_ListGadget,0,Val(Left(Tmp$,1)))   
    AddGadgetItem(#Geo_ListGadget,0,Tmp$)
  Else                                                       ;copy en bottom
    SetGadgetItemState(#Geo_ListGadget,CountGadgetItems(#Geo_ListGadget),Val(Left(Tmp$,1)))
    AddGadgetItem(#Geo_ListGadget,CountGadgetItems(#Geo_ListGadget),Tmp$)  
  EndIf
  
EndProcedure

Procedure Ligne_in_Titre(linetext)                         ;copy line x to name header
  
  For u=1 To Colonne_defaut
    Tmp$=GetGadgetItemText(#Geo_ListGadget,linetext,u)
    SetGadgetItemText(#Geo_ListGadget,-1,Tmp$,u)
  Next u
  
  ; RemoveGadgetItem(#Geo_ListGadget,linetext) 
  ; RemoveGadget attention sans test repetition  dangereuse
  ; RemoveGadget attention without repetition test dangerous
  
EndProcedure

Procedure Titre_in_Ligne()                         ;copy name header  to line 0
  
  SetGadgetItemState(#Geo_ListGadget,0,Val(Left(Tmp$,1)))
  Tmp$=""
  For u=1 To Colonne_defaut
    Tmp$+GetGadgetItemText(#Geo_ListGadget,-1,u)+Chr(#LF)
  Next u
  Tmp$=Left(Tmp$,Len(tmp$)-1)
  
  AddGadgetItem(#Geo_ListGadget,0,"0"+Chr(#LF)+Tmp$)
  Full_scrol(0)
  For u=1 To Colonne_defaut
    SetGadgetItemText(#Geo_ListGadget,-1,UCase(Chr(64+u))+Space(4),u)
  Next u
  
EndProcedure

Procedure efface_ligne(linetext)                   ; delete line  
  
  Resultat=MessageRequester(" ATTENTION ","    EFFACE LA LIGNE"+Chr(13)+Chr(13)+"    DELETE LINE",#PB_MessageRequester_YesNo)
  If Resultat=6
    RemoveGadgetItem(#Geo_ListGadget,linetext)
  EndIf 
  
EndProcedure

Procedure.s InputRequesterOkCancel(Title$,Message$,DefaultString$)  ;Auteur christiansen
  
  Protected Result$, Window, String, OK, Cancel      
  WindowR = OpenWindow(#Geo_WindowReq,0,0,300,95,Title$,#PB_Window_ScreenCentered) 
  TextGadget(#PB_Any,10,10,280,20,Message$)
  String  = StringGadget(#PB_Any,10,30,280,20,DefaultString$): SetActiveGadget(String)
  OK      = ButtonGadget(#PB_Any,60,60,80,25,"OK",#PB_Button_Default)
  Cancel  = ButtonGadget(#PB_Any,150,60,80,25,"Cancel")
  Repeat
    If WaitWindowEvent() = #PB_Event_Gadget
      If EventGadget() = OK
        Result$ = GetGadgetText(String)
        Break
      ElseIf EventGadget() = Cancel
        Result$ = ""
        Break
      EndIf
    EndIf
    If GetKeyState_(#VK_RETURN) > 1
      ResultR$ = GetGadgetText(String)
      Break
    EndIf
  ForEver
  CloseWindow(#Geo_WindowReq)
  ProcedureReturn Result$
  
EndProcedure

Procedure CompareFunc(*item1.PB_ListIconItem, *item2.PB_ListIconItem, lParamSort) 
  
  ;new tri positif/negatif on numbers , sort
  Protected x,t1.d,t2.d
  
  t1=ValD(GetGadgetItemText(#Geo_ListGadget,*item1\userdata,lparamsort))
  t2=ValD(GetGadgetItemText(#Geo_ListGadget,*item2\userdata,lparamsort))
  
  If t1<t2
    x=2
  Else
    x=0
  EndIf
  
  ProcedureReturn (updown+1)!x-1
  
EndProcedure  

Procedure CompareFunc_checkbox(*item1.PB_ListIconItem, *item2.PB_ListIconItem, lParamSort)   
  ;new tri checkbox , sort
  Protected x,t1.d,t2.d
  
  t1=GetGadgetItemState(#Geo_ListGadget,*item1\userdata)
  t2=GetGadgetItemState(#Geo_ListGadget,*item2\userdata)
  
  If t1>t2
    x=2
  Else
    x=0
  EndIf
  
  ProcedureReturn (updown+1)!x-1
  
EndProcedure   

Procedure CompareFuncText(*item1.PB_ListIconItem, *item2.PB_ListIconItem, lParamSort)
  
  Protected x
  ;tri tout, all sort 
  ;If GetGadgetItemText(#Geo_ListGadget,*item1\userdata,lparamsort)<GetGadgetItemText(#Geo_ListGadget,*item2\userdata,lparamsort)
  ;tri en capitales ; sort
  If UCase(GetGadgetItemText(#Geo_ListGadget,*item1\userdata,lparamsort))<UCase(GetGadgetItemText(#Geo_ListGadget,*item2\userdata,lparamsort))
    x=2
  Else
    x=0
  EndIf
  
  ProcedureReturn (updown+1)!x-1
  
EndProcedure
Procedure ShowItemData(coln)
  Protected i
  For i=0 To CountGadgetItems(#Geo_ListGadget)
    SetGadgetItemText(#Geo_ListGadget,i,Str(GetGadgetItemData(#Geo_ListGadget,i)),coln)
  Next i
EndProcedure
Procedure BackupItemData()
  
  Protected i
  i=CountGadgetItems(#Geo_ListGadget);   i=SendMessage_(GadgetID(#Geo_ListGadget),#LVM_GETITEMCOUNT,0,0)
  
  While i
    i-1
    GadgetData(i)\DataValue=GetGadgetItemData(#Geo_ListGadget,i);  History-Zeiger in Array sichern
    SetGadgetItemData(#Geo_ListGadget,i,i);                        Zeilenwert für Sortierung in Listgadget speichern
  Wend
  
EndProcedure

Procedure RestoreItemData()
  
  Protected i
  
  i=CountGadgetItems(#Geo_ListGadget);   i=SendMessage_(GadgetID(#Geo_ListGadget),#LVM_GETITEMCOUNT,0,0)
  While i
    i-1
    GadgetData(i)\DataPosition=GetGadgetItemData(#Geo_ListGadget,i);   Sortierte Zeilenwerte kurzfristig merken
  Wend
  
  i=CountGadgetItems(#Geo_ListGadget);   i=SendMessage_(GadgetID(#Geo_ListGadget),#LVM_GETITEMCOUNT,0,0)
  While i
    i-1;                                                             History-Zeiger wirder zurück in das ListIconGadget schr
    SetGadgetItemData(#Geo_ListGadget,i,GadgetData(GadgetData(i)\DataPosition)\DataValue)
  Wend
  
EndProcedure

Procedure KillFocus() 
  If hEdit 
    SetGadgetItemText(#Geo_ListGadget, CurItem, GetGadgetText(#Geo_GadgetText), CurSubItem) 
    FreeGadget(#Geo_GadgetText) 
    hEdit = 0 
  EndIf 
EndProcedure 

Procedure DrawRectangle(hwnd, *rc.RECT) 
  hDC = GetDC_(hwnd) 
  OldPen = SelectObject_(hDC, GetStockObject_(#LTGRAY_BRUSH)) ;#BLACK_PEN #LTGRAY_BRUSH #GRAY_BRUSH #DKGRAY_BRUSH
  OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH))
  SelectObject_(hdc,Oldbrush)
  nDrawMode=SetROP2_(hDC,9)   ;5,9,14 autres mode sympa      
  Rectangle_(hDC, *rc\left, *rc\top, *rc\right, *rc\bottom) 
  SetROP2_(hdc,nDrawMode)
  SelectObject_(hDC, OldPen) 
  DeleteObject_(OldBrush)
  DeleteObject_(OldPen)
  ReleaseDC_(hwnd, hDC) 
EndProcedure 

Procedure EditProc(hwnd, uMsg, wParam, lParam) 
  result = 0 
  Select uMsg 
    Case #WM_KEYDOWN 
      result = CallWindowProc_(OldEditProc, hwnd, uMsg, wParam, lParam) 
      If wParam=#VK_RETURN 
        KillFocus() 
      EndIf 
    Default 
      result = CallWindowProc_(OldEditProc, hwnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure LViewProc(hwnd, uMsg, wParam, lParam)
  result = 0 
  Select uMsg 
    Case #WM_LBUTTONDBLCLK
      If hwnd<>hEdit
        KillFocus() 
        *pInfo.LVHITTESTINFO = GetSubItem(hwnd)
        rc.RECT 
        rc\top = *pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        If *pInfo\iItem<>-1                                          ; empeche Saisie header / stop header entry
          SendMessage_(hwnd, #LVM_GETSUBITEMRECT, *pInfo\iItem, rc) 
          If hEdit=0 And *pInfo\iSubItem>0
            UseGadgetList(hwnd) 
            CurItem = *pInfo\iItem 
            CurSubItem = *pInfo\iSubItem 
            Text$ = GetGadgetItemText(#Geo_ListGadget, CurItem, CurSubItem) 
            If CurSubItem=0 
              rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH,0 , 0) 
            EndIf 
            hEdit = StringGadget(#Geo_GadgetText, rc\left+1, rc\top, rc\right-rc\left-1, rc\bottom-rc\top-1, Text$, #PB_String_BorderLess) 
            If CurSubItem=0 
              ; SendMessage_(hEdit, #WM_SETFONT, FontBold, #True) ; police
              SendMessage_(hEdit, #WM_SETFONT, FontReg, #True) 
            Else 
              SendMessage_(hEdit, #WM_SETFONT, FontReg, #True) 
            EndIf 
            OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc()) 
            SetFocus_(hEdit)
          EndIf 
        EndIf
      Else 
        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_RBUTTONDOWN
      If hwnd<>hEdit
        KillFocus() 
        *pInfo.LVHITTESTINFO = GetSubItem(hwnd)
        rc.RECT 
        rc\top = *pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, *pInfo\iItem, rc) 
        rc\left+1 
        rc\bottom-1 
        If CellSelectOn 
          InvalidateRect_(hwnd, rct, #True) 
        EndIf
        CellSelectOn = 1 
        CurSelItem = *pInfo\iItem 
        CurSelSubItem = *pInfo\iSubItem 
        If CurSelSubItem=0 
          rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
        EndIf 
        If *pInfo\iSubItem>0 
          DrawRectangle(hwnd, rc) 
          CopyMemory(rc, rct, SizeOf(RECT)) 
        EndIf
        If DisplayPopupMenu(#Geo_PopMenu,WindowID(#Geo_Window))   ; Popmenu
          linetext=*pInfo\iItem                                   ; cellule numbers
          coln=*pInfo\iSubItem                                    ; colonne numbers
          KillFocus()   
          InvalidateRect_(hwnd, rct, #True) 
        EndIf
      Else 
        SetFocus_(hEdit) 
        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      EndIf     
    Case #WM_LBUTTONDOWN
      If hwnd<>hEdit 
        KillFocus() 
        *pInfo.LVHITTESTINFO = GetSubItem(hwnd)
        rc.RECT 
        rc\top = *pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, *pInfo\iItem, rc) 
        rc\left+1 
        rc\bottom-1 
        If CellSelectOn 
          InvalidateRect_(hwnd, rct, #True) 
        EndIf
        CellSelectOn = 1 
        CurSelItem = *pInfo\iItem 
        CurSelSubItem = *pInfo\iSubItem 
        If CurSelSubItem=0 
          rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
        EndIf 
        linetext=*pInfo\iItem   
        If *pInfo\iSubItem>0  
          DrawRectangle(hwnd, rc) 
          CopyMemory(rc, rct, SizeOf(RECT))      
        Else
          If SendMessage_(hwnd, #LVM_GETSUBITEMRECT, *pInfo\iItem, rc)<>0  ; test  no select all checkbox to clic listicon
            If GetGadgetItemState(#Geo_ListGadget,*pInfo\iItem)=2
              SetGadgetItemState(#Geo_ListGadget,*pInfo\iItem,0)
            Else
              SetGadgetItemState(#Geo_ListGadget,*pInfo\iItem,2)
            EndIf
          EndIf
        EndIf
      Else 
        SetFocus_(hEdit) 
        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_CTLCOLOREDIT 
      If GetFocus_()=lParam 
        SetBkMode_(wParam, #TRANSPARENT) 
        If CurItem&1=0 
          TextBkColor = RGB(160, 230, 240)     ; color back entry
          If CurSubItem=<6 
            TextColor = RGB(255, 0, 0)         ; color entry
          EndIf 
        Else 
          TextBkColor = RGB(160, 230, 220)     ; color back entry
          If CurSubItem=<6 
            TextColor = RGB(255, 0, 0)         ; color entry
          EndIf 
        EndIf 
        SetTextColor_(wParam, TextColor) 
        result = CreateSolidBrush_(TextBkColor)  
      Else 
        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_VSCROLL 
      result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      rc.RECT 
      TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
      If CellSelectOn 
        rc\top = CurSelSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
        rct\top = rc\top 
        rct\bottom = rc\bottom-1 
        If TopVisibleItem<=CurSelItem 
          DrawRectangle(hwnd, rct) 
        EndIf 
      EndIf 
      If hEdit 
        If TopVisibleItem<=CurItem 
          ResizeGadget(#Geo_GadgetText,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore) 
          HideGadget(#Geo_GadgetText, #False) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(#Geo_GadgetText, #True) 
        EndIf 
        SetFocus_(hEdit) 
      EndIf 
    Case #WM_HSCROLL 
      result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      rc.RECT 
      TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, CountGadgetItems(#Geo_ListGadget), 0) 
      If CellSelectOn 
        rc\top = CurSelSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
        rct\left = rc\left+1 
        rct\right = rc\right 
        If TopVisibleItem<=CurSelItem 
          DrawRectangle(hwnd, rct) 
        EndIf 
      EndIf 
      If hEdit 
        If TopVisibleItem<=CurItem 
          ResizeGadget(#Geo_GadgetText, rc\left,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
          HideGadget(#Geo_GadgetText, #False) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(#Geo_GadgetText, #True) 
        EndIf 
        SetFocus_(hEdit) 
      EndIf 
    Default 
      result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure WndProc(hwnd, uMsg, wParam, lParam) 
  result = #PB_ProcessPureBasicEvents
  If IsWindow(#Geo_Window)
    GetClientRect_(WindowID(#Geo_Window),w.RECT)
    Select uMsg 
      Case #WM_NOTIFY 
        Protected *msg.NMHDR = lParam
        If *msg\hwndFrom = ListGadget And *msg\code = #LVN_COLUMNCLICK
          Protected *pnmv.NM_LISTVIEW = lParam
          If lastcol<>*pnmv\iSubItem
            updown=1
          EndIf
          BackupItemData()
          If *pnmv\iSubItem=1 Or *pnmv\iSubItem=3 ; colonne tri numbers sort
            SendMessage_(ListGadget, #LVM_SORTITEMS,*pnmv\iSubItem,@CompareFunc())
          ElseIf *pnmv\iSubItem=0                 ; colonne tri checkbox sort
            SendMessage_(ListGadget, #LVM_SORTITEMS,*pnmv\iSubItem,@CompareFunc_checkbox())
          Else                                    ; colonne tri texte   sort
            SendMessage_(ListGadget, #LVM_SORTITEMS,*pnmv\iSubItem,@CompareFuncText())
          EndIf
          RestoreItemData()
          ShowItemData(Colonne_defaut+1)
          UpdateWindow_(WindowID(#Geo_Window))
          lastcol = *pnmv\iSubItem
          updown*-1
        EndIf
        *pnmh.NMHDR = lParam 
        Select *pnmh\code 
          Case #NM_CUSTOMDRAW 
            *LVCDHeader.NMLVCUSTOMDRAW = lParam 
            *nmhdr.NMHDR = lParam
            If *LVCDHeader\nmcd\hdr\hWndFrom=ListGadget 
              Select *LVCDHeader\nmcd\dwDrawStage 
                Case #CDDS_PREPAINT 
                  result = #CDRF_NOTIFYITEMDRAW 
                Case #CDDS_ITEMPREPAINT 
                  result = #CDRF_NOTIFYSUBITEMDRAW 
                Case #CDDS_SUBITEMPREPAINT 
                  Row = *LVCDHeader\nmcd\dwItemSpec 
                  Col = *LVCDHeader\iSubItem 
                  If Col=6 
                    SelectObject_(*LVCDHeader\nmcd\hDC, FontBold)    ;police 
                    ;SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
                  Else 
                    SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
                  EndIf 
                  If Row&1=0 
                    *LVCDHeader\clrTextBk = RGB(255, 255, 223) 
                    *LVCDHeader\clrText = RGB(0, 0, 0)        
                  EndIf
                  If col=1    ;changement de couleur en fonction du texte ; color change based on the text
                    If GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,1)<>""
                      If UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,2))="E"
                        *LVCDHeader\clrText = RGB(0, 0, 255)
                      Else
                        *LVCDHeader\clrText = RGB(255, 0, 0)
                      EndIf
                    EndIf 
                  EndIf
                  If col=2
                    If UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,2))="E"
                      *LVCDHeader\clrText = RGB(0, 0, 255)
                    Else
                      *LVCDHeader\clrText = RGB(255, 0, 0)
                    EndIf 
                  EndIf
                  If col=3
                    If GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,3)<>""
                      If UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,4))="N"
                        *LVCDHeader\clrText = RGB(0, 0, 255)
                      Else
                        *LVCDHeader\clrText = RGB(255, 0, 0)
                      EndIf 
                    EndIf 
                  EndIf
                  If col=4
                    If UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,4))="N"
                      *LVCDHeader\clrText = RGB(0, 0, 255)
                    Else
                      *LVCDHeader\clrText = RGB(255, 0, 0)
                    EndIf 
                  EndIf
                  If col=5
                    If UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,5))="R"
                      *LVCDHeader\clrText = RGB(255, 0, 0)   ;rouge  / Red
                    ElseIf UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,5))="V"
                      *LVCDHeader\clrText = RGB(0,255, 0)    ;vert   / green
                    ElseIf UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,5))="B"
                      *LVCDHeader\clrText = RGB(0,0, 255)    ;bleu  / blue
                    ElseIf UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,5))="J"
                      *LVCDHeader\clrText = RGB(255,150,150) ;orange 
                    ElseIf UCase(GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,5))="C"
                      *LVCDHeader\clrText = RGB(255,0,255)   ;violet   
                    Else
                      *LVCDHeader\clrText = RGB(0,0,0)       ;noir 
                    EndIf 
                  EndIf
                  If col=6
                    If GetGadgetItemText(#Geo_ListGadget,*LVCDHeader\nmcd\dwItemSpec ,6)<>""
                      *LVCDHeader\clrText = RGB(0, 0, 0)
                    EndIf 
                  EndIf
                  result = #CDRF_NEWFONT 
              EndSelect 
            EndIf 
        EndSelect 
    EndSelect 
  EndIf
  ProcedureReturn result 
EndProcedure 

Procedure ajouteligne()
  
  For u=1 To Colonne_defaut 
    tmp$=Chr(#SC)+Space(Colonne(u)\CWidth) +":"+StrD(Width_text(Colonne(u)\cnom))+Space(4)
  Next u
  tmp$+Chr(#SC)
  AddGadgetItem(#Geo_ListGadget,-1,tmp$)
  Full_scrol(1)   ; 1 = affiche la ligne de saisie avec le scroll / 1 = shows the input line with the scroll
  
EndProcedure 

Procedure  paramlisticon()
  
  hHeader_ListGadget = SendMessage_(ListGadget, #LVM_GETHEADER, 0, 0) ; drag drop colonne # ajouter l'option listicon
  
  SendMessage_(ListGadget, #CCM_SETVERSION, 5, 0) 
  
  SendMessage_(ListGadget, #LVM_SETBKCOLOR, 0, RGB(255, 255, 223)) 
  
  updown = 1
  lastcol = 0
  
  ShowItemData(Colonne_defaut+1)
  SendMessage_(ListGadget,#WM_SETREDRAW,#True,0)
  
  For u=1 To Colonne_defaut 
    SendMessage_(ListGadget, #LVM_SETCOLUMNWIDTH, u, #LVSCW_AUTOSIZE_USEHEADER) 
  Next u 
  
EndProcedure 

Procedure windows_listicon()
  If OpenWindow(#Geo_Window, 0, 0,700, 290, "COORDONNEES GEOGRAPHIQUES DES SEISMES ", #PB_Window_ScreenCentered|#PB_Window_SystemMenu| #PB_Window_MinimizeGadget| #PB_Window_MaximizeGadget | #PB_Window_SizeGadget|#PB_Window_Invisible)=0:End:EndIf 
  If CreatePopupMenu(#Geo_PopMenu) 
    MenuItem(1,"Copier la Ligne       Ctrl+C") 
    MenuItem(2,"Coller Fin/Last       Ctrl+V")
    MenuItem(3,"Coller Haut/Home     ")
    MenuBar()
    MenuItem(4,"Edit Nom Colonne ")
    MenuBar()
    MenuItem(5,"Copy Ligne > Titre")
    MenuItem(6,"Titre > Ligne 0 ")
    MenuBar()
    MenuItem(10,"Efface la ligne")                    ;delete line 
  EndIf 
  
  ButtonGadget(#Geo_bouton1,180,250,140,30,"Ajouter une Ligne  (+line)")
  ButtonGadget(#Geo_bouton2,350,250,140,30,"Sauver txt")  ; 
  ButtonGadget(#Geo_bouton3,40,250,70,30,"Scroll_Top")
  ButtonGadget(#Geo_bouton4,560,250,100,30,"Sauver csv")  ; csv sauve pas les noms de colonnes
  
  
  ListGadget = ListIconGadget(#Geo_ListGadget, 10, 10, 680, 230,"", 150,1342242825) ;   1342242825 code gadget options 
  
  ; ########################  Formattage du gadget listicon  ##############
  
  For u=0 To Colonne_defaut           ; place les colonnes et leurs titres
    AddGadgetColumn(#Geo_ListGadget, u, Colonne(u)\cnom,Colonne(u)\CWidth)
  Next u
  RemoveGadgetColumn(#Geo_ListGadget,u) 
  
  chargefichier()
  
  paramlisticon()
  
  OldLViewProc = SetWindowLong_(ListGadget, #GWL_WNDPROC, @LViewProc()) 
  SetWindowCallback(@WndProc()) 
  
  HideWindow(#Geo_Window,0)
  
  ;SetActiveGadget(#Geo_ListGadget)
  
  Repeat 
    eventlist=WaitWindowEvent()
    If eventlist = #WM_KEYDOWN  ;  = 1 key press > GetAsyncKeyState
      If (GetAsyncKeyState_(#VK_LCONTROL)&32768) And  (GetAsyncKeyState_(#VK_C)&32768)
        copier_pressepapier(linetext)  ; copier
      EndIf 
      If (GetAsyncKeyState_(#VK_LCONTROL)&32768) And  (GetAsyncKeyState_(#VK_V)& 32768)
        coller_pressepapier(1)          ; coller
        Full_scrol(1)
      EndIf 
    EndIf 
    Select eventlist
      Case #PB_Event_Gadget
        Select EventGadget()
            
          Case #Geo_bouton1
            
            ajouteligne()
            
          Case #Geo_bouton2                 ; sortie avec sauvegarde des données txt ; quit write
            
            sauvefichier(1)
            
          Case    #Geo_bouton3
            
            Full_scrol(0)                     ;0 = scroll en haut / 0 = scroll Top
            
          Case #Geo_bouton4                 ; sortie avec sauvegarde des données csv ; quit write
            
            sauvefichier(0)
            
        EndSelect 
        
      Case #PB_Event_Menu 
        Select EventMenu()  
          Case 1
            copier_pressepapier(linetext)
          Case 2  
            coller_pressepapier(1)
            Full_scrol(1)
          Case 3  
            coller_pressepapier(0)
            Full_scrol(0)
          Case 4   
            Colonne(coln)\cnom=InputRequesterOkCancel("Renomme Colonne","Entrer le  Nom:","")
            SetGadgetItemText(#Geo_ListGadget,-1,Colonne(coln)\cnom,coln)
          Case 5  
            Ligne_in_titre(linetext)
          Case 6  
            Titre_in_Ligne()
          Case 10
            Efface_ligne(linetext)
        EndSelect 
        
      Case #PB_Event_SizeWindow 
        
        ResizeGadget(#Geo_ListGadget,#PB_Ignore,#PB_Ignore,WindowWidth(#Geo_Window)-20,WindowHeight(#Geo_Window)-60)
        ; resize boutons
        ResizeGadget(#Geo_bouton3,WindowWidth(#Geo_Window)/18,WindowHeight(#Geo_Window)-40,WindowWidth(#Geo_Window)/10,30)
        ResizeGadget(#Geo_bouton1,WindowWidth(#Geo_Window)/5,WindowHeight(#Geo_Window)-40,WindowWidth(#Geo_Window)/4,30)
        ResizeGadget(#Geo_bouton2,WindowWidth(#Geo_Window)/2,WindowHeight(#Geo_Window)-40,WindowWidth(#Geo_Window)/4,30)
        ResizeGadget(#Geo_bouton4,WindowWidth(#Geo_Window)/1.25,WindowHeight(#Geo_Window)-40,WindowWidth(#Geo_Window)/7,30)
        
      Case #PB_Event_CloseWindow       ; test oui/non = pour sauvegarde des données /  test yes/no = for write donnée
        
        Resultat=MessageRequester(" QUITTER ","     OUI   = Avec Sauvegarde / Save"+Chr(13)+"     NON = Sans Sauvegarde / No Save",#PB_MessageRequester_YesNo)
        If Resultat=6
          sauvefichier(1)
          quit=1
        Else 
          quit=1
        EndIf  
    EndSelect 
  Until quit=1
  DestroyWindow_(#Geo_Window)
  CloseWindow(#Geo_Window)
EndProcedure


;-"Test Listicon Callback"
OpenWindow(990, 20, 20,200, 70, "Test Listicon Callback", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

ButtonGadget(991,30,20,50,30,"List")
ButtonGadget(992,120,20,50,30,"Quit")  ; 

Repeat
  Event= WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget() 
        Case 991
          windows_listicon()
        Case 992
          Break
      EndSelect   
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver
End    

Le séparateur est maintenant le point virgule code Ascii: 59 ";"

nom du fichier: Liste_Seismes.csv

Code : Tout sélectionner

Longitude   ;±;Latitude    ;±;C;nom du lieu
147.2900    ;O;61.0300     ;N;R;Alaska Anchorage          27/03/1964 17.36h locale
72.4308     ;O;35.5046     ;S;R;Chili Conception          27/02/2010  3.34h locale
73.0300     ;O;38.1700     ;S;B;Chili Valdivia            22/05/1960 15.11h locale
72.3159     ;O;18.2725     ;N;R;Haiti Port-au-prince      12/12/2010 16.53h locale
142.2208    ;E;38.1919     ;N;C;Japon Tohoku Tsunami      11/03/2011 14.46h locale
102.3200    ;O;18.1100     ;N;J;Mexique Mexico            19/09/1985  7.19h locale
73.3824     ;O;16.1536     ;S;J;Perou Arequipa            23/06/2001 15.33h locale
96.0000     ;E; 3.0300     ;N;C;Sumatra Andaman Tsunami   26/12/2004  7.59h locale
122.3300    ;O;37.4500     ;N;V;USA San Franscico         18/04/1906  5.12h locale

[Kwai chang caine]

Super belle ta GRID, Classe, distinguées

Vraiment merci, car c'est un GADGET qu'on a de plus en plus besoin pour se la jouer EXCEL, et y'a pas foule dans ce genre de codes
SROD en a créé une d'enfer en LIB, mais faut payer

Y'en a quelques autres aussi, mais sincèrement, la tienne est trop bien
Tout y est l'auto-resize des colonnes en double-clic, le classement alpha (Juste peut être il manque qu'a chaque clic ça change le classement, mais bon), et évidement modifiable ça manque trop a l'original

Donc encore bravo et surtout merci du partage

[kernadec]

merci KCC
c'est trop d'honneur, ce n'est qu'une modeste compile
pour la grille les compliments reviennent à Mr Elchoni

Cordialement

[kernadec]

bonsoir
Voilà, comme je n'étais pas satisfait de la procédure pour le tri des nombres!
et ayant retrouvé un code de tri amélioré de Mickaël Vogel et Lord en 2009

mais toujours avec ce problème pour le tri des nombres négatifs....
Alors, J'ai Modifié la procédure en plus simple..
et remis le code à jour avec ses nouvelles procédures.

Cordialement

[Kwai chang caine]

Encore merci

[GallyHC]

Bonjour,

Je penses que cela me sera utile rapidement , merci

Cordialement,
GallyHC

[kernadec]

j'avais zappé le tri des checkboxs
voilà.. c'est fait, code mis à jour

Cordialement

[Kwai chang caine]

J'ai compris.....tu te lasses pas que je te remercie
Et ben pas de chance...moi non plus..alors merci beaucoup

[kernadec]

merci kcc, content que cette compile te fasse plaisir..
je viens de corriger un ptit truc embêtant, quand on cliquait sous la colonne des checkboxs
il y avait une sélection globale des checkboxs......
j'ai mis un petit test pour que ça n'arrive plus...
code mis à jour

Cordialement

[Kwai chang caine]

merci kcc, content que cette compile te fasse plaisir..

C'est super utile, pour "quinquin" qui fait que des utilitaires, bien souvent il a besoin de "carré" pour mettre des choses dedans
Et pis...si on veux concurrencer CROCRO...t'es obligé d'avoir l'equivalent de son logiciel phare


C'est trop bon..je vais pourvoir encore une fois te remercier
Voila donc une journée qui commence bien

Et n'hésite pas à remettre des fonctions...j'ai assez d'affection et d'admiration pour toi, ton grand savoir, tu le sais , pour pouvoir te remercier..disons ....encore 10 ans tous les jours

[kernadec]

bonjour kcc

merci, tu est vraiment trop..

Pour les options voilà

code mis à jour

Cordialement

[Kwai chang caine]

Bon au debut, "j'm'ai dit" KERNADEC il a fait un joli code pour faire une fonction simple dans un de ses codes, et il en fait profiter les copains
Mais au fil de la flotte....enfin de l'eau....je commence à sentir monter en toi le plaisir de réaliser un truc de ouf style PBI qui va bien, et qui permettrait d'avoir juste en rajoutant la ligne IncludeFile la puissance du graphisme d'un tableur (Je ne parle que de la grille principale bien sur)

Alors la...si tu en as le temps...et le coeur t'en dit..tu va pas te faire marcher sur les pieds, y'a un autoroute devant toi...que dis-je....un autoroute...une voie lactée...
Car hors mis SROD qui a fait une LIB payante, je ne crois pas que quelqu'un ai créé un truc de ce genre complet, et en plus en open source ??
A mon avis..mais tu connais sa valeur ....ce serais de la balle

Car à la maniere de l'open source de COMATE qui a ammené à PB la puissance de l'OLE, un PBI comme celui-ci, ammenerais PB dans la cour des grands avec un tableur à sa hauteur...

Mais c'est un travail de titan, c'est d'ailleur pour ça que tout le monde donne une partie des codes des fonctions et s'arrete a quelques unes dont ils ont grand besoin
Puis aussi, et c'est normal, une fois que t'as tant travaillé, ne veulent pas donner le source complet si il existe.

Voila...en attendant..j'ai testé ton nouveau code, et j'ai un plantage a la ligne 416 au procedurereturn

Code : Tout sélectionner

    result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
  EndSelect 
  ProcedureReturn result 

Autre chose, j'avais pas remarqué que le classement pouvait s'inverser car il faut cliquer 2 fois sur l'entete pour que le classement s'inverse

Et si je peux encore dire quelque chose...tu as créé un Sauve..et qu'est ce que tu dirais d'un truc de ouf....que personne n'a jamais pensé dans le monde de la prog ....c'est bon aussi d'etre un précurseur UN LOAD

Autrement...encore une chose que je n'ai encore jamais osé te dire...
MERCI

[kernadec]

n' exagéreront rien, je ne serais jamais
un de ces virtuose, je fais cela pour le fun....

pour le load tu as le chargement d'un fichier auto au départ
un ptit bouton avec un Filerequester') pourraient faire l'affaire.
sinon mettre un entête de fichier qui gèrent les paramétrés de la Listbox

pour le code, voilà corrigé

j'avais essayé un truc à l'arrache, mais bon
c'était pour avoir une bande se sélection avec le clic souris
je l'ai mis en stand by, je vais regarder ça se soir,

Car cet après midi je vais en ville prendre un verre
avec mes copains.

Cordialement

[Kwai chang caine]

pour le load tu as le chargement d'un fichier auto au départ
un ptit bouton avec un Filerequester') pourraient faire l'affaire.
sinon mettre un entête de fichier qui gèrent les paramétrés de la Listbox

Merci je vais regarder

pour le code, voilà corrigé

MERKI !!

Car cet après midi je vais en ville prendre un verre avec mes copains.

Y'en a qui en ont de la chance .....y vont se coucher moins bete ce soir
Attention a la taille du verre..les neurones n'ont jamais appris a nager

[kernadec]

ajout d'un fond gris quand on clique sur un champ

merci ,KCC
aujourd'hui désolé ...
mais j'ai bien rigoler avec jbernard13
et l'autre jour avec dayvid et son Mouais....

Cordialement