PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Create a map 2D with PB

https://www.purebasic.fr/english/viewtopic.php?t=59723

Page 2 of 2

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 10:48 am
by wilbert
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.

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 11:13 am
by Kwai chang caine
Yes ..i can, i can....but i not dare !!! :mrgreen:

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...."
Image
"It's not a real good idea to try a bull.... :? "
Image
"Even romantic" :mrgreen:

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 12:11 pm
by Fig
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 ?? :oops: http://wordoxhelper.free.fr/datadepartements.DAT
Yes i already answered to this... It's kind of a Dijkstra flooding. Not really a big deal.

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 1:07 pm
by Kwai chang caine
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) :wink:
In fact little KCC not really have the word like ambition, it's too big :oops: ....
The "Rhone-alpes" region is enough for the moment :mrgreen:

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

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 1:14 pm
by RASHAD
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

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 1:24 pm
by Fig
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.

Posted: Wed Jun 25, 2014 1:40 pm
by Kwai chang caine
@Fig
Thanks for the DAT 8)
Yes i believe with all the good job you do for me, i can take the road alone now :wink: finally i hope :mrgreen:

@Rashad
Thanks RASHAD !!! 8)
I have a problem with the zoom, that not works :(
Perhaps my version of IE8 is too old ??

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 2:34 pm
by kernadec
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

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 2:57 pm
by Kwai chang caine
Hello my friend KERNADEC :D
Thanks to your code, but i have a grey window...with hourglass :|

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

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 3:11 pm
by Kwai chang caine
Whaooouhh (2) !!!
That's works great KERNADEC without the SetActiveGadget
Thanks a lot 8)

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 3:38 pm
by Kwai chang caine
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 :oops: because i don't understand why, fillarea clear sometime the red border already drawing :shock:
Even if i made more heavy, the red frontier sometime is when even deleted :cry:

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

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

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 6:35 pm
by kernadec
Excuse me Kcc code corrigé!

as usual, I am distracted :D

best regards

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 6:42 pm
by Kwai chang caine
No problem...i'm just surprising to have found the bug alone :D
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited