PureBasic

Voilà je voudrais savoir comment faire pour que quand on appelle ma fonction celle-ci renvoie au programme toutes les secondes une valeur sans être obliger de rappeler la fonction.
Par exemple la fonction sert à donner depuis combien de seconde l'ordinateur est allumé. Donc on l'appelle une fois mais toutes les secondes elle renvoie le temps.
Voilà
merci

Ben y a rien de plus simple, regarde ElapsedMillisecond() dans l'aide, l'exemple fourni correspond exactement à ce que tu cherches.

Oui finalement utilise le code de Flype ci-dessous...toujours aussi prompt à la soluce.

oui mais c'est pas exactement ce qu'il demande.

si j'ai bien compris tu voudrais faire quelquechose comme çà :

( fais tourner en mode debug pour quitter le prog !!! )

Code : Tout sélectionner

Structure Monitor_Struct
  exit.l
  delay.l
  threadId.l
  *millisecs.Long
EndStructure

Global monitor.Monitor_Struct

Procedure.l Monitor_Thread(arg.l)
  
  Repeat
    monitor\millisecs\l = ElapsedMilliseconds()
    Delay(monitor\delay)
  Until monitor\exit = #True
  
EndProcedure

ProcedureDLL.l Monitor_Start(*millisecs, delay.l = 1)
  monitor\exit = #False
  monitor\delay = delay
  monitor\millisecs = *millisecs
  monitor\threadId = CreateThread(@Monitor_Thread(), 0)
  ProcedureReturn monitor\threadId 
EndProcedure

ProcedureDLL.l Monitor_Stop()
  monitor\exit = #True
EndProcedure

;-
;-
;-

If Monitor_Start(@ms.l, 15)
  
  Repeat
    Delay(1)
    Debug ms
  ForEver
  
  Monitor_Stop()
  
EndIf

le truc c'est de donner à ta fonction d'appel le pointeur sur une variable

Le mieux est d'utiliser un SendMessage:

Code : Tout sélectionner

#Mon_Message=1025
Global Fin.l

Procedure.l Thread(Window.l) 
  Static a
  Repeat
      a=a+1
      SendMessage_(Window,#Mon_Message,a,0)
      Delay(1000)
  Until Fin=1
EndProcedure 


ProcedureDLL.l Information(Window.l) 
    CreateThread(@Thread(),Window.l) 
EndProcedure 

ProcedureDLL.l Fin_Information() 
    Fin=1
EndProcedure 

Procedure Callback(WindowID, Message, wParam, lParam)
  Resultat = #PB_ProcessPureBasicEvents
  Select Message
      Case 1025
          SetGadgetText(0,Str(wParam))
      
  EndSelect
  ProcedureReturn Resultat
EndProcedure

If OpenWindow(0, 0, 0, 220, 200, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
SetWindowCallback(@Callback())

CreateGadgetList(WindowID(0))
TextGadget(0,10,10,200,20,"",#PB_Text_Border)
ButtonGadget(1,10,40,200,20,"Recevoir des informations")


Repeat
  Select WaitWindowEvent()
      Case #PB_Event_Gadget 
          Select EventGadget() 
              Case 1
                  Information(WindowID(0)) 
                  
          EndSelect
          
      Case #PB_Event_CloseWindow
          Quit=1
  EndSelect  
Until quit=1 
Fin_Information()  
EndIf

Pour compléter l'exemple de nico je suggère de définir le numéro de message avec RegisterWindowMessage_() pour éviter tout conflit possible ^^

Dri

RegisterWindowMessage_() n'est nécessaire que lorque l'on envoie le message à plusieurs processus et ainsi garantir une valeur de message unique sinon il faut simplement que la valeur du message soit supérieur à #WM_USER soit 1024.

Exact, il suffit juste d'utiliser WM_USER comme valeur de base.

Je pensais surtout au fait d'utiliser des libs qui sousclassent des fenetres et utilisent éventuellement des messages dont n'a pas connaissance

Dri

J'ai pas compris la remarque, mais pour créer de nouveaux messages on doit faire : #WM_MYMESSAGE = #WM_USER + 1
Si le message n'est pas décrit quelque part, on aura beau utiliser RegisterWindowMessage(), on ne sera pas quel message il faudra traiter.

Dr. Dri a écrit :Je pensais surtout au fait d'utiliser des libs qui sousclassent des fenetres et utilisent éventuellement des messages dont n'a pas connaissance

Dri

Ah ben oui, c'est juste; t'as raison, Register.... est préférable pour les utilisateurs de libs externes ou bien si l'on crée soit même une lib.

Merci, je vais voir ça entre le taf et la chaleur. Car je veux transformer ce code en lib statique pour PB car tout le monde demande toujours :

Code : Tout sélectionner

 
; Author: V2 
; Date: 13. November 2003 

; Adapté pour la v4 par Jacobus 05/2006 

Enumeration 
  #Window 
  #cmdStart 
  #progressbar 
  #Frame 
  #cmdExit 
  #Label 
  #Label2 
  #URL 
EndEnumeration 


Procedure.s Reverse(s.s) 
  O.s=Mid(s,Len(s),1) 
  P=Len(s)-1 
  While P>0 
    O.s=O+Mid(s,P,1) 
    P=P-1 
  Wend 
  ProcedureReturn O 
EndProcedure 

Procedure SetProgressbarRange(Gadget.l, Minimum.l, Maximum.l) 
  ;? SetProgressbarRange(#progressbar, 0, 100) 
  PBM_SETRANGE32 = $400 + 6 
  SendMessage_(GadgetID(Gadget), PBM_SETRANGE32, Minimum, Maximum) 
EndProcedure 

Procedure DoEvents() 
  msg.MSG 
  If PeekMessage_(msg,0,0,0,1) 
    TranslateMessage_(msg) 
    DispatchMessage_(msg) 
  Else 
    Sleep_(1) 
  EndIf 
EndProcedure 

Procedure.s GetQueryInfo(hHttpRequest.l, iInfoLevel.l) 
  lBufferLength.l=0 
  lBufferLength = 1024 
  sBuffer.s=Space(lBufferLength) 
  HttpQueryInfo_(hHttpRequest, iInfoLevel, sBuffer, @lBufferLength, 0) 
  ProcedureReturn Left(sBuffer, lBufferLength) 
EndProcedure 

Procedure UrlToFileWithProgress(myFile.s, URL.s) 
  isLoop.b=1 
  Bytes.l=0 
  fBytes.l=0 
  Buffer.l=4096 
  res.s="" 
  tmp.s="" 
  
  OpenType.b=1 
  INTERNET_FLAG_RELOAD.l = $80000000 
  INTERNET_DEFAULT_HTTP_PORT.l = 80 
  INTERNET_SERVICE_HTTP.l = 3 
  HTTP_QUERY_STATUS_CODE.l = 19 
  HTTP_QUERY_STATUS_TEXT.l = 20 
  HTTP_QUERY_RAW_HEADERS.l = 21 
  HTTP_QUERY_RAW_HEADERS_CRLF.l = 22 

  *Memoire = AllocateMemory(Buffer) 

  Result = CreateFile(1, myFile) 
  hInet = InternetOpen_("", OpenType, #Null, #Null, 0) 
  hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0) 
  
  ;get Filesize 
  domain.s = ReplaceString(Left(URL,(FindString(URL, "/",8) - 1)),"http://","") 
  hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0) 
  If hInetCon > 0 
    hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"http://"+domain+"/",""), "http/1.1", #Null, 0, INTERNET_FLAG_RELOAD, 0) 
    If hHttpOpenRequest > 0 
      iretval = HttpSendRequest_(hHttpOpenRequest, #Null, 0, 0, 0) 
      If iretval > 0 
        tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE) 
        If Trim(tmp) = "200" 
          tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF) 
          If FindString(tmp,"Content-Length:",1)>0 
            ii.l=FindString(tmp, "Content-Length:",1) + Len("Content-Length:") 
            tmp = Mid(tmp, ii, Len(tmp)-ii) 
            myMax = Val(Trim(tmp)) 
          EndIf 
        EndIf 
      EndIf 
    EndIf 
  EndIf 
  
  SetGadgetText(#Label, "Taille fichier: " + Str(myMax)) 
  SetProgressbarRange(#progressbar,0,myMax) 
  
  ;start downloading 
  Repeat 
    InternetReadFile_(hURL, *Memoire, Buffer, @Bytes) 
    If Bytes = 0 
      isLoop=0 
    Else 
      fBytes=fBytes+Bytes 
        SetGadgetText(#Label2, "Bytes reçus: " + Str(fBytes)) 
      If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf 
      CreateFile(1, "FileLoaded.*") 
      WriteData(1,*Memoire, Bytes) 
    EndIf 
      DoEvents() 
  Until isLoop=0 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  SetGadgetState(#progressbar, 0) 
  CloseFile(1)    
  FreeMemory(*Memoire) 
EndProcedure 



If OpenWindow(#Window, 0, 0, 400, 175,"Téléchargement avec barre de progression",#PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered ) 

  If CreateGadgetList(WindowID(#Window)) 
      StringGadget(#URL, 10, 10, 380, 20, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg") 
      ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth) 
      TextGadget(#Label, 10, 80,300,20,"Taille fichier: ") 
      TextGadget(#Label2, 10, 100,300,20,"Bytes reçus: ") 
      Frame3DGadget(#Frame, -10, 120, 420, 110, "") 
      ButtonGadget(#cmdExit, 160, 140, 110, 25, "Exit") :GadgetToolTip(#cmdExit,"Fermer et quitter") 
      ButtonGadget(#cmdStart, 280, 140, 110, 25, "Start", #PB_Button_Default) :GadgetToolTip(#cmdStart,"Démarrer le téléchargement") 
  EndIf 
        
  Repeat 
    EventID.l = WaitWindowEvent() 
    If EventID = #PB_Event_Gadget    
      Select EventGadget() 
        Case #cmdStart 
        
          URL.s = GetGadgetText(#URL) 
          
          ;get filename (checking /) 
          myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1) 
          ;request path 
          myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:\") 

          UrlToFileWithProgress(myFolder + myFile, URL) 
        Case #cmdExit 
          End 
      EndSelect 
    EndIf                
  Until EventID = #PB_Event_CloseWindow 
EndIf 
End

Voilà si quelqu'un s'en sent aussi la force lol

PureBasic

dll...

dll...