Forum | | | | - Page 1 - |
| Tommy | an short investigation about : Show of Landkarten with Date-Maps. Gibt's already Experience with the Integration of/ one Api moreover ? I erfasse Haltestellendaten and wants to site the Punktes through Übernahme the Orts - and Straßenangaben via Landkarte Show and the Coordinates thereby take and the data base with take off. large task or there already Ähnliches? |
| | | | |
| | | | | - Page 1 - |
| Thomas Freier | something in the direction? [...]
Nachtrag: with of/ one Offlinekarte ? [...] |
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/24/14 ▲ |
| |
| | Tommy | GENAU! webmart.de position, like Google Maps too, The ticket to input the address available. my target would it, The address of Program To transfer (appeal through URL?"And The display the ticket in a Window darzustellen. One special Goodie would naturally yet The Übernahme the Coordinates.... in the code enclosed can I of course - to display the Bildes in the aufklappenden Image display for PNG's and the Ladebalken for Page The ticket in the Browserfenster see, but the term is so useless.
have You moreover weiterführende ideas??
Greeting Tommy
'$I firebird.inc
' data base
' ---------
'var fbDLL& = fbUseDLL("fbclient.dll",0)
'declare hdb& 'lever the data base
'Deklariere Eingabefelder
'------------------------
'Haltestellenname, place, latitude, longitude, booking, Buchtlänge, Echtzeitsystem, Funk, IP, Kennung1, Kennung2, Street, Nr, PLZ
Declare HST_Name$,HST_Ort$,Latitude$,Longitude$,booking$,Buchtlaenge$,Echtzeit$, Funk$, IP$, Kennung1$, Kennung2$, Street$, Nr$, PLZ$
Declare HST_Name&,HST_Ort&,Latitude&,Longitude&,Bucht&,Buchtlaenge&,Echtzeit&, Funk&, IP&, Kennung1&, Kennung2&, Strasse&, Nr&, PLZ&
Declare GoogleString$, Webcontrol&
Declare e%,x%,y%,zh%
Declare Save&,Exit&
Def GetSysColor(1) !"USER32","GetSysColor"
Set("SQLColWidth",15)
' data base link produce
'hdb& = fbInit("SYSDBA", "masterkey", "3TSDatabase.fdb" ,0)
x% = 955
y% = 435
zh%= 25
Window Title "Haltestelle erfassen"
Window Style 48 + 512
Window (%MaxX - x%) / 2,(%MaxY - y%) / 2 - x%,y%
UseFont "Arial",16,0,0,0,0
SetDialogFont 1
CLS GetSyscolor(15)
Create("Text",%HWnd,"Haltestellenname:",10,20,100,20)
HST_Name& = Create("Edit",%HWnd,"",140,20,350,20)
Create("Text",%HWnd,"Strasse/lane:",10,20+zh%,100,20)
Strasse& = Create("Edit",%HWnd,"",140,20+zh%,350,20)
Create("Text",%HWnd,"Nr:",500,20+zh%,30,20)
Nr& = Create("Edit",%HWnd,"",550,20+zh%,30,20)
Create("Text",%HWnd,"Ort:",10,20 + zh%*2,75,20)
HST_Ort& = Create("Edit",%HWnd,"",140,20 + zh%*2,200,20)
Create("Text",%HWnd,"Plz:",360,20 + zh%*2,75,20)
Plz& = Create("Edit",%HWnd,"",420,20 + zh%*2,70,20)
Create("Text",%HWnd,"Latitude (wide) :",10,20 + 3 * zh%,140,20)
Latitude& = Create("Edit",%HWnd,"",140,20 + 3 * zh%,150,20)
Create("Text",%HWnd,"Longitude (length):",310,20 + 3 * 25,140,20)
Longitude& = Create("Edit",%HWnd,"",450,20 + 3 * 25,150,20)
'halbfertiges part
'GoogleString$="https://maps.googleapis.com/maps/api/staticmap?center=Berkeley,CA&zoom=14&size=400x400&sensor=false"
var h& = @create("htmlWin",%hWnd,"maps.googleapis.com/maps/api/staticmap?center=Berkeley,CA&zoom=14&size=400x400&sensor=false",5,610,10,300,300)
waitinput
|
| | | | |
| | Thomas Freier | In these direction?
'Haltestellenname, place, latitude, longitude, booking, Buchtlänge, Echtzeitsystem, Funk, IP, Kennung1, Kennung2, Street, Nr, PLZ
Declare HST_Name$,HST_Ort$,Latitude$,Longitude$,booking$,Buchtlaenge$,Echtzeit$, Funk$, IP$, Kennung1$, Kennung2$, Street$, Nr$, PLZ$
Declare HST_Name&,HST_Ort&,Latitude&,Longitude&,Bucht&,Buchtlaenge&,Echtzeit&, Funk&, IP&, Kennung1&, Kennung2&, Strasse&, Nr&, PLZ&
Declare GoogleString$, Webcontrol&
Declare e%,x%,y%,zh%
Declare Save&,Exit&
Def GetSysColor(1) !"USER32","GetSysColor"
Set("SQLColWidth",15)
' data base link produce
'hdb& = fbInit("SYSDBA", "masterkey", "3TSDatabase.fdb" ,0)
x% = 955
y% = 435
zh%= 25
Window Title "Haltestelle erfassen"
'Window Style 48 + 512
Window (%MaxX - x%) / 2,(%MaxY - y%) / 2 - x%,y%
UseFont "Arial",16,0,0,0,0
SetDialogFont 1
CLS GetSyscolor(15)
Create("Text",%HWnd,"Haltestellenname:",10,20,100,20)
HST_Name& = Create("Edit",%HWnd,"",140,20,350,20)
Create("Text",%HWnd,"Strasse/lane:",10,20+zh%,100,20)
Strasse& = Create("Edit",%HWnd,"",140,20+zh%,350,20)
Create("Text",%HWnd,"Nr:",500,20+zh%,30,20)
Nr& = Create("Edit",%HWnd,"",550,20+zh%,30,20)
Create("Text",%HWnd,"Ort:",10,20 + zh%*2,75,20)
HST_Ort& = Create("Edit",%HWnd,"",140,20 + zh%*2,200,20)
Create("Text",%HWnd,"Plz:",360,20 + zh%*2,75,20)
Plz& = Create("Edit",%HWnd,"",420,20 + zh%*2,70,20)
Create("Text",%HWnd,"Latitude (wide) :",10,20 + 3 * zh%,140,20)
Latitude& = Create("Edit",%HWnd,"",140,20 + 3 * zh%,150,20)
Create("Text",%HWnd,"Longitude (length):",310,20 + 3 * 25,140,20)
Longitude& = Create("Edit",%HWnd,"",450,20 + 3 * 25,150,20)
'Kordinaten the Haltestelle are famous
settext Latitude&,"48.13699"
settext Longitude&,"11.5754"
'now The html produce
STANDORT
var h& = @create("htmlWin",%hWnd,$TempDir +"Test.html",5,610,10,300,300)
while 1
waitinput
wend
End
proc STANDORT'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ html produce
assign #2,$TempDir +"Test.html"
rewrite #2
Print #2,"<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN'"
Print #2,"'https://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>"
Print #2,"<html xmlns='https://www.w3.org/1999/xhtml' xmlns:v='urn:schemas-microsoft-com:vml'>"
Print #2,"<HEAD>"
Print #2,"<TITLE>Karte</TITLE>"
Print #2,"<style type='Text/css'>"
Print #2,"#ticket { width: 400px; height: 400px;}"
Print #2,"</style>"
Print #2,"<script type='Text/javascript' src='https://maps.google.com/maps/api/js?sensor=false'></script>"
Print #2,"<script type='Text/javascript'>"
Print #2,"function initialize() {"
Print #2, " var latlng = new google.maps.LatLng("+gettext$(Latitude&)+", "+gettext$(Longitude&)+");"
Print #2," var myOptions = {"
Print #2," zoom: 18,"
Print #2," center: latlng,"
Print #2," mapTypeId: google.maps.MapTypeId.ROADMAP"
Print #2," };"
Print #2," var map = new google.maps.Map(document.getElementById('ticket'), myOptions);"
Print #2," var marker = new google.maps.Marker({"
Print #2," position: latlng,"
Print #2," map: map,"
Print #2," title: 'Hello champion."+chr $(092)+chr $(110)+" i'm here!' "
Print #2," });}"
Print #2,"</script>"
Print #2,"</HEAD>"
Print #2,"<body onload='initialize()'>"
Print #2," <div id='ticket' ></div>"
Print #2,"</body>"
Print #2,"</html>"
Close #2
endproc
|
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/25/14 ▲ |
| |
| | p.specht
| good idea, by me "scriptfehler", what must I adjust? |
| | | XProfan 11Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'... | 01/25/14 ▲ |
| |
| | Thomas Freier | might the Line break his
'Hello champion."+chr$(092)+chr$(110)+" i'm here!'
once so testing
'Hello champion. i'm here!'
|
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/25/14 ▲ |
| |
| | Thomas Freier |
I erfasse Haltestellendaten and wants to site the Punktes through Übernahme the Orts - and Straßenangaben via Landkarte Show and the Coordinates thereby take and the data base with take off.
Datenübernahme Perhaps by drag&drop. names from the ticket are you don't say so and müßten nachgetragen go. example: [...]
|
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/25/14 ▲ |
| |
| | Tommy | Hello Thomas!
somehow is my latest response extinct
the Script is a genialer Ansatz and ought to as Problemlöser bring into action let. though would it cool, your Script walk To see! by me dismisses it itself unfortunately with a Scriptfehler (see Appendix) would You there again drüberschauen, Please? too your last Ansatz is for my Task very überlegenswert! i'd Yes sooner inverse dran weg want: The address enter and The Koordianten take.....
with many greet from Wien Tommy
|
| | | | |
| | Thomas Freier | I wisely not How I the Error find could. Getestet with FF, Opera, safari and k-meleon and no Problems. neither over XProfan. can The attitude at eurem IE The cause his? enclosed The Arbeits-html. |
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/25/14 ▲ |
| |
| | Julian Schmidt | Thomas suitor (25.01.14)
might the Line break his 'Hello champion."+chr$(092)+chr$(110)+" i'm here!'
once so testing 'Hello champion. i'm here!'
objectively must it so hot.
then functions it. |
| | | | |
| | Thomas Freier | @Julian, thanks. is somehow verschütt gone as i here whom Line break as an afterthought registered having, because in of my *.prf was is so include. |
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/26/14 ▲ |
| |
| | Tommy | working! GENIAL! best Thanks! |
| | | | |
| | | | - Page 2 - |
| | Thomas Freier | here another abgewandelter Script of "Pascal" for Tipfaule. Adressen into GridBOX, by Double click in that EDIT and Drag&Drop in that vain area of [...] After the Search then by Drag&Drop lat and lon into ensprechenden Split wander.
$H windows.ph
$H Messages.ph
$H commctrl.ph
usermessages 16
Def GetSysColor(1) !"USER32","GetSysColor"
Def WindowFromPoint(2)!"USER32","WindowFromPoint"
Def GetCursorPos(1) !"USER32","GetCursorPos"
Declare p#,h&,item&
Dim p#,8
declare FORMATETC#:dim FORMATETC#,20
long FORMATETC#,4=0,1,-1,1
struct STGMEDIUM=tymed&,Value&,IUnknown&
declare STGMEDIUM#:dim STGMEDIUM#,STGMEDIUM
proc GetData'-------------------------------------------------GetData
parameters IFace&
var VTable&=long(IFace&,0)
return call(long(VTable&,12),IFace&,FORMATETC#,STGMEDIUM#)
endproc'-------------------------------------------------------------
proc Dummy'-----------------------------------------------------Dummy
return 0'--E_OK
endproc'-------------------------------------------------------------
proc Drop'-------------------------------------------------------Drop
parameters This&,IDataObject&,KeyState&,X&,Y&
long FORMATETC#,0=~CF_HDROP'----------------stature: DropFiles
ifnot GetData(IDataObject&)
var Mem&=~GlobalLock(STGMEDIUM#.Value&)
INSERT stringw$(Mem&,20)
' print "Datei:",stringw$(Mem&,20)
~GlobalUnlock(STGMEDIUM#.Value&)
~GlobalFree(STGMEDIUM#.Value&)
endif
long FORMATETC#,0=~CF_TEXT'-----------------stature: Text
ifnot GetData(IDataObject&)
var Mem&=~GlobalLock(STGMEDIUM#.Value&)
INSERT string $(Mem&,0)
~GlobalUnlock(STGMEDIUM#.Value&)
~GlobalFree(STGMEDIUM#.Value&)
endif
return 0'--E_OK
endproc'-------------------------------------------------------------
Proc INSERT
Parameters row$
var a$=Chr$(13)+Chr$(10)'Line break
GetCursorPos(p#)' Empfänger is ?
h&=WindowFromPoint(Long(p#,0),Long(p#,4))
~GetCursorPos(HIT#)
~ScreenToClient(Lb&,HIT#)
sendmessage(Lb&,~LVM_HITTEST,0,HIT#)'---------------------Info over Cursor in reference on Lv
sendmessage(Lb&,~LVM_SUBITEMHITTEST,0,HIT#)
zielx&= HIT#.SubItem&
ziely&= HIT#.Item&
If h&=Lb&
If ziely&=-1
@InsertString(Lb&,0,"|||")
SetText Lb&,0, zielx&, trim$($ row)
Else
SetText Lb&,ziely&, zielx&, trim$($ row)
EndIf
EndIf
ENDPROC'-------------------------------------------------------------
'=========================================================================
Cls GetSysColor(15)
SetWindowPos %HWND=0,0-570,310;-1
var Font&=Create("Font","MS Sans Serif",16,0,0,0,0)
SETDIALOGFONT Font&
CreateText(%hwnd,"Ziel:",10,12,90,22)
var edi&=Create("RichEdit",%hwnd,"",100,10,300,22)
var Text$ = "Ort;0;350;lat;0;80;lon;0;80"
var Lb& = Create("GridBox", %hwnd, Text$, 0, 10, 44, 540, 190)
SetFont Lb&,Font&
declare IDropTarget#,IDropTarget&
dim IDropTarget#,32'-----------------------IDropTarget-interface
long IDropTarget#, 0=procaddr("Dummy",2)'--QueryInterface
long IDropTarget#, 4=procaddr("Dummy",1)'--AddRef
long IDropTarget#, 8=procaddr("Dummy",1)'--Release
long IDropTarget#,12=procaddr("Dummy",5)'--DragEnter
long IDropTarget#,16=procaddr("Dummy",5)'--DragOver
long IDropTarget#,20=procaddr("Dummy",1)'--DragLeave
long IDropTarget#,24=procaddr("Drop",5)'---Drop
long IDropTarget#,28=IDropTarget#
IDropTarget&=IDropTarget#+28
external("ole32","OleInitialize",0)
external("ole32","RegisterDragDrop",%hwnd,IDropTarget&)
declare HIT#'------LVHITTESTINFO-structure
struct HIT=x&,y&,Flags&,Item&,SubItem&
dim Hit#,HIT
declare ziely&,zielx&
AddStrings(Lb&,"Geniner street 50 Lübeck||")
AddStrings(Lb&,"Marli street 50 Lübeck||")
AddStrings(Lb&,"Ziegel street 50 Lübeck||")
SubClass %hwnd, 1
User Messages 2000
while 1
waitinput
case %umessage=16:break
If (%umessage = 2000)
Text$ = GetText$(Lb&, &uwparam, &ulparam)
settext edi&,Text$
Setfocus(edi&)
SendString(edi&,"+({END})")
Endif
endwhile
external("ole32","RevokeDragDrop",%hwnd)
external("ole32","OleUninitialize")
dispose IDropTarget#,FORMATETC#,STGMEDIUM#,p#,hit#
DeleteObject font&
end
SubClassProc
If SubClassMessage(%hWnd, ~WM_NOTIFY)
If Long(&sLParam,8)=-3
item&=Long(&sLParam,12)
If item&<>-1
SendMessage(%hwnd, 2000, item&, Long(&sLParam,16))
EndIf
EndIf
EndIf
ENDPROC
|
| | | Gruß Thomas Windows XP SP2, XProfan X2 | 01/26/14 ▲ |
| |
|
AnswerTopic-Options | 12.307 Views |
Themeninformationenthis Topic has 4 subscriber: |