dll...

Le psychopathe · Message par **Le psychopathe** » lun. 24/juil./2006 23:51

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

Jacobus · Message par **Jacobus** » mar. 25/juil./2006 1:35

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.

Flype · Message par **Flype** » mar. 25/juil./2006 1:40

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

nico · Message par **nico** » mar. 25/juil./2006 19:08

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

Dr. Dri · Message par **Dr. Dri** » mar. 25/juil./2006 19:38

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

nico · Message par **nico** » mar. 25/juil./2006 20:38

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.

KarLKoX · Message par **KarLKoX** » mar. 25/juil./2006 21:47

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

Dr. Dri · Message par **Dr. Dri** » mer. 26/juil./2006 6:55

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

Dri

KarLKoX · Message par **KarLKoX** » mer. 26/juil./2006 9:10

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.

nico · Message par **nico** » mer. 26/juil./2006 11:23

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.

Le psychopathe · Message par **Le psychopathe** » mer. 26/juil./2006 15:50

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