Ecran de veille

Programmation d'applications complexes
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

j'ai hate de voir le code :D
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

je n'ai pas trop le temps de m'en occuper la semaine , ça sera pour ce week-end .

Si c'est la partie écran de veille qui t'intéresse ,je me suis contenté de reprendre le code de Kale.
J'ai vu que son code respectait les principes énoncés sur le site http://nono40.developpez.com/tutoriel/d ... reensaver/ , donc je ne me suis pas cassé la tête , un simple copier/coller et hop , ça marche.
Il y a une portion de son code que je ne comprends pas , mais bon , il faut garder une part de mystère :)

je ferai éventuellement des recherches pour essayer d'en savoir plus, je crois qu'il donnait le lien où il avait trouvé "l'inspiration" , j'irai y jeter un oeil .

enfin ,il est super cool son code ,ça m"a rendu bien service :)
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

c super j'aime beaucoup
Image
Fred
Site Admin
Messages : 2808
Inscription : mer. 21/janv./2004 11:03

Message par Fred »

Excellent :). Comtois touche vraiment à tout..
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Message par nico »

:o
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

je n'ai pas eu le temps d'ajouter ce que je voulais , mais voila le code quand même :)

J'ai une petite question , quand j'ouvre la fenêtre configuration , je vois les gadgets s'afficher un par un , comment faire pour que la fenêtre s"affiche avec tous les gadgets en une fois ?

REmarque : Le fichier 0100_boules.PNG est extrait du jeu Bubble de djes ( dans sa signature ) .

Code : Tout sélectionner

;Comtois le 26/02/05
;Pour l'écran de veille , j'ai trouvé de l'aide sur les sites suivants 
;http://nono40.developpez.com/tutoriel/delphi/screensaver/
;http://purebasicforums.com/english/viewtopic.php?t=8891
;http://purebasicforums.com/english/viewtopic.php?t=6010
;http://purebasic.hmt-forum.com/viewtopic.php?t=2439

;Merci à tous 

