Redirection Web (RESOLU)

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
MetalOS
Messages : 1510
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Redirection Web (RESOLU)

Message par MetalOS »

Pour un projet de logiciel j'ai besoin de charger une carte Open Street Map dans un webgadget et jusque là pas de problème. Seulement sur la carte il existe un lien qui redirige sur le site officiel d'Open Street Map et quand je clique dessus il me charge le site dans le même webgadget que la carte que je doit exploiter. Existe t'il une solution avec le webgadget pour charger le site d'Open Street Map dans le navigateur par défaut au lieu de le charger dans le Webgadget ?

Voici mon code:

Code : Tout sélectionner

;By MetalOS

;- Global Variables and Constants
Global BubbleTipStyle.l:BubbleTipStyle=0

;- Window Constants
Enumeration 1
  #Window_Form1
EndEnumeration
#WindowIndex=#PB_Compiler_EnumerationValue


;- Gadget Constants
Enumeration 1
  ;Window_Form1
  #MenuBar_Form1_Fichier
  #MenuBar_Form1_Quitter

  #Gadget_Form1_Web1
  #Gadget_Form1_Button1
  #Gadget_Form1_Button2
  #Gadget_Form1_String1
  #Gadget_Form1_Button3


EndEnumeration
#GadgetIndex=#PB_Compiler_EnumerationValue


;- MenuBar Constants
Enumeration 1
  #MenuBar_Form1
EndEnumeration
#MenuBarIndex=#PB_Compiler_EnumerationValue


;- StatusBar Constants
Enumeration 1
  #StatusBar_Form1
EndEnumeration
#StatusBarIndex=#PB_Compiler_EnumerationValue
#StatusBar_Form1_Field1 =0
#StatusBar_Form1_Field2 =1
#StatusBar_Form1_Field3 =2
#StatusBar_Form1_Field4 =3

Procedure.s MakeHtmlCode(adresse.s = "")
   Protected html.s
   Protected *c.character
      
   ;nur für DataZeilen
   For *c = ?MapLabel To ?MapLabelEnd
      If *c\c = 0           
         *c\c = 13       
      EndIf   
   Next
   
   ;Script laden
   html = PeekS(?MapLabel, ?MapLabelEnd - ?MapLabel)
   
   If adresse
      html = ReplaceString(html, "List Deutschland", adresse)  
   EndIf
      
   ProcedureReturn html  
   
DataSection
   MapLabel:
   
   Data.S "<!DOCTYPE HTML>"
   Data.s "<html>"
   Data.s "<head>"
   Data.s "<title>OpenLayers Demo</title>"
   Data.s "<style type='text/css'>"
   Data.s "  html, body, #basicMap {"
   Data.s "      width: 100%;"
   Data.s "      height: 100%;"
   Data.s "      margin: 0;"
   Data.s "  }"
   Data.s "</style>"
   Data.s "<script src='http://www.openlayers.org/api/OpenLayers.js'></script>"
   Data.s "<script>"
   Data.s "  function init() {"
   Data.s "    Map = new OpenLayers.Map('basicMap');"
   Data.s "    var mapnik = new OpenLayers.Layer.OSM();"
   Data.s "    Map.addLayer(mapnik);"
   Data.s "    Map.setCenter(new OpenLayers.LonLat(4.0,48.0) // Centre de la carte"
   Data.s "      .transform("
   Data.s "        new OpenLayers.Projection('EPSG:4326'), // transformation de WGS 1984"
   Data.s "        new OpenLayers.Projection('EPSG:900913') // en projection Mercator sphérique"
   Data.s "      ), 5 // Zoom level"
   Data.s "    );"
   Data.s "  }"
   Data.s "</script>"
   Data.s "</head>"
   Data.s "<body onload='init();'>"
   Data.s "<div id='basicMap'></div>"
   Data.s "</body>"
   Data.s "</html>"   
   MapLabelEnd:
EndDataSection 

EndProcedure

Procedure.l Window_Form1()
  If OpenWindow(#Window_Form1,378,165,725,585,"Open Street Map.",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_Invisible)
      CreateMenu(#MenuBar_Form1,WindowID(#Window_Form1))
      MenuTitle("Fichier")
      MenuItem(#MenuBar_Form1_Quitter,"Quitter")
      WebGadget(#Gadget_Form1_Web1,0,0,725,495,"")
      SetGadgetItemText(#Gadget_Form1_Web1, #PB_Web_HtmlCode, MakeHtmlCode(adresse.s))
      ButtonGadget(#Gadget_Form1_Button1,5,510,60,20,"Lieu 1")
      ButtonGadget(#Gadget_Form1_Button2,75,510,60,20,"Lieu 2")
      StringGadget(#Gadget_Form1_String1,140,510,515,20,"")
      ButtonGadget(#Gadget_Form1_Button3,660,510,60,20,"Valider")
      CreateStatusBar(#StatusBar_Form1,WindowID(#Window_Form1))
        AddStatusBarField(100)
        AddStatusBarField(100)
        AddStatusBarField(100)
        AddStatusBarField(100)
      HideWindow(#Window_Form1,0)
      ProcedureReturn WindowID(#Window_Form1)
  EndIf
EndProcedure



;- Main Loop
If Window_Form1()

  quitForm1=0
  Repeat
    EventID  =WaitWindowEvent()
    MenuID   =EventMenu()
    GadgetID =EventGadget()
    WindowID =EventWindow()

    Select EventID
      Case #PB_Event_CloseWindow
        If WindowID=#Window_Form1
          quitForm1=1
        EndIf

      Case #PB_Event_Menu
        Select MenuID
          Case #MenuBar_Form1_Quitter
        EndSelect

      Case #PB_Event_Gadget
        Select GadgetID
          Case #Gadget_Form1_Button1
            
          Case #Gadget_Form1_Button2
          Case #Gadget_Form1_String1
          Case #Gadget_Form1_Button3
        EndSelect

    EndSelect
  Until quitForm1
  CloseWindow(#Window_Form1)
EndIf
End
Dernière modification par MetalOS le lun. 13/août/2012 10:02, modifié 1 fois.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Redirection Web

Message par Backup »

si tu peux avoir l'adresse du lien dans une variable

tu lance cette adresse directement avec RunPrg ....

pour avoir le contenu d'une page web dans une variable

ce Code de Pile , reste une reference :)

Code : Tout sélectionner

;/ Author : Pille
; Proxy like this : "192.168.0.1:8080"
Global Site.s="http://www.purebasic.fr/french/viewtopic.php?f=1&t=13034&p=145244#p145244"

Declare.s Url2Text2(Url.s, OpenType.b,ProxyAndPort.s)
Declare.s Url2Text(Url.s)

Enumeration
	#window
	#editeur
EndEnumeration





;/ Test

MessageRequester(Site.s,Url2Text(Site.s))
OpenWindow(#window,10,10,10,10,"resultat",#PB_Window_SystemMenu )

Repeat
	Event=WindowEvent()
	
Until Event = #PB_Event_CloseWindow




ProcedureDLL.s Url2Text2(Url.s, OpenType.b,ProxyAndPort.s)
	; 1 INTERNET_OPEN_TYPE_DIRECT                       Resolves all host names locally.
	; 0 INTERNET_OPEN_TYPE_PRECONFIG                    Retrieves the proxy Or direct configuration from the registry.
	; 4 INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY  Retrieves the proxy Or direct configuration from the registry And prevents the use of a startup Microsoft JScript Or Internet Setup (INS) file.
	; 3 INTERNET_OPEN_TYPE_PROXY                        Passes requests To the proxy unless a proxy bypass list is supplied And the name To be resolved bypasses the proxy. In this Case, the function uses INTERNET_OPEN_TYPE_DIRECT.
	
	isLoop.b=1
	INET_RELOAD.l = $80000000
	hInet.l=0
	hURL.l=0
	Bytes.l=0
	Buffer.s=Space(2048)
	res.s=""
	
	
	
	hInet = InternetOpen_("", OpenType, ProxyAndPort, "", 0)
	hURL = InternetOpenUrl_(hInet, Url, #Null, 0, INET_RELOAD, 0)
	
	Repeat
		InternetReadFile_(hURL,@Buffer, Len(Buffer), @Bytes)
		If Bytes = 0
			isLoop=0
			Else
			res = res + Left(Buffer, Bytes)
		EndIf
	Until isLoop=0
	
	InternetCloseHandle_(hURL)
	InternetCloseHandle_(hInet)
	ProcedureReturn res
EndProcedure

ProcedureDLL.s Url2Text(Url.s)
	ProcedureReturn Url2Text2(Url,1,"")
EndProcedure

; EPB

Autre soluce, en telechargeant la page web

Code : Tout sélectionner

; exemple de Chris
InitNetwork()
Dir$ = GetCurrentDirectory()
Page$ = Dir$ + "index.php"


;/ Connexion au site, et téléchargement de la page d'index
Result = ReceiveHTTPFile("http://www.purebasic.fr/french/", Page$)

;/ Lecture du fichier et mise en mémoire
If Result <> 0
	If ReadFile(0, Page$)
		L = Lof(0) : *Mem = AllocateMemory(L)
		If *Mem
			ReadData(0, *Mem, L)
			Fichier$ = PeekS(*Mem, MemoryStringLength(*Mem), #PB_UTF8)
			
		EndIf
		FreeMemory(*Mem) : CloseFile(0)
	EndIf
EndIf

Debug Fichier$; EPB

Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

bonjour
merci, Dobro pour les codes

dans le code de MetalOS
je préfère sans les datas c' est plus facile de changer de carte.

Cordialement

Code : Tout sélectionner

;By MetalOS

;- Global Variables and Constants
Global BubbleTipStyle.l:BubbleTipStyle=0

;- Window Constants
Enumeration 1
  #Window_Form1
EndEnumeration
#WindowIndex=#PB_Compiler_EnumerationValue


;- Gadget Constants
Enumeration 1
  ;Window_Form1
  #MenuBar_Form1_Fichier
  #MenuBar_Form1_Quitter
  
  #Gadget_Form1_Web1
  #Gadget_Form1_Button1
  #Gadget_Form1_Button2
  #Gadget_Form1_String1
  #Gadget_Form1_Button3
  
  
EndEnumeration
#GadgetIndex=#PB_Compiler_EnumerationValue


;- MenuBar Constants
Enumeration 1
  #MenuBar_Form1
EndEnumeration
#MenuBarIndex=#PB_Compiler_EnumerationValue


;- StatusBar Constants
Enumeration 1
  #StatusBar_Form1
EndEnumeration
#StatusBarIndex=#PB_Compiler_EnumerationValue
#StatusBar_Form1_Field1 =0
#StatusBar_Form1_Field2 =1
#StatusBar_Form1_Field3 =2
#StatusBar_Form1_Field4 =3

Procedure html(long$,lat$)  
  
  Protected script$
  
  script$+ "<!DOCTYPE HTML>"+ #CRLF$
  script$+ "<html>"+ #CRLF$
  script$+ "<head>"+ #CRLF$
  script$+ "<title>OpenLayers Demo</title>"+ #CRLF$
  script$+ "<style type='text/css'>"+ #CRLF$
  script$+ "  html, body, #basicMap {"+ #CRLF$
  script$+ "      width: 100%;"+ #CRLF$
  script$+ "      height: 100%;"+ #CRLF$
  script$+ "      margin: 0;"+ #CRLF$
  script$+ "  }"+ #CRLF$
  script$+ "</style>"+ #CRLF$
  script$+ "<script src='http://www.openlayers.org/api/OpenLayers.js'></script>"+ #CRLF$
  script$+ "<script>"+ #CRLF$
  script$+ "  function init() {"+ #CRLF$
  script$+ "    Map = new OpenLayers.Map('basicMap');"+ #CRLF$
  script$+ "    var mapnik = new OpenLayers.Layer.OSM();"+ #CRLF$
  script$+ "    Map.addLayer(mapnik);"+ #CRLF$
  script$+ "    Map.setCenter(new OpenLayers.LonLat("+ #CRLF$
  script$+ long$+","+lat$+ #CRLF$
  script$+ ") // Centre de la carte"+ #CRLF$
  script$+ "      .transform("+ #CRLF$
  script$+ "        new OpenLayers.Projection('EPSG:4326'), // transformation de WGS 1984"+ #CRLF$
  script$+ "        new OpenLayers.Projection('EPSG:900913') // en projection Mercator sphérique"+ #CRLF$
  script$+ "      ),15 // Zoom level"+ #CRLF$
  script$+ "    );"+ #CRLF$
  script$+ "  }"+ #CRLF$
  script$+ "</script>"+ #CRLF$
  script$+ "</head>"+ #CRLF$
  script$+ "<body onload='init();'>"+ #CRLF$
  script$+ "<div id='basicMap'></div>"+ #CRLF$
  script$+ "</body>"+ #CRLF$
  script$+ "</html>"+ #CRLF$   
  
  SetGadgetItemText(#Gadget_Form1_Web1, #PB_Web_HtmlCode,script$)
  
EndProcedure

Procedure.l Window_Form1()
  If OpenWindow(#Window_Form1,378,165,725,585,"Open Street Map.",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_Invisible)
    CreateMenu(#MenuBar_Form1,WindowID(#Window_Form1))
    MenuTitle("Fichier")
    MenuItem(#MenuBar_Form1_Quitter,"Quitter")
    WebGadget(#Gadget_Form1_Web1,0,0,725,495,"")
    ButtonGadget(#Gadget_Form1_Button1,5,510,60,20,"Lieu 1")
    ButtonGadget(#Gadget_Form1_Button2,75,510,60,20,"Lieu 2")
    StringGadget(#Gadget_Form1_String1,140,510,515,20,"")
    ButtonGadget(#Gadget_Form1_Button3,660,510,60,20,"WEB")
    CreateStatusBar(#StatusBar_Form1,WindowID(#Window_Form1))
    AddStatusBarField(100)
    AddStatusBarField(100)
    AddStatusBarField(100)
    AddStatusBarField(100)
    HideWindow(#Window_Form1,0)
    ProcedureReturn WindowID(#Window_Form1)
  EndIf
EndProcedure



;- Main Loop
If Window_Form1()
  
  quitForm1=0
  Repeat
    EventID  =WaitWindowEvent()
    MenuID   =EventMenu()
    GadgetID =EventGadget()
    WindowID =EventWindow()
    
    Select EventID
      Case #PB_Event_CloseWindow
        If WindowID=#Window_Form1
          quitForm1=1
        EndIf
        
      Case #PB_Event_Menu
        Select MenuID
          Case #MenuBar_Form1_Quitter
        EndSelect
        
      Case #PB_Event_Gadget
        Select GadgetID
          Case #Gadget_Form1_Button1
            long$=StrD(2.35)   ;decimales
            lat$=StrD(48.86)   ;decimales
            html(long$,lat$)
          Case #Gadget_Form1_Button2
            long$=StrD(-0.35)  ;decimales
            lat$=StrD(49.18)   ;decimales 
            html(long$,lat$)
          Case #Gadget_Form1_String1
            
          Case #Gadget_Form1_Button3
            RunProgram("http://maps.google.com/maps?q=49.18,+-0.35+%28vous%20êtes%20ici%29&iwloc=A&hl=fr")
        EndSelect
        
    EndSelect
  Until quitForm1
  CloseWindow(#Window_Form1)
EndIf
End
Dernière modification par kernadec le sam. 11/août/2012 13:09, modifié 2 fois.
Avatar de l’utilisateur
Ar-S
Messages : 9540
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Redirection Web

Message par Ar-S »

Le lien doit pouvoir être supprimé, il suffit de récupérer le .js en string et d'utiliser removestring(<a href='http://openstreetmap.org/' etc...) avant d'executer ta procedure.
En remplaçant

Code : Tout sélectionner

	script$+ "<script src='http://www.openlayers.org/api/OpenLayers.js'></script>"+ #CRLF$
par
	script$+ "<script src='"+ js$ +"'></script>"+ #CRLF$
Et pour le garder en l'ouvrant dans l'explorer, même chose mais au lieu de de virer le lien, lui ajouter un target='_blank' (sauf si ce dernier ouvre le lien dans le webgadget, c'est le risque, j'ai pas testé.)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

bonjour Ar-s
code corrigé, Merci.

mais pour la nouvelle fenêtre target='_blank' ??
pas trouvé ou le mettre, car je me retrouve avec une fenêtre google sans map.

Cordialement
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Redirection Web

Message par Backup »

kernadec a écrit :bonjour Ar-s
code corrigé, Merci.
aucune carte ne s'affiche dans la fenetre avec ton code ;)
seul le bouton Web fonctionne


tu as oublie de definir " js$ "
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

:oops:
merci, Dobro
remis le code comme il était...

j 'avais corrigé sans vérifié :roll:

Cordialement
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Redirection Web

Message par Backup »

OK çA MARCHE :)
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

il fonctionne sous Seven 32 chez moi..
mais avec windowXP? je viens de regarder effectivement
y a un soucis l'image s'affiche et s’ éfface. :?

Cordialement
Avatar de l’utilisateur
Ar-S
Messages : 9540
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Redirection Web

Message par Ar-S »

En reprenant le code de Kernadec, j'ai essayé ma bidouille sans succès,
je webgadget n'apprecie pas le script. J'ai du zapper un truc
Etape 1 enregistrer le .js dans le même dossier que votre programme.

Code : Tout sélectionner

;By MetalOS

;- Global Variables and Constants
Global BubbleTipStyle.l:BubbleTipStyle=0

;- Window Constants
Enumeration 1
	#Window_Form1
EndEnumeration
#WindowIndex=#PB_Compiler_EnumerationValue


;- Gadget Constants
Enumeration 1
	;Window_Form1
	#MenuBar_Form1_Fichier
	#MenuBar_Form1_Quitter
	
	#Gadget_Form1_Web1
	#Gadget_Form1_Button1
	#Gadget_Form1_Button2
	#Gadget_Form1_String1
	#Gadget_Form1_Button3
	
	
EndEnumeration
#GadgetIndex=#PB_Compiler_EnumerationValue


;- MenuBar Constants
Enumeration 1
	#MenuBar_Form1
EndEnumeration
#MenuBarIndex=#PB_Compiler_EnumerationValue


;- StatusBar Constants
Enumeration 1
	#StatusBar_Form1
EndEnumeration
#StatusBarIndex=#PB_Compiler_EnumerationValue
#StatusBar_Form1_Field1 =0
#StatusBar_Form1_Field2 =1
#StatusBar_Form1_Field3 =2
#StatusBar_Form1_Field4 =3

Global path$ = GetCurrentDirectory()
Global JS$ = "file:///C:/Program%20Files%20%28x86%29/PureBasic/Examples/OpenMap/js.js"
Debug JS$ 

Procedure.S MakeJS(FicherJs.S)
  JavaScript.S = ""
  If ReadFile(0, FicherJs) 
    While Eof(0) = 0           ; Boucle tant que la fin du fichier n'est pas atteinte. (Eof = 'End Of File') 
      JavaScript + ReadString(0)      ; Affiche ligne par ligne le contenu du fichier
    Wend
    CloseFile(0)
    JavaScript = RemoveString(JavaScript, "Data CC-By-SA by <a href='http://openstreetmap.org/'>OpenStreetMap</a>")
    ProcedureReturn JavaScript
  Else
    MessageRequester("Information","Impossible d'ouvrir le fichier!")
    ProcedureReturn "Erreur"
  EndIf
  
EndProcedure

Global NewJS.S
NewJS.S = MakeJS(path$+"js.js")




Procedure html(long$,lat$)  
	
	Protected script$
	
	script$+ "<!DOCTYPE HTML>"+ #CRLF$
	script$+ "<html>"+ #CRLF$
	script$+ "<head>"+ #CRLF$
	script$+ "<title>OpenLayers Demo</title>"+ #CRLF$
	script$+ "<style type='text/css'>"+ #CRLF$
	script$+ "  html, body, #basicMap {"+ #CRLF$
	script$+ "      width: 100%;"+ #CRLF$
	script$+ "      height: 100%;"+ #CRLF$
	script$+ "      margin: 0;"+ #CRLF$
	script$+ "  }"+ #CRLF$
	script$+ "</style>"+ #CRLF$
	script$+ "<script language="+Chr(34)+"JavaScript"+Chr(34)+">" + NewJS + "</script>"+ #CRLF$
	script$+ "<script>"+ #CRLF$
	script$+ "  function init() {"+ #CRLF$
	script$+ "    Map = new OpenLayers.Map('basicMap');"+ #CRLF$
	script$+ "    var mapnik = new OpenLayers.Layer.OSM();"+ #CRLF$
	script$+ "    Map.addLayer(mapnik);"+ #CRLF$
	script$+ "    Map.setCenter(new OpenLayers.LonLat("+ #CRLF$
	script$+ long$+","+lat$+ #CRLF$
	script$+ ") // Centre de la carte"+ #CRLF$
	script$+ "      .transform("+ #CRLF$
	script$+ "        new OpenLayers.Projection('EPSG:4326'), // transformation de WGS 1984"+ #CRLF$
	script$+ "        new OpenLayers.Projection('EPSG:900913') // en projection Mercator sphérique"+ #CRLF$
	script$+ "      ),15 // Zoom level"+ #CRLF$
	script$+ "    );"+ #CRLF$
	script$+ "  }"+ #CRLF$
	script$+ "</script>"+ #CRLF$
	script$+ "</head>"+ #CRLF$
	script$+ "<body onload='init();'>"+ #CRLF$
	script$+ "<div id='basicMap'></div>"+ #CRLF$
	script$+ "</body>"+ #CRLF$
	script$+ "</html>"+ #CRLF$   
	
	SetGadgetItemText(#Gadget_Form1_Web1, #PB_Web_HtmlCode,script$)
	
EndProcedure

Procedure.l Window_Form1()
	If OpenWindow(#Window_Form1,378,165,725,585,"Open Street Map.",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_Invisible)
		CreateMenu(#MenuBar_Form1,WindowID(#Window_Form1))
		MenuTitle("Fichier")
		MenuItem(#MenuBar_Form1_Quitter,"Quitter")
		WebGadget(#Gadget_Form1_Web1,0,0,725,495,"")
		ButtonGadget(#Gadget_Form1_Button1,5,510,60,20,"Lieu 1")
		ButtonGadget(#Gadget_Form1_Button2,75,510,60,20,"Lieu 2")
		StringGadget(#Gadget_Form1_String1,140,510,515,20,"")
		ButtonGadget(#Gadget_Form1_Button3,660,510,60,20,"WEB")
		CreateStatusBar(#StatusBar_Form1,WindowID(#Window_Form1))
		AddStatusBarField(100)
		AddStatusBarField(100)
		AddStatusBarField(100)
		AddStatusBarField(100)
		HideWindow(#Window_Form1,0)
		ProcedureReturn WindowID(#Window_Form1)
  EndIf
EndProcedure



;- Main Loop
If Window_Form1()
	
	quitForm1=0
	Repeat
		EventID  =WaitWindowEvent()
		MenuID   =EventMenu()
		GadgetID =EventGadget()
		WindowID =EventWindow()
		
		Select EventID
      Case #PB_Event_CloseWindow
				If WindowID=#Window_Form1
					quitForm1=1
        EndIf
				
      Case #PB_Event_Menu
				Select MenuID
          Case #MenuBar_Form1_Quitter
        EndSelect
				
      Case #PB_Event_Gadget
				Select GadgetID
          Case #Gadget_Form1_Button1
						long$=StrD(2.35)   ;decimales
						lat$=StrD(48.86)   ;decimales
						html(long$,lat$)
          Case #Gadget_Form1_Button2
						long$=StrD(-0.35)  ;decimales
						lat$=StrD(49.18)   ;decimales 
						html(long$,lat$)
          Case #Gadget_Form1_String1
						
          Case #Gadget_Form1_Button3
						RunProgram("http://maps.google.com/maps?q=49.18,+-0.35+%28vous%20êtes%20ici%29&iwloc=A&hl=fr")
        EndSelect
				
    EndSelect
  Until quitForm1
	CloseWindow(#Window_Form1)
EndIf
End

~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
MetalOS
Messages : 1510
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Re: Redirection Web

Message par MetalOS »

8O 8O 8O 8O Merci pour toutes ces réponses je vais tester. Même si le lien reste afficher sur la carte ce n'est pas grave tant que j'arrive à rediriger sur le navigateur. Merci.
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

bonsoir MetalOS
un autre mode sans la pub :D

Cordialement

Code : Tout sélectionner

;By MetalOS

;- Global Variables and Constants
Global BubbleTipStyle.l:BubbleTipStyle=0

;- Window Constants
Enumeration 1
  #Window_Form1
EndEnumeration
#WindowIndex=#PB_Compiler_EnumerationValue


;- Gadget Constants
Enumeration 1
  ;Window_Form1
  #MenuBar_Form1_Fichier
  #MenuBar_Form1_Quitter
  
  #Gadget_Form1_Web1
  #Gadget_Form1_Button1
  #Gadget_Form1_Button2
  #Gadget_Form1_String1
  #Gadget_Form1_Button3
  #Gadget_Form1_Button4
  #Gadget_Form1_Button5
EndEnumeration
#GadgetIndex=#PB_Compiler_EnumerationValue

;- MenuBar Constants
Enumeration 1
  #MenuBar_Form1
EndEnumeration
#MenuBarIndex=#PB_Compiler_EnumerationValue


;- StatusBar Constants
Enumeration 1
  #StatusBar_Form1
EndEnumeration
#StatusBarIndex=#PB_Compiler_EnumerationValue
#StatusBar_Form1_Field1 =0
#StatusBar_Form1_Field2 =1
#StatusBar_Form1_Field3 =2
#StatusBar_Form1_Field4 =3

Procedure html(long$,lat$,echel)  
  Protected script$
  
  script$ + "<!DOCTYPE HTML PUBLIC "                                     + #CRLF$ 
  script$ + "-//W3C//DTD HTML 4.01 Transitional//FR"                     + #CRLF$
  script$ + "http://www.w3.org/TR/html4/loose.dtd"                       + #CRLF$
  script$ + ">"                                                          + #CRLF$
  script$ + "<html>"                                                     + #CRLF$
  script$ + "<head>"                                                     + #CRLF$
  script$ + "   <meta http-equiv="                                       + #CRLF$
  script$ + "Content-Type"                                               + #CRLF$
  script$ + " content="                                                  + #CRLF$
  script$ + "text/html; charset=iso-8859-1"                              + #CRLF$
  script$ + ">"                                                          + #CRLF$
  script$ + "   <meta name="                                             + #CRLF$
  script$ + "GENERATOR"                                                  + #CRLF$
  script$ + " content="                                                  + #CRLF$
  script$ + "Mozilla/4.75 [fr]C-CCK-MCD QXW0325k  (WinNT; U) [Netscape]" + #CRLF$
  script$ + ">"                                                          + #CRLF$
  script$ + "   <title>Carte</title>"                                    + #CRLF$
  script$ + "   <style type="                                            + #CRLF$
  script$ + "text/css"                                                   + #CRLF$
  script$ + ">"                                                          + #CRLF$
  script$ + "      body { margin-left:0px; margin-right:0px; margin-top:0px; margin-bottom:0px; overflow:hidden;}" + #CRLF$
  script$ + "   </style>"                                                + #CRLF$
  script$ + "</head>"                                                    + #CRLF$
  script$ + "<body bgcolor="                                             + #CRLF$
  script$ + "#FFFFFF"                                                    + #CRLF$
  script$ + " scroll="                                                   + #CRLF$
  script$ + "no"                                                         + #CRLF$
  script$ + ">"                                                          + #CRLF$
  script$ + "<p><img src="                                               + #CRLF$
  script$ + "http://maps.google.com/maps/api/staticmap?center=" + lat$+","+long$ + "&zoom="+Str(Echel)+"&size=640x640&sensor=false" + #CRLF$
  script$ + "></p>"                                                      + #CRLF$
  script$ + "</body>"                                                    + #CRLF$
  script$ + "</html>"                                                    + #CRLF$
  SetGadgetItemText(#Gadget_Form1_Web1, #PB_Web_HtmlCode, script$)
  
EndProcedure

Procedure.l Window_Form1()
  If OpenWindow(#Window_Form1,450, 200, 640, 750,"Open Street Map.",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_WindowCentered|#PB_Window_Invisible)
    CreateMenu(#MenuBar_Form1,WindowID(#Window_Form1))
    MenuTitle("Fichier")
    MenuItem(#MenuBar_Form1_Quitter,"Quitter")
    WebGadget(#Gadget_Form1_Web1,0,0,640,640,"")
    ButtonGadget(#Gadget_Form1_Button1,5,650,60,20,"Lieu 1")
    ButtonGadget(#Gadget_Form1_Button2,75,650,60,20,"Lieu 2")
    StringGadget(#Gadget_Form1_String1,140,650,420,20,"")
    ButtonGadget(#Gadget_Form1_Button3,570,650,60,20,"WEB")
    ButtonGadget(#Gadget_Form1_Button4,5,680,60,20,"Zoom +")
    ButtonGadget(#Gadget_Form1_Button5,75,680,60,20,"Zoom -")
    
    
    CreateStatusBar(#StatusBar_Form1,WindowID(#Window_Form1))
    AddStatusBarField(100)
    AddStatusBarField(100)
    AddStatusBarField(100)
    AddStatusBarField(100)
    HideWindow(#Window_Form1,0)
    ProcedureReturn WindowID(#Window_Form1)
  EndIf
EndProcedure


echel.l=15
;- Main Loop
If Window_Form1()
  
  quitForm1=0
  Repeat
    EventID  =WaitWindowEvent()
    MenuID   =EventMenu()
    GadgetID =EventGadget()
    WindowID =EventWindow()
    
    Select EventID
      Case #PB_Event_CloseWindow
        If WindowID=#Window_Form1
          quitForm1=1
        EndIf
        
      Case #PB_Event_Menu
        Select MenuID
          Case #MenuBar_Form1_Quitter
        EndSelect
        
      Case #PB_Event_Gadget
        Select GadgetID
          Case #Gadget_Form1_Button1
            long$=StrD(2.35)   ;decimales
            lat$=StrD(48.86)   ;decimales
            html(long$,lat$,echel)
          Case #Gadget_Form1_Button2
            long$=StrD(-0.35)  ;decimales
            lat$=StrD(49.18)   ;decimales 
            html(long$,lat$,echel)
          Case #Gadget_Form1_String1
            
          Case #Gadget_Form1_Button3
            RunProgram("http://maps.google.fr/maps?q=49.18,+-0.35+%28vous%20êtes%20ici%29&iwloc=A&hl=fr")
          Case #Gadget_Form1_Button4
            echel+1
            If echel > 22 :echel = 22 :EndIf
            html(long$,lat$,echel)  
          Case #Gadget_Form1_Button5
            echel-1
            If echel < 1 :echel = 1 :EndIf
            html(long$,lat$,echel) 
        EndSelect
        
    EndSelect
  Until quitForm1
  CloseWindow(#Window_Form1)
EndIf
End
Avatar de l’utilisateur
MetalOS
Messages : 1510
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Re: Redirection Web

Message par MetalOS »

Super merci Kernadec. Existe t'il des restrictions pour utiliser l'api de google map dans un executable ?
Avatar de l’utilisateur
kernadec
Messages : 1606
Inscription : ven. 25/avr./2008 11:14

Re: Redirection Web

Message par kernadec »

je sais pas vraiment...
je pense que google aime le pognon et que les voitures google ont un cout, les satellites aussi...

mais ils en ont parlé ici...

http://www.purebasic.fr/english/viewtop ... 2&t=50564&

Cordialement
Avatar de l’utilisateur
MetalOS
Messages : 1510
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Re: Redirection Web

Message par MetalOS »

Merci à tous pour votre aide :wink:
Répondre