Create a map 2D with PB

wilbert · Post by **wilbert** » Wed Jun 25, 2014 10:48 am

You could also consider using the new OpenGLGadget.
Unfortunately I'm not familiar with OpenGL but I guess zooming might be easier compared to the CanvasGadget.

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 11:13 am

Yes ..i can, i can....but i not dare !!!

In fact, i have thinking to all this splendid and power library before create this thread...

But i say to me :

"KCC...when you are not able to ride a donkey...."

"It's not a real good idea to try a bull....

"

"Even romantic"

Fig · Post by **Fig** » Wed Jun 25, 2014 12:11 pm

Kwaï chang caïne wrote: So in my little head i say to me perhaps the second code create the "datadepartements.DAT" for the first ???
I have try and see all the departements selectionned is saved in the "datadepartements.DAT"

As you guessed, the second code generates the "Datadepartement.Dat" for the first code.
This second code fill the departement you select with the mouse and "extract" the shape of the departement.
Then it exports them in the datadepartements.Dat
You don't really need the second code except if you want to adapt the data for an other use. (or an other map... Romania, Russia, Germany, Europe... take your pick)
Maybe it may interest someone in the future, so i keep the second code here.

Kwaï chang caïne wrote: And justly, my second stupid question is how you select all the department for create this data ?? http://wordoxhelper.free.fr/datadepartements.DAT

Yes i already answered to this... It's kind of a Dijkstra flooding. Not really a big deal.

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 1:07 pm

Fig wrote:You don't really need the second code except if you want to adapt the data for an other use. (or an other map... Romania, Russia, Germany, Europe... take your pick)

Justly, i begin to the france, but after i try to do some departements and their township...
It's for that i ask to you that.. (You have reading in my mind)

In fact little KCC not really have the word like ambition, it's too big

....
The "Rhone-alpes" region is enough for the moment

I have see some card on the web with only the border of regions and townships, but apparently numerous is not freeware

RASHAD · Post by **RASHAD** » Wed Jun 25, 2014 1:14 pm

Ctrl + ,Ctrl - to Zoom In or Out
Ctrl + MouseWheel to Zoom in or out
Arrow keys to move Up ,Down, Left & Right
Have fun KCC

Code: Select all

Procedure Mouse_Wheel(Delta)
  In.INPUT
  In\type        = #INPUT_MOUSE;
  In\mi\dwFlags  = #MOUSEEVENTF_WHEEL
  In\mi\mouseData = Delta * 120
  SendInput_(1,@In,SizeOf(INPUT))
EndProcedure

Procedure LeftClick()
  In.INPUT
  In\type        = #INPUT_MOUSE
  In\mi\dwFlags  = #MOUSEEVENTF_LEFTDOWN
  SendInput_(1,@In,SizeOf(INPUT))

  In\mi\dwFlags  = #MOUSEEVENTF_LEFTUP
  SendInput_(1,@In,SizeOf(INPUT))
EndProcedure

LoadImage(0,"g:\projects\for test\France Map2.bmp")
CreateImage(1,ImageWidth(0),ImageHeight(0))
If  FileSize(GetHomeDirectory()+"France Map2.bmp") > 0
     DeleteFile(GetHomeDirectory()+"France Map2.bmp")
EndIf

