PureBasic

Histoire de me remettre dans le bain, j'ai repris mon petit programme "Code Postal"
J'ai modifié le système de recherche pour pouvoir utiliser un '?' comme joker.

Par exemple si vous cherchez un bled qui commence par "MONTI" , vous mettez 'MONTI?" et le programme vous renvoie la liste complète de tous les patelins dont le nom commence par la chaine saisie. Idem avec un morceau de code postal.
Si vous ne mettez pas le '?', vous aurez la liste de tous les bleds qui ont la chaine saisie dans leur nom. Idem avec un morceau de code postal.

Si vous mettez le '?' devant la chaine, ben vous aurez...rien. Parce que faut quand même pas déconner, non plus.
En fait, ça se contente de rechercher ce qui se trouve à gauche du '?'. Mais c'est bien suffisant pour ce genre de truc.

Et en plus, cerise sur le bifteck, ça donne le code postal et le département, et vous pouvez copier un des trois (code postal, commune, département) ou les trois avec un clic droit sur la liste.

C'est ici, avec le code source

Pas mal Chris, merci pour le partage, le seul hic est que si je fais un resize de la fenêtre, le gadget #Str_Result disparait

Oups!!!

J'ai ajouté une status bar, mais j'ai oublié de modifier les dimensions dans la callback
Voilà les nouvelles, je modifie le code et je re-uploade l'archive.

Code : Tout sélectionner

  Select Msge
    Case #WM_SIZE
      ResizeGadget(#List_Result, #PB_Ignore, #PB_Ignore, WindowWidth(#Window_0) - 165, WindowHeight(#Window_0) - 65)
      ResizeGadget(#Str_Result, #PB_Ignore, WindowHeight(#Window_0) - 55, WindowWidth(#Window_0) - 10, #PB_Ignore)

Pas mal.

Il ne manque que un trie dans la liste de résultat de la recherche.

Si tu fais un recherche par code postal, tu tris les résultats sur le code postal
Si tu fais un recherche par nom de ville, tu tris les résultats sur le nom de ville

Ça sera plus pratique car pour le moment, c'est le bordel

Et en prime, tu effaces le bouton "rechercher" et tu fais la recherche en temps réel

Car tu fais une recherche et que tu tâtonnes sur l'orthographe, ça serais plus sympa de voir la liste évolué en temps réel.

Comment ça je suis exigeant ????

Allez j'en rajoute.
Il faut que tu ajoutes une dimension minimum à ta fenêtre car on peut la réduire un peu trop et ça fait n'importe quoi. Voir "WindowBounds()"

Qui aime bien châtie bien

(on trouve toujours un proverbe qui va bien)

Le Soldat Inconnu a écrit :Pas mal.

Il ne manque que un trie dans la liste de résultat de la recherche.

Si tu fais un recherche par code postal, tu tris les résultats sur le code postal
Si tu fais un recherche par nom de ville, tu tris les résultats sur le nom de ville

Ça sera plus pratique car pour le moment, c'est le bordel

Et en prime, tu effaces le bouton "rechercher" et tu fais la recherche en temps réel
Car tu fais une recherche et que tu tâtonnes sur l'orthographe, ça serais plus sympa de voir la liste évolué en temps réel.

Comment ça je suis exigeant ????

Allez j'en rajoute.
Il faut que tu ajoutes une dimension minimum à ta fenêtre car on peut la réduire un peu trop et ça fait n'importe quoi. Voir "WindowBounds()"

Qui aime bien châtie bien (on trouve toujours un proverbe qui va bien)

Le code est dans l'archive
A priori, si tu viens sur le forum et que tu postes, c'est que tu as un ordinateur, un clavier, internet et des doigts.

Alors démerde toi pour ajouter ce que tu veux

Chris! Toujours aussi rognon! C'est étrange, ça me rappelle des sujets qui datent d'une période pendant laquelle je ne connaissais pas PureBASIC...

Le code est dans l'archive
A priori, si tu viens sur le forum et que tu postes, c'est que tu as un ordinateur, un clavier, internet et des doigts.

Alors démerde toi pour ajouter ce que tu veux

Oh ! je te donne des idées pour occuper tes longues soirée d'hiver et voilà comment on est remercié

Ollivier a écrit :Chris! Toujours aussi rognon!.

non là je le trouve plutôt tres cool

ça me rappelle des sujets qui datent d'une période pendant laquelle je ne connaissais pas PureBASIC...

ouaip , mais qu'est ce qu'on se marrait !!

Dobro a écrit :
Ollivier a écrit :Chris! Toujours aussi rognon!.

non là je le trouve plutôt tres cool

Ollivier a écrit :ça me rappelle des sujets qui datent d'une période pendant laquelle je ne connaissais pas PureBASIC...
ouaip , mais qu'est ce qu'on se marrait !!

Je n'ai pas cet humour: je n'ai pas besoin de voir deux personnes s'opposer même le plus légèrement du monde pour me marrer, au contraire, je trouve ça dommage...

Maintenant, je pense que malgré cela, tu me tolères?

Ollivier a écrit : Je n'ai pas cet humour: je n'ai pas besoin de voir deux personnes s'opposer même le plus légèrement du monde pour me marrer, au contraire, je trouve ça dommage...

Maintenant, je pense que malgré cela, tu me tolères?

ce n'etait pas le sens de mon propos ...

je reprends donc :

Ollivier a écrit:
ça me rappelle des sujets qui datent d'une période pendant laquelle je ne connaissais pas PureBASIC...

Dobro répond :
ouaip , mais qu'est ce qu'on se marrait !!

tant qu'a deformer le sens de mon propos..

tu aurai pu aussi te dire, que je disait qu'avant on se marrait
avant quoi ? ....... ta venue !

mais non tu as préféré partir sur le cliché "pacifiste" en parlant de 2 personnes qui s'oppose...

alors voici le sens de mon propos

avant on se marrait , parceque certe il y avait des conflits de points de vues,
certes, c'etait rock'n roll , mais vois tu , nous (les anciens) ont s'est tous mis sur la gueule
mais on s'est vraiment marré , parceque , rien n'es resté de mauvais de tout ça

je déplore justement l'arrivé de gens comme toi , KCC et d'autres, qui finalement prennent tout de travers...

la preuve , lorsque je dis "on se marrait" , tout de suite tu part sur une interpretation pas drole

perso Chris ou Le Soldat et certains autres , lorsqu'ils râlent, ben moi ça me fait marrer

parceque je les connais un peu , par le Forum , et je sais que c'est de la "ralerie" Gauloise

ton coté bougon a toi, me fais nettement moins rire ...

et oui , je te tolere .... comme d'autres me tolere ...

A priori, si tu viens sur le forum et que tu postes, c'est que tu as un ordinateur, un clavier, internet et des doigts.

Alors démerde toi pour ajouter ce que tu veux

En plus j'ai eu un peu de temps

Voila: Il faut utiliser le fichier des codes postaux et l'icone de Chris.

Code : Tout sélectionner

;======================================
; MLD le 20/01/2011                   =
; Code postal2 sur une idée de Chris  =
; PB 4.51                             =
;======================================
Enumeration
#Fpr = 1
#cont = 2
#List_Result = 3
#Txt_1 = 4
#Txt_2 = 5
#Optv = 6
#Optcd = 7
#Optdep = 8
#Str_Result = 9
#Str_rech = 10
#bt_aide = 11
#bt_cop = 12
#bt_raz = 13
#bt_stop = 14
#Txtgr = 15
#Txtresult = 16
#timer1 = 17
EndEnumeration
Global Dim tabcp.s(0)
Global Dim tricp.s(0)
FontID4 = LoadFont(4,"Tahoma",8 ,#PB_Font_Bold|#PB_Font_HighQuality)
Global flag_opt.b ;1 = Ville 2 = code 3= departement
;color le HEADER
Global AddressCallback 
Global Colour 

DataSection
  FileStart:
  IncludeBinary "CodePos.csv"
  FileEnd:
EndDataSection

Hlp1$= "Un " + Chr(34) + "?"+ Chr(34) + " derrière une partie du nom ou du code postal permet de retrouver" + Chr(10)
Hlp2$= "une commune ou un code commençant par la chaine saisie." + Chr(10)
Hlp3$= Chr(10)
Hlp4$= "Un click gauche sur la grille selectionne le code postal, que l'on peut copié dans le presse papier"
Hlp5$= "" + Chr(10)
Hlp6$= "Pas trop compliqué, non?"

Procedure colorgr()
 nbligne = CountGadgetItems(#List_Result) - 1
 For NbElement = 1 To (nbligne +1)Step 2
  SetGadgetItemColor(#List_Result, NbElement, #PB_Gadget_BackColor,$91E3F7) 
 Next 
EndProcedure

Procedure pasdegrillevide()
If CountGadgetItems(#List_Result) = 0
  For rp =1 To 8
   AddGadgetItem(#List_Result, -1, " " ) 
  Next
Else
  If CountGadgetItems(#List_Result) < 8
  For rp = CountGadgetItems(#List_Result) To 8
   AddGadgetItem(#List_Result, -1, " " ) 
  Next
 EndIf
EndIf
colorgr()
EndProcedure

Procedure nbelm()
nbelm$ = Str(CountGadgetItems(#List_Result))
SetGadgetText(#Txtgr,"Nombre de propositions : " + nbelm$) 
EndProcedure

Procedure AddressListSubclassed(hwnd, msg, wParam, lParam) ;color le header grille
   FontID4 = LoadFont(4,"Tahoma",8 ,#PB_Font_Bold|#PB_Font_HighQuality)
   #LVM_GETHEADER = #LVM_FIRST + 31 
   Protected hdi.HD_ITEM 
  result = CallWindowProc_(AddressCallback, hwnd, msg, wParam, lParam)
  Select msg 
    Case #WM_NOTIFY 
      *pnmh.NMHDR = lParam        
       If *pnmh\code = #NM_CUSTOMDRAW 
        *pnmcd.NMCUSTOMDRAW = lParam                                                                
        Select *pnmcd\dwDrawStage 
          Case #CDDS_PREPAINT 
            result = #CDRF_NOTIFYITEMDRAW 
          Case #CDDS_ITEMPREPAINT                                                                    
            text$ = Space(100) 
            hdi\mask = #HDI_TEXT 
            hdi\pszText = @text$ 
            hdi\cchTextMax = Len(text$) 
            SendMessage_(*pnmh\hwndFrom, #HDM_GETITEM, *pnmcd\dwItemSpec, hdi)                    
            If *pnmcd\uItemState & #CDIS_SELECTED 
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH | #DFCS_PUSHED)  
              InflateRect_(*pnmcd\rc, -1, -1) 
            Else 
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH) 
            EndIf                      
            ; Draw background. 
            InflateRect_(*pnmcd\rc, -2, -1) 
            SetBkMode_(*pnmcd\hdc, #TRANSPARENT) 
            FillRect_(*pnmcd\hdc, *pnmcd\rc, Colour) ;couleur fond du header
            SetTextColor_(*pnmcd\hdc, $ED2C12) 
            DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_LEFT | #DT_VCENTER | #DT_END_ELLIPSIS) 
            result = #CDRF_SKIPDEFAULT 
        EndSelect 
      EndIf 
  EndSelect 
  ProcedureReturn result 
EndProcedure 

Procedure raz()
ClearGadgetItems(#List_Result):nbelm():pasdegrillevide()
SetGadgetText(#Str_Result,""):SetGadgetText(#Str_Rech,""):SetActiveGadget(#Str_rech)
EndProcedure

Procedure finalerte()
AddWindowTimer(#Fpr,#timer1, 2900)
Repeat 
 Event = WaitWindowEvent()
  If Event = #PB_Event_Timer And EventTimer() = #timer1
    SetGadgetText(#Str_Result,"")
    SetGadgetColor(#Str_Result, #PB_Gadget_FrontColor,$0)
    SetGadgetColor(#Txtresult, #PB_Gadget_FrontColor,$0)
    SetGadgetText(#Txtresult,"Code postal sélectionné")
  EndIf
 Until Event = #PB_Event_Timer And EventTimer() = #timer1 
RemoveWindowTimer(#Fpr,#timer1) 
EndProcedure

Procedure alerte(indal.b)
Select indal.b
 Case 1
  ta$ = "  Il faut indiquer une recherche!"
 Case 2
  ta$ = "  Acun résultat.Vérifiez l'objet de la recherche!"
 Case 3
  ta$ = "  Il faut faire un choix dans la liste!"
EndSelect 
SetGadgetColor(#Str_Result, #PB_Gadget_FrontColor,$0709B3)
SetGadgetColor(#Txtresult, #PB_Gadget_FrontColor,$0709B3)
SetGadgetText(#Txtresult,"Alerte") 
SetGadgetText(#Str_Result,ta$) 
finalerte() 
EndProcedure

Procedure recherche(indrec.b)
xx = 0
zz = 0
For ww = 1 To ArraySize(tabcp.s())
    T$ = tabcp.s(ww)
     If indrec.b = 1
      If Trim(StringField(T$, 1, ";")) = Trim(GetGadgetText(#Str_rech))
        AddGadgetItem(#List_Result,-1, Chr(10) + StringField(T$, 2, ";") + Chr(10)+ StringField(T$, 1, ";")  + Chr(10) + StringField(T$, 3, ";") )  
      EndIf
     EndIf 
     If indrec.b = 2
      If Trim(StringField(T$, 2, ";")) = Trim(GetGadgetText(#Str_rech))
       AddGadgetItem(#List_Result,-1, Chr(10) + StringField(T$, 2, ";") + Chr(10)+ StringField(T$, 1, ";")  + Chr(10) + StringField(T$, 3, ";") )  
      EndIf
     EndIf
     If indrec.b = 3
      If Trim(StringField(T$, 3, ";")) = Trim(GetGadgetText(#Str_rech))
       xx = xx + 1
       ReDim tricp.s(xx)
       tricp.s(xx) = T$ 
      EndIf
     EndIf
     If indrec.b = 4
      longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
      If Left(Trim(StringField(T$, 1, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
      xx = xx + 1
       ReDim tricp.s(xx)
       tricp.s(xx) = T$ 
      EndIf
     EndIf
    If indrec.b = 5
      longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
      If Left(Trim(StringField(T$, 2, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
      xx = xx + 1
       ReDim tricp.s(xx)
       tricp.s(xx) = StringField(T$, 2, ";")+";" + StringField(T$, 1, ";")+";" +  StringField(T$, 3, ";")+";"
      EndIf
     EndIf
    If indrec.b = 6
      longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
      If Left(Trim(StringField(T$, 3, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
      xx = xx + 1
       ReDim tricp.s(xx)
       tricp.s(xx) = StringField(T$, 3, ";")+";" + StringField(T$, 1, ";")+";" +  StringField(T$, 2, ";")+";"
      EndIf
     EndIf 
Next     
If indrec.b = 3 Or indrec.b = 4 
SortArray(tricp.s(),#PB_Sort_Ascending) 
For ss = 1 To ArraySize(tricp.s())
 AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 2, ";") + Chr(10)+ StringField(tricp.s(ss), 1, ";")  + Chr(10) + StringField(tricp.s(ss), 3, ";") )  
Next 
EndIf
If indrec.b = 5
SortArray(tricp.s(),#PB_Sort_Ascending) 
For ss = 1 To ArraySize(tricp.s())
 AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 1, ";") + Chr(10)+ StringField(tricp.s(ss), 2, ";")  + Chr(10) + StringField(tricp.s(ss), 3, ";") )  
Next 
EndIf
If indrec.b = 6
SortArray(tricp.s(),#PB_Sort_Ascending) 
For ss = 1 To ArraySize(tricp.s())
 AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 3, ";") + Chr(10)+ StringField(tricp.s(ss), 2, ";")  + Chr(10) + StringField(tricp.s(ss), 1, ";") )  
Next 
EndIf
nbelm()
elmgr.l = CountGadgetItems(#List_Result)
pasdegrillevide()
If elmgr.l = 0
 alerte(2)
EndIf 
Dim tricp.s(0)
EndProcedure

Procedure orienterecherche()
 If Right(GetGadgetText(#Str_Rech),1) <>"?"
   If flag_opt.b = 1:recherche(1):EndIf
   If flag_opt.b = 2:recherche(2):EndIf
   If flag_opt.b = 3:recherche(3):EndIf
 Else
   If flag_opt.b = 1:recherche(4):EndIf
   If flag_opt.b = 2:recherche(5):EndIf
   If flag_opt.b = 3:recherche(6):EndIf
 EndIf  
EndProcedure

OpenWindow(#Fpr, 38, 14, 680, 230, "Code Postal",#PB_Window_MinimizeGadget |#PB_Window_ScreenCentered| #PB_Window_TitleBar )
StickyWindow( #fpr, 1)
SetWindowColor(#Fpr,$11E0EE) 
ContainerGadget(#cont, 5, 5, 670, 220,#PB_Container_Double) 
AddKeyboardShortcut(#fpr, #PB_Shortcut_Return, 0)
ListIconGadget(#List_Result, 182, 1, 484, 160, "", 0, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection| #LVS_NOSORTHEADER )
AddGadgetColumn(#List_Result, 1,  "    C.P", 55)
AddGadgetColumn(#List_Result, 2, "                          Ville", 235)
AddGadgetColumn(#List_Result, 3, "               Département", 173);190
SetGadgetColor(#List_Result, #PB_Gadget_BackColor, $E3DFE0)
SetGadgetColor(#List_Result,#PB_Gadget_LineColor,$808080)
Colour = CreateSolidBrush_($C4C4C4) 
AddressCallback = SetWindowLong_(GadgetID(#List_Result), #GWL_WNDPROC, @AddressListSubclassed())
SetGadgetFont(#List_Result,FontID4 ) 
TextGadget(#Txt_1,20, 10, 150, 20, "Rechercher :", #PB_Text_Center)
TextGadget(#Txt_2, 15, 115, 150, 20, "Recherche par la ville", #PB_Text_Center)
OptionGadget(#Optv, 15, 30, 110, 20, "   Par la ville")
OptionGadget(#Optcd, 15, 55, 110, 20, "   Par le code postal")
OptionGadget(#Optdep, 15, 80, 110, 20, " Par le département")
StringGadget(#Str_Result, 182, 175, 484, 20, "", #PB_String_ReadOnly)
StringGadget(#Str_rech, 5, 135, 170, 20, "", #PB_String_UpperCase)
SetGadgetState(#Optv, 1)
SetActiveGadget(#Str_rech)
ButtonGadget(#bt_aide, 50, 170, 40, 30,"Aide")
ButtonGadget(#bt_cop, 10, 170, 40, 30,"Copie")
ButtonGadget(#bt_raz, 90, 170, 40, 30,"Autre")
ButtonGadget(#bt_stop, 130, 170, 40, 30,"Stop")
TextGadget(#Txtgr,500, 162, 150, 12, "")
SetGadgetColor(#Txtgr, #PB_Gadget_FrontColor,$989898)
TextGadget(#Txtresult,190, 198, 150, 15, "Code postal sélectionné")
nbelm()
pasdegrillevide()

flag_opt.b = 1
If ReadFile(0, "CodePos.csv")
  a = 0
  While Eof(0) = 0
  a = a +1
  ReDim tabcp.s(a)
  tabcp.s(a)  = Trim(ReadString(0))
Wend
EndIf
CloseFile(0)

Repeat
  Event = WaitWindowEvent()
   If Event = #PB_Event_Menu 
      Select EventMenu()
       Case 0
       If GetActiveGadget()=  #Str_Rech
         If GetGadgetText(#Str_Rech) <> ""
          ClearGadgetItems(#List_Result)
          While WindowEvent() : Wend 
          orienterecherche()
         Else 
          alerte(1) 
        EndIf  
       EndIf
      EndSelect
   EndIf
   Select EventGadget()
    Case #Optv
     Select EventType()
      Case #PB_EventType_LeftClick
       flag_opt.b = 1 :raz()
       SetGadgetText(#Txt_2,"   Par la ville"):SetActiveGadget(#Str_rech)
       SendMessage_(GadgetID(#Str_Rech), #EM_LIMITTEXT, 40, 0)
      EndSelect
    Case #Optcd
     Select EventType()
      Case #PB_EventType_LeftClick
       flag_opt.b = 2 :raz()
       SetGadgetText(#Txt_2,"   Par le code postal"):SetActiveGadget(#Str_rech)
       SendMessage_(GadgetID(#Str_rech), #EM_LIMITTEXT, 5, 0)
      EndSelect
    Case #Optdep
     Select EventType()
      Case #PB_EventType_LeftClick
       flag_opt.b = 3 :raz()
       SetGadgetText(#Txt_2,"   Par le département"):SetActiveGadget(#Str_rech)
       SendMessage_(GadgetID(#Str_Rech), #EM_LIMITTEXT, 40, 0)
      EndSelect
    Case #Str_Rech
     Select EventType()
      Case #PB_EventType_Change 
       If GetGadgetText(#Str_Rech) = "":ClearGadgetItems(#List_Result):nbelm():pasdegrillevide():SetGadgetText(#Str_Result,""):EndIf
     EndSelect  
    Case #List_Result
     Select EventType()
      Case #PB_EventType_LeftClick
       itemcp.l = GetGadgetState(#List_Result)
       SetGadgetText(#Str_Result, GetGadgetItemText(#List_Result,itemcp,1) + " " + GetGadgetItemText(#List_Result,itemcp,2))
       SetActiveGadget(#Str_rech)
     EndSelect
    Case #bt_cop
    If GetGadgetText(#Str_Result) = ""
     alerte(3)
    Else
     SetClipboardText(GetGadgetText(#Str_Result))
    EndIf 
    Case #bt_aide
     MessageRequester("Aide",  Hlp1$+ Hlp2$ + Hlp3$ + Hlp4$ + Hlp5$ + Hlp6$, #MB_OK|#MB_ICONINFORMATION)
    Case #bt_raz
     raz()
    Case #bt_stop
     CloseWindow(#Fpr)
     DeleteObject_(Colour)
     FreeArray(tabcp.s())
     End
   EndSelect
Until Event = #PB_Event_CloseWindow
DeleteObject_(Colour)
FreeArray(tabcp.s())
End

Seul petit problème : La ListeIcon a tendence a disparaitre quand elle revient a zéro? .Je ne comprend pas

peut-être un bug de PB

si quelq'un connait une solution merci d'avance.

Vous pouvez faire de ce code ce que vous voulez.

Michel

on peut utiliser LockWindowUpdate_( (voir msdn) pour figer le rafraichissement d'une fenêtre lors de modification de remplissage d'un gadget, ça évite les effets de clignotement.

Le Soldat Inconnu a écrit :on peut utiliser LockWindowUpdate_( (voir msdn) pour figer le rafraichissement d'une fenêtre lors de modification de remplissage d'un gadget, ça évite les effets de clignotement.

Bonjour LSI
Merci

J'ai fait quelques essais, sans obtenir de bon résultats

(je me suis certainement pris comme un manche)

Tu n'aurais pas un exemple d'utilisation dans tes tiroirs

A mon avis ce gadget demande vraiment une remise a jour complète de la part de la team PB

Michel

Oki, j'ai corrigé le programme;

Alors les modifications :
- J'ai déplacé le ClearGadgetItem quand on lance une recherche dans la procedure recherche()
- J'ai ajouté un LockWindowUpdate_( dans la procedure recherche
- J'ai ajouté un CloseGadgetList() qui manquait (et oui, un ContainerGadget est ouvert mais jamais fermé)
- J'ai corrigé les textes (ça, c'est en fonction des gouts de chacun)

et voilà

Code : Tout sélectionner

;======================================
; MLD le 20/01/2011                   =
; Code postal2 sur une idée de Chris  =
; PB 4.51                             =
;======================================
Enumeration
	#Fpr = 1
	#cont = 2
	#List_Result = 3
	#Txt_1 = 4
	#Txt_2 = 5
	#Optv = 6
	#Optcd = 7
	#Optdep = 8
	#Str_Result = 9
	#Str_rech = 10
	#bt_aide = 11
	#bt_cop = 12
	#bt_raz = 13
	#bt_stop = 14
	#Txtgr = 15
	#Txtresult = 16
	#timer1 = 17
EndEnumeration
Global Dim tabcp.s(0)
Global Dim tricp.s(0)
FontID4 = LoadFont(4,"Tahoma",8 ,#PB_Font_Bold|#PB_Font_HighQuality)
Global flag_opt.b ;1 = Ville 2 = code 3= departement
;color le HEADER
Global AddressCallback 
Global Colour 

DataSection
	FileStart:
	IncludeBinary "CodePos.csv"
	FileEnd:
EndDataSection

Hlp1$= "Un " + Chr(34) + "?"+ Chr(34) + " derrière une partie du nom ou du code postal permet de retrouver" + Chr(10)
Hlp2$= "une commune ou un code commençant par la chaine saisie." + Chr(10)
Hlp3$= Chr(10)
Hlp4$= "Un click gauche sur la grille selectionne le code postal, que l'on peut copié dans le presse papier"
Hlp5$= "" + Chr(10)
Hlp6$= "Pas trop compliqué, non?"

Procedure colorgr()
	nbligne = CountGadgetItems(#List_Result) - 1
	For NbElement = 1 To (nbligne +1)Step 2
		SetGadgetItemColor(#List_Result, NbElement, #PB_Gadget_BackColor,$91E3F7) 
	Next 
EndProcedure

Procedure pasdegrillevide()
	If CountGadgetItems(#List_Result) = 0
		For rp =1 To 8
			AddGadgetItem(#List_Result, -1, " " ) 
		Next
	Else
		If CountGadgetItems(#List_Result) < 8
			For rp = CountGadgetItems(#List_Result) To 8
				AddGadgetItem(#List_Result, -1, " " ) 
			Next
		EndIf
	EndIf
	colorgr()
EndProcedure

Procedure nbelm()
	nbelm$ = Str(CountGadgetItems(#List_Result))
	SetGadgetText(#Txtgr,"Nombre de propositions : " + nbelm$) 
EndProcedure

Procedure AddressListSubclassed(hwnd, msg, wParam, lParam) ;color le header grille
	FontID4 = LoadFont(4,"Tahoma",8 ,#PB_Font_Bold|#PB_Font_HighQuality)
	#LVM_GETHEADER = #LVM_FIRST + 31 
	Protected hdi.HD_ITEM 
	result = CallWindowProc_(AddressCallback, hwnd, msg, wParam, lParam)
	Select msg 
		Case #WM_NOTIFY 
			*pnmh.NMHDR = lParam        
			If *pnmh\code = #NM_CUSTOMDRAW 
				*pnmcd.NMCUSTOMDRAW = lParam                                                                
				Select *pnmcd\dwDrawStage 
					Case #CDDS_PREPAINT 
						result = #CDRF_NOTIFYITEMDRAW 
					Case #CDDS_ITEMPREPAINT                                                                    
						text$ = Space(100) 
						hdi\mask = #HDI_TEXT 
						hdi\pszText = @text$ 
						hdi\cchTextMax = Len(text$) 
						SendMessage_(*pnmh\hwndFrom, #HDM_GETITEM, *pnmcd\dwItemSpec, hdi)                    
						If *pnmcd\uItemState & #CDIS_SELECTED 
							DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH | #DFCS_PUSHED)  
							InflateRect_(*pnmcd\rc, -1, -1) 
						Else 
							DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH) 
						EndIf                      
						; Draw background. 
						InflateRect_(*pnmcd\rc, -2, -1) 
						SetBkMode_(*pnmcd\hdc, #TRANSPARENT) 
						FillRect_(*pnmcd\hdc, *pnmcd\rc, Colour) ;couleur fond du header
						SetTextColor_(*pnmcd\hdc, $ED2C12) 
						DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_LEFT | #DT_VCENTER | #DT_END_ELLIPSIS) 
						result = #CDRF_SKIPDEFAULT 
				EndSelect 
			EndIf 
	EndSelect 
	ProcedureReturn result 
EndProcedure 

Procedure raz()
	ClearGadgetItems(#List_Result):nbelm():pasdegrillevide()
	SetGadgetText(#Str_Result,""):SetGadgetText(#Str_rech,""):SetActiveGadget(#Str_rech)
EndProcedure

Procedure finalerte()
	AddWindowTimer(#Fpr,#timer1, 2900)
	Repeat 
		Event = WaitWindowEvent()
		If Event = #PB_Event_Timer And EventTimer() = #timer1
			SetGadgetText(#Str_Result,"")
			SetGadgetColor(#Str_Result, #PB_Gadget_FrontColor,$0)
			SetGadgetColor(#Txtresult, #PB_Gadget_FrontColor,$0)
			SetGadgetText(#Txtresult,"Code postal sélectionné")
		EndIf
	Until Event = #PB_Event_Timer And EventTimer() = #timer1 
	RemoveWindowTimer(#Fpr,#timer1) 
EndProcedure

Procedure alerte(indal.b)
	Select indal.b
		Case 1
			ta$ = "  Il faut indiquer une recherche!"
		Case 2
			ta$ = "  Acun résultat.Vérifiez l'objet de la recherche!"
		Case 3
			ta$ = "  Il faut faire un choix dans la liste!"
	EndSelect 
	SetGadgetColor(#Str_Result, #PB_Gadget_FrontColor,$0709B3)
	SetGadgetColor(#Txtresult, #PB_Gadget_FrontColor,$0709B3)
	SetGadgetText(#Txtresult,"Alerte") 
	SetGadgetText(#Str_Result,ta$) 
	finalerte() 
EndProcedure

Procedure recherche(indrec.b)
	LockWindowUpdate_(WindowID(#Fpr))
	ClearGadgetItems(#List_Result)
	xx = 0
	zz = 0
	For ww = 1 To ArraySize(tabcp.s())
		T$ = tabcp.s(ww)
		If indrec.b = 1
			If Trim(StringField(T$, 1, ";")) = Trim(GetGadgetText(#Str_rech))
				AddGadgetItem(#List_Result,-1, Chr(10) + StringField(T$, 2, ";") + Chr(10)+ StringField(T$, 1, ";")  + Chr(10) + StringField(T$, 3, ";") )  
			EndIf
		EndIf 
		If indrec.b = 2
			If Trim(StringField(T$, 2, ";")) = Trim(GetGadgetText(#Str_rech))
				AddGadgetItem(#List_Result,-1, Chr(10) + StringField(T$, 2, ";") + Chr(10)+ StringField(T$, 1, ";")  + Chr(10) + StringField(T$, 3, ";") )  
			EndIf
		EndIf
		If indrec.b = 3
			If Trim(StringField(T$, 3, ";")) = Trim(GetGadgetText(#Str_rech))
				xx = xx + 1
				Redim tricp.s(xx)
				tricp.s(xx) = T$ 
			EndIf
		EndIf
		If indrec.b = 4
			longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
			If Left(Trim(StringField(T$, 1, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
				xx = xx + 1
				Redim tricp.s(xx)
				tricp.s(xx) = T$ 
			EndIf
		EndIf
		If indrec.b = 5
			longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
			If Left(Trim(StringField(T$, 2, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
				xx = xx + 1
				Redim tricp.s(xx)
				tricp.s(xx) = StringField(T$, 2, ";")+";" + StringField(T$, 1, ";")+";" +  StringField(T$, 3, ";")+";"
			EndIf
		EndIf
		If indrec.b = 6
			longcp.b = Len(Trim(GetGadgetText(#Str_rech)))-1
			If Left(Trim(StringField(T$, 3, ";")),longcp) = Left(Trim(GetGadgetText(#Str_rech)),longcp)
				xx = xx + 1
				Redim tricp.s(xx)
				tricp.s(xx) = StringField(T$, 3, ";")+";" + StringField(T$, 1, ";")+";" +  StringField(T$, 2, ";")+";"
			EndIf
		EndIf 
	Next     
	If indrec.b = 3 Or indrec.b = 4 
		SortArray(tricp.s(),#PB_Sort_Ascending) 
		For ss = 1 To ArraySize(tricp.s())
			AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 2, ";") + Chr(10)+ StringField(tricp.s(ss), 1, ";")  + Chr(10) + StringField(tricp.s(ss), 3, ";") )  
		Next 
	EndIf
	If indrec.b = 5
		SortArray(tricp.s(),#PB_Sort_Ascending) 
		For ss = 1 To ArraySize(tricp.s())
			AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 1, ";") + Chr(10)+ StringField(tricp.s(ss), 2, ";")  + Chr(10) + StringField(tricp.s(ss), 3, ";") )  
		Next 
	EndIf
	If indrec.b = 6
		SortArray(tricp.s(),#PB_Sort_Ascending) 
		For ss = 1 To ArraySize(tricp.s())
			AddGadgetItem(#List_Result,-1, Chr(10) + StringField(tricp.s(ss), 3, ";") + Chr(10)+ StringField(tricp.s(ss), 2, ";")  + Chr(10) + StringField(tricp.s(ss), 1, ";") )  
		Next 
	EndIf
	nbelm()
	elmgr.l = CountGadgetItems(#List_Result)
	pasdegrillevide()
	If elmgr.l = 0
		alerte(2)
	EndIf 
	Dim tricp.s(0)
	LockWindowUpdate_(0)
EndProcedure

Procedure orienterecherche()
	If Right(GetGadgetText(#Str_rech),1) <>"?"
		If flag_opt.b = 1:recherche(1):EndIf
		If flag_opt.b = 2:recherche(2):EndIf
		If flag_opt.b = 3:recherche(3):EndIf
	Else
		If flag_opt.b = 1:recherche(4):EndIf
		If flag_opt.b = 2:recherche(5):EndIf
		If flag_opt.b = 3:recherche(6):EndIf
	EndIf  
EndProcedure

OpenWindow(#Fpr, 0, 0, 680, 230, "Code Postal",#PB_Window_MinimizeGadget |#PB_Window_ScreenCentered| #PB_Window_TitleBar )
StickyWindow( #Fpr, 1)
SetWindowColor(#Fpr,$11E0EE) 
ContainerGadget(#cont, 5, 5, 670, 220,#PB_Container_Double) 
	AddKeyboardShortcut(#Fpr, #PB_Shortcut_Return, 0)
	ListIconGadget(#List_Result, 182, 1, 484, 160, "", 0, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection| #LVS_NOSORTHEADER )
	AddGadgetColumn(#List_Result, 1,  "    C.P", 55)
	AddGadgetColumn(#List_Result, 2, "                          Ville", 235)
	AddGadgetColumn(#List_Result, 3, "               Département", 173);190
	SetGadgetColor(#List_Result, #PB_Gadget_BackColor, $E3DFE0)
	SetGadgetColor(#List_Result,#PB_Gadget_LineColor,$808080)
	Colour = CreateSolidBrush_($C4C4C4) 
	AddressCallback = SetWindowLong_(GadgetID(#List_Result), #GWL_WNDPROC, @AddressListSubclassed())
	SetGadgetFont(#List_Result,FontID4 ) 
	TextGadget(#Txt_1,20, 10, 150, 20, "Rechercher :", #PB_Text_Center)
	TextGadget(#Txt_2, 15, 115, 150, 20, "Recherche d'une ville", #PB_Text_Center)
	OptionGadget(#Optv, 15, 30, 110, 20, "Une ville")
	OptionGadget(#Optcd, 15, 55, 110, 20, "Un code postal")
	OptionGadget(#Optdep, 15, 80, 110, 20, "Un département")
	StringGadget(#Str_Result, 182, 175, 484, 20, "", #PB_String_ReadOnly)
	StringGadget(#Str_rech, 5, 135, 170, 20, "", #PB_String_UpperCase)
	SetGadgetState(#Optv, 1)
	SetActiveGadget(#Str_rech)
	ButtonGadget(#bt_aide, 50, 170, 40, 30,"Aide")
	ButtonGadget(#bt_cop, 10, 170, 40, 30,"Copie")
	ButtonGadget(#bt_raz, 90, 170, 40, 30,"Autre")
	ButtonGadget(#bt_stop, 130, 170, 40, 30,"Stop")
	TextGadget(#Txtgr,500, 162, 150, 12, "")
	SetGadgetColor(#Txtgr, #PB_Gadget_FrontColor,$989898)
	TextGadget(#Txtresult,190, 198, 150, 15, "Code postal sélectionné")
CloseGadgetList()

nbelm()
pasdegrillevide()

flag_opt.b = 1
If ReadFile(0, "CodePos.csv")
	a = 0
	While Eof(0) = 0
		a = a +1
		Redim tabcp.s(a)
		tabcp.s(a)  = Trim(ReadString(0))
	Wend
EndIf
CloseFile(0)

Repeat
	Event = WaitWindowEvent()
	If Event = #PB_Event_Menu 
		Select EventMenu()
			Case 0
				If GetActiveGadget()=  #Str_rech
					If GetGadgetText(#Str_rech) <> ""
						orienterecherche()
					Else 
						alerte(1) 
					EndIf  
				EndIf
		EndSelect
	EndIf
	Select EventGadget()
		Case #Optv
			Select EventType()
				Case #PB_EventType_LeftClick
					flag_opt.b = 1 :raz()
					SetGadgetText(#Txt_2,"Recherche d'une ville"):SetActiveGadget(#Str_rech)
					SendMessage_(GadgetID(#Str_rech), #EM_LIMITTEXT, 40, 0)
			EndSelect
		Case #Optcd
			Select EventType()
				Case #PB_EventType_LeftClick
					flag_opt.b = 2 :raz()
					SetGadgetText(#Txt_2,"Recherche d'un code postal"):SetActiveGadget(#Str_rech)
					SendMessage_(GadgetID(#Str_rech), #EM_LIMITTEXT, 5, 0)
			EndSelect
		Case #Optdep
			Select EventType()
				Case #PB_EventType_LeftClick
					flag_opt.b = 3 :raz()
					SetGadgetText(#Txt_2,"Recherche d'un département"):SetActiveGadget(#Str_rech)
					SendMessage_(GadgetID(#Str_rech), #EM_LIMITTEXT, 40, 0)
			EndSelect
		Case #Str_rech
			Select EventType()
				Case #PB_EventType_Change 
					If GetGadgetText(#Str_rech) = "":ClearGadgetItems(#List_Result):nbelm():pasdegrillevide():SetGadgetText(#Str_Result,""):EndIf
			EndSelect  
		Case #List_Result
			Select EventType()
				Case #PB_EventType_LeftClick
					itemcp.l = GetGadgetState(#List_Result)
					SetGadgetText(#Str_Result, GetGadgetItemText(#List_Result,itemcp,1) + " " + GetGadgetItemText(#List_Result,itemcp,2))
					SetActiveGadget(#Str_rech)
			EndSelect
		Case #bt_cop
			If GetGadgetText(#Str_Result) = ""
				alerte(3)
			Else
				SetClipboardText(GetGadgetText(#Str_Result))
			EndIf 
		Case #bt_aide
			MessageRequester("Aide",  Hlp1$+ Hlp2$ + Hlp3$ + Hlp4$ + Hlp5$ + Hlp6$, #MB_OK|#MB_ICONINFORMATION)
		Case #bt_raz
			raz()
		Case #bt_stop
			CloseWindow(#Fpr)
			DeleteObject_(Colour)
			FreeArray(tabcp.s())
			End
	EndSelect
Until Event = #PB_Event_CloseWindow
DeleteObject_(Colour)
FreeArray(tabcp.s())
End

Bonjour LSI

Merci c'est ok

Effectivement LockWindowUpdate est la solution.

Pour le containerGadget, je ne savais pas qu'il était nécéssaire de le fermer systématiquement, mais en réfléchissant c'est logique.
J'ai déplacé le LockWindowUpdate_(0) aprés la ligne 215 sinon il manque l'alerte quand la grille est vide.
Bonne journée
Michel

PureBasic

Remise en forme...

Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...

Re: Remise en forme...