PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

ListIconGadget Editable. [RESOLU]

http://forums.purebasic.com/french/viewtopic.php?t=7997

Page 1 sur 1

ListIconGadget Editable. [RESOLU]

Publié : lun. 14/avr./2008 17:02
par MetalOS
Salut le forum, voila tous est dans le titre de ce que je cherche à faire. J'ais chercher dans le forum mais je n'est pas trouver mon bonheur, j'ais trouver un code sur purearea mais un peut compliquer pour moi. Le voici.

Code : Tout sélectionner

; English forum:
; Author: El Choni (updated for PB3.92+ by Andre, updated for PB4.00 by blbltheworm)
; Date: 09. May 2003
; OS: Windows
; Demo: No

Procedure LoWord(value) 
  ProcedureReturn value & $FFFF 
EndProcedure 

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

#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 

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

Declare EditProc(hwnd, uMsg, wParam, lParam) 
Declare LViewProc(hwnd, uMsg, wParam, lParam) 
Declare WndProc(hwnd, uMsg, wParam, lParam) 
Declare KillFocus() 
Declare DrawRectangle(hwnd, *rc.RECT) 

#CCM_SETVERSION = #CCM_FIRST+7 

Global FontReg, FontBold 
FontReg = LoadFont(1, "Tahoma", 9) 
FontBold = LoadFont(2, "Tahoma", 9, #PB_Font_Bold) 

If OpenWindow(0, 0, 0, 400, 260, "Color List View Rows", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)=0:End:EndIf 
If CreateGadgetList(WindowID(0))=0:End:EndIf 

ListGadget = ListIconGadget(1, 10, 10, 380, 240, "", 70, #PB_ListIcon_GridLines|#LVS_NOSORTHEADER) 

SendMessage_(ListGadget, #CCM_SETVERSION, 5, 0) 

AddGadgetColumn(1, 1, "Sun", 35) 
AddGadgetColumn(1, 2, "Mon", 35) 
AddGadgetColumn(1, 3, "Tue", 35) 
AddGadgetColumn(1, 4, "Wed", 35) 
AddGadgetColumn(1, 5, "Thu", 35) 
AddGadgetColumn(1, 6, "Fri", 35) 
AddGadgetColumn(1, 7, "Sat", 35) 

For i=18 To 34 
  hour12 = i 
  If hour12>25 
    hour12-24 
    Hour$ = " pm" 
  Else 
    Hour$ = " am" 
  EndIf 
  If hour12&1 
    Hour$=Str(hour12/2)+":30"+Hour$;LSet(Str(hour12/2)+":30"+Hour$, 9, " ") 
  Else 
    Hour$=Str(hour12/2)+":00"+Hour$;LSet(Str(hour12/2)+":00"+Hour$, 9, " ") 
  EndIf 
  AddGadgetItem(1, -1, Hour$+Chr(10)+Str(hour12/2)+"1"+Chr(10)+Str(hour12/2)+"2"+Chr(10)+Str(hour12/2)+"3"+Chr(10)+Str(hour12/2)+"4"+Chr(10)+Str(hour12/2)+"5"+Chr(10)+Str(hour12/2)+"6"+Chr(10)+Str(hour12/2)+"7") 
Next i 

SendMessage_(ListGadget, #LVM_SETBKCOLOR, 0, RGB(255, 255, 223)) 

CreateGadgetList(ListGadget) 
OldLViewProc = SetWindowLong_(ListGadget, #GWL_WNDPROC, @LViewProc()) 
SetWindowCallback(@WndProc()) 

For i=0 To 7 
  SendMessage_(ListGadget, #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER) 
Next i 

Repeat 
Until WaitWindowEvent()=#PB_Event_CloseWindow 

End 

Procedure KillFocus() 
  If hEdit 
    SetGadgetItemText(1, CurItem, GetGadgetText(2), CurSubItem) 
    FreeGadget(2) 
    hEdit = 0 
  EndIf 
EndProcedure 

Procedure DrawRectangle(hwnd, *rc.RECT) 
  hDC = GetDC_(hwnd) 
  OldPen = SelectObject_(hDC, GetStockObject_(#BLACK_PEN)) 
  OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH)) 
  Rectangle_(hDC, *rc\left, *rc\top, *rc\right, *rc\bottom) 
  SelectObject_(hDC, OldBrush) 
  SelectObject_(hDC, 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 
        pInfo\pt\x = LoWord(lParam) 
        pInfo\pt\y = HiWord(lParam) 
        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
        rc.RECT 
        rc\top = pInfo\iSubItem 
        rc\left = #LVIR_BOUNDS 
        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
        If hEdit=0 
          UseGadgetList(hwnd) 
          CurItem = pInfo\iItem 
          CurSubItem = pInfo\iSubItem 
          Text$ = GetGadgetItemText(1, CurItem, CurSubItem) 
          If CurSubItem=0 
            rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0) 
          EndIf 
          hEdit = StringGadget(2, 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) 
          Else 
            SendMessage_(hEdit, #WM_SETFONT, FontReg, #True) 
          EndIf 
          OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc()) 
          SetFocus_(hEdit) 
        EndIf 
      Else 
        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam) 
      EndIf 
    Case #WM_LBUTTONDOWN 
      If hwnd<>hEdit 
        KillFocus() 
        pInfo.LVHITTESTINFO 
        pInfo\pt\x = LoWord(lParam) 
        pInfo\pt\y = HiWord(lParam) 
        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
        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 
        DrawRectangle(hwnd, rc) 
        CopyMemory(rc, rct, SizeOf(RECT)) 
      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(255, 255, 223) 
          If CurSubItem=3 
            TextColor = RGB(255, 0, 0) 
          EndIf 
        Else 
          TextBkColor = RGB(208, 208, 176) 
          If CurSubItem=3 
            TextColor = RGB(0, 0, 255) 
          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(2,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore) 
          HideGadget(2, #False) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(2, #True) 
        EndIf 
        SetFocus_(hEdit) 
      EndIf 
    Case #WM_HSCROLL 
      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\left = rc\left+1 
        rct\right = rc\right 
        If TopVisibleItem<=CurSelItem 
          DrawRectangle(hwnd, rct) 
        EndIf 
      EndIf 
      If hEdit 
        If TopVisibleItem<=CurItem 
          ResizeGadget(2, rc\left,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
          HideGadget(2, #False) 
          RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
        Else 
          HideGadget(2, #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 
  Select uMsg 
    Case #WM_NOTIFY 
      *pnmh.NMHDR = lParam 
      Select *pnmh\code 
        Case #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = 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=0 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontBold) 
                Else 
                  SelectObject_(*LVCDHeader\nmcd\hDC, FontReg) 
                EndIf 
                If Row&1=0 
                  *LVCDHeader\clrTextBk = RGB(255, 255, 223) 
                  If Col=3 
                    *LVCDHeader\clrText = RGB(255, 0, 0) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                Else 
                  *LVCDHeader\clrTextBk = RGB(208, 208, 176) 
                  If Col=3 
                    *LVCDHeader\clrText = RGB(0, 0, 255) 
                  Else 
                    *LVCDHeader\clrText = RGB(0, 0, 0) 
                  EndIf 
                EndIf 
                result = #CDRF_NEWFONT 
            EndSelect 
          EndIf 
      EndSelect 
  EndSelect 
  ProcedureReturn result 
EndProcedure 


; IDE Options = PureBasic v4.00 (Windows - x86)
; Folding = --
Si toutefois quelqu'un aurrait un truc plus simple pour pouvoir éditer chaque case une à une. Merci d'avance pour vos réponses.

Publié : lun. 14/avr./2008 18:46
par Jacobus
Voici un petit exemple rapide et simple à comprendre pour éditer une ListIconGadget() case par case, mais avec un InputRequester()
Ce n'est pas exactement la même chose qu'écrire directement dedans, mais c'est quand même efficace et pas trop lourd.

Code : Tout sélectionner

;Code en PB 4.10
;
Enumeration
#WinEditListicon
#Popup_Modif
#Menu_Type
#Menu_Marque
#Menu_Modele
#TextEditListicon
#Listicon
EndEnumeration

If OpenWindow(#WinEditListicon,0,0, 400, 350, "Edition d'un ListiconGadget()",#PB_Window_SystemMenu  | #PB_Window_ScreenCentered |#PB_Window_TitleBar)=0 Or CreateGadgetList(WindowID(#WinEditListicon))=0  
  End 
EndIf

If CreatePopupMenu(#Popup_Modif)
  OpenSubMenu("Modifier...")
    MenuItem(#Menu_Type, "Le Type")
    MenuBar()
    MenuItem(#Menu_Marque, "La Marque")
    MenuBar()
    MenuItem(#Menu_Modele, "Le Modèle")
  CloseSubMenu()
EndIf
  
 TextGadget(#TextEditListicon,10,5,380,30,"Pour modifier les données dans chaque case, faire un clic droit sur l'item voulu, puis choisir l'élément à modifier dans la liste.")
 
 ListIconGadget(#Listicon,10,45,380,290,"Type",170,#PB_ListIcon_FullRowSelect|#PB_ListIcon_CheckBoxes)
 AddGadgetColumn(#Listicon, 1, "Marque", 100)
 AddGadgetColumn(#Listicon, 2, "Modèle", 100)
 
 ;Listing d'exemple
 For n1 = 0 To 9 
  AddGadgetItem(#Listicon,-1,"Automobile"+Chr(10)+"Ferrari"+Chr(10)+"rouge")
 Next n1
 
 
 Repeat
  Event = WaitWindowEvent() 
   If Event = #PB_Event_Gadget
     Select EventGadget() 
     
      Case #Listicon
       Position = GetGadgetState(#Listicon)
		    If Position >= 0
		      If EventType() = #PB_EventType_RightClick ; si on clic bouton droit
		        DisplayPopupMenu(#PopUp_Modif,WindowID(#WinEditListicon)) ; affiche le popup
		      EndIf 
		    EndIf
      
     EndSelect 
 EndIf 

  If Event =  #PB_Event_Menu
     Select EventMenu()
         
      Case #Menu_Type
			  Pos = GetGadgetState(#Listicon)
			   If Pos >= 0
			    modif.s = InputRequester("Modifier le Type", "Entrez vos modifications :", GetGadgetItemText(#Listicon, Pos, 0))
			    SetGadgetItemText(#Listicon, Pos, modif, 0) 
			   EndIf
			   
			 Case #Menu_Marque
			  Pos = GetGadgetState(#Listicon)
			   If Pos >= 0
			    modif.s = InputRequester("Modifier la marque", "Entrez vos modifications :", GetGadgetItemText(#Listicon, Pos, 1))
			    SetGadgetItemText(#Listicon, Pos, modif, 1)
			   EndIf
			 
			 Case #Menu_Modele
			  Pos = GetGadgetState(#Listicon)
			   If Pos >= 0
			    modif.s = InputRequester("Modifier le modèle", "Entrez vos modifications :", GetGadgetItemText(#Listicon, Pos, 2))
			    SetGadgetItemText(#Listicon, Pos, modif, 2)
			   EndIf
   
   
     EndSelect  
   EndIf 
 Until Event = #PB_Event_CloseWindow
End
Cependant si tu veux éditer directement, tu peux utiliser la librairie de Gnozal PureLVSORT, dispo sur son site : http://freenet-homepage.de/gnozal/

Publié : lun. 14/avr./2008 21:09
par Neosis
Salut tous le monde :)
Voici un code que j'ai trouvé dans mes archives.
J'espére que ça te conviens? :)

Code : Tout sélectionner

; English forum:
; Author: El Choni (updated for PB3.92+ by Andre, updated for PB4.00 by blbltheworm)
; Date: 09. May 2003
; OS: Windows
; Demo: No

Procedure LOWORD(Value)
      ProcedureReturn Value & $FFFF
EndProcedure

Procedure HIWORD(Value)
      ProcedureReturn Value >> 16 & $FFFF
EndProcedure

#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

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

Declare EditProc(hwnd, uMsg, wParam, lParam)
Declare LViewProc(hwnd, uMsg, wParam, lParam)
Declare WndProc(hwnd, uMsg, wParam, lParam)
Declare KillFocus()
Declare DrawRectangle(hwnd, *rc.RECT)

#CCM_SETVERSION = #CCM_FIRST+7

Global FontReg, FontBold
FontReg = LoadFont(1, "Tahoma", 9)
FontBold = LoadFont(2, "Tahoma", 9, #PB_Font_Bold)

If OpenWindow(0, 0, 0, 400, 260, "Color List View Rows", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)=0:End:EndIf
If CreateGadgetList(WindowID(0))=0:End:EndIf

ListGadget = ListIconGadget(1, 10, 10, 380, 240, "", 70, #PB_ListIcon_GridLines|#LVS_NOSORTHEADER)

SendMessage_(ListGadget, #CCM_SETVERSION, 5, 0)

AddGadgetColumn(1, 1, "Sun", 35)
AddGadgetColumn(1, 2, "Mon", 35)
AddGadgetColumn(1, 3, "Tue", 35)
AddGadgetColumn(1, 4, "Wed", 35)
AddGadgetColumn(1, 5, "Thu", 35)
AddGadgetColumn(1, 6, "Fri", 35)
AddGadgetColumn(1, 7, "Sat", 35)

For i=18 To 34
      hour12 = i
      If hour12>25
            hour12-24
            Hour$ = " pm"
      Else
            Hour$ = " am"
      EndIf
      If hour12&1
            Hour$=Str(hour12/2)+":30"+Hour$;LSet(Str(hour12/2)+":30"+Hour$, 9, " ")
      Else
            Hour$=Str(hour12/2)+":00"+Hour$;LSet(Str(hour12/2)+":00"+Hour$, 9, " ")
      EndIf
      AddGadgetItem(1, -1, Hour$+Chr(10)+Str(hour12/2)+"1"+Chr(10)+Str(hour12/2)+"2"+Chr(10)+Str(hour12/2)+"3"+Chr(10)+Str(hour12/2)+"4"+Chr(10)+Str(hour12/2)+"5"+Chr(10)+Str(hour12/2)+"6"+Chr(10)+Str(hour12/2)+"7")
Next i

SendMessage_(ListGadget, #LVM_SETBKCOLOR, 0, RGB(255, 255, 223))

CreateGadgetList(ListGadget)
OldLViewProc = SetWindowLong_(ListGadget, #GWL_WNDPROC, @LViewProc())
SetWindowCallback(@WndProc())

For i=0 To 7
      SendMessage_(ListGadget, #LVM_SETCOLUMNWIDTH, i, #LVSCW_AUTOSIZE_USEHEADER)
Next i

Repeat
Until WaitWindowEvent()=#PB_Event_CloseWindow

End

Procedure KillFocus()
      If hEdit
            SetGadgetItemText(1, CurItem, GetGadgetText(2), CurSubItem)
            FreeGadget(2)
            hEdit = 0
      EndIf
EndProcedure

Procedure DrawRectangle(hwnd, *rc.RECT)
      hdc = GetDC_(hwnd)
      OldPen = SelectObject_(hdc, GetStockObject_(#BLACK_PEN))
      OldBrush = SelectObject_(hdc, GetStockObject_(#NULL_BRUSH))
      Rectangle_(hdc, *rc\left, *rc\top, *rc\right, *rc\bottom)
      SelectObject_(hdc, OldBrush)
      SelectObject_(hdc, 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
                        pInfo\pt\x = LoWord(lParam)
                        pInfo\pt\y = HiWord(lParam)
                        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo)
                        rc.RECT
                        rc\top = pInfo\iSubItem
                        rc\left = #LVIR_BOUNDS
                        SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc)
                        If hEdit=0
                              UseGadgetList(hwnd)
                              CurItem = pInfo\iItem
                              CurSubItem = pInfo\iSubItem
                              Text$ = GetGadgetItemText(1, CurItem, CurSubItem)
                              If CurSubItem=0
                                    rc\right = rc\left+SendMessage_(hwnd, #LVM_GETCOLUMNWIDTH, 0, 0)
                              EndIf
                              hEdit = StringGadget(2, 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)
                              Else
                                    SendMessage_(hEdit, #WM_SETFONT, FontReg, #True)
                              EndIf
                              OldEditProc = SetWindowLong_(hEdit, #GWL_WNDPROC, @EditProc())
                              SetFocus_(hEdit)
                        EndIf
                  Else
                        result = CallWindowProc_(OldLViewProc, hwnd, uMsg, wParam, lParam)
                  EndIf
            Case #WM_LBUTTONDOWN
                  If hwnd<>hEdit
                        KillFocus()
                        pInfo.LVHITTESTINFO
                        pInfo\pt\x = LOWORD(lParam)
                        pInfo\pt\y = HIWORD(lParam)
                        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo)
                        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
                        DrawRectangle(hwnd, rc)
                        CopyMemory(rc, rct, SizeOf(RECT))
                  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(255, 255, 223)
                              If CurSubItem=3
                                    TextColor = RGB(255, 0, 0)
                              EndIf
                        Else
                              TextBkColor = RGB(208, 208, 176)
                              If CurSubItem=3
                                    TextColor = RGB(0, 0, 255)
                              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(2,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore)
                              HideGadget(2, #False)
                              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)
                        Else
                              HideGadget(2, #True)
                        EndIf
                        SetFocus_(hEdit)
                  EndIf
            Case #WM_HSCROLL
                  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\left = rc\left+1
                        rct\right = rc\right
                        If TopVisibleItem<=CurSelItem
                              DrawRectangle(hwnd, rct)
                        EndIf
                  EndIf
                  If hEdit
                        If TopVisibleItem<=CurItem
                              ResizeGadget(2, rc\left,#PB_Ignore,#PB_Ignore,#PB_Ignore)
                              HideGadget(2, #False)
                              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)
                        Else
                              HideGadget(2, #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
      Select uMsg
            Case #WM_NOTIFY
                  *pnmh.NMHDR = lParam
                  Select *pnmh\code
                        Case #NM_CUSTOMDRAW
                              *LVCDHeader.NMLVCUSTOMDRAW = 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=0
                                                      SelectObject_(*LVCDHeader\nmcd\hdc, FontBold)
                                                Else
                                                      SelectObject_(*LVCDHeader\nmcd\hdc, FontReg)
                                                EndIf
                                                If Row&1=0
                                                      *LVCDHeader\clrTextBk = RGB(255, 255, 223)
                                                      If Col=3
                                                            *LVCDHeader\clrText = RGB(255, 0, 0)
                                                      Else
                                                            *LVCDHeader\clrText = RGB(0, 0, 0)
                                                      EndIf
                                                Else
                                                      *LVCDHeader\clrTextBk = RGB(208, 208, 176)
                                                      If Col=3
                                                            *LVCDHeader\clrText = RGB(0, 0, 255)
                                                      Else
                                                            *LVCDHeader\clrText = RGB(0, 0, 0)
                                                      EndIf
                                                EndIf
                                                result = #CDRF_NEWFONT
                                    EndSelect
                              EndIf
                  EndSelect
      EndSelect
      ProcedureReturn result
EndProcedure

Publié : mar. 15/avr./2008 15:06
par MetalOS
Merci bien pour vos réponses, je vais essayer tous ca.

Publié : sam. 26/avr./2008 7:13
par MetalOS
Merci pour vos sources ca marche nikel, maintenant je cherche à pouvoir enregistrer le contenue complet du ListeIconGadget dans un fichier texte ou autre chose et de pouvoir le recharger à l'identique plus tard mais je ne c pas comment faire (utilisation d'un tableau...) je cherche mais si toute fois quel'qu'un à une idée. Merci d'avance. (mais je cherche quand même de mon coté :) )

Publié : sam. 26/avr./2008 18:29
par Neosis
Je me suis posé la même question que toi il y a quelques temps...

Voici un petit code que ma montrer "Stefou" qui pourrez t'aiguiller dans la manière de faire. :)
#max_client=10000
#l_nom=50
Global Dim nom.s(#max_client)
#l_telephone=12
Global Dim telephone.l(#max_client)
#l_adresse=100
Global Dim adresse.s(#max_client)
#l_cp=7
Global Dim cp.l(#max_client)
#l_ville=50
Global Dim ville.s(#max_client)

For i=0 To #max_client
nom(i)="nom"+Str(i)
telephone(i)=Random(9999999)
adresse(i)=Str(i)+" rue du moulin"
cp(i)=Random(99999)
ville(i)="Ville " +Str(i)
Next

Procedure sauve_base_donnee()
If CreateFile(0,"C:\Documents and Settings\Administrateur\Mes documents\EF_DOSSIER\test.txt")
For i=0 To #max_client
ligne$=""
ligne$=ligne$+LSet(nom(i),#l_nom)
ligne$=ligne$+LSet(Str(telephone(i)),#l_telephone)
ligne$=ligne$+LSet(adresse(i),#l_adresse)
ligne$=ligne$+LSet(Str(cp(i)),#l_cp)
ligne$=ligne$+LSet(ville(i),#l_ville)

WriteStringN(0,ligne$)

Next
CloseFile(0)
EndIf

EndProcedure

Procedure lire_base_donnee()
If ReadFile(0,"bd.txt")
i=-1
Repeat
ligne$=ReadString(0)

If ligne$<>""
i=i+1
Debug nom(i)=Trim(Left(ligne$,#l_nom))
nom$=nom(i)
telephone(i)=Val(Trim(Mid(ligne$,#l_nom,#l_telephone)))
adresse(i)=Trim(Mid(ligne$,#l_nom+#l_telephone,#l_adresse))
cp(i)=Val(Trim(Mid(ligne$,#l_nom+#l_telephone+#l_adresse,#l_cp)))
ville(i)=Trim(Mid(ligne$,#l_nom+#l_telephone+#l_adresse+#l_cp,#l_ville))
EndIf

Until Loc(0)=Lof(0)
MessageRequester("",nom$)
CloseFile(0)
EndIf

EndProcedure

sauve_base_donnee()
lire_base_donnee()

CallDebugger

Publié : sam. 26/avr./2008 20:00
par Jacobus
Voici 2 procédures qui te permettront de créer un listing du contenu d'un Listicongadget() et de le recharger facilement. Basé pour l'exemple sur 8 colonne (de 0 à 7) mais tu peux en enlever ou en ajouter. Deux procédures qui peuvent servir pour plusieurs Listicongadget() en les adaptant en fonctions générales en passant (Listicon.l, NbColonnes.l) en paramètres par exemple...
Code PB 4.10

Code : Tout sélectionner

Procedure Create_Listing()
   
   Listing$ = "..\Listing.txt"   ; donner le chemin complet du fichier  
   If OpenFile(#file, Listing$)  ; Ouvre le fichier existant ou crée un nouveau fichier             
     WriteStringN(#file, Str(CountGadgetItems(#Listicon))) ; le nombre d'éléments dans la listicon
       For List = 0 To CountGadgetItems(#Listicon)-1      ; pour chaque element de la liste
         ;récupération du contenu de chaque colonne
         Resultat0$ = GetGadgetItemText(#Listicon,List,0)
         Resultat1$ = GetGadgetItemText(#Listicon,List,1) 
         Resultat2$ = GetGadgetItemText(#Listicon,List,2) 
         Resultat3$ = GetGadgetItemText(#Listicon,List,3)
         Resultat4$ = GetGadgetItemText(#Listicon,List,4)
         Resultat5$ = GetGadgetItemText(#Listicon,List,5)
         Resultat6$ = GetGadgetItemText(#Listicon,List,6)
         Resultat7$ = GetGadgetItemText(#Listicon,List,7)
         WriteStringN(#file,Resultat0$) ; on écrit le contenu de chaque colonne sur une ligne dans le fichier 
         WriteStringN(#file,Resultat1$) ; ça simplifie grandement la relecture
         WriteStringN(#file,Resultat2$) ; WriteStringN sert à revenir à la ligne automatiquement
         WriteStringN(#file,Resultat3$)
         WriteStringN(#file,Resultat4$)
         WriteStringN(#file,Resultat5$)
         WriteStringN(#file,Resultat6$)
         WriteStringN(#file,Resultat7$)
       Next  List
      CloseFile(#file) ; on referme
   EndIf 
   
EndProcedure

Procedure Load_Listing()
  
  ClearGadgetItemList(#Listicon) ; on s'assure qu'il n'y a rien d'autre dans la listicon, donc on la vide   
  Listing$ = "..\Listing.txt"    ; le fichier précédemment créé...
  
  If OpenFile(0, ListingMC$)   ; Ouvre le fichier en écriture (pour éventuellement ajouter des données)
     nbr=Val(ReadString(0))    ; lit le nombre d'elements 
      For P = 1 To nbr        
 ; donc pour chaque element de la liste on récupère 8 valeurs/lignes
 ; correspondant aux 8 colonnes
         Resultat0$ = ReadString(0)
         Resultat1$ = ReadString(0)
         Resultat2$ = ReadString(0) 
         Resultat3$ = ReadString(0)
         Resultat4$ = ReadString(0)
         Resultat5$ = ReadString(0)
         Resultat6$ = ReadString(0)
         Resultat7$ = ReadString(0)
       ;on a lu chaque ligne dont on a besoin pour remplir la grille
       ;chaque variable se voit ainsi doté d'une valeur (numéro ou text vu que c'est du string)
       ;on ajoute chaque valeur de variable récupérée dans la listicon et dans l'ordre...
        AddGadgetItem(#Listicon,-1,Resultat0$+Chr(10)+Resultat1$+Chr(10)+Resultat2$+Chr(10)+Resultat3$+Chr(10)+Resultat4$+Chr(10)+Resultat5$+Chr(10)+Resultat6$+Chr(10)+Resultat7$) 
      Next  P
    CloseFile(0) ; on referme
  EndIf 
        
EndProcedure

Publié : lun. 28/avr./2008 2:25
par MetalOS
Merci je vais essayer ca et je vous tien au courant. Encore merci.
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru