record point3D point 'strukturu point rozšíříme o prvek Z real Z end record begin dialog helpp1 167 65 180 190 "Dialog" text tx1 5 0 170 35 10 "" text tx2 5 35 170 39 10 "tx1001" text tx3 5 80 170 29 10 "tx1001" text tx4 5 110 170 69 10 "tx1001" sub Create() string a a=" V rámečku Vstup zadejte systém, ze kterého se budou převádět zadávané souřadnice (Výchozí systém). " a=a+"Dále v tomtéž rámečku zadejte do políček 1. a 2. souřadnici vybraného systému podle nadpisu nad políčky. " tx1.Caption=a a=" V rámečku Výstup zadejte systém, do kterého se budou převádět zadávané souřadnice (Cílový systém). " a=a+"Pro provedení převodu stiskněte tlačítko Výpočet. Výsledné hodnoty se zobrazí v rámečku Výstup v políčkách podle nadpisu nad nimi." tx2.Caption=a a=" V případě, že požadujete výstup, nebo vstup v jiném formátu, nebo s jiným počtem desetiných míst, použijte záložku nastavení." tx3.Caption=a a=" V záložce Nastavení v rámečku Formát úhlových jednotek lze nastavit, zda se úhlové jednotky budou zobrazovat v " a=a+"desetinách stupňů, nebo ve stupních, minutách a vteřinách. V rámečku Počet plat. cifer lze nastavit počet desetiných míst pro dané jednotky. " a=a+"V rámečku Nastavení výpočtu je zobrazena aktuálně používaná definiční tabulka. " a=a+"Stiskem tlačítka Definice výpočtů otevřeme dialog, ve kterém ji lze editovat, nebo případně otevřít jinou." tx4.Caption=a end sub end dialog helpp1 h1 begin dialog helpp2 167 65 180 173 "Dialog" text tx1 5 0 170 79 10 "" text tx2 5 80 170 59 10 "tx1001" sub Create() string a a=" V rámečku Vstup zadejte systém, ze kterého se budou převádět zadávané souřadnice (Výchozí systém). " a=a+"Dále v tomtéž rámečku zvolte soubor ve fotmátu .txt, který chcete transformovat. " a=a+"V prvním řádku tohoto souboru je libovolná hlavička. V dalších řádcích jsou souřadnice bodů v pořadí č.b X(fi) Y(lam), oddělené mezerou." a=a+"V případě, že je v Nastavení zvolen vstup úhlových jednotek ve formátu stupně, minuty, vteřiny, a " a=a+"Výchozí systém je v úhlových jednotkách, jsou stupně, minuty a vteřiny taktéž odděleny mezerou. " tx1.Caption=a a=" V rámečku Výstup zadejte systém, do kterého se budou převádět zadávané souřadnice (Cílový systém). A soubor, do kterého se uloží vypočtené souřadnice." a=a+"Výstupní soubor může být v formátu .txt (oddělovačem je mezera), nebo .tab (oddělovačem je tabelátor). Pro provedení převodu stiskněte tlačítko Výpočet. " a=a+"Pro formát výstupních hodnot platí vlastnosti zvolené v záložce Nastavení." tx2.Caption=a end sub end dialog helpp2 h2 begin dialog helpp3 167 65 300 230 "Dialog" text tx1 5 0 290 49 10 "" text tx2 5 50 290 10 10 "tx1001" text tx3 5 60 290 10 10 "tx1001" text tx4 5 70 290 10 10 "tx1001" text tx5 5 80 290 10 10 "tx1001" text tx6 5 90 290 10 10 "tx1001" text tx7 5 100 290 10 10 "tx1001" text tx8 5 110 290 10 10 "tx1001" text tx9 5 120 290 10 10 "tx1001" text tx10 5 130 290 10 10 "tx1001" text tx11 5 140 290 10 10 "tx1001" text tx12 5 150 290 20 10 "tx1001" text tx13 5 170 290 10 10 "tx1001" text tx14 5 180 290 20 10 "tx1001" sub Create() string a a=" V této tabulce jsou nastaveny všechny výpočetní postupy. V prvním a druhém sloupci je uvedeno libovolné jméno Výchozího a Cílového systému, které se pak objeví v rozbaovacím meny v dialogu " a=a+"Ve třetím jsou pak funkce, které se postupně provádějí a převodou souřadnice do Cílového systému. " a=a+"Funce se provádějí od řádku, kde je definován Výchozí a Cílový sys. až po řádek než je definován další Výchozí a Cílový sys." a=a+"Do třetího sloupce lze zvolit následující funkce: " tx1.Caption=a a=" XY_Bessel - převede X, Y na Fi, Lam pomocí Křovákova zobrazení" ,tx2.Caption=a a=" Bessel_XY - převede Fi, Lam na X, Y pomocí Křovákova zobrazení" ,tx3.Caption=a a=" XY_Gauss - převede X, Y na Fi, Lam pomocí Gaussova zobrazení" ,tx4.Caption=a a=" Gauss_XY - převede Fi, Lam na X, Y pomocí Gaussova zobrazení" ,tx5.Caption=a a=" Wgs84UTMENBL - převede E (Easting), N (Norhing) na B (Fi) L (Lam) pomocí zobrazení UTM" ,tx6.Caption=a a=" Wgs84UTMBLEN - převede B (Fi) L (Lam) na E (Easting), N (Norhing) pomocí zobrazení UTM" ,tx7.Caption=a a=" Bessel_Krasovskij42 - převede Fi, Lam z Besselova (S-JTSK) na Krasovskeho elipsoid (S-42)" ,tx8.Caption=a a=" Krasovskij42_Bessel - převede Fi, Lam z Krasovskeho (S-42) na Besselův elipsoid (S-JTSK)" ,tx9.Caption=a a=" Bessel_Krasovskij52 - převede Fi, Lam z Besselova (S-JTSK) na Krasovskeho elipsoid (S-42)" ,tx10.Caption=a a=" Krasovskij42_Bessel - převede Fi, Lam z Krasovskeho (S-52) na Besselův elipsoid (S-JTSK)" ,tx11.Caption=a a=" Tran3D - převede Fi, Lam na Fi, Lam pomocí sedmiprvkové 3D transformace s využitím parametrů v dalších sloupcích. Jako výchozí a cíloví elipsoid lze zvolit elipsoid: Bessel, Krasovskij, WGS-84." ,tx12.Caption=a a=" Ferro_Green - převede Lam vztažené k Ferrskému poledníku na Lam vztažené ke Greenwichi. " ,tx13.Caption=a a=" Green_Ferro - převede Lam vztažené k Greenwichi poledníku na Lam vztažené ke Ferrskému poledníku. " ,tx14.Caption=a end sub end dialog helpp3 h3 table tab edit A 50 "Výchozí sys." edit B 50 "Cílový sys." edit C 60 "Kroky trans." edit D 27 "rotX['']" edit E 27 "rotY['']" edit F 27 "rotZ['']" edit G 27 "posX[m]" edit H 27 "posY[m]" edit I 27 "posZ[m]" edit J 30 "zkreslení" edit K 30 "z elipsoidu:" edit L 30 "na elipsoid:" end table begin dialog defvyp 7 84 442 215 "Nastavení" tab t 2 0 439 200 "Definice výpočtů" button Esc 53 201 40 13 1 "&Esc" button uloz 103 201 40 13 2 "Uložit" button OK 3 201 40 13 1 "&OK" button otevri 154 201 40 13 3 "Otevřít" button ins 207 201 45 13 3 "Vložit řádek" button rem 262 201 45 13 4 "Smazat řádek" button Help 318 201 45 13 1 "Help" string cesta sub Help.Click() DialogModeless(h3,2) end sub sub ins.Click() TabInsRow(self,t,TabCurRow(self,t)) end sub sub rem.Click() TabDelRow(self,t,TabCurRow(self,t)) end sub sub OK.Click() int i=1 do while i<=TabCntRows(self,t) TabGetRow(self,t,i) nd.t.A.Value=t.A.Value, nd.t.B.Value=t.B.Value, nd.t.C.Value=t.C.Value nd.t.D.Value=t.D.Value, nd.t.E.Value=t.E.Value, nd.t.F.Value=t.F.Value nd.t.G.Value=t.G.Value, nd.t.H.Value=t.H.Value, nd.t.I.Value=t.I.Value nd.t.J.Value=t.J.Value, nd.t.K.Value=t.K.Value, nd.t.L.Value=t.L.Value TabSetRow(nd,nd.t,i) i=i+1 //TabMaxRows(nd,nd.t,i) nd.ces.Value=cesta wend nastaveni(0) end sub sub otevri.Click() string filter = "tabulky"+chr$(0)+"*.tab"+chr$(0)+"vsechny soubory"+chr$(0)+"*.*"+chr$(0) string ext = "" // implicitni pripona cesta = trunc$(DlgOpenFile(filter,ext,"C:/Honza/diplomka/"),chr$(0)) TabLoad(self,t,cesta) end sub sub uloz.Click() string filter = "tabulky"+chr$(0)+"*.tab"+chr$(0)+"vsechny soubory"+chr$(0)+"*.*"+chr$(0) string ext ="" cesta=DlgSaveFile(filter,ext,) TabSave(self,t,cesta) end sub sub Create() int i=1 do while i<=TabCntRows(nd,nd.t) TabGetRow(nd,nd.t,i) t.A.Value=nd.t.A.Value, t.B.Value=nd.t.B.Value, t.C.Value=nd.t.C.Value t.D.Value=nd.t.D.Value, t.E.Value=nd.t.E.Value, t.F.Value=nd.t.F.Value t.G.Value=nd.t.G.Value, t.H.Value=nd.t.H.Value, t.I.Value=nd.t.I.Value t.J.Value=nd.t.J.Value , t.K.Value=nd.t.K.Value, t.L.Value=nd.t.L.Value TabSetRow(self,t,i) i=i+1 wend TabMaxRows(self,t,i) end sub end dialog defvyp dv begin dialog nastdial 179 189 200 85 "Nastavení" radiobox des 6 19 65 13 "Desetiny stupňů" group radiobox min 6 31 79 13 15 "Stupně, minuty, vteřiny" button Tabulka 134 69 56 11 18 "Definice výpočtů" frame fr1005 0 5 90 47 11 "Formát úhlových jednotek:" frame fr1006 0 58 193 26 "Nastavení výpočtů" tab t 0 0 0 0 "" edit ces 3 68 129 13 17 "tabulka" text tx1008 94 140 0 0 "tx1008" editint pcm 143 11 23 13 "pc" editint pcs 143 24 23 13 "edi1010" editint pcv 143 37 23 13 "edi1011" text tx1012 106 14 37 9 14 "Pro metry:" text tx1013 106 27 37 9 15 "Pro stupně:" text tx1014 106 39 37 9 16 "Pro vteřiny:" frame fr1015 94 5 98 47 17 "Počet plat. cifer:" sub Create() pcm.Value=3 pcs.Value=5 pcv.Value=3 string cesta // TabMaxRows(self,t,20) cesta=AdjustPath(IniDirectory(),"TABLES\TranTab.tab") TabLoad(self,t,cesta) // TabCntRows(self, t) // TabMaxRows(self,t,33) des.Value=1 nastaveni(1) ces.Value= cesta // d1.VystupX.Value="", d1.LVystupSt.Value="", d1.LVystupMin.Value="",d1.LVystupVter.Value="" // d1.VystupY.Value="",d1.FVystupSt.Value="", d1.FVystupMin.Value="",d1.FVystupVter.Value="" end sub sub Tabulka.Click() DialogModeless(dv,1) end sub sub min.Click() nastaveni(0) if min.Value AND d1.VstupX.Value!="" then d1.FVstupSt.Value=str$(floor(val(d1.VstupX.Value))) d1.FVstupMin.Value=str$(floor((val(d1.VstupX.Value)-floor(val(d1.VstupX.Value)))*60)) d1.FVstupVter.Value=str$( ((val(d1.VstupX.Value)-floor(val(d1.VstupX.Value)))*60 - floor((val(d1.VstupX.Value)-floor(val(d1.VstupX.Value)))*60))*60 ) d1.LVstupSt.Value=str$(floor(val(d1.VstupY.Value))) d1.LVstupMin.Value=str$(floor((val(d1.VstupY.Value)-floor(val(d1.VstupY.Value)))*60)) d1.LVstupVter.Value=str$(((val(d1.VstupY.Value)-floor(val(d1.VstupY.Value)))*60 - floor((val(d1.VstupY.Value)-floor(val(d1.VstupY.Value)))*60))*60 ) d1.FVystupSt.Value=str$(floor(val(d1.VystupX.Value))) d1.FVystupMin.Value=str$(floor((val(d1.VystupX.Value)-floor(val(d1.VystupX.Value)))*60)) d1.FVystupVter.Value=str$( ((val(d1.VystupX.Value)-floor(val(d1.VystupX.Value)))*60 - floor((val(d1.VystupX.Value)-floor(val(d1.VystupX.Value)))*60))*60 ) d1.LVystupSt.Value=str$(floor(val(d1.VystupY.Value))) d1.LVystupMin.Value=str$(floor((val(d1.VystupY.Value)-floor(val(d1.VystupY.Value)))*60)) d1.LVystupVter.Value=str$(((val(d1.VystupY.Value)-floor(val(d1.VystupY.Value)))*60 - floor((val(d1.VystupY.Value)-floor(val(d1.VystupY.Value)))*60))*60 ) end if end sub sub des.Click() nastaveni(0) if des.Value AND d1.FVstupSt.Value!="" then d1.VstupX.Value=str$(val(d1.FVstupSt.Value)+val(d1.FVstupMin.Value)/60+val(d1.FVstupVter.Value)/3600) d1.VstupY.Value=str$(val(d1.LVstupSt.Value)+val(d1.LVstupMin.Value)/60+val(d1.LVstupVter.Value)/3600) d1.VystupX.Value=str$(val(d1.FVystupSt.Value)+val(d1.FVystupMin.Value)/60+val(d1.FVystupVter.Value)/3600) d1.VystupY.Value=str$(val(d1.LVystupSt.Value)+val(d1.LVystupMin.Value)/60+val(d1.LVystupVter.Value)/3600) end if end sub end dialog nastdial nd begin dialog type1 177 174 200 85 "1 Bod" text textx 3 8 52 9 11 "X (Fi)" text texty 61 8 52 9 12 "Y (Lambda)" edit FVstupSt 2 17 15 13 12 " " edit FVstupMin 18 17 13 13 10 " " edit FVstupVter 32 17 25 13 11 " " edit LVstupSt 61 17 15 13 13 " " edit LVstupMin 77 17 13 13 14 " " edit LVstupVter 91 17 25 13 15 " " text textfi 3 43 52 9 7 "X (Fi)" text textlambda 61 43 52 9 "Y (Lambda)" edit VstupX 2 17 53 13 "X" edit FVystupSt 2 52 15 13 4 " " edit FVystupMin 18 52 13 13 5 " " edit FVystupVter 32 52 25 13 8 " " edit VstupY 61 17 52 13 12 "Y" edit LVystupSt 61 52 15 13 9 " " edit LVystupMin 77 52 13 13 10 " " edit LVystupVter 91 52 25 13 11 " " button transformuj 2 69 41 13 5 "Výpočet" text tx1017 120 8 49 10 5 "Výchozí systém:" combobox vstup1 120 17 69 60 2 "cb1019" vscroll dropdown combobox vystup1 120 52 69 60 3 "cb1017" vscroll dropdown text tx1013 119 42 53 9 4 "Cílový systém:" edit VystupY 61 52 53 13 "Y" edit VystupX 2 52 53 13 "Y" button Help 46 69 41 13 "&Help" frame fr1025 0 3 192 29 "Vstup" frame fr1028 0 38 192 29 "Výstup" //button Esc 90 69 41 13 "&Esc" sub Create() vstup1.Out="S-JTSK" // VystupX.Value="", LVystupSt.Value="", LVystupMin.Value="",LVystupVter.Value="" // VystupY.Value="",FVystupSt.Value="", FVystupMin.Value="",FVystupVter.Value="" end sub sub Help.Click() DialogModeless(h1,2) end sub sub vstup1.Change() nastaveni(1) VystupX.Value="", LVystupSt.Value="", LVystupMin.Value="",LVystupVter.Value="" VystupY.Value="",FVystupSt.Value="", FVystupMin.Value="",FVystupVter.Value="" end sub sub vystup1.Change() nastaveni(0) // if VstupX.Visible AND VstupX.Value="" then VystupX.Value="", LVystupSt.Value="", LVystupMin.Value="",LVystupVter.Value="" VystupY.Value="",FVystupSt.Value="", FVystupMin.Value="",FVystupVter.Value="" // elseif LVstupSt.Visible AND LVstupSt.Value="" then // VystupX.Value="", LVystupSt.Value="", LVystupMin.Value="",LVystupVter.Value="" // VystupY.Value="",FVystupSt.Value="", FVystupMin.Value="",FVystupVter.Value="" // end if end sub sub transformuj.Click() point in,out string jout ,jin string pom real pom1 if VstupX.Visible=1 then in.X=val(VstupX.Value),in.Y=val(VstupY.Value) elseif LVstupSt.Visible=1 then in.X=val(FVstupSt.Value)+val(FVstupMin.Value)/60+val(FVstupVter.Value)/3600 in.Y=val(d1.LVstupSt.Value)+val(d1.LVstupMin.Value)/60+val(d1.LVstupVter.Value)/3600 end if vypocet(vstup1.Out,vystup1.Out,in,out,jout,jin) if VystupX.Visible=1 then if jout="m" then VystupX.Value=FormatReal(out.X,"."+str$(nd.pcm.Value)) VystupY.Value=FormatReal(out.Y,"."+str$(nd.pcm.Value)) end if if jout="stup" then VystupX.Value=FormatReal(out.X,"."+str$(nd.pcs.Value)) VystupY.Value=FormatReal(out.Y,"."+str$(nd.pcs.Value)) end if elseif FVystupSt.Visible=1 then FVystupSt.Value=str$(floor(out.X)) FVystupMin.Value=str$(floor((out.X-floor(out.X))*60)) pom1= ((out.X-floor(out.X))*60 - floor((out.X-floor(out.X))*60))*60 FVystupVter.Value=FormatReal(pom1,"2."+str$(nd.pcv.Value)) LVystupSt.Value=str$(floor(out.Y)) LVystupMin.Value=str$(floor((out.Y-floor(out.Y))*60)) pom1= ((out.Y-floor(out.Y))*60 - floor((out.Y-floor(out.Y))*60))*60 LVystupVter.Value=FormatReal(pom1,"2."+str$(nd.pcv.Value)) //str$(((out.Y-floor(out.Y))*60 - floor((out.Y-floor(out.Y))*60))*60 ) end if end sub end dialog type1 d1 begin dialog type2 159 146 200 85 "Ze souboru" button nacti 100 18 19 11 2 "..." edit Vstupsoubor 2 17 97 13 6 "vstup" edit Vystupsoubor 2 52 97 13 1 "vystup" button uloz 100 53 19 11 4 "..." combobox vstup2 120 17 69 60 2 "cb1019" vscroll dropdown combobox vystup2 120 52 69 60 3 "cb1017" vscroll dropdown button transformuj2 2 69 41 13 5 "Výpočet" text tx1007 2 7 26 9 1 "soubor:" text tx1008 2 42 26 9 3 "soubor:" text tx1017 120 8 49 9 5 "Výchozí systém:" text tx1013 119 42 53 9 4 "Cílový systém:" frame fr1025 0 3 192 29 "Vstup" frame fr1028 0 38 192 29 1 "Výstup" button Help 46 69 41 13 "&Help" string nacist string cesta file souborvstup file souborvystup sub Create() // nastaveni() // vstup2.Out="S-JTSK" end sub sub Help.Click() DialogModeless(h2,2) end sub sub vstup2.Change() d1.vstup1.Out=d2.vstup2.Out nastaveni(1) end sub sub uloz.Click() string filter = "textove soubory"+chr$(0)+"*.txt"+chr$(0)+"tabulka"+chr$(0)+"*.tab"+chr$(0)+"vsechny soubory"+chr$(0)+"*.*" string ext ="" cesta=trunc$(DlgSaveFile(filter,ext,"C:/Honza/diplomka/"),chr$(0)) Vystupsoubor.Value=cesta end sub sub nacti.Click() string filter = "textove soubory"+chr$(0)+"*.txt"+chr$(0)+"vsechny soubory"+chr$(0)+"*.*"+chr$(0) string ext = "" // implicitni pripona nacist = trunc$(DlgOpenFile(filter,ext,"C:/Honza/diplomka/"),chr$(0)) Vstupsoubor.Value=nacist end sub sub transformuj2.Click() point in//dynamic in[0] point out//dynamic out[0] string cb,jout ,jin ,s,stx,sty,minx,miny,vtrx,vtry , od="," real pom1 int i=0 souborvystup=open(cesta,"w+") souborvstup=open(nacist,"r") if padstr$(cesta,3)="txt" then od=" " if padstr$(cesta,3)="tab" then od=chr$(9) line_input(souborvstup) //nacte hlavicku // line_output(souborvystup,vystup2.Out+od+"cb"+od+"X"+od+"Y") //napise hlavicku // if jout="m" then line_output(souborvystup,vystup2.Out+od+"cb "+od+"X"+od+"Y" ) // if jout="stup" then line_output(souborvystup,vystup2.Out+od+"cb "+od+"Fi"+od+"Lam" ) do while NOT eof(souborvstup) i=i+1 // redim in[i], redim out[i] input souborvstup," ",cb,in.X,in.Y if cb!="" then vypocet(vstup2.Out,vystup2.Out,in,out,jout,jin) if jout="m" then if i=1 AND od=" " then line_output(souborvystup,vystup2.Out+" cb XY") if i=1 AND od=chr$(9) then line_output(souborvystup,vystup2.Out), line_output(souborvystup,"cb"+od+"X"+od+"Y") print souborvystup ,cb+od+FormatReal(out.X,"."+str$(nd.pcm.Value))+od+FormatReal(out.Y,"."+str$(nd.pcm.Value)) elseif jout="stup" then if nd.des.Value then if i=1 AND od=" " then line_output(souborvystup,vystup2.Out+" cb Fi Lam") if i=1 AND od=chr$(9) then line_output(souborvystup,vystup2.Out), line_output(souborvystup,"cb"+od+"Fi"+od+"Lam" ) print souborvystup ,cb+od+FormatReal(out.X,"."+str$(nd.pcs.Value))+od+FormatReal(out.Y,"."+str$(nd.pcs.Value)) elseif nd.min.Value then if i=1 AND od=" " then line_output(souborvystup,vystup2.Out+" cb Fi Lam") if i=1 AND od=chr$(9) then line_output(souborvystup,vystup2.Out), line_output(souborvystup,"cb"+od+"Fi"+od+"´"+od+"''"+od+"Lam"+od+"´"+od+"''" ) stx=str$(floor(out.X)) minx=str$(floor((out.X-floor(out.X))*60)) pom1= ((out.X-floor(out.X))*60 - floor((out.X-floor(out.X))*60))*60 vtrx=FormatReal(pom1,"2."+str$(nd.pcv.Value)) sty=str$(floor(out.Y)) miny=str$(floor((out.Y-floor(out.Y))*60)) pom1= ((out.Y-floor(out.Y))*60 - floor((out.Y-floor(out.Y))*60))*60 vtry=FormatReal(pom1,"2."+str$(nd.pcv.Value)) print souborvystup,cb+od+stx+od+minx+od+vtrx+od+sty+od+miny+od+vtry end if end if end if wend //Vystupsoubor.Value=str$(out[1].X ) close(souborvystup),close(souborvstup) end sub end dialog type2 d2 begin dialog type4 107 143 200 103 "Transfomace mezi systémy" sub Create() DialogInsFolder(self,d1) DialogInsFolder(self,d2) DialogInsFolder(self,nd) end sub end dialog sub nastaveni(int pom) int i=1 string vs=chr$(44) string vy//=chr$(44) string predchoz="" string jin,jout point in,out ' .......................................Nacteni vstupniho a vystupniho systemu........................ do while i<=TabCntRows(nd,nd.t) TabGetRow(nd, nd.t, i) if nd.t.A.Value !=predchoz AND nd.t.A.Value!="" then vs=vs+nd.t.A.Value+chr$(44) predchoz=nd.t.A.Value end if if nd.t.A.Value = d1.vstup1.Out then vy=vy+chr$(44)+nd.t.B.Value if pom=1 then d1.vystup1.Out=nd.t.B.Value, d2.vystup2.Out=nd.t.B.Value end if i=i+1 loop d1.vstup1.In=vs d1.vystup1.In=vy d2.vstup2.In=vs d2.vystup2.In=vy //.........................jednotky vstupu..................................... in.X=1,in.Y=1 vypocet(d1.vstup1.Out,d1.vystup1.Out,in,out,jout,jin) if jin="stup" then d1.textx.Caption="Fi" d1.texty.Caption="Lam" if nd.min.Value then d1.VstupX.Visible=0,d1.FVstupSt.Visible=1,d1.FVstupMin.Visible=1,d1.FVstupVter.Visible=1 d1.VstupY.Visible=0,d1.LVstupSt.Visible=1,d1.LVstupMin.Visible=1,d1.LVstupVter.Visible=1 elseif nd.des.Value then d1.VstupX.Visible=1,d1.FVstupSt.Visible=0,d1.FVstupMin.Visible=0,d1.FVstupVter.Visible=0 d1.VstupY.Visible=1,d1.LVstupSt.Visible=0,d1.LVstupMin.Visible=0,d1.LVstupVter.Visible=0 end if elseif jin="m" then d1.textx.Caption="X" d1.texty.Caption="Y" d1.VstupX.Visible=1,d1.FVstupSt.Visible=0,d1.FVstupMin.Visible=0,d1.FVstupVter.Visible=0 d1.VstupY.Visible=1,d1.LVstupSt.Visible=0,d1.LVstupMin.Visible=0,d1.LVstupVter.Visible=0 end if //...................................jednotky vystupu......................................................... if jout="stup" then d1.textfi.Caption="Fi", d1.textlambda.Caption="Lam" if nd.min.Value then d1.VystupX.Visible=0,d1.FVystupSt.Visible=1,d1.FVystupMin.Visible=1,d1.FVystupVter.Visible=1 d1.VystupY.Visible=0,d1.LVystupSt.Visible=1,d1.LVystupMin.Visible=1,d1.LVystupVter.Visible=1 elseif nd.des.Value then d1.VystupX.Visible=1,d1.FVystupSt.Visible=0,d1.FVystupMin.Visible=0,d1.FVystupVter.Visible=0 d1.VystupY.Visible=1,d1.LVystupSt.Visible=0,d1.LVystupMin.Visible=0,d1.LVystupVter.Visible=0 end if else d1.textfi.Caption="X", d1.textlambda.Caption="Y" d1.VystupX.Visible=1,d1.FVystupSt.Visible=0,d1.FVystupMin.Visible=0,d1.FVystupVter.Visible=0 d1.VystupY.Visible=1,d1.LVystupSt.Visible=0,d1.LVystupMin.Visible=0,d1.LVystupVter.Visible=0 end if end sub sub vypocet(string Sysvstup, string Sysvystup, point BodVstup,point& BodVystup,string& jout,string& jin) point D,Pom point3D rot,pos point P=BodVstup real a, e2, A, E2 , E22 int i=1 int j=1 do while j<=TabCntRows(nd,nd.t) TabGetRow(nd, nd.t, j) if nd.t.A.Value =Sysvstup AND nd.t.B.Value = Sysvystup then i=j do select case nd.t.C.Value case "XY_Bessel" if i=j then jin="m" //jdeli o prvni funkci vstup je v metrech XY_Bessel(P), jout="stup" case "Bessel_XY" if i=j then jin="stup" Bessel_XY(P) , jout="m" case "Bessel_Krasovskij52" if i=j then jin="stup" Pom=P Bessel_XY(Pom) JTSKS52dBdL(Pom,D) P.X=P.X+D.X, P.Y=P.Y+D.Y , jout="stup" case "Krasovskij52_Bessel" if i=j then jin="stup" Pom=P Bessel_XY(Pom) JTSKS52dBdL(Pom,D) P.X =P.X-D.X, P.Y= P.Y-D.Y , jout="stup" case "Gauss_XY" if i=j then jin="stup" Gauss_XY(P), jout="m" case "XY_Gauss" if i=j then jin="m" XY_Gauss(P), jout="stup" case "Bessel_Krasovskij42" if i=j then jin="stup" Pom=P , jout="stup" Bessel_XY(Pom) JTSKS42dBdL(Pom,D) P.X=P.X+D.X, P.Y=P.Y+D.Y case "Krasovskij42_Bessel" if i=j then jin="stup" Pom=P Bessel_XY(Pom) , jout="stup" JTSKS42dBdL(Pom,D) P.X =P.X-D.X, P.Y= P.Y-D.Y case "Tran3D" if i=j then jin="stup" rot.X=val(nd.t.D.Value), rot.Y=val(nd.t.E.Value), rot.Z=val(nd.t.F.Value) pos.X=val(nd.t.G.Value), pos.Y=val(nd.t.H.Value), pos.Z=val(nd.t.I.Value) select case nd.t.K.Value case "Bessel" a=6377397.15508, e2=0.006674372230622 case "WGS-84" a=6378137, e2=0.006694379990141 case "Krasovskij" a = 6378245, e2=0.006693421622966 end select select case nd.t.L.Value case "WGS-84" A=6378137, E2=0.006694379990141 ,E22=0.006739496742276 case "Bessel" A=6377397.15508, E2=0.006674372230622,E22=0.006719218797978 case "Krasovskij" A = 6378245, E2=0.006693421622966, E22 = 0.006738525414683 end select Tran3D(P,rot,pos,val(nd.t.J.Value),a,e2,A,E2,E22) ,jout="stup" case "Wgs84UTMBLEN" if i=j then jin="stup" Wgs84UTMBLEN(P), jout="m" case "Wgs84UTMENBL" if i=j then jin="m" Wgs84UTMENBL(P), jout="stup" case "Ferro_Green" if i=j then jin="stup" P.Y=(P.Y-(17 + 40 / 60)) , jout="stup" case "Green_Ferro" if i=j then jin="stup" P.Y=(P.Y+(17 + 40 / 60)) , jout="stup" end select i=i+1 TabGetRow(nd, nd.t, i) if nd.t.A.Value!="" AND nd.t.B.Value!="" then exit loop if nd.t.C.Value=""then exit loop loop exit loop // po ukonceni vypoctu uz dal nehleda end if j=j+1 loop BodVystup=P end sub sub XY_Bessel(point& P) // XY => ro, eps point kart,koule, kuzpol,Bessel,JTSK JTSK=P kuzpol.X=sqrt(JTSK.X^2+JTSK.Y^2) //ro kuzpol.Y=atan(JTSK.Y/JTSK.X) //eps // ro, eps => sirku, delku real n=0.97992470462,ro0=1298039.00462 real v=tan((78.5/2+45)*PI/180), t=ro0/kuzpol.X, u=t^(1/n) kart.X=2*(atan(v*u)-(45*PI/180)) //sirka kart.Y=kuzpol.Y/n //delka // sirka, delka => U,V real Uk= 59.7118602500*PI/180 real Vk= 42.5253936806*PI/180 koule.X= asin(sin(kart.X)*sin(Uk)-cos(kart.X)*cos(Uk)*cos(kart.Y)) //U koule.Y=Vk-asin(cos(kart.X)*sin(kart.Y)/cos(koule.X)) //V // U,V=> fi, lambda real alfa= 1.000597498372,u0=49.4599572917,fi0=49.5 real du=(koule.X*180/PI)-u0 Bessel.X=fi0+1.001416022789*du-86.87150417/10^6*du^2+16.70197/10^(8)*du^3+117.5089/10^10*du^4 //fi Bessel.Y=((koule.Y*180/PI)/alfa) //lambda P=Bessel end sub sub Bessel_XY(point& P) point kart, koule,kuzpol,Bessel,JTSK Bessel=P // Fi, lambda => U, V real alfa= 1.000597498372,u0=49.4599572917,fi0=49.5 real dfy=Bessel.X-fi0 //real a= tan((elip.X/2+45)*PI/180) //real b= (-(((1-e*sin(elip.X*PI/180))/(1+e*sin(elip.X*PI/180))))^(e/2)) koule.X=(u0+dfy*(99.8585979496/(10^2))+86.50351075/(10^6)*dfy^2-15.1091/(10^8)*dfy^3-117.3673/(10^10)*dfy^4)*PI/180 //U koule.Y=PI/180*(alfa*Bessel.Y) //V // U,V => sirka, delka real Uk= 59.7118602500*PI/180 real Vk= 42.5253936806*PI/180 kart.X=asin(sin(Uk)*sin(koule.X)+cos(Uk)*cos(koule.X)*cos(Vk-koule.Y)) //S kart.Y=asin(sin(Vk-koule.Y)*cos(koule.X)/cos(kart.X)) //D // sirku, delku => ro, eps real n=0.97992470462,ro0=1298039.00462 kuzpol.X=ro0* ( ( tan((39.25+45)*PI/180) / (tan(kart.X/2+45*PI/180)) )^n ) //ro kuzpol.Y=n*kart.Y //eps // ro, eps => XY JTSK.X=kuzpol.X*cos(kuzpol.Y) //X JTSK.Y=kuzpol.X*sin(kuzpol.Y) //Y P=JTSK end sub sub JTSKS52dBdL(point& JTSK,point& D) real kk, a, b, C, d, e, f, g, h, k, y, x , ' ro ve stupnich y = JTSK.Y / 1000000, x = JTSK.X / 1000000 kk = -4.6646882192 a = 3.7091175824 b = -2.398277763 C = 0.33032733438 d = 0.60870873196 e = 1.0618597384 f = -0.12981050105 g = 0.011459645715 h = -0.16229009822 k = -0.011197738456 D.X = kk + a * x + b * y + C * x * x + d * x * y + e * y * y + f * x * x * x D.X = D.X + g * x * x * y + h * x * y * y + k * y * y * y D.X = D.X / 3600 kk = -6.799325277 a = 4.276704132 b = 10.540362944 C = -0.74948487035 d = -4.1908247218 e = 0.71106826869 f = 0.008062422824 g = 0.61432628711 h = 0.0053423421521 k = -0.20059555161 D.Y = kk + a * x + b * y + C * x * x + d * x * y + e * y * y + f * x * x * x D.Y = D.Y + g * x * x * y + h * x * y * y + k * y * y * y D.Y = D.Y / 3600 end sub // {jtsks52dbdl} // ----------- JTSK S-42 vypocet oprav dB, dL ----------- } sub JTSKS42dBdL(point& JTSK,point& D) real kk, a, b, C, d, e, f, g, h, k, y, x y = JTSK.Y / 1000000: x = JTSK.X / 1000000 kk = 6.4581309976 a = -25.2396636867 b = -6.31688387734 C = 25.3931214924 d = 6.479497342 e = 2.8729496693 f = -7.3246633461 g = -2.42395424509 h = -1.1948940070888 k = -0.1977771878 D.X = kk + a * x + b * y + C * x * x + d * x * y + e * y * y + f * x * x * x D.X = D.X + g * x * x * y + h * x * y * y + k * y * y * y D.X = D.X / 3600 kk = 2.763002544688 a = -21.17728368056 b = 9.7515238404 C = 20.98226652614 d = 0.929265490037 e = -1.52922105939 f = -5.861019136333 g = -2.860928322308 h = 0.8723432775432 k = 0.438453018241 D.Y = kk + a * x + b * y + C * x * x + d * x * y + e * y * y + f * x * x * x D.Y = D.Y + g * x * x * y + h * x * y * y + k * y * y * y D.Y = D.Y / 3600 end sub '{jtsks42dbdl} // -------------- Gauss BL XY ------------------------ sub Gauss_XY(point& P) point S52 point Kras=P int pas real Ro = 57.2957795130823 ' ro ve stupnich real LNULA, E22, E21, N, T, a, C, ETA2, LL, B,M,gama a = 6378245: C = 6356863.019 E22 = 0.00673852541468 , E21 = 0.00669342162297 Kras.X=Kras.X/Ro, Kras.Y=Kras.Y/Ro //-(17 + 40 / 60)) /Ro pas = floor((Kras.Y * Ro / 6) + 1) LNULA = pas * 6 - 3 LL = (Kras.Y - LNULA / Ro) B = 111134.861084 * Kras.X * Ro - 16036.480269 * sin(2*Kras.X) + 16.828067 * sin(4*Kras.X) - 0.021975 * sin(6*Kras.X) + 0.000031 * sin(8*Kras.X) T = sin(Kras.X) / cos(Kras.X) ETA2 = E22 * cos(Kras.X) ^ 2 N = a / sqrt(1 - E21 * sin(Kras.X) ^ 2) //--------------------vypocet X ----------------------- S52.X = B + N * sin(Kras.X) * cos(Kras.X) * (LL * LL / 2) S52.X = S52.X + N * sin(Kras.X) * cos(Kras.X) ^ 3 * (5 - T * T + 9 * ETA2 + 4 * ETA2 * ETA2) * (LL ^ 4 / 24) //------------------ vypocet Y ----------------- S52.Y = N * cos(Kras.X) * LL S52.Y = S52.Y + N * cos(Kras.X) * cos(Kras.X) * cos(Kras.X) * (1 - T * T + ETA2) * (LL * LL * LL / 6) S52.Y = S52.Y + N * cos(Kras.X) ^ 5 * (5 - 18 * T ^ 6 + 14 * ETA2 - 58 * ETA2 * T * T) * (LL ^ 5 / 120) S52.Y = S52.Y + 500000 + pas * 1000000 //------------ vypocet delkoveho zkresleni m -----------} M = 1 + cos(Kras.X) ^ 2 * (1 + ETA2) * LL * LL / 2 + cos(Kras.X) ^ 4 * (5 - 4 * T * T) * LL ^ 4 / 24 //------------- vypocet konvergence ------------------} gama = sin(Kras.X) * LL + sin(Kras.X) * cos(Kras.X) ^ 2 * (1 + 3 * ETA2 + 2 * ETA2 ^ 2) * (LL ^ 3 / 3) + sin(Kras.X) * cos(Kras.X) ^ 4 * (2 - T * T) * LL ^ 5 / 15 P=S52 end sub // {GaussBLXY} sub XY_Gauss(point& P) point S52, Kras S52=P int paspol real b1,b, L, M, gama real a, C, E2, EE, LNULA, LL, BR, T, N, L1, L2, L3, ETA2 real Ro = 57.2957795130823 ' ro ve stupnich // YY = S52.Y a = 6378245: C = 6356863.019 E2 = 0.673852541468 / 100: EE = 0.669342162297 / 100 paspol = floor(S52.Y / 1000000) LNULA = paspol * 6 - 3 b1 = S52.X / 111134.861084 BR = b1 / Ro S52.Y = S52.Y - paspol * 1000000 - 500000 b=b1-(-0.002518467884*Ro*sin(2*BR)+0.0000026428*Ro*sin(4*BR)-3.681*Ro*sin(6*BR)/10^(9)) BR=b/Ro b=b1-(-0.002518467884*Ro*sin(2*BR)+0.0000026428*Ro*sin(4*BR)-3.681*Ro*sin(6*BR)/10^(9)) BR = b / Ro T = sin(BR) / cos(BR) ETA2 = E2 * cos(BR) * cos(BR) N = a * a / (C * sqrt(ETA2 + 1)) // ------------- vypocet L ------------------- L = LNULA L1 = (Ro * S52.Y) / (N * cos(BR)) L = L + L1 L2 = -(Ro * S52.Y ^ 3) * (1 + 2 * T ^ 2 + ETA2) / (6 * N ^ 3 * cos(BR)) L = L + L2 L3 = (Ro * S52.Y ^ 5) * (5 + 28 * T ^ 2 + 24 * T ^ 4 + 6 * ETA2 + 8 * T ^ 2 * ETA2) / (120 * N ^ 5 * cos(BR)) L = L + L3 // ------------- vypocet B ---------------------- b = b - (Ro * T * S52.Y ^ 2) * (1 + ETA2) / (2 * N ^ 2) b = b + (Ro * T * S52.Y ^ 4) * (5 + 3 * T ^ 2 + 6 * ETA2 - 6 * T ^ 2 * ETA2 - 3 * ETA2 ^ 2 - 9 * T ^ 2 * ETA2 ^ 2) / (24 * N ^ 4) // S52.Y = YY Kras.Y = L //+(17 + 40 / 60): Kras.X = b //---------- vypocet delkoveho zkresleni m -------- LL = L - LNULA / Ro M = 1 + cos(b) ^ 2 * (1 + ETA2) * LL ^ 2 / 2 + cos(b) ^ 4 * (5 - 4 * T * T) * LL ^ 4 / 24 //------------- vypocet konvergence ------------- gama = sin(b) * LL + sin(b) * cos(b) * cos(b) * (1 + 3 * ETA2 + 2 * ETA2 ^ 2) * (LL ^ 3 / 3) + sin(b) * cos(b) ^ 4 * (2 - T ^ 2) * LL ^ 5 / 15 P=Kras end sub ' {GaussXYBL} ' { -------------- WGS84 UTM BL EN ------------------------ } sub Wgs84UTMBLEN(point& P) point BL , EN int Zone, pas 'B - Bwgs84, rovnobezka, B ze slova Breite, jinak Fi 'L - Lwgs84, polednik, L ze slova Lange, jinak Lambda 'Zone - cislo meridialniho pasu pocitano od 180 poledniku 'Nutm, Eutm - Northing a Easting, rovinne souradnice zobrazeni UTM real B,LNULA, E22, E21, N, T, ETA2, EE, LL, real Ro = 57.2957795130823 ' ro ve stupnich real a = 6378137 real C = 6356752.31425 BL.X=P.X/Ro , BL.Y=(P.Y)/Ro E22 = 0.006739496742276: EE = 0.006694379990141 'konstanty pro WGS84 elipsoid E21 = 0.006694379990141 ' { ---- a jde se pocitat ---- } pas = floor(BL.Y * Ro / 6) +1 Zone =30 +pas LNULA = pas*6 - 3 LL = (BL.Y - LNULA / Ro) B = 111132.9525474 * BL.X * Ro - 16038.508615 * sin(2*BL.X) + 16.8326 * sin(4*BL.X) - 0.021975 * sin(6*BL.X) +0.000031 * sin(8*BL.X) T = sin(BL.X)/cos(BL.X) ETA2 = E22 * cos(BL.X) ^ 2 N = a / sqrt(1 - E21 * sin(BL.X) ^ 2) //--------------------vypocet X ----------------------- EN.X = B + N * sin(BL.X) * cos(BL.X) * (LL * LL/2) EN.X = EN.X + N * sin(BL.X) * cos(BL.X)^3 * (5 - T * T + 9 * ETA2 + 4 * ETA2 * ETA2) * (LL^4 / 24) EN.X=EN.X*0.9996 //------------------ vypocet Y ----------------- EN.Y = N * cos(BL.X) * LL EN.Y = EN.Y + N * cos(BL.X) * cos(BL.X) * cos(BL.X) * (1 - T * T + ETA2) * (LL * LL * LL / 6) EN.Y = EN.Y + N * cos(BL.X) ^ 5 * (5 - 18 * T ^ 6 + 14 * ETA2 - 58 * ETA2 * T * T) * (LL ^ 5 / 120) EN.Y = EN.Y * 0.9996 + 500000+Zone*1000000 P=EN end sub ' {UTMWgs84BLEN} sub Wgs84UTMENBL(point& P) point EN, BL EN=P int paspol real b1,b, L, real LNULA, E2, N, T, ETA2, BR, EE, L1,L2,L3 real Ro = 57.2957795130823 ' ro ve stupnich real a = 6378137 real C = 6356752.31425 E2 = 0.006739496742276: EE = 0.00669437999014 EN.X=EN.X/0.9996 paspol = floor(EN.Y/ 1000000) LNULA = (paspol-30) * 6 - 3 BR = b1 / Ro EN.Y = (EN.Y - 500000)-1000000*(paspol) EN.Y=EN.Y/0.9996 b1 = (EN.X )/ 111132.9525474 b=b1-(-0.002518829691*Ro*sin(2*BR)+0.000002643543*Ro*sin(4*BR)-3.453*Ro*sin(6*BR)/10^(9)) BR=b/Ro b=b1-(-0.002518829691*Ro*sin(2*BR)+0.000002643543*Ro*sin(4*BR)-3.453*Ro*sin(6*BR)/10^(9)) BR = b / Ro b=b1-(-0.002518829691*Ro*sin(2*BR)+0.000002643543*Ro*sin(4*BR)-3.453*Ro*sin(6*BR)/10^(9)) BR = b / Ro T = sin(BR) / cos(BR) ETA2 = E2 * cos(BR) * cos(BR) N = a * a / (C * sqrt(ETA2 + 1)) // ------------- vypocet L ------------------- L = LNULA L1 = (Ro * EN.Y) / (N * cos(BR)) L = L + L1 L2 = -(Ro * EN.Y ^ 3) * (1 + 2 * T ^ 2 + ETA2) / (6 * N ^ 3 * cos(BR)) L = L + L2 L3 = (Ro * EN.Y ^ 5) * (5 + 28 * T ^ 2 + 24 * T ^ 4 + 6 * ETA2 + 8 * T ^ 2 * ETA2) / (120 * N ^ 5 * cos(BR)) L = L + L3 T = sin(BR) / cos(BR) ETA2 = E2 * cos(BR) * cos(BR) N = a * a / (C * sqrt(ETA2 + 1)) // ------------- vypocet B ---------------------- b = b - (Ro * T * EN.Y ^ 2) * (1 + ETA2) / (2 * N ^ 2) b = b + (Ro * T * EN.Y ^ 4) * (5 + 3 * T ^ 2 + 6 * ETA2 - 6 * T ^ 2 * ETA2 - 3 * ETA2 ^ 2 - 9 * T ^ 2 * ETA2 ^ 2) / (24 * N ^ 4) // ------------- vypocet L ------------------- BL.Y = L //+(17 + 40 / 60)) BL.X = b P=BL end sub ' {Wgs84UTMENBL} sub Tran3D(point& P,point3D rot,point3D pos,real m,real a,real e2,real A,real E2,real E22) //rot ve vterinach real N,W,h,Ro = 57.2957795130823,i=1 point in,out, point3D in3D, out3D rot.X=rot.X/3600/Ro, rot.Y=rot.Y/3600/Ro,rot.Z=rot.Z/3600/Ro in=P in.X=(in.X)/Ro in.Y=(in.Y)/Ro W=sqrt(1-e2*(sin(in.X))^2) N=a/W h=230 in3D.X=(N+h)*cos(in.X)*cos(in.Y) in3D.Y=(N+h)*cos(in.X)*sin(in.Y) in3D.Z=(N*(1-e2)+h)*sin(in.X) out3D.X=(1+m)*( in3D.X +rot.Z*in3D.Y -rot.Y*in3D.Z)+pos.X out3D.Y=(1+m)*(-rot.Z*in3D.X +in3D.Y +rot.X*in3D.Z)+pos.Y out3D.Z=(1+m)*( rot.Y*in3D.X -rot.X*in3D.Y +in3D.Z)+pos.Z out.Y=atan(out3D.Y/out3D.X)*Ro out.X=atan (out3D.Z*(1+E22)/sqrt(out3D.X^2+out3D.Y^2)) W=sqrt(1-E2*(sin(out.X))^2) N=A/W for i=0 to 5 // iterace out.X=atan( (out3D.Z+N*E2*sin(out.X))/sqrt(out3D.X^2+out3D.Y^2) ) i=i+1 next out.X=out.X*Ro P=out end sub macro Trans type4 d4 DialogModal(d4,2) end macro