PureBasic

Pour les non anglophone et pour archive, voici le programme permettant d'exploiter un fichier de donnée afin d'afficher la carte de France sous forme de sprites, un sprite par département.
On peut greffer toutes sortes de données là dessus pour faire un jeu ou un soft didactique d'apprentissage.
Le fichier de données, à mettre dans le même répertoire que le listing.
http://wordoxhelper.free.fr/datadepartements.DAT

Le listing d'affichage: il colorie le département survolé par la souris et affiche le numéro du département.

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitNetwork()=0:MessageRequester("Error","Error DirectX",0):EndIf

If OpenWindow(0,0,0,870,801, "pathfinding Cooperatif ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
    If OpenWindowedScreen(WindowID(0),0,0,870,801,0,0,0,#PB_Screen_NoSynchronization)=0
        MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
        End
    EndIf
EndIf
CreateSprite(200,20,20)
StartDrawing(SpriteOutput(200))
Box(0,0,20,20,#Red)
Box(1,1,20,20,#Black)
StopDrawing()
CreateSprite(201,1,1,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(201))
Plot(0,0,#White)
StopDrawing()
Structure xy
x.i
y.i
EndStructure
Structure dep
numero.i
barycentreX.i
barycentreY.i
xmin.i
ymin.i
Map vecteur.xy()
EndStructure

Global NewList departement.dep()

;charge les departements
If OpenFile(0,"datadepartements.DAT")
    While Eof(0)=0
        AddElement(departement())
        departement()\numero=Val(StringField(ReadString(0),2,": "))
        departement()\barycentreX=Val(StringField(ReadString(0),2,": "))
        departement()\barycentreY=Val(StringField(ReadString(0),2,": "))
        departement()\xmin=Val(StringField(ReadString(0),2,": "))
        departement()\ymin=Val(StringField(ReadString(0),2,": "))
        nb_vecteur.i=Val(StringField(ReadString(0),2,": "))
        xmin=870:ymin=801:xmax=0:ymax=0:a=0
        For i=1 To nb_vecteur
            a+1
            a$=StringField(ReadString(0),2,": ")
            b$=StringField(ReadString(0),2,": ")
            AddMapElement(departement()\vecteur(),a$+"/"+b$)
            departement()\vecteur()\x=Val(a$)
            If departement()\vecteur()\x>xmax:xmax=departement()\vecteur()\x:EndIf
            If departement()\vecteur()\x<xmin:xmin=departement()\vecteur()\x:EndIf
            departement()\vecteur()\y=Val(b$)
            If departement()\vecteur()\y>ymax:ymax=departement()\vecteur()\y:EndIf
            If departement()\vecteur()\y<ymin:ymin=departement()\vecteur()\y:EndIf
        Next
        Debug a
        Debug nb_vecteur
        If CreateSprite(departement()\numero,xmax-xmin+1,ymax-ymin+1,#PB_Sprite_PixelCollision)
        StartDrawing(SpriteOutput(departement()\numero))
            a=0
            ForEach departement()\vecteur()
            a+1
            Plot(departement()\vecteur()\x-xmin,departement()\vecteur()\y-ymin,#Red)
            Next
            Debug a
            FillArea(departement()\barycentreX-xmin-1,departement()\barycentreY-ymin,-1,#White)
        StopDrawing()
        EndIf
    Wend
EndIf



Repeat
WindowEvent()
FlipBuffers()
ClearScreen(#Blue)
ExamineKeyboard()
ExamineMouse()
x=MouseX():y=MouseY()
test_souris.i=-1
ForEach departement()
    DisplayTransparentSprite(departement()\numero,departement()\xmin,departement()\ymin)
    If SpritePixelCollision(201,x,y,departement()\numero,departement()\xmin,departement()\ymin)
        test_souris=ListIndex(departement())
    EndIf
Next

   If test_souris>-1
      SelectElement(departement(),test_souris)
      StartDrawing(ScreenOutput())
         FillArea(departement()\barycentreX,departement()\barycentreY,-1,#Green)
         DrawText(departement()\barycentreX,departement()\barycentreY,Str(departement()\numero))
      StopDrawing()
   EndIf

;display mouse sprite
DisplayTransparentSprite(200,x,y)

Until KeyboardPushed(#PB_Key_Escape)

Je vous fourni aussi le soft qui m'a permit de créer le fichier de données correspondant à une carte de France.
On peut bien sûr s'en servir pour toute sorte de chose, cela permet de "vectoriser" toute figure géométrique délimité par un trait de couleur.
[espace] pour entrer un département pointé par la souris
[S] pour sauvegarder le fichier
[escape] pour sortir

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitNetwork()=0:MessageRequester("Error","Error DirectX",0):EndIf

If OpenWindow(0,0,0,870,801, "carte de France", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
    If OpenWindowedScreen(WindowID(0),0,0,870,801,0,0,0,#PB_Screen_NoSynchronization)=0
        MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
        End
    EndIf
EndIf
CreateSprite(0,20,20)
StartDrawing(SpriteOutput(0))
Box(0,0,20,20,#Red)
Box(1,1,20,20,#Black)
StopDrawing()
LoadSprite(1,"France Map.bmp")
Structure xy
x.i
y.i
EndStructure
Structure dep
numero.i
barycentreX.i
barycentreY.i
xmin.i
ymin.i
Map vecteur.xy()
EndStructure

Global NewList departement.dep()

Procedure Find_limit(x.i,y.i,numero_departement.i)
    AddElement(departement())
    Dim carte.i(870,801)
    NewList fringe.xy()
    AddElement(fringe())
    fringe()\x=x
    fringe()\y=y
    carte(x,y)=1
    StartDrawing(SpriteOutput(1))
    couleur.i=Point(x,y)
    Repeat
        For i=-1 To 1
            For j=-1 To 1
                If i=0 And j=0:Continue:EndIf
                xx=fringe()\x+i:yy=fringe()\y+j
                If carte(xx,yy):Continue:EndIf
                carte(xx,yy)=1
                If Point(xx,yy)<>couleur
                    AddMapElement(departement()\vecteur(),Str(xx)+"/"+Str(yy))
                    departement()\vecteur()\x=xx:departement()\vecteur()\y=yy
                    Continue
                EndIf
                AddElement(fringe())
                fringe()\x=xx:fringe()\y=yy
                PreviousElement(fringe())
            Next j  
        Next i
        DeleteElement(fringe())
    Until FirstElement(fringe())=0
    StopDrawing()
    ;fringe red display
    StartDrawing(SpriteOutput(1))
    xb=0:yb=0:a=0:xmin=870:ymin=801
    ForEach departement()\vecteur()
        a+1
        If departement()\vecteur()\x<xmin:xmin=departement()\vecteur()\x:EndIf
        If departement()\vecteur()\y<ymin:ymin=departement()\vecteur()\y:EndIf
        Plot(departement()\vecteur()\x,departement()\vecteur()\y,#Red)
        xb=departement()\vecteur()\x+xb
        yb=departement()\vecteur()\y+yb
    Next
    Debug a
    departement()\xmin=xmin
    departement()\ymin=ymin
    ;barycentre
    xb=xb/MapSize(departement()\vecteur())
    yb=yb/MapSize(departement()\vecteur())-2
    FillArea(xb,yb,-1,#Black)
    StopDrawing()
    departement()\barycentreX=xb:departement()\barycentreY=yb
    departement()\numero=numero_departement
EndProcedure

Repeat
WindowEvent()
FlipBuffers()
ClearScreen(#Black)
ExamineKeyboard()
ExamineMouse()
x=MouseX():y=MouseY()
;display map
DisplaySprite(1,0,0)
StartDrawing(ScreenOutput())
ForEach departement()
    DrawText(departement()\barycentreX-7,departement()\barycentreY-5,Str(departement()\numero))
Next
StopDrawing()
;display mouse sprite
DisplayTransparentSprite(0,x,y)

If KeyboardReleased(#PB_Key_Space) ;And carte(x,y)=0
    ;input department number
    numero_departement.i=Val(InputRequester("Numero du département","entrez le numéro du département",""))
    find_limit(x,y,numero_departement)
EndIf
;sauvegarde
If KeyboardReleased(#PB_Key_S) And CreateFile(0,"datadepartements.DAT")
ForEach departement()
    WriteStringN(0,"Numero departement: "+Str(departement()\numero))
    WriteStringN(0,"Barycentre X: "+Str(departement()\barycentreX))
    WriteStringN(0,"Barycentre Y: "+Str(departement()\barycentreY))
    WriteStringN(0,"Pt haut gauche X: "+Str(departement()\xmin))
    WriteStringN(0,"Pt haut gauche Y: "+Str(departement()\ymin))
    WriteStringN(0,"NB vecteur: "+Str(MapSize(departement()\vecteur())))
    a=0
    ForEach departement()\vecteur()
    a+1
    WriteStringN(0,"PT"+Str(a)+" X: "+Str(departement()\vecteur()\x))
    WriteStringN(0,"PT"+Str(a)+" Y: "+Str(departement()\vecteur()\y))
    Next
    Debug a
Next
CloseFile(0)
EndIf


Until KeyboardPushed(#PB_Key_Escape)

Une carte qui va avec pour l'exemple:

La carte utilise un système de projection ?

Le premier poste utilise un fichier créé avec le programme du deuxieme poste.

Un bout du fichier Dat au format texte. J'ai fait en sorte que ce soit lisible:
Numero departement: 94
Barycentre X: 431
Barycentre Y: 202
Pt haut gauche X: 424
Pt haut gauche Y: 199
NB vecteur: 51
PT1 X: 425
PT1 Y: 207
...
PT51 X:425
PT51 Y:208
...etc pour chaque département.

Les Pt1... sont les coordonnées des points de la périphérie du département. En les liant par des lignes ont peut changer d'échelle sans utiliser le zoom des sprites...

Pour le coup cela est une véritable archive, s'ils disparaissent pour de bon, à ce qu'on entend de-ci de-là!

Vraiment sympa !

Pour plus de fluidité pour l'exemple d'affichage de la carte, tu peux modifier le bout suivant :

Code : Tout sélectionner

	If test_souris>-1 
	SelectElement(departement(),test_souris) 
	StartDrawing(ScreenOutput()) 
	FillArea(x,y,-1,#Green) 
	DrawText(x,y,Str(departement()\numero)) 
	StopDrawing() 
	EndIf

par

Code : Tout sélectionner

	If test_souris>-1
		SelectElement(departement(),test_souris)
		StartDrawing(ScreenOutput())
		If Point(x, y) <> #Red
			FillArea(x,y,-1,#Green)
			
			DrawText(x,y,Str(departement()\numero))
		EndIf
		StopDrawing()
	EndIf

Et pour la suite, tu peux ajouter un filtre qui permet d'obtenir les limites pour une image qui n'est de couleur uniforme

Graph100> Merci.

J'ai adapté ton idée et modifié le listing...
Pas de problème, le listing d'affichage de la carte n'est qu'un exemple, chacun en fera ce qu'il veut, le plus important étant la partie qui fabrique les sprites.
Ensuite, il y a possibilité de faire des trucs sympa genre les départements éclatés qui viennent s'assembler tout seuls par exemple... etc

Frenchy Pilou> Je ne garantis pas que ça ne disparaitra pas, en ce qui concerne ce que j'héberge. (la carte et le fichier Dat)
Pour le listing c'est sûr que non... (on peut prendre quasiment n'importe quelle carte et refaire un fichier Dat avec le deuxième listing, donc...)
Ceux que ça intéresse se mettent de coté le bidule, voila.

Si la nouvelle fonctionnalité Json était intégré à la LTS j'aurais pu encore réduire le listing pour plus de lisibilité.
Je trouve dommage que sur le forum français, les balises "code" ne tronquent pas le listing comme sur le forum anglais, ça donne plus de lisibilité.

bonjour à tous
beau travail, merci Fig pour le partage

Pour définir des zones d’image cliquable, on peut aussi utiliser la méthode de ce petit Tuto
http://seoisnotacrime.com/carte-image-cliquable/

Cordialement

PureBasic

Carte de France vectorisé [LTS 5.22]

Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé

Re: Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé [LTS 5.22]

Re: Carte de France vectorisé [LTS 5.22]