Paul, of coarse, I do not to waste your time, so here is main program
with callbacks (I did not attach one call-back function called cb_open_in_out() which is pretty long, but to investigate the problem this callback is not relevant. I also did not attached another two subroutines for the same reason.
Remember to use UTF-8 without signature to use my source codes
(there are lot of slovak special characters, first of all in comments)
WINAPP
PROGRAM TXT_2_SGF_WIN_APP
! USE TXT_SGF
USE MSWIN
IMPLICIT NONE
! INCLUDE <windows.ins>
EXTERNAL sb_vstup3, sb_vstup4,knc, cont, cb_open_in_out, cb_znam, cb_about
INTEGER*4 button_grey_control, knc, cont, cb_open_in_out, cb_znam, cb_about !!!pokracuj
INTEGER*4 ans, w, h, sb_vstup3, sb_vstup4, i, vybrate, kod, test, button_grey_control_mapa
LOGICAL STOP_PROCESSING_2
CHARACTER*129 subor3, subor4 ! Deklarácia premenných (vstupný a výstupný súbor) vrátane cesty k nim
CHARACTER*1 zmena(2) ! Deklarácia pre výber v combo boxe (a alebo n)
CHARACTER*181 b1_h, b2_h, b3_h ! Deklarácia HELP reťazcov
CHARACTER*20 b4_h
DATA (zmena(i), i=1,2)/'a','n'/
COMMON/retazec1/subor3
COMMON/retazec2/subor4
COMMON/cel_cisla1/button_grey_control
COMMON/cel_cisla2/vybrate
COMMON/zmena_znam/zmena
COMMON/testovanie1/kod
COMMON/testovanie2/test
COMMON/kontrola/STOP_PROCESSING_2
COMMON/grafika/button_grey_control_mapa
STOP_PROCESSING_2 = .FALSE. !to je pre externu funkciu KON_2, ktorá sa vyvola pri kontrole vstupneho suboru, ak sa v nom najde chyba v subroutine
!Konverzia_TXT_2_SGF-input
test = -1
kod = -1
b1_h='Textový súbor so 7-riadkovou hlavičkou a hodnotami'//char(10)//' X,Y,DX,DY v tvare nepravouholníkovej mriežky, '//char(10)//&
&'(hodnoty X,Y nie sú zoradené vzostupne)'
b2_h='Výstupný súbor, do ktorého sa zapíšu hodnoty X,Y,DX,DY vo'//char(10)//' vzostupnom poradí doplnené hodnotami X,Y,&
& pre ktoré DX=0, DY=0,'//char(10)//'aby sa vytvorila pravouholníková mriežka bodov'
b3_h='Po zvolení vst. a výst. súboru sa kliknutím'//char(10)//'na tento gombík spustí konverzia údajov'
b4_h='Ukončenie programu'
w=830
h=490
subor3='.txt'
subor4='.txt'
button_grey_control = 0
button_grey_control_mapa = 0
ans=winio@('%sz&',w,h)
ans=winio@('%ww[thin_border]&')
ans=winio@('%ca[Program: TXT_2_SGF, © Martin Kalafut]&')
ans=winio@('%mn[&Súbor[&Otvoriť súbor,~Zme&niť znamienka pre DX a DY]]&',cb_open_in_out,button_grey_control,cb_znam)
ans=winio@('%mn[[~Začať &konverziu,|,&Ukončiť]]&',button_grey_control,cont,knc)
ans=winio@('%mn[&Mapa[~&Zobraziť]]&',button_grey_control_mapa,knc)
ans=winio@('%mn[Po&moc[O p&rograme]]&',cb_about)
ans=winio@('%4nl%ta%bf%fn[Courier New]Zvoľ vstupný TXT súbor:%4ta%bc[yellow]%`^?bt[&Vybrať vstupný súbor]@%`bh&',&
'FILE_OPENR[Zvoľ súbor]',subor3,sb_vstup3,b1_h,1)
ans=winio@('%bg[grey]&')
ans=winio@('%2nl%ta%sf%bf%fn[Courier New]%ob%80st%cb&',subor3)
ans=winio@('%3nl%ta%bf%fn[Courier New]Zvoľ výstupný TXT súbor:%4ta%bc[yellow]%~^?bt[&Vy&brať výstupný súbor]@%`bh&',&
button_grey_control,'FILE_OPENW[Zvoľ súbor]',subor4,sb_vstup4,b2_h,1)
ans=winio@('%2nl%ta%sf%bf%fn[Courier New]%ob%80st%cb&',subor4)
vybrate=1
ans=winio@('%3nl%ta%bf%fn[Courier New]Zmeniť zn. pred DX a DY vo výslednom TXT súbore? (a=áno, n=nie)%`5.2ls&',zmena,3l,vybrate)
ans=winio@('%3nl%ta%bf%fn[Courier New]Spustenie konverzie údajov:%ta%bc[green]%~^?bt[Š&TART]@%`bh&',button_grey_control,cont,b3_h,1)
ans=winio@('%ta%bf%fn[Courier New]Koniec programu:%ta%bc[red]%^?bt[&KONIEC]@%`bh',knc,b4_h,1)
END PROGRAM TXT_2_SGF_WIN_APP
INTEGER FUNCTION knc() ! call-back funkcia na ukončenie programu jednak pre button KONIEC, jednak pre menu položku SÚBOR/UKONČIŤ
IMPLICIT NONE
INTEGER*4 knc
knc=-2
END FUNCTION knc
INTEGER FUNCTION cont() ! call-back funkcia na spustenie konverzie jednak pre button ŠTART a aj pre položku menu SÚBOR/ZAČAŤ KONVERZIU
IMPLICIT NONE
INTEGER*4 cont, button_grey_control, vybrate, button_grey_control_mapa
CHARACTER*129 subor3, subor4
COMMON/cel_cisla1/button_grey_control
COMMON/cel_cisla2/vybrate
COMMON/retazec1/subor3
COMMON/retazec2/subor4
COMMON/grafika/button_grey_control_mapa ! subroutina Konverzia_TXT_2_SGF-Input da info tejto externej funkcii tym, ze nastavi tuto premennu na rovnu 1
! (button_grey_control_mapa = 1, ak cela konverzia uspesne prebehne a tato hodnota (1) sa
! odovzda hlavnemu programu (kedze je COMMON), kde je definovana na zaciatku programu ako
! button_grey_control_mapa = 0, a zmenou na 1 sa zaktivni submenu MAPA/ZOBRAZIŤ (ktore je zo zaciatku neaktivne
!(kedze nie je co zobrazovat, kym cela konverzia uspesne neprebehne)
cont=2
CALL window_update@(vybrate)
!!! CALL Konverzia_TXT_2_SGF_Input (subor3, subor4, vybrate)
END FUNCTION cont
INTEGER FUNCTION sb_vstup3() ! Call-back funkcia pre button VYBRAŤ VSTUPNÝ SÚBOR na zvolenie a zapísanie mena (aj s cestou) vstupného súboru do boxu v hlavnom okne
IMPLICIT NONE
CHARACTER*129 subor3
INTEGER*4 sb_vstup3, button_grey_control
COMMON/cel_cisla1/button_grey_control
COMMON/retazec1/subor3
button_grey_control=1
sb_vstup3=2
CALL window_update@(subor3)
END FUNCTION sb_vstup3
INTEGER FUNCTION sb_vstup4() ! Call-back funkcia pre button VYBRAŤ VÝSTUPNÝ SÚBOR na zvolenie a zapísanie mena (aj s cestou) výstupného súboru do boxu v hlavnom okne
IMPLICIT NONE
LOGICAL, EXTERNAL :: FEXISTS@
LOGICAL L
CHARACTER*129 subor3, subor4
INTEGER*4 sb_vstup4, button_grey_control, err_code, w, h, ans
COMMON/cel_cisla1/button_grey_control
COMMON/retazec1/subor3
COMMON/retazec2/subor4
IF(FEXISTS@(subor4,err_code)) then
IF(subor4.eq.subor3) THEN
w=520
h=180
ans=winio@('%sz&',w,h)
ans=winio@('%ca[Info o zvolenom výstupnom súbore]&')
ans=winio@('%si#%bx&',0.3d0) ! %bx s argumentom výšky pixela (dounle precision-v tomoto prípade 0.3d0, pridá šedý pásik nad textom
! so zvolenou ikonou, ktorý je nad textom oddeleny ciarou
ans=winio@('%nl%ta%sf%cnNie je možné vybrať rovnaký názov výstupného súboru, aký&')
ans=winio@('%nl%ta má aj vstupný súbor! Mením koncovku súboru na *.csv!&')
ans=winio@('%2nl%cn%9`bt[OK]')
!!! ans=winio@('%si#%ta%cn%ws&','Nie je možné vybrať rovnaký názov výstupného súboru,')
!!! ans=winio@('%nl%ta%cn%ws&','aký má aj vstupný súbor! Koncovka bude automaticky zmenená na ')
!!! ans=winio@('%ws&','.csv')
!!! ans=winio@(' &')
!!! ans=winio@('%2nl%cn%9`bt[OK]')
CALL SET_SUFFIX@(subor4,'CSV',L) ! Volanie internej funckie FTN95 SETSUFFIX@ na zmenu koncovky mena vystupneho suboru
ELSE
w=0
h=0
ans=winio@('%sz&',w,h)
ans=winio@('%ca[Info o zvolenom výstupnom súbore]&')
ans=winio@('%si!%ta%sf%cnSúbor už existuje! Ak nezmeníte názov súboru, bude prepísaný!&')
ans=winio@('%2nl%cn%9`bt[OK]')
END IF
END IF
sb_vstup4=2
CALL window_update@(subor4)
END Function sb_vstup4
INTEGER FUNCTION cb_znam() ! call-back funkcia pre menu položku Zmeniť znamienka pre DX a DY
IMPLICIT NONE
INTEGER*4 cb_znam, vybrate, ans
CHARACTER*(1) zmena(2)
COMMON/cel_cisla2/vybrate
COMMON/zmena_znam/zmena
ans=winio@('%ca[Definovanie znamienok pre hodnoty DX a DY]&')
ans=winio@('%bg[grey]&')
ans=winio@('%3nl%ta%bf%fn[Courier New]Zmeniť zn. pred DX a DY vo výslednom TXT súbore? (a=áno, n=nie)%5.2ls&',zmena,3l,vybrate)
ans=winio@('%3nl%cn%9`bt[&OK]')
CALL window_update@(vybrate)
cb_znam=2
END FUNCTION cb_znam
INTEGER FUNCTION cb_about() ! Call-back funkcia pre menu položku POMOC/O PROGRAME
IMPLICIT NONE
INTEGER*4 cb_about, ans
ans=winio@('%ca[O programe TXT_2_SGF]&')
ans=winio@('%fn[Arial]%ts%bf%cnProgram TXT_2_SGF&',2.0d0)
ans=winio@('%`bf%ts%3nl&',1.0d0)
ans=winio@('%taVykoná správne zoradenie vstupných údajov X,Y,DX,DY nepravouholníkovej mriežky pokrývajúcej celú SR%nl&')
ans=winio@('%taa doplní ju na pravouholníkovú mriežku, kde všetky doplnené body mriežky majú hodnoty DX a DY nulové.%nl&')
ans=winio@('%taPravouholníkový tvar mriežky je nutný pre vytvorenie binárneho SGF (SHIFT GRID FILE) formátu, ktorý sa%nl&')
ans=winio@('%tav softvéri Trimble Bussines Center používa na transformáciu GNSS geocentrických súradníc do%nl&')
ans=winio@('%talokálneho súradnicového systému S-JTSK. Výsledkom konverzie je čitateľný TXT súbor obsahujúci%nl&')
ans=winio@('%tapravouholníkovú mriežku s požadovaným zoradením hodnôt súradníc X, Y a ich zmien DX, DY.%2nl&')
ans=winio@('%taHodnoty v každom bode mriežky sú súradnice X,Y v súradnicovom systéme S-JTSK03 spolu%nl&')
ans=winio@('%tas príslušnými zmenami DX a DY, ktoré vyjadrujú väzbu na pôvodný súradnicový systém S-JTSK.%2nl&')
ans=winio@('%taVstupný súbor je v čitateľnom TXT formáte a prvých sedem riadkov obsahuje hlavičku, ktorá musí%nl&')
ans=winio@('%tamať nasledovný formát (hodnoty Xmin, Xmax, Ymin, Ymax, Xkrok, Ykrok môžu byť aj iné):%2nl&')
ans=winio@('%ta1.riadok obsahuje minimálnu hodnotu súradnice X(S-JTSK03):%taXmin = -1335000 m%nl&')
ans=winio@('%ta2.riadok obsahuje maximálnu hodnotu súradnice X(S-JTSK03):%taXmax = -1132000 m%nl&')
ans=winio@('%ta3.riadok obsahuje minimálnu hodnotu súradnice Y(S-JTSK03):%taYmin = -592000 m%nl&')
ans=winio@('%ta4.riadok obsahuje maximálnu hodnotu súradnice Y(S-JTSK03):%taYmax = -165000 m%nl&')
ans=winio@('%ta5.riadok obsahuje krok v súradnici X(S-JTSK03):%2taXkrok = 1000 m%nl&')
ans=winio@('%ta6.riadok obsahuje krok v súradnici Y(S-JTSK03):%2taYkrok = 1000 m%nl&')
ans=winio@('%ta7.riadok obsahuje NULOVÚ hodnotu%nl&')
ans=winio@('%ta8.riadok a ďalšie až do konca obsahujú konkrétne súradnice X (m), Y(m) v S-JTSK03 v bodoch mriežky %nl&')
ans=winio@('%taa ich zmeny DX (m), DY (m) vyjadrujúcimi posuny voči S-JTSK a musia byť v tvare:%nl&')
ans=winio@('%ta-1333000 -483000 -0.74 0.25 (oddeľovač hodnôt údajov môže byť medzera alebo čiarka)%3nl&')
ans=winio@('%ta%bf%tc[red]UPOZORNENIE: Vyššie uvedený vstupný formát údajov MUSÍ byť dodržaný, inak konverzia zlyhá!%nl&')
ans=winio@('%taVšetky hodnoty súradníc (X,Y) vstupnej mriežky MUSIA byť ZÁPORNÉ celé čísla (bez desatinných miest)!%2nl&')
ans=winio@('%ta%tc[black]Autor vstupného TXT súboru nepravouholníkovej mriežky je GKÚ Bratislava.&')
ans=winio@('%2nl%taAutor konverzného programu TXT_2_SGF: Dr. Ing. Martin Kalafut (martin.kalafut@agis.sk)&')
ans=winio@('%bg[grey]&')
ans=winio@('%3nl%cn%9`bt[OK]')
cb_about=1
END FUNCTION cb_about
INTEGER FUNCTION button1 ()
IMPLICIT NONE
INTEGER*4 button1, test
COMMON/testovanie2/test
test=0 ! prepísanie súboru
button1=0
END FUNCTION button1
INTEGER FUNCTION button2 ()
IMPLICIT NONE
INTEGER*4 button2, test
COMMON/testovanie2/test
test = 1 ! súbor sa znovu bude vyberať
button2=0
END FUNCTION button2