;{-Include
Declare Erreur(Message$)
Declare Limite(*Valeur.LONG, Min.l, Max.l)
Declare TracePolygone()
Declare AffPoints()
Declare TestPoint(X1.l, Y1.l, X2.l, Y2.l, d.l)
Declare PolygoneConvexe()
Declare Repartition()
Declare SauvePreference()
Declare ChargePreference()
Declare OnlyOneSCRStart(ScreensaverName.s)
Declare OnlyOneSCRStop()
Declare ExecutePreview()
Declare ExecuteScreenSaver()
Declare Config()
Enumeration
  #Window_0
  #TrackBar_NbBoules
  #Radio_CoulBoule
  #Frame3D_Lignes
  #Radio_AutreCoul
  #Frame3D_Boules
  #TrackBar_Sprite
  #Button_Ok
  #Button_Annuler
  #Button_Infos
  #Image_Conf
  #Button_CoulFond
  #Button_CoulLigne
  #Frame3D_Fond
  #String_NbBoules
  #String_Sprite
EndEnumeration

#Taille = 20

Structure NewPoint
  x.l
  y.l
  dx.l
  dy.l
EndStructure  

Structure Conf
  NbBoules.l        ; de 2 à 50 
  Sprite.l          ; 1 à 8 sprites possibles
  CoulFond.l        ; 
  CoulSprite.l[8]   ; Mémorise la couleur des sprites
  SelectCoulLigne.l ; Couleur identique aux boules = 0 , autre = 1
  CoulLigne.l  
EndStructure

NewList ListPoint.NewPoint()
NewList Polygone.NewPoint()

Dim TexteCouleur.s(8)
Global Conf.Conf
Global ScreenWidth.l
Global ScreenHeight.l
Global previewFlag.l
Global Parameter.s
Global prevWinHndlString.s
Global prevWinHndl.l
Global prevThreadID.l
Global Couleur.l

ScreensaverName.s = "Polygone convexe"
ScreenWidth.l = GetSystemMetrics_(#SM_CXSCREEN)
ScreenHeight.l = GetSystemMetrics_(#SM_CYSCREEN)

Restore RgbCouleurs
For i=0 To 7
  Read Conf\CoulSprite[i]
Next i
Restore TxtCouleurs
For i=0 To 7
  Read TexteCouleur(i)
Next  

LoadFont(0, "Comic sans MS", 10) 
;}

;{- Gestion écran de veille
;Récupère le paramètre passé au programme 
Parameter = UCase(ProgramParameter())

If Len(Parameter) > 2

  prevWinHndlString = RemoveString(Parameter, Left(Parameter, 3), 1)
  Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
  Parameter = Left(Parameter, 1)
  
Else
  
  Parameter = RemoveString(Parameter, Left(Parameter, 1), 1)
  prevWinHndlString = ProgramParameter()
  If FindString(prevWinHndlString, "-", 0) <> 0 : prevWinHndlString = RemoveString(prevWinHndlString, "-", 1) : EndIf
  If FindString(prevWinHndlString, "/", 0) <> 0 : prevWinHndlString = RemoveString(prevWinHndlString, "/", 1) : EndIf
  
EndIf

prevWinHndl = Val(prevWinHndlString)
;}

;Une seule instance du programme !
OnlyOneSCRStart(ScreensaverName)

;Gestion des paramètres passés au programme
Select Parameter
  
  Case "" ;double click
    Config()
    
  Case "A" ;Mot de passe
    End
    
  Case "C" ;Configuration 
    Config()
    
  Case "P" ;Prévisualisation
    ExecutePreview()
    
  Case "S" ;Ecran de veille 
    ExecuteScreenSaver()
    
EndSelect

OnlyOneSCRStop()

End

;-PROCEDURES
;Une seule instance de l'écran de veille
Procedure OnlyOneSCRStart(ScreensaverName.s)
  ;repris entièrement d'un code de Kale
  *MutexName = @ScreensaverName
  Shared OnlyOneStartMutex.l
  OnlyOneStartMutex = CreateMutex_(0, 1, *MutexName)
  OnlyOneStartError.l = GetLastError_()
  
  If OnlyOneStartMutex <> 0 And OnlyOneStartError = 0
    ProcedureReturn 1
  Else
    CloseHandle_(OnlyOneStartMutex)
    End
  EndIf
  
EndProcedure

;Ferme l'écran de veille
Procedure OnlyOneSCRStop()
  ;repris entièrement d'un code de Kale  
  CloseHandle_(OnlyOneStartMutex)
EndProcedure

;preview window callback
Procedure PreviewCallback(hWnd, message, wParam, lParam)
  ;repris entièrement d'un code de Kale
  Select message
    Case #WM_CLOSE
      UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#Null))
      DestroyWindow_(hWnd)
      End
  EndSelect
  Result = DefWindowProc_(hWnd, message, wParam, lParam)
  ProcedureReturn Result
EndProcedure

;Lance la prévisualisation 
Procedure ExecutePreview()
  ;repris d'un code de Kale
  previewWindowSize.rect
  GetClientRect_(prevWinHndl, @previewWindowSize)
  PreviewWindowClass.WNDCLASS
  Classname.s = "PreviewWindowClass"
  PreviewWindowClass\style = #CS_HREDRAW | #CS_VREDRAW
  PreviewWindowClass\lpfnWndProc = @PreviewCallback()
  PreviewWindowClass\cbClsExtra = 0
  PreviewWindowClass\cbWndExtra = 0
  PreviewWindowClass\hInstance = GetModuleHandle_(#Null)
  PreviewWindowClass\hIcon = 0
  PreviewWindowClass\hCursor = 0
  PreviewWindowClass\hbrBackground = 0
  PreviewWindowClass\lpszMenuName = 0
  PreviewWindowClass\lpszClassName = @Classname
  RegisterClass_(PreviewWindowClass)
  hWnd.l = CreateWindowEx_(0, "PreviewWindowClass", "", #WS_CHILD | #WS_VISIBLE, 0, 0, previewWindowSize\right, previewWindowSize\bottom, prevWinHndl, 0, GetModuleHandle_(#Null), 0)
  
  If hWnd
    
    CreateImage(1,previewWindowSize\right, previewWindowSize\bottom)
    StartDrawing(ImageOutput())
    
    For y=0 To ImageHeight()
      Line(0,y,ImageWidth(),1,RGB(0,$FF*y/ImageHeight(),$CC*y/ImageHeight()))
    Next
    
    DrawingMode(1)
      DrawingFont(UseFont(0))
      FrontColor(255, 255, 255)
      T$="Polygone convexe" 
      Locate((ImageWidth() - TextLength(T$)) / 2, (ImageHeight() / 2) - 20)
      DrawText(T$)
      T$="H.Demarche - 19/02/05"
      Locate((ImageWidth() - TextLength(T$)) / 2, (ImageHeight() / 2) + 20)
      DrawText(T$)            
    StopDrawing()
    
    If CreateGadgetList(hWnd) = 0
      Erreur("Gadget list in preview window could not be created!")
    EndIf
    
    ImageGadget(1, 0, 0, previewWindowSize\right, previewWindowSize\bottom, UseImage(1))
    
    While GetMessage_(message.MSG, 0, 0, 0)
      TranslateMessage_(message)
      DispatchMessage_(message)
    Wend
    
  EndIf
  
EndProcedure

;Lance l'écran de veille 
Procedure ExecuteScreenSaver()
  
  Shared ScreensaverName 
  
  If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
    Erreur("Impossible d'initialiser DirectX 7 Ou plus")
  ElseIf OpenScreen(ScreenWidth, ScreenHeight, 32, ScreensaverName) = 0
    Erreur("impossible d'ouvrir le mode plein écran!")
  EndIf
  
  ;Informe le système que l'on est en écran de veille
  SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 1, @oldval, 0)
  
  ;Cache la souris
  ShowCursor_(0)
   
  ChargePreference()
  Repartition()
  
  ;/Sprite
  UsePNGImageDecoder()
  
  TransparentSpriteColor(-1, 255, 0, 255) 
  
  If CatchSprite(10, ?Boules)=0
    Erreur("CatchSprite")
  EndIf
  
  ClipSprite(10,Conf\Sprite * 40, 0, 40, 40)
  
  Repeat
    
    ClearScreen(Red(Conf\CoulFond), Green(Conf\CoulFond), Blue(Conf\CoulFond))
    
    AffPoints()
    PolygoneConvexe()
    TracePolygone()
    
    ForEach ListPoint()
      DisplayTransparentSprite(10, ListPoint()\x - #Taille, ListPoint()\y - #Taille)
    Next  
    
    FlipBuffers()
    Delay(1)
    ExamineKeyboard()
    ExamineMouse()
    
  Until KeyboardPushed(#PB_Key_All) Or MouseDeltaX() <> 0 Or MouseDeltaY() <> 0 Or MouseWheel() <> 0 Or MouseButton(1) <> 0 Or MouseButton(2) <> 0
  
  ;Montre la souris
  ShowCursor_(1)
  
  ;Informe le système que l'on est plus en écran de veille
  SystemParametersInfo_(#SPI_SCREENSAVERRUNNING, 0, @oldval, 0)
  
  End
  
EndProcedure

;Lance la configuration
Procedure ImageConf()
  
  If Conf\SelectCoulLigne = 0
    Conf\CoulLigne = Conf\CoulSprite[Conf\Sprite]
  EndIf  
  
  UseImage(0)
  
  StartDrawing(ImageOutput())
  
  d = 15
  
  Box(0,0,ImageWidth(),ImageHeight(),Conf\CoulFond)
  
  LineXY(ImageWidth() / 2, d, d, ImageHeight() - d, Conf\CoulLigne)
  LineXY(ImageWidth() / 2, d, ImageWidth() - d, ImageHeight() - d, Conf\CoulLigne)
  LineXY(10, ImageHeight() - d, ImageWidth() - d, ImageHeight() - d, Conf\CoulLigne)
  
  Circle(ImageWidth() / 2, d, 12, Conf\CoulSprite[Conf\Sprite])
  Circle(ImageWidth() - d, ImageHeight() - d, 12, Conf\CoulSprite[Conf\Sprite])
  Circle(d, ImageHeight() - d, 12, Conf\CoulSprite[Conf\Sprite])
  
  StopDrawing()
  
  SetGadgetState(#Image_Conf, ImageID()) 
  
EndProcedure

Procedure Config()
  
  Shared ScreensaverName
  CreateImage(0,200,200)
  
  If OpenWindow(#Window_0, 216, 0, 472, 235, #PB_Window_SystemMenu | #PB_Window_WindowCentered , ScreensaverName)
    
    If CreateGadgetList(WindowID())
      
      Frame3DGadget(#Frame3D_Boules, 10, 10, 220, 70, "Boules")
      TrackBarGadget(#TrackBar_Sprite, 20, 50, 130, 20, 0, 7, #PB_TrackBar_Ticks)
      GadgetToolTip(#TrackBar_Sprite, "Sélection couleur des boules")
      TrackBarGadget(#TrackBar_NbBoules, 20, 30, 130, 20, 2, 50)
      GadgetToolTip(#TrackBar_NbBoules, "Nombre de boules")
      StringGadget(#String_NbBoules, 160, 30, 60, 20, "", #PB_String_Numeric )
      GadgetToolTip(#String_NbBoules, "Nombre de boules")
      StringGadget(#String_Sprite, 160, 50, 60, 20, "", #PB_String_ReadOnly)
      GadgetToolTip(#String_Sprite, "Nombre de boules")
      
      Frame3DGadget(#Frame3D_Lignes, 10, 80, 220, 70, "Lignes")
      OptionGadget(#Radio_AutreCoul, 20, 120, 90, 20, "Autre couleur")
      OptionGadget(#Radio_CoulBoule, 20, 100, 100, 20, "Couleur boules")
      ButtonGadget(#Button_CoulLigne, 130, 120, 90, 20, "Couleur lignes")
      GadgetToolTip(#Button_CoulLigne, "Couleur des lignes")
      
      Frame3DGadget(#Frame3D_Fond, 10, 150, 220, 50, "Fond")
      ButtonGadget(#Button_CoulFond, 20, 170, 200, 20, "Couleur du fond")
      GadgetToolTip(#Button_CoulFond, "Couleur du fond")
      
      ButtonGadget(#Button_Ok, 10, 210, 60, 20, "Ok")
      ButtonGadget(#Button_Annuler, 90, 210, 60, 20, "Annuler")
      ButtonGadget(#Button_Infos, 170, 210, 60, 20, "Infos")
      
      ImageGadget(#Image_Conf, 250, 20, 200, 200, ImageID(), #PB_Image_Border)
    EndIf
    
    ChargePreference()
    SetGadgetState(#TrackBar_NbBoules, Conf\NbBoules)
    SetGadgetState(#TrackBar_Sprite, Conf\Sprite)
    
    If Conf\SelectCoulLigne = 1 
      SetGadgetState(#Radio_CoulBoule, 0) 
      SetGadgetState(#Radio_AutreCoul, 1)   
      HideGadget(#Button_CoulLigne, 0)
    Else
      SetGadgetState(#Radio_CoulBoule, 1) 
      SetGadgetState(#Radio_AutreCoul, 0) 
    EndIf  
    
    SetGadgetText(#String_NbBoules, Str(Conf\NbBoules))
    SetGadgetText(#String_Sprite, TexteCouleur(Conf\Sprite))
    

    ImageConf()


    Repeat
      
      EventID.l = WaitWindowEvent()
      
      Select EventID
        
        Case 0
         
          Delay(1)
        
        Case #PB_EventCloseWindow
          Quit = 1
          
        Case #PB_Event_Gadget
          
          Select EventGadgetID()
            
            Case #Button_Annuler
              ChargePreference()
              Quit = 1
              
            Case #Button_Ok
              SauvePreference()
              Quit = 1
              
            Case #Button_Infos
              MessageRequester("Infos","Merci à djes pour ces dessins , et un grand merci à la communauté Purebasic", 0)
              
            Case #TrackBar_NbBoules
              Conf\NbBoules = GetGadgetState(#TrackBar_NbBoules) 
              SetGadgetText(#String_NbBoules,Str(Conf\NbBoules))
              
            Case #String_NbBoules
              Conf\NbBoules = Val(GetGadgetText(#String_NbBoules)) 
              Conf\NbBoules = M3D_MinMax(Conf\NbBoules, 2, 50) 
              SetGadgetState(#TrackBar_NbBoules, Conf\NbBoules)
              
            Case #TrackBar_Sprite
              Conf\Sprite = GetGadgetState(#TrackBar_Sprite)  
              SetGadgetText(#String_Sprite, TexteCouleur(Conf\Sprite))
              ImageConf()
              
            Case #Radio_CoulBoule
              Conf\SelectCoulLigne = 0
              HideGadget(#Button_CoulLigne, 1)
              Conf\CoulLigne = Conf\CoulSprite[Conf\Sprite]
              ImageConf()
              
            Case #Radio_AutreCoul
              Conf\SelectCoulLigne = 1  
              HideGadget(#Button_CoulLigne, 0)
              
            Case #Button_CoulLigne
              Color.l = ColorRequester(Conf\CoulLigne) 
              If Color > -1 
                Conf\CoulLigne = Color
              EndIf
              ImageConf()
              
            Case #Button_CoulFond
              Color.l = ColorRequester(Conf\CoulFond) 
              If Color > -1 
                Conf\CoulFond = Color
              EndIf  
              ImageConf()
              
          EndSelect
          
      EndSelect    
      
    Until Quit
    
  EndIf
  
  End
  
EndProcedure
Procedure Erreur(Message$)
  
  MessageRequester("Erreur", Message$, 0) 
  End 
  
EndProcedure
Procedure SauvePreference()

  FichierPreference.s = Space(255)
  GetModuleFileName_(0, @FichierPreference, 255)
  FichierPreference = GetPathPart(FichierPreference)
  
  If Right(FichierPreference, 1) <> "\"
    FichierPreference + "\"
  EndIf
  
  Fichier$ = FichierPreference + "Polygone.ini"
  
  If CreatePreferences(Fichier$)
    
    PreferenceComment("Couleur de l'écran")
    WritePreferenceLong("Couleur de l'écran", Conf\CoulFond)  
    PreferenceComment(" ") 
    PreferenceComment("de 2 à 50 boules")
    WritePreferenceLong("Nombre de boules", Conf\NbBoules)
    PreferenceComment(" ") 
    PreferenceComment("Sélection boule : de 0 à 7")
    WritePreferenceLong("Sélection boule",Conf\Sprite)  
    PreferenceComment(" ") 
    PreferenceComment("Sélection Couleur des lignes ( couleur identique aux boules = 0 , autre = 1")
    WritePreferenceLong("Sélection couleur lignes",Conf\SelectCoulLigne)  
    PreferenceComment(" ") 
    PreferenceComment("Couleur des lignes")
    WritePreferenceLong("Couleur des lignes", Conf\CoulLigne)  
    ClosePreferences()
    
  Else
    
    Erreur("sauve préférence")
    
  EndIf
  
EndProcedure
Procedure ChargePreference()
  
  FichierPreference.s = Space(255)
  GetModuleFileName_(0, @FichierPreference, 255)
  FichierPreference = GetPathPart(FichierPreference)
 
  If Right(FichierPreference, 1) <> "\"
    FichierPreference + "\"
  EndIf
  
  Fichier$= FichierPreference + "Polygone.ini"
  
  If OpenPreferences(Fichier$)
    
    Conf\CoulFond        = ReadPreferenceLong("Couleur de l'écran", 0)  
    Limite(@Conf\CoulFond, 0, $FFFFFF) 
    Conf\NbBoules        = ReadPreferenceLong("Nombre de boules", 6)
    Limite(@Conf\NbBoules, 2, 50) 
    Conf\Sprite          = ReadPreferenceLong("Sélection boule", 1)  
    Limite(@Conf\Sprite, 0, 7) 
    Conf\SelectCoulLigne = ReadPreferenceLong("Sélection couleur lignes", 0)  
    Limite(@Conf\SelectCoulLigne, 0, 1) 
    Conf\CoulLigne       = ReadPreferenceLong("Couleur des lignes", $FFFFFF)  
    Limite(@Conf\CoulLigne, 0, $FFFFFF) 
    
    ClosePreferences()
    
  EndIf  
EndProcedure
Procedure Repartition()
  
  ;Répartition des boules sur l'écran 
  For i = 1 To Conf\NbBoules
    
    AddElement(ListPoint()) 
    *MemPos.NewPoint = ListPoint()
    MemIndex = ListIndex(ListPoint())
    
    Repeat
      
      Collision = #False
      x = #Taille + Random(ScreenWidth - #Taille * 2)
      y = #Taille + Random(ScreenHeight - #Taille * 2)
      
      If CountList(ListPoint()) > 1
        
        ForEach ListPoint()
          
          If ListIndex(ListPoint()) = MemIndex
            Continue
          EndIf  
          
          If Sqr(Pow(ListPoint()\x - x, 2.0) + Pow(ListPoint()\y - y, 2.0)) <= #Taille * 2 
            Collision = #True
            Break
          EndIf
          
        Next
        
      EndIf
      
    Until Collision = #False
    
    SelectElement(ListPoint(), MemIndex)
    ListPoint()\x = x
    ListPoint()\y = y
    ListPoint()\dx = 2 + Random(2)
    ListPoint()\dy = 2 + Random(2)
    
  Next
EndProcedure
Procedure PolygoneConvexe()
  
  If CountList(ListPoint()) < 2
    ProcedureReturn #False
  EndIf
  
  ;Initialise 
  *Min.NewPoint = #Null
  *p0.NewPoint  = #Null
  *pi.NewPoint  = #Null
  *pc.NewPoint  = #Null
  
  ;Trouve le point le plus bas dans la liste des points
  FirstElement(ListPoint())
  *Min = ListPoint()
  
  ForEach ListPoint()
    
    *p0 = ListPoint()
    
    ;Mémorise le point le plus bas , ou le plus à gauche s'il y a égalité
    If (*p0\y < *Min\y) Or ((*p0\y = *Min\y) And (*p0\x < *Min\x))
      *Min = *p0
    EndIf
    
  Next  
  
  ;Initialise la liste pour le contour convexe
  ClearList(Polygone())
  
  ;Effectue la progression de Jarvis pour calculer le contour 
  *p0 = *Min
  
  Repeat
    
    ;Insertion du nouveau p0 dans le contour convexe
    If AddElement(Polygone()) = 0
      Erreur("plus de mémoire pour ajouter un élément dans polygone")
    Else  
      Polygone()\x = *p0\x
      Polygone()\y = *p0\y
    EndIf
    
    ;Trouve le point pc dans le sens des aiguilles d'une montre
    *pc = #Null
    
    ForEach ListPoint()
      
      *pi = ListPoint()
    
      ;Saute p0 
      If *pi = *p0
        Continue
      EndIf
      
      ;Sélectionne le premier point 
      If *pc = #Null
        *pc = ListPoint()
        Continue
      EndIf
      
      ;Teste si pi est dans le sens des aiguilles d'une montre par rapport à pc
      z=(((*pi\x - *p0\x) * (*pc\y - *p0\y)) - ((*pi\y - *p0\y) * (*pc\x - *p0\x))) 
      
      If z > 0
        
        ;pi est dans le sens des aiguilles d'une montre par rapport à pc
        *pc = *pi
        
      ElseIf z = 0
      
        ;Si pi et pc sont colinéaires , on choisit le plus éloigné de p0
        longueurpi = Pow(*pi\x - *p0\x, 2.0) + Pow(*pi\y - *p0\y, 2.0)
        longueurpc = Pow(*pc\x - *p0\x, 2.0) + Pow(*pc\y - *p0\y, 2.0)
        
        If longueurpi > longueurpc
          *pc = *pi
        EndIf
        
      EndIf  
      
    Next
    
    ;Cherche le point suivant
    *p0 = *pc
    
  Until *p0 = *Min
  
EndProcedure
Procedure TracePolygone()
  
  If Conf\SelectCoulLigne
    CouleurPolygone = Conf\CoulLigne
  Else
    CouleurPolygone = Conf\CoulSprite[Conf\Sprite]
  EndIf
  
  StartDrawing(ScreenOutput())
  
    SelectElement(Polygone(), 0)
    *mem0.NewPoint = Polygone()
    *mem.NewPoint  = Polygone()
    
    While NextElement(Polygone())
      LineXY(*mem\x, *mem\y, Polygone()\x, Polygone()\y, CouleurPolygone)
      *mem = Polygone()
    Wend  
    
    LineXY(*mem0\x, *mem0\y, *mem\x, *mem\y, CouleurPolygone)
    
  StopDrawing()
    
EndProcedure
Procedure.l Limite(*Valeur.LONG, Min.l, Max.l)
  
  If *Valeur\l < Min
    
    *Valeur\l = Min
    ProcedureReturn #True
    
  ElseIf *Valeur\l > Max
    
    *Valeur\l = Max
    ProcedureReturn #True
    
  EndIf
  
EndProcedure
Procedure AffPoints()
  
  ForEach ListPoint()
    
    ListPoint()\x + ListPoint()\dx
    ListPoint()\y + ListPoint()\dy 
    
    If Limite(@ListPoint()\x, #Taille, ScreenWidth - #Taille)
      ListPoint()\dx * -1
    EndIf
    
    If Limite(@ListPoint()\y, #Taille, ScreenHeight - #Taille)
      ListPoint()\dy * -1
    EndIf
    
    *MemPos.NewPoint = ListPoint()
    MemIndex = ListIndex(ListPoint())
    
    ForEach ListPoint()

      If ListIndex(ListPoint()) = MemIndex
        Continue
      EndIf  
      
      ;Calcul la distance 
      Distance = Sqr(Pow(ListPoint()\x - *MemPos\x, 2.0) + Pow(ListPoint()\y - *MemPos\y, 2.0))
      
      If Distance <= #Taille * 2
        *MemPos\dx * -1
        *MemPos\dy * -1  
        *MemPos\x + *MemPos\dx
        *MemPos\y + *MemPos\dy 
      EndIf
      
    Next 
    
    SelectElement(ListPoint(), MemIndex)
    
  Next
  
EndProcedure

Procedure TestPoint(X1.l, Y1.l, X2.l, Y2.l, d.l)
  
  If X1 > X2 - d And X1 < X2 + d And Y1 > Y2 - d And Y1 < Y2 + d
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
  
EndProcedure

;-Datas

DataSection
RgbCouleurs:
Data.l $D6, $D6D6, $D600, $D64500, $C700D6, $5FF4, $C2D600, $6B6B6B
TxtCouleurs:
Data.s "Rouge", "Jaune", "Vert", "Bleu", "Violet", "Orange", "Cyan", "Gris"
Boules:
IncludeBinary "0100_boules.PNG"
EndDataSection
Dernière modification par comtois le dim. 27/févr./2005 14:44, modifié 1 fois.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

comtois a écrit : J'ai une petite question , quand j'ouvre la fenêtre configuration , je vois les gadgets s'afficher un par un , comment faire pour que la fenêtre s"affiche avec tous les gadgets en une fois ?
Mets la fenêtre avec le flag #PB_Window_Invisible

et juste avant la boucle de cette fenêtre mets

Code : Tout sélectionner

HideWindow(WindowID(), 0)
si ça ne va pas met le Hide devant l'appel de la procedure ImageConf()
Fred
Site Admin
Messages : 2808
Inscription : mer. 21/janv./2004 11:03

Message par Fred »

C'est une erreur dans le code. Le 'Delay(1)' ne doit etre executé que s'il n'y a plus d'évènement dans la queue, donc dans le 'Case 0' à la place de 'Default'.
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

exact , ça fonctionne beaucoup mieux en mettant le delay(1) au bon endroit :)

Merci
Répondre