If OpenWindow(0, 0, 0, ImageWidth(0)+20,ImageHeight(0)+80,  "WebGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_SizeGadget)
  ContainerGadget(4,10,10,ImageWidth(0),ImageHeight(0))
     WebGadget(0, 0, 0, ImageWidth(0), ImageHeight(0), "") 
  CloseGadgetList()
  HideGadget(4,1)
  CanvasGadget(1,10,10,ImageWidth(0),ImageHeight(0),#WS_CLIPSIBLINGS)
  StartDrawing(CanvasOutput(1))
      DrawImage(ImageID(0),0,0)
  StopDrawing()
  
  ButtonGadget(2,10,ImageHeight(0)+20,80,24,"Edit")
  ButtonGadget(3,100,ImageHeight(0)+20,80,24,"ZOOM In/Out")
  SetWindowColor(0,#Gray)
     
  AddKeyboardShortcut(0,#PB_Shortcut_Control|107,1)
  AddKeyboardShortcut(0,#PB_Shortcut_Control|109,2)
  AddKeyboardShortcut(0,#PB_Shortcut_Control|187,3)
  AddKeyboardShortcut(0,#PB_Shortcut_Control|189,4)
   
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
          Quit = 1
          
          
    Case #PB_Event_SizeWindow
        ResizeGadget(0,#PB_Ignore, #PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-20)        
         
       
    Case #PB_Event_Menu
        Select EventMenu()
            Case 1,3
                If Plus = 0
                  GetWindowRect_(GadgetID(0),r.RECT)
                  SetCursorPos_((r\right-5),(r\bottom-5))
                  LeftClick ()
                  Plus + 1
                EndIf
                Mouse_Wheel(2)
                
            Case 2,4
                If Minus = 0
                  GetWindowRect_(GadgetID(0),r.RECT)
                  SetCursorPos_((r\right-5),(r\bottom-5))
                  LeftClick ()
                  Minus + 1
                EndIf
                Mouse_Wheel(-2)
        EndSelect
        
        Case #PB_Event_Gadget
          Select EventGadget()
           Case 1
                  Select EventType()
                       Case  #PB_EventType_MouseMove
                       x =  GetGadgetAttribute(1,#PB_Canvas_MouseX)
                       y =  GetGadgetAttribute(1,#PB_Canvas_MouseY)
                       
                  Case #PB_EventType_RightClick
                     Color = ColorRequester()
                      StartDrawing(CanvasOutput(1))                                 
                                 FillArea(x,y,-1,Color)                             
                      StopDrawing()
                      StartDrawing(ImageOutput(1))
                           DrawImage(GetGadgetAttribute(1,#PB_Canvas_Image ) ,0,0)
                      StopDrawing()
                      SaveImage(1,GetHomeDirectory()+"France Map2.bmp",#PB_ImagePlugin_BMP)
                     
        
                  EndSelect
            Case 2
                    HideGadget(4,1)
                    HideGadget(0,1)
                    HideGadget(1,0)
                    
            Case 3
                    HideGadget(4,0)
                    HideGadget(0,0)
                    HideGadget(1,1)
                    SetGadgetText(0, GetHomeDirectory()+"France Map2.bmp")
                    SetCursorPos_(WindowX(0)+100,WindowY(0)+100)
                    LeftClick()


          EndSelect

  EndSelect
Until Quit = 1
   
EndIf

Fig · Post by **Fig** » Wed Jun 25, 2014 1:24 pm

Rhones Alpes is the following:
http://wordoxhelper.free.fr/datadeparte ... eAlpes.DAT

Concerning the town it's easy to do, I am sure you are capable to adapt my code to add the informations you need.

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 1:40 pm

@Fig
Thanks for the DAT

Yes i believe with all the good job you do for me, i can take the road alone now

finally i hope

@Rashad
Thanks RASHAD !!!

I have a problem with the zoom, that not works

Perhaps my version of IE8 is too old ??

kernadec · Post by **kernadec** » Wed Jun 25, 2014 2:34 pm

hi KCC
move click left and whell mouse zoom

best regard

Code: Select all

Enumeration
  #Window
  #Image0  
  #Image1 
  #Scroll
  #canvas
EndEnumeration


LoadImage(#Image0, "France Map.bmp") 
CreateImage(#Image1,ImageWidth(#Image0),ImageHeight(#Image0))

CopyImage(#Image0,#Image1)               ;  crée une copie de l'image pour eviter la degradation de resize

OpenWindow(#Window,0, 0,ImageWidth(#Image0)+20,ImageHeight(#Image0)+20, "Zoom Canvas ScrollArea clic deplace  Kernadec", #WS_SYSMENU | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
ScrollAreaGadget(#Scroll, 0, 0,WindowWidth(#Window),WindowHeight(#Window),ImageWidth(#Image0),ImageHeight(#Image0),30)
SetWindowColor(#Window,#White) 
CanvasGadget(#canvas, 0, 0,ImageWidth(#Image0),ImageHeight(#Image0),#PB_Canvas_DrawFocus|#PB_Canvas_Keyboard)
SetGadgetAttribute(#Scroll,#PB_ScrollArea_X,(ImageWidth(#Image0)-WindowWidth(#Window))/2)
SetGadgetAttribute(#Scroll,#PB_ScrollArea_Y,(ImageHeight(#Image0)-WindowHeight(#Window))/2)
SetActiveGadget(#canvas)             ; focus Canvas : MouseWheel     
bm=#False
Repeat
  Event= WaitWindowEvent()
     Select EventType()  
    Case #PB_EventType_MouseWheel  
      
      delta=delta+(GetGadgetAttribute(#canvas,#PB_Canvas_WheelDelta )*10) ; delta*10
      CopyImage(#Image1,#Image0)      ; restore l'image originale                         
      ResizeImage(#Image0,(ImageWidth(#Image0)-delta),(ImageHeight(#Image0)-delta),#PB_Image_Smooth)	
      StartDrawing(CanvasOutput(#canvas))
      Box(-20,-20,WindowWidth(#Window)*2,WindowHeight(#Window)*2,RGB(255,255,255))
      DrawAlphaImage(ImageID(#Image0),PosXm1+(delta/2),PosYm1+(delta/2),255)
      StopDrawing()
      
    Case #PB_EventType_RightButtonDown ; choix du bouton deplacer
      bm=#True
      PosXm = GetGadgetAttribute(#canvas,#PB_Canvas_MouseX)-PosXm1
      PosYm = GetGadgetAttribute(#canvas,#PB_Canvas_MouseY)-PosYm1
      
    Case #PB_EventType_LeftButtonDown  ; choix du bouton deplacer
      bm=#True
      PosXm = GetGadgetAttribute(#canvas,#PB_Canvas_MouseX)-PosXm1
      PosYm = GetGadgetAttribute(#canvas,#PB_Canvas_MouseY)-PosYm1  
      
    Case #PB_EventType_MouseMove       ; deplacement
      If bm=#True
        PosXm1 = GetGadgetAttribute(#canvas,#PB_Canvas_MouseX)-PosXm
        PosYm1 = GetGadgetAttribute(#canvas,#PB_Canvas_MouseY)-PosYm
      EndIf
      CopyImage(#Image1,#Image0)      ; Restore l'image originale  
      ResizeImage(#Image0,(ImageWidth(#Image0)-delta),(ImageHeight(#Image0)-delta),#PB_Image_Smooth)	
      StartDrawing(CanvasOutput(#canvas))
      Box(-20,-20,WindowWidth(#Window)*2,WindowHeight(#Window)*2,RGB(255,255,255))
      DrawAlphaImage(ImageID(#Image0),PosXm1+(delta/2),PosYm1+(delta/2),255)
      StopDrawing() 
      
    Case #PB_EventType_LeftButtonUp
      bm=#False  
      
    Case #PB_EventType_RightButtonUp    
      bm=#False
  EndSelect  
  
  Select event
    Case #PB_Event_SizeWindow
      ResizeGadget(#Scroll,#PB_Ignore,#PB_Ignore,WindowWidth(#Window),WindowHeight(#Window))
      win_w=WindowWidth(#Window)
      win_h=WindowHeight(#Window)
  EndSelect  
  
Until Event= #PB_Event_CloseWindow
End

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 2:57 pm

Hello my friend KERNADEC

Thanks to your code, but i have a grey window...with hourglass

Edit : I have commented the SetActiveGadget(#canvas) and that's works better

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 3:11 pm

Whaooouhh (2) !!!
That's works great KERNADEC without the SetActiveGadget
Thanks a lot

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 3:38 pm

1/ I have try to modify the FIG code for selected on the fly each department.
http://www.purebasic.fr/english/viewtop ... 48#p447048

That works...finally nearly

because i don't understand why, fillarea clear sometime the red border already drawing

Even if i made more heavy, the red frontier sometime is when even deleted

2/ If someone know furthermore how all selected with a button...i marry him

Code: Select all

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

If OpenWindow(0,0,0,870,850, "p ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
 ButtonGadget(5, 700, 810, 70, 30, "All select")
 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
 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 xx < SpriteWidth(1) And yy < SpriteHeight(1) And xx > 0 And yy > 0
     If Point(xx,yy)<>couleur
      AddMapElement(departement()\vecteur(),Str(xx)+"/"+Str(yy))
      departement()\vecteur()\x=xx:departement()\vecteur()\y=yy
      Continue
     EndIf
    EndIf
    
    AddElement(fringe())
    fringe()\x=xx:fringe()\y=yy
    PreviousElement(fringe())
    
   Next j
   
  Next i
  
  DeleteElement(fringe())
  
 Until FirstElement(fringe())=0
 
 ;fringe red display
 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 - 1,departement()\vecteur()\y - 1,#Red)
  Plot(departement()\vecteur()\x,departement()\vecteur()\y,#Red)
  Plot(departement()\vecteur()\x + 1,departement()\vecteur()\y + 1,#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,#Blue)

 departement()\barycentreX=xb:departement()\barycentreY=yb
 departement()\numero=numero_departement
 
EndProcedure

StartDrawing(SpriteOutput(1))
CouleurFond = Point(20,20)
StopDrawing()

Repeat

 Event = WindowEvent()
 FlipBuffers()
 ClearScreen(#White)
 ExamineKeyboard()
  
 y=WindowMouseY(0)
 x=WindowMouseX(0)
 ;display map
 DisplaySprite(1,0,0)
 StartDrawing(SpriteOutput(1))
 
 If x < SpriteWidth(1) And y < SpriteHeight(1) And x > 0 And y > 0
 
  CouleurPointeur = Point(x,y)
   
  If x > 1 And y > 1 And CouleurPointeur <> #Red And CouleurPointeur <> #Blue And CouleurPointeur <> #White And CouleurPointeur <> CouleurFond
   find_limit(x,y,numero_departement)
  EndIf
 
 EndIf
 
 StopDrawing()

 ;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
 
 ; Select all the regions
 If Event = #PB_Event_Gadget And EventGadget() = 5
  CallDebugger
 EndIf
 
Until Event = #PB_Event_CloseWindow

Code modified

kernadec · Post by **kernadec** » Wed Jun 25, 2014 6:35 pm

Excuse me Kcc code corrigé!

as usual, I am distracted

best regards

Kwai chang caine · Post by **Kwai chang caine** » Wed Jun 25, 2014 6:42 pm

No problem...i'm just surprising to have found the bug alone

PureBasic Forums - English

Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB

Re: Create a map 2D with PB