home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / foxupdat / upd_rt.exe / TRANSPRT.PRG < prev   
Text File  |  1993-09-28  |  343KB  |  10,585 lines
  1. *:*****************************************************************************
  2. *:
  3. *: Procedure file: C:\FOXPROW\TRANSPRT.PRG
  4. *:         System: FoxPro 2.5 Transporter
  5. *:         Author: Microsoft Corp.
  6. *:      Copyright (c) 1993,
  7. *:  Last modified: 1/4/93 at 15:57:18
  8. *:
  9. *:  Procs & Fncts: SETALL
  10. *:               : ERRORHANDLER
  11. *:               : STRIPPATH()
  12. *:               : CLEANUP
  13. *:               : SETVERSION
  14. *:               : GETOLDREPORTTYPE()
  15. *:               : DOUPDATE()
  16. *:               : CVRT102FRX()
  17. *:               : CVRTFBPRPT()
  18. *:               : OPENDBF()
  19. *:               : STARTTHERM
  20. *:               : CONVERTER
  21. *:               : UPDTHERM
  22. *:               : IMPORT
  23. *:               : SYNCHTIME
  24. *:               : CONVERTTYPE()
  25. *:               : MAKECURSOR
  26. *:               : GRAPHICTOCHAR
  27. *:               : CHARTOGRAPHIC
  28. *:               : UPDATESCREEN
  29. *:               : CONVERTPROJECT
  30. *:               : UPDATEREPORT
  31. *:               : NEWCHARTOGRAPHIC
  32. *:               : NEWGRAPHICTOCHAR
  33. *:               : NEWBANDS
  34. *:               : ALLGRAPHICTOCHAR
  35. *:               : ALLCHARTOGRAPHIC
  36. *:               : INITBANDS
  37. *:               : BLDBREAKEXP
  38. *:               : BLDBREAKS
  39. *:               : BLDDETAIL
  40. *:               : ADDTOTAL
  41. *:               : LITEXIST()
  42. *:               : GETLITEXPR()
  43. *:               : MAKEBAND
  44. *:               : MAKETEXT
  45. *:               : MAKEFIELD
  46. *:               : GETHEADING()
  47. *:               : LINESFORHEADING()
  48. *:               : HOWMANYHEADINGS()
  49. *:               : FLD_HEAD_EXIST()
  50. *:               : TOTALS_EXIST()
  51. *:               : CENTER_COL()
  52. *:               : EVALIMPORTEXPR
  53. *:               : MAPBUTTON()
  54. *:               : SCATTERBUTTONS
  55. *:               : FINDLIKEVPOS
  56. *:               : FINDLIKEHPOS
  57. *:               : MAKECHARFIT
  58. *:               : ALLENVIRONS
  59. *:               : ALLOTHERS
  60. *:               : FILLININFO
  61. *:               : ADJRPTFLOAT
  62. *:               : ADJRPTSUPPRESS
  63. *:               : ADJRPTRESET
  64. *:               : GETCHARSUPPRESS()
  65. *:               : SUPPRESSBLANKLINES
  66. *:               : ALLGROUPS
  67. *:               : RPTCONVERT
  68. *:               : RPTOBJCONVERT
  69. *:               : GETBANDINDEX
  70. *:               : BANDINFO()
  71. *:               : CLONEBAND
  72. *:               : RESIZEBAND
  73. *:               : BANDPOS()
  74. *:               : EMPTYBAND()
  75. *:               : GETBANDCODE()
  76. *:               : CVTREPORTVERTICAL()
  77. *:               : CVTREPORTHORIZONTAL()
  78. *:               : CVTRPTLINES()
  79. *:               : MERGELABELOBJECTS
  80. *:               : LABELOBJMERGE
  81. *:               : ADDLABELBLANKS
  82. *:               : LINESBETWEEN
  83. *:               : LABELBANDS
  84. *:               : LABELLINES
  85. *:               : CALCPOSITIONS
  86. *:               : CALCWINDOWDIMENSIONS
  87. *:               : FINDWIDEROBJECTS
  88. *:               : ADJHPOS
  89. *:               : SGN()
  90. *:               : REPOOBJECTS
  91. *:               : ADJITEMSINBOXES
  92. *:               : ITEMSINBOXES
  93. *:               : FINDOTHERSONLINE()
  94. *:               : ADJINVBTNS
  95. *:               : ADJPOSTINV
  96. *:               : FINDALIGNEND()
  97. *:               : STRETCHLINESTOBORDERS
  98. *:               : JOINLINES
  99. *:               : JOINHORIZONTAL
  100. *:               : JOINVERTICAL
  101. *:               : MEETBOXCHAR
  102. *:               : ZAPBOXCHAR
  103. *:               : ADDJOIN
  104. *:               : REJOINBOXES
  105. *:               : JOINLINEWIDTH()
  106. *:               : GETLASTOBJECTLINE()
  107. *:               : ADJOBJCODE
  108. *:               : GETWINDFONT
  109. *:               : ADJHEIGHTANDWIDTH
  110. *:               : COLUMNAR()
  111. *:               : DOSSIZE()
  112. *:               : ADJBITMAPCTRL
  113. *:               : ADJCOLOR
  114. *:               : RGBTOX()
  115. *:               : ADJPEN
  116. *:               : ADJFONT
  117. *:               : CONVERTCOLORPAIR
  118. *:               : GETCOLOR()
  119. *:               : WHATSTYLE()
  120. *:               : ADJTEXT
  121. *:               : ADJBOX
  122. *:               : GETLINEWIDTH()
  123. *:               : HORIZBUTTON()
  124. *:               : MAXBTNWIDTH()
  125. *:               : GETOBJWIDTH()
  126. *:               : GETOBJHEIGHT()
  127. *:               : GETRIGHTMOST
  128. *:               : GETLOWEST
  129. *:               : DOCREATE
  130. *:               : ADDGRAPHICALLABELGROUPS
  131. *:               : UPDATELABELDATA
  132. *:               : PLATFORMDEFAULTS
  133. *:               : UPDATEVERSION
  134. *:               : STAMPVAL()
  135. *:               : SHIFTL()
  136. *:               : SHIFTR()
  137. *:               : EMPTYPLATFORM()
  138. *:               : STRUCTDIALOG()
  139. *:               : CURPOS()
  140. *:               : SCXFRXDIALOG()
  141. *:               : TRANSPRMPT()
  142. *:               : RDVALID()
  143. *:               : DEACCLAU()
  144. *:               : SHOWCLAU()
  145. *:               : SCRNCTRL()
  146. *:               : ENABLEPROC()
  147. *:               : PVALID()
  148. *:               : ACTTHERM
  149. *:               : DEACTTHERM
  150. *:               : CLEANWIND
  151. *:               : ESCHANDLER
  152. *:               : ERRSHOW
  153. *:               : JUSTSTEM()
  154. *:               : WRITERESULT
  155. *:               : ISOBJECT()
  156. *:               : ISREPTOBJECT()
  157. *:               : ISGRAPHOBJ()
  158. *:               : HASRECORDS()
  159. *:               : ASKFONT()
  160. *:               : IS20SCX()
  161. *:               : IS20FRX()
  162. *:               : IS20LBX()
  163. *:               : GETSNIPFLAG()
  164. *:               : MATCH()
  165. *:               : WORDNUM()
  166. *:               : ADDBS()
  167. *:               : JUSTFNAME()
  168. *:               : JUSTPATH()
  169. *:               : FORCEEXT()
  170. *:               : CVTLONG()
  171. *:               : CVTSHORT()
  172. *:               : CVTBYTE()
  173. *:               : OBJ2BASEFONT()
  174. *:               : VERSIONCAP()
  175. *:               : BLACKBOX()
  176. *:               : SELECTOBJ
  177. *:               : INITSEL
  178. *:               : ADDSEL
  179. *:               : ISSELECTED()
  180. *:               : ASSEMBLE()
  181. *:               : TYPE2NAME()
  182. *:               : CLEANPICT()
  183. *:               : TPSELECT
  184. *:               : TOGGLE()
  185. *:               : OKVALID()
  186. *:               : WREADDEAC()
  187. *:
  188. *:          Calls: SETALL             (procedure in TRANSPRT.PRG)
  189. *:               : ERRORHANDLER       (procedure in TRANSPRT.PRG)
  190. *:               : STRIPPATH()        (function  in TRANSPRT.PRG)
  191. *:               : CLEANUP            (procedure in TRANSPRT.PRG)
  192. *:               : SETVERSION         (procedure in TRANSPRT.PRG)
  193. *:               : GETOLDREPORTTYPE() (function  in TRANSPRT.PRG)
  194. *:               : DOUPDATE()         (function  in TRANSPRT.PRG)
  195. *:               : CVRT102FRX()       (function  in TRANSPRT.PRG)
  196. *:               : CVRTFBPRPT         (procedure in TRANSPRT.PRG)
  197. *:               : OPENDBF()          (function  in TRANSPRT.PRG)
  198. *:               : STARTTHERM         (procedure in TRANSPRT.PRG)
  199. *:               : CONVERTER          (procedure in TRANSPRT.PRG)
  200. *:               : UPDTHERM           (procedure in TRANSPRT.PRG)
  201. *:               : IMPORT             (procedure in TRANSPRT.PRG)
  202. *:               : SYNCHTIME          (procedure in TRANSPRT.PRG)
  203. *:               : CONVERTTYPE()      (function  in TRANSPRT.PRG)
  204. *:               : MAKECURSOR         (procedure in TRANSPRT.PRG)
  205. *:
  206. *:      Documented              FoxDoc version 3.00a
  207. *:*****************************************************************************
  208. *
  209. * TRANSPORT - FoxPro screen, report and label conversion utility.
  210. *
  211. *:*****************************************************************************
  212. * Copyright (c) 1993 Microsoft Corp.
  213. * One Microsoft Way
  214. * Redmond, WA 98052
  215. *
  216. * Notes:
  217. * In this program, for clarity/readability reasons, we use variable
  218. * names that are longer than 10 characters.  Note, however, that only
  219. * the first 10 characters are significant.
  220. *
  221. *
  222. * Revision History:
  223. * First written by Matt Pohle, John Beaver and Walt Kennamer for FoxPro 2.5
  224. *
  225.  
  226. PROCEDURE transprt
  227. PARAMETER m.g_scrndbf, m.tp_filetype, m.dummy
  228. * "g_crndbf" is the name of the file to transport.  It will usually be in some sort
  229. * of database format (e.g., SCX/PJX/MNX) but might also be a FoxBASE+ or FoxPro 1.02
  230. * report or label file, which is not a database.
  231. *
  232. * "tp_filetype" specifies what kind of file "g_scrndbf" is.  Allowable values are
  233. * found in the #DEFINE constants immediately below.  Note that the Transporter usually
  234. * does not use this value and instead figures out what kind of file it is being
  235. * presented with by counting the fields in the database.  For FoxBASE+ and FoxPro 1.02 files,
  236. * however, the Transporter does use this parameter to convert the report or label
  237. * data into 2.0 database format before transporting to Windows.  Note that the FoxBASE+
  238. * types are never actually passed in m.tp_filetype.  They are inferred in GetOldReportType
  239. * and GetOldLabelTypefrom the ID byte in the report/label files.
  240.  
  241. * The "dummy" parameter is not used.  At one point in the developement of the Transporter,
  242. * another parameter was passed.
  243.  
  244. *
  245. * Define Global Constants
  246. *
  247. * Filetype constants for FoxPro 2.0 and FoxPro 2.5 formats
  248. #DEFINE c_20pjxtype        1
  249. #DEFINE c_25scxtype       12
  250. #DEFINE c_20scxtype        2
  251. #DEFINE c_25frxtype       13
  252. #DEFINE c_20frxtype        3
  253. #DEFINE c_25lbxtype       14
  254. #DEFINE c_20lbxtype        4
  255. * FoxPro 1.02 and FoxBASE+ formats.  Note that the FoxBASE+ types are never
  256. * actually passed in m.tp_filetype.  They are inferred in GetOldReportType and
  257. * GetOldLabelTypefrom the ID byte in the report/label files.  The suffix tells
  258. * us how the file was called, by REPORT FORM ... or by MODIFY REPORT ...
  259. #DEFINE c_frx102repo      23
  260. #DEFINE c_frx102modi      33
  261. #DEFINE c_fbprptrepo      43
  262. #DEFINE c_fbprptmodi      53
  263. #DEFINE c_lbx102repo      24
  264. #DEFINE c_lbx102modi      34
  265. #DEFINE c_fbplblrepo      44
  266. #DEFINE c_fbplblmodi      54
  267.  
  268. * Definitions for Objtype fields in screens/reports/labels
  269. #DEFINE c_otheader         1
  270. #DEFINE c_otworkar         2
  271. #DEFINE c_otindex          3
  272. #DEFINE c_otrel            4
  273. #DEFINE c_ottext           5
  274. #DEFINE c_otline           6
  275. #DEFINE c_otbox            7
  276. #DEFINE c_otrepfld         8
  277. #DEFINE c_otband           9
  278. #DEFINE c_otgroup         10
  279. #DEFINE c_otlist          11
  280. #DEFINE c_ottxtbut        12
  281. #DEFINE c_otradbut        13
  282. #DEFINE c_otchkbox        14
  283. #DEFINE c_otfield         15
  284. #DEFINE c_otpopup         16
  285. #DEFINE c_otpicture       17
  286. #DEFINE c_otrepvar        18
  287. #DEFINE c_ot20lbxobj      19
  288. #DEFINE c_otinvbut        20
  289. #DEFINE c_otpdset         21
  290. #DEFINE c_otspinner       22
  291. #DEFINE c_otfontdata      23
  292.  
  293. * Window types
  294. #DEFINE c_user             1
  295. #DEFINE c_system           2
  296. #DEFINE c_dialog           3
  297. #DEFINE c_alert            4
  298.  
  299. * ObjCode definitions
  300. #DEFINE c_sgsay            0
  301. #DEFINE c_sgget            1
  302. #DEFINE c_sgedit           2
  303. #DEFINE c_sgfrom           3
  304. #DEFINE c_sgbox            4
  305. #DEFINE c_sgboxd           5
  306. #DEFINE c_sgboxp           6
  307. #DEFINE c_sgboxc           7
  308.  
  309. #DEFINE c_lnvertical       0
  310. #DEFINE c_lnhorizontal     1
  311.  
  312. #DEFINE c_ocboxgrp         1
  313.  
  314. * Attempt to preserve colors of text, lines and boxes when transporting to DOS?
  315. #DEFINE c_maptextcolor     .T.
  316.  
  317. * Field counts
  318. #DEFINE c_20scxfld        57
  319. #DEFINE c_scxfld          79
  320. #DEFINE c_20frxfld        36
  321. #DEFINE c_frxfld          74
  322. #DEFINE c_ot20label       30
  323. #DEFINE c_20lbxfld        17
  324. #DEFINE c_20pjxfld        33
  325. #DEFINE c_pjxfld          31
  326.  
  327. * Metrics for various objects, report bands, etc.
  328. #DEFINE c_pophght      1.231
  329. #DEFINE c_radhght      1.308
  330. #DEFINE c_chkhght      1.308
  331. #DEFINE c_listht       1.000
  332. #DEFINE c_adjfld       0.125
  333. #DEFINE c_adjlist      0.125
  334. #DEFINE c_adjtbtn      0.769
  335. #DEFINE c_adjrbtn      0.308
  336. #DEFINE c_vchkbox      0.154
  337. #DEFINE c_vradbtn      0.154
  338. #DEFINE c_vpopup       0.906
  339. #DEFINE c_vlist        0.500
  340. #DEFINE c_hpopup       1.000
  341. #DEFINE c_adjbox       0.500
  342. #DEFINE c_chkpixel        12
  343.  
  344. #DEFINE c_pixelsize       96
  345. #DEFINE c_bandheight   ((19/96) * 10000)
  346. #DEFINE c_bandfudge    4350
  347.  
  348. #DEFINE c_charrptheight   66
  349. #DEFINE c_charrptwidth    80
  350. #DEFINE c_linesperinch    (66/11)
  351. #DEFINE c_charsperinch    13.71
  352.  
  353. * Version codes, put into Objcode fields in the header record
  354. #DEFINE c_25scx           63
  355. #DEFINE c_25frx           53
  356.  
  357. * Major file types
  358. #DEFINE c_report           0
  359. #DEFINE c_screen           1
  360. #DEFINE c_label            2
  361. #DEFINE c_project          3
  362.  
  363. * Error codes
  364. #DEFINE c_error1   "Unbedeutender"
  365. #DEFINE c_error2   "Schwerer"
  366. #DEFINE c_error3   "Irreparabler"
  367.  
  368. * Font style for Transporter dialogs
  369. #DEFINE c_dlgface   "MS Sans Serif"
  370. #DEFINE c_dlgsize   8.000
  371. #DEFINE c_dlgstyle  "BT"
  372. #DEFINE c_dlgsty1   "BO"
  373.  
  374. * Return values
  375. #DEFINE c_yes              1
  376. #DEFINE c_no               0
  377. #DEFINE c_cancel          -1
  378.  
  379. * Codepage translation
  380. #DEFINE c_cptrans       .T.    && do special CP translation for FoxBASE+ and FoxPro 1.02?
  381. #DEFINE c_doscp          437   && default DOS code page
  382. #DEFINE c_wincp         1252   && default Windows code page
  383. #DEFINE c_maccp            0
  384. #DEFINE c_unixcp           0
  385.  
  386. * bands[] array indexes
  387. #DEFINE c_tobandvpos       1
  388. #DEFINE c_tobandheight     2
  389. #DEFINE c_fmbandvpos       3
  390. #DEFINE c_fmbandheight     4
  391.  
  392. * Defines used in converting FoxBASE+ reports
  393. #DEFINE maxliterals    55
  394. #DEFINE litpoolsize    1452
  395. #DEFINE maxrepflds    24
  396. #DEFINE h_page    1
  397. #DEFINE h_break 3
  398. #DEFINE l_item    4
  399. #DEFINE f_break 5
  400. #DEFINE f_page    7
  401. #DEFINE f_rpt    8
  402.  
  403. PRIVATE ALL
  404.  
  405. IF SET("TALK") = "ON"
  406.    SET TALK OFF
  407.    m.talkset = "ON"
  408. ELSE
  409.    m.talkset = "OFF"
  410. ENDIF
  411. m.pcount = PARAMETERS()
  412. PUSH KEY
  413.  
  414. *
  415. * Declare Environment Variables so that they are visible throughout the program
  416. *
  417. STORE "" TO m.cursor, m.consol, m.bell, m.exact, m.escape, m.onescape, m.safety, ;
  418.    m.fixed, m.print, m.unqset, m.udfparms, m.exclusive, m.onerror, ;
  419.    m.trbetween, m.comp, m.device, m.status, m.g_fromplatform, m.choice, ;
  420.    m.g_fromobjonlyalias, m.g_boxeditemsalias, m.g_tempalias, m.mtopic, m.rbord, m.mcollate
  421. STORE 0 TO m.deci, m.memowidth, m.currarea
  422.  
  423. DO setall
  424.  
  425. * Set default typeface for reports
  426. m.g_rptfface            = "Courier"
  427. m.g_rptfstyle           = 0
  428. m.g_rpttxtfontstyle     = ""
  429. m.g_rptfsize            = 8
  430. IF _MAC OR _WINDOWS
  431.    m.g_rptlinesize      = (FONTMETRIC(1, m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  432.    m.g_rptcharsize      = (FONTMETRIC(6, m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  433. ENDIF
  434.  
  435. * Font selections for fields/text in the SCX/FRX itself.  May be overridden by user.
  436. m.g_fontface         = "MS Sans Serif"
  437. m.g_fontsize         = 8
  438. m.g_fontstyle        = "B"
  439.  
  440. * Font selections for controls in the SCX/FRX.  Not overrideable.
  441. m.g_cfontface        = "MS Sans Serif"
  442. m.g_cfontsize        = 8
  443.  
  444. m.g_foxfont          = "Foxfont"
  445. m.g_normstyle        = 0
  446. m.g_boldstyle        = 1
  447.  
  448. m.g_filetype         = " "
  449. m.g_fromplatform     = " "
  450. m.g_toplatform       = " "
  451. m.g_windheight       = 1
  452. m.g_windwidth        = 1
  453. m.g_thermwidth       = 0
  454. m.g_mercury          = 0
  455. m.g_20alias          = ""
  456. m.g_status           = 0
  457. m.g_energize         = .F.
  458. m.g_norepeat         = .F.
  459.  
  460. m.g_allobjects       = .T.
  461. m.g_newobjects       = .T.
  462. m.g_snippets         = .T.
  463. m.g_scrnalias        = ""
  464. m.g_updenviron       = .F.  && have we transported the environment records?
  465. m.g_tpselcnt         = 0    && number of entries in the tparray selection array
  466.  
  467. m.g_boxstrg = ['─','─','│','│','┌','┐','└','┘','─','─','│','│','┌','┐','└','┘']
  468.  
  469. m.g_returncode       = c_cancel
  470.  
  471. m.g_tocodepage       = 0
  472. m.g_fromcodepage     = 0
  473.  
  474. * Dimension the array of records to be transported.  This is the picklist of new and
  475. * updated objects.
  476. DIMENSION tparray[1,2]
  477.  
  478. DIMENSION g_lastobjectline[2]
  479. g_lastobjectline = 0
  480. m.g_tempindex = "S" + SUBSTR(LOWER(SYS(3)),2,8) + ".cdx"
  481.  
  482. m.onerror = ON("ERROR")
  483. ON ERROR DO errorhandler WITH MESSAGE(), LINENO(), c_error3
  484.  
  485. IF m.pcount < 2
  486.    DO ErrorHandler WITH "Ungⁿltige Anzahl von Parametern",LINENO(),c_error3
  487. ENDIF
  488.  
  489. *
  490. * Make sure we have a file name we can deal with.  Prompt if the file cannot be found.
  491. *
  492. IF TYPE("m.g_scrndbf") != "C"
  493.    m.g_scrndbf = ""
  494. ENDIF
  495. m.g_scrndbf = UPPER(ALLTRIM(m.g_scrndbf))
  496. DO CASE
  497. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "SCX"
  498.    IF !FILE(m.g_scrndbf)
  499.       m.g_scrndbf = GETFILE("SCX", "Wo ist "+strippath(m.g_scrndbf))
  500.    ENDIF
  501. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "FRX"
  502.    IF !FILE(m.g_scrndbf)
  503.       m.g_scrndbf = GETFILE("FRX", "Wo ist "+strippath(m.g_scrndbf))
  504.    ENDIF
  505. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "LBX"
  506.    IF !FILE(m.g_scrndbf)
  507.       m.g_scrndbf = GETFILE("LBX", "Wo ist "+strippath(m.g_scrndbf))
  508.    ENDIF
  509. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "PJX"
  510.    IF !FILE(m.g_scrndbf)
  511.       m.g_scrndbf = GETFILE("PJX", "Wo ist "+strippath(m.g_scrndbf))
  512.    ENDIF
  513. OTHERWISE
  514.    IF !FILE(m.g_scrndbf)
  515.       m.g_scrndbf = GETFILE("SCX|FRX|LBX|PJX", "Zu konvertierende Datei", "OK")
  516.    ENDIF
  517. ENDCASE
  518.  
  519. IF !FILE(m.g_scrndbf) OR EMPTY(m.g_scrndbf)
  520.    DO cleanup
  521.    RETURN .F.
  522. ENDIF
  523.  
  524. DO putwinmsg WITH "FoxPro Konvertierungsprogramm: " + LOWER(strippath(m.g_scrndbf))
  525.  
  526. DO setversion
  527.  
  528. * If we've been passed an old format report or label form, see if it is a FoxPro 1.02
  529. * form, a FoxBASE+ form, or an unknown form. 
  530. * Convert FoxPro 1.02 or FoxBASE+ DOS reports into 2.5 DOS reports
  531. IF INLIST(m.tp_filetype,c_frx102modi,c_frx102repo,c_lbx102modi, c_lbx102repo)
  532.    IF INLIST(m.tp_filetype,c_frx102modi,c_frx102repo)
  533.       m.tp_filetype = getoldreporttype()   && FoxPro 1.02 or FoxBASE+ report?
  534.    ELSE
  535.       m.tp_filetype = getoldlabeltype()    && FoxPro 1.02 or FoxBASE+ label?
  536.    ENDIF
  537.    
  538.    m.g_fromcodepage = c_doscp
  539.      
  540.    IF doupdate()           && prompt to convert to 2.5 format; sets m.g_filetype
  541.       DO CASE
  542.       CASE INLIST(m.tp_filetype,c_frx102modi,c_frx102repo)
  543.          * FoxPro 1.02 report
  544.          m.g_scrndbf = cvrt102frx(m.g_scrndbf, m.tp_filetype)
  545.       CASE INLIST(m.tp_filetype,c_fbprptmodi,c_fbprptrepo)
  546.          * FoxBASE+ report
  547.          m.g_scrndbf = cvrtfbprpt(m.g_scrndbf, m.tp_filetype)
  548.       CASE INLIST(m.tp_filetype,c_lbx102modi,c_lbx102repo)
  549.          * FoxPro 1.02 label
  550.          m.g_scrndbf = cvrt102lbx(m.g_scrndbf, m.tp_filetype)
  551.       CASE INLIST(m.tp_filetype,c_fbplblmodi,c_fbplblrepo)
  552.          * FoxBASE+ label
  553.          m.g_scrndbf = cvrtfbplbl(m.g_scrndbf, m.tp_filetype)
  554.       OTHERWISE
  555.          DO errorhandler WITH "Unbekanntes Berichtsformat",LINENO(),c_error3
  556.       ENDCASE
  557.    ELSE
  558.       DO cleanup
  559.       RETURN c_cancel
  560.    ENDIF
  561. ENDIF
  562.  
  563. * Open the screen/report/label/project file
  564. IF !opendbf(m.g_scrndbf)
  565.    m.g_returncode = c_cancel
  566. ENDIF
  567.  
  568. *
  569. * We have three basic conversion cases.  These are transporting a 2.0 file to a 
  570. * graphical 2.5 platform (structure change and conversion), converting a 2.0 file 
  571. * to a character 2.5 platform (structure change) and transporting a 2.5 platform 
  572. * to another 2.5 platform (character/graphical conversion).  This case statement
  573. * calls the appropriate dialog routines and makes sure we have done all the 
  574. * preparation (like creating the cursor we actually work with.)
  575. *
  576. * The 1.02 and FoxBASE+ reports/labels are handled in basically the same way.  
  577. * They get their own cases in this construct since we don't want to prompt the 
  578. * user twice for conversion.  Almost all of the actual conversion of these files 
  579. * has already taken place, in the "cvrt102frx" procedure (and related procedures) 
  580. * called above.
  581. *
  582. * Conversion of 2.0 project files is handled in its own case also.
  583. *
  584. DO CASE
  585. CASE INLIST(m.tp_filetype,c_frx102repo,c_fbprptrepo,c_lbx102repo,c_fbplblrepo) ;
  586.        AND (_WINDOWS OR _MAC)
  587.    * FoxPro 1.02 or FoxBASE+ report/label opened via REPORT/LABEL FORM.  At this point, 
  588.    * we've already converted the old format form into FoxPro 2.5 DOS format.
  589.    * Finish conversion, but don't transport it to Windows.
  590.    m.g_fromplatform = "DOS"
  591.    DO getcodepage
  592.    m.g_returncode = c_yes
  593.    DO starttherm WITH "Konvertiere",g_filetype
  594.    DO putwinmsg WITH "Konvertiere " + LOWER(strippath(m.g_scrndbf))
  595.    DO converter
  596.    DO updtherm WITH 100
  597.    
  598. CASE INLIST(m.tp_filetype,c_frx102modi,c_fbprptmodi,c_lbx102modi,c_fbplblmodi) ;
  599.        AND (_WINDOWS OR _MAC)
  600.    * FoxPro 1.02 or FoxBASE+ report/label opened via MODIFY REPORT/LABEL. At this point,
  601.    *  we've already converted the old format form into FoxPro 2.5 DOS format.
  602.    * Finish conversion, and then transport it to Windows.
  603.    m.g_fromplatform = "DOS"
  604.    DO getcodepage
  605.    m.g_returncode = c_yes
  606.    DO putwinmsg WITH "Konvertiere " + LOWER(strippath(m.g_scrndbf))
  607.    DO converter
  608.    DO putwinmsg WITH "Portiere " + LOWER(strippath(m.g_scrndbf))
  609.    DO import
  610.    DO synchtime WITH m.g_toplatform, m.g_fromplatform
  611.    DO updtherm WITH 100
  612.    
  613. CASE ((FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld OR FCOUNT() = c_20lbxfld);
  614.       AND (_DOS OR _UNIX))
  615.    * Convert it to a DOS report, but don't transport it to Windows
  616.    DO CASE
  617.    CASE !doupdate()  && displays dialog and sets g_toPlatform
  618.       m.g_returncode = c_cancel
  619.    OTHERWISE
  620.       m.g_fromplatform = "DOS"
  621.       DO getcodepage
  622.       m.g_returncode = c_yes
  623.       DO starttherm WITH "Konvertiere",g_filetype
  624.       DO converter
  625.       DO updtherm WITH 100
  626.    ENDCASE
  627.    
  628. CASE (FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld ;
  629.       OR FCOUNT() = c_20lbxfld) AND (_WINDOWS OR _MAC)
  630.    
  631.    * Convert it to DOS and then transport it to Windows
  632.    m.choice = converttype(.T.)
  633.    DO getcodepage
  634.       
  635.    DO CASE
  636.    CASE m.choice = c_yes
  637.       m.g_returncode = c_yes
  638.       DO converter
  639.       DO import
  640.       DO synchtime WITH m.g_toplatform, m.g_fromplatform
  641.       DO updtherm WITH 100
  642.    CASE m.choice = c_no
  643.       m.g_returncode = c_no
  644.       
  645.    OTHERWISE
  646.       m.g_returncode = c_cancel
  647.    ENDCASE
  648.    
  649. CASE FCOUNT() = c_scxfld OR FCOUNT() = c_frxfld
  650.    m.choice = converttype(.F.)
  651.    DO CASE
  652.    CASE m.choice = c_yes
  653.       m.g_returncode = c_yes
  654.       DO makecursor
  655.       DO import
  656.       IF m.g_returncode <> c_cancel
  657.          * This might happen if the user picked "Cancel" on the screen that lets
  658.          * him/her uncheck specific items.
  659.          SELECT (m.g_scrnalias)
  660.          DO synchtime WITH m.g_toplatform, m.g_fromplatform
  661.          DO updtherm WITH 100
  662.       ENDIF
  663.    CASE m.choice = c_no
  664.       m.g_returncode = c_no
  665.       
  666.    OTHERWISE
  667.       m.g_returncode = c_cancel
  668.    ENDCASE
  669. CASE FCOUNT() = c_20pjxfld
  670.    IF versnum() > "2.5"
  671.       * Identify fields that contain binary data.  These should not be codepage-translated.
  672.       * Note that files opened via low level routines (e.g., FoxPro 1.02 reports) will not 
  673.       * be codepage-translated automatically.  Strings in those files that require codepage
  674.       * translation will be codepage translated explicitly below.
  675.       SET NOCPTRANS TO arranged, object, symbols, devinfo
  676.    ENDIF
  677.  
  678.    * Converting a 2.0 project to 2.5 format
  679.    IF !doupdate()                 && displays dialog and sets g_toPlatform
  680.       m.g_returncode = c_cancel
  681.    ELSE
  682.       m.g_fromplatform = "DOS"
  683.       DO getcodepage
  684.       m.g_returncode = c_yes
  685.       DO putwinmsg WITH "Konvertiere " + LOWER(strippath(m.g_scrndbf))
  686.       DO starttherm WITH "Konvertiere ",g_filetype
  687.       DO converter
  688.       DO updtherm WITH 100
  689.    ENDIF
  690. CASE FCOUNT() = c_pjxfld
  691.    * 2.5 project passed to us by mistake--shouldn't ever happen.
  692.    WAIT WINDOW "Keine Konvertierung notwendig." NOWAIT
  693.    m.g_returncode = c_cancel
  694. OTHERWISE
  695.    DO errorhandler WITH "Unbekanntes oder ungⁿltiges Dateiformat", LINENO(), c_error3
  696.    m.g_returncode = c_cancel
  697. ENDCASE
  698.  
  699. DO cleanup
  700. RETURN m.g_returncode
  701.  
  702. *!*****************************************************************************
  703. *!
  704. *!       Function: OPENDBF
  705. *!
  706. *!      Called by: TRANSPRT.PRG                      
  707. *!
  708. *!*****************************************************************************
  709. FUNCTION opendbf
  710. PARAMETER fname
  711. m.g_scrnalias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  712. SELECT 0
  713. USE (m.fname) AGAIN ALIAS (m.g_scrnalias)
  714. IF RECCOUNT() = 0
  715.    WAIT WINDOW "Keine SΣtze zu portieren" NOWAIT
  716.    RETURN .F.
  717. ENDIF
  718. RETURN .T.
  719.  
  720. *
  721. * doupdate - Ask the user if a 2.0 screen/report/label should be updated to 2.5 format.
  722. *
  723. *!*****************************************************************************
  724. *!
  725. *!       Function: DOUPDATE
  726. *!
  727. *!      Called by: TRANSPRT.PRG                      
  728. *!
  729. *!          Calls: STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  730. *!
  731. *!*****************************************************************************
  732. FUNCTION doupdate
  733. PRIVATE m.result
  734.  
  735. DO CASE
  736. CASE INLIST(m.tp_filetype,c_frx102modi, c_frx102repo)
  737.    m.g_filetype = c_report
  738.    m.result = structdialog("Berichtsdatei aus 1.02 in 2.5-Format konvertieren?")
  739.    
  740. CASE INLIST(m.tp_filetype,c_fbprptmodi, c_fbprptrepo)
  741.    m.g_filetype = c_report
  742.    m.result = structdialog("Berichtdatei aus FoxBASE+ in FoxPro 2.5-Format konvertieren?")
  743.    
  744. CASE INLIST(m.tp_filetype,c_lbx102modi, c_lbx102repo)
  745.    m.g_filetype = c_label
  746.    m.result = structdialog("Etikettendatei aus 1.02 in 2.5-Format konvertieren?")
  747.    
  748. CASE INLIST(m.tp_filetype,c_fbplblmodi, c_fbplblrepo)
  749.    m.g_filetype = c_label
  750.    m.result = structdialog("Etikettendatei aus FoxBASE+ in FoxPro 2.5-Format konvertieren?")
  751.    
  752. CASE FCOUNT() = c_20scxfld
  753.    m.g_filetype = c_screen
  754.    m.result = structdialog("Maskendatei aus 2.0 in 2.5-Format konvertieren?")
  755.    
  756. CASE FCOUNT() = c_20frxfld
  757.    m.g_filetype = c_report
  758.    m.result = structdialog("Berichtsdatei aus 2.0 in 2.5-Format konvertieren?")
  759.    
  760. CASE FCOUNT() = c_20lbxfld
  761.    RETURN .F.
  762.    
  763. CASE FCOUNT() = c_20pjxfld
  764.    m.g_filetype = c_project
  765.    m.result = structdialog("Projektdatei aus 2.0 in 2.5-Format konvertieren?")
  766. ENDCASE
  767. RETURN m.result
  768.  
  769. *
  770. * converttype - Display the dialog used when converting between 2.5 platforms
  771. *
  772. *!*****************************************************************************
  773. *!
  774. *!       Function: CONVERTTYPE
  775. *!
  776. *!      Called by: TRANSPRT.PRG                      
  777. *!
  778. *!          Calls: CLEANUP            (procedure in TRANSPRT.PRG)
  779. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  780. *!
  781. *!           Uses: M.G_SCRNALIAS      
  782. *!
  783. *!*****************************************************************************
  784. FUNCTION converttype
  785. PARAMETER m.twooh
  786. PRIVATE m.i, m.pcount, m.nplatforms
  787.  
  788. IF m.twooh  && If it's a 2.0 file, there is only one platform to convert from.
  789.    DIMENSION platforms[1]
  790.    platforms[1] = "FoxPro fⁿr MS-DOS"
  791.    
  792.    DO CASE                           && Remember the type of file we are converting
  793.    CASE INLIST(m.tp_filetype,c_frx102modi,c_frx102repo,c_fbprptmodi,c_fbprptrepo)
  794.       m.g_filetype = c_report
  795.       
  796.    CASE FCOUNT() = c_20scxfld
  797.       m.g_filetype = c_screen
  798.       
  799.    CASE FCOUNT() = c_20frxfld
  800.       m.g_filetype = c_report
  801.       
  802.    CASE FCOUNT() = c_20lbxfld
  803.       m.g_filetype = c_label
  804.       
  805.    CASE FCOUNT() = c_20pjxfld
  806.       m.g_filetype = c_project
  807.    ENDCASE
  808. ELSE
  809.    IF FCOUNT() = c_scxfld                && Remember the type of file we are converting
  810.       m.g_filetype = c_screen
  811.    ELSE
  812.       IF UPPER(RIGHT(m.g_scrndbf, 4)) = ".LBX"
  813.          LOCATE FOR objtype = c_ot20label OR ;
  814.             ((platform = "WINDOWS" OR platform = "MAC") AND ;
  815.             objtype = c_otheader AND BOTTOM)
  816.          IF FOUND()
  817.             m.g_filetype = c_label
  818.          ELSE
  819.             m.g_filetype = c_report
  820.          ENDIF
  821.       ELSE
  822.          m.g_filetype = c_report
  823.       ENDIF
  824.    ENDIF
  825.    
  826.    * Get a list of the platforms in this file.
  827.    SELECT DISTINCT platform ;
  828.       FROM (m.g_scrnalias) ;
  829.       WHERE !DELETED() ;
  830.       INTO ARRAY availplatforms
  831.    m.nplatforms = _TALLY
  832.    
  833.    m.g_fromplatform = availplatforms[1]
  834.    m.pcount = 0
  835.    
  836.    FOR i = 1 TO m.nplatforms            && Get a list of available platforms excluding the current one.
  837.       DO CASE
  838.       CASE ATC('DOS',availplatforms[m.i]) > 0 AND !_DOS
  839.          m.pcount = m.pcount + 1
  840.          DIMENSION platforms[m.pcount]
  841.          platforms[m.pcount] = 'FoxPro for MS-DOS'
  842.          
  843.       CASE ATC('WINDOWS',availplatforms[m.i]) > 0 AND !_WINDOWS
  844.          m.pcount = m.pcount + 1
  845.          DIMENSION platforms[m.pcount]
  846.          platforms[m.pcount] = 'FoxPro for Windows'
  847.          
  848.       CASE ATC('UNIX',availplatforms[m.i]) > 0 AND !_UNIX
  849.          m.pcount = m.pcount + 1
  850.          DIMENSION platforms[m.pcount]
  851.          platforms[i] = 'FoxPro for Unix'
  852.          
  853.       CASE ATC('MAC',availplatforms[m.i]) > 0 AND !_MAC
  854.          m.pcount = m.pcount + 1
  855.          DIMENSION platforms[m.pcount]
  856.          platforms[i] = 'FoxPro for Macintosh'
  857.       ENDCASE
  858.    ENDFOR
  859.    RELEASE availplatforms
  860.    
  861.    IF m.nplatforms = 0 OR m.pcount = 0                        && There isn't anything to convert from.
  862.       WAIT WINDOW "Keine Konvertierung notwendig." NOWAIT
  863.       DO cleanup
  864.       RETURN c_cancel
  865.    ENDIF
  866. ENDIF
  867.  
  868. *   Call the dialog routine appropriate to this file type.
  869. DO CASE                        && Ask the user what we should do.
  870. CASE m.g_filetype = c_screen
  871.    RETURN scxfrxdialog("SCX")
  872. CASE m.g_filetype = c_report
  873.    RETURN scxfrxdialog("FRX")
  874. CASE m.g_filetype = c_label
  875.    RETURN scxfrxdialog("LBX")
  876. ENDCASE
  877. RETURN c_cancel
  878.  
  879. *
  880. * setversion - set global variable m.g_toPlatform with the name of the platform
  881. *            we are running on.
  882. *
  883. *!*****************************************************************************
  884. *!
  885. *!      Procedure: SETVERSION
  886. *!
  887. *!      Called by: TRANSPRT.PRG                      
  888. *!
  889. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  890. *!
  891. *!*****************************************************************************
  892. PROCEDURE setversion
  893.  
  894. DO CASE
  895. CASE _WINDOWS
  896.    m.g_toplatform = "WINDOWS"
  897.    m.g_tocodepage = c_wincp
  898. CASE _MAC
  899.    m.g_toplatform = "MAC"
  900.    m.g_tocodepage = c_maccp
  901. CASE _UNIX
  902.    m.g_toplatform = "UNIX"
  903.    m.g_tocodepage = c_unixcp
  904. CASE _DOS
  905.    m.g_toplatform = "DOS"
  906.    m.g_tocodepage = c_doscp
  907. OTHERWISE
  908.    DO errorhandler WITH "Unbekannte Version von FoxPro.", LINENO(), c_error3
  909. ENDCASE
  910.  
  911. *
  912. * import - Do the import.
  913. *
  914. *!*****************************************************************************
  915. *!
  916. *!      Procedure: IMPORT
  917. *!
  918. *!      Called by: TRANSPRT.PRG                      
  919. *!
  920. *!          Calls: EMPTYPLATFORM()    (function  in TRANSPRT.PRG)
  921. *!               : GETCHARSUPPRESS()  (function  in TRANSPRT.PRG)
  922. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  923. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  924. *!
  925. *!           Uses: M.G_SCRNALIAS      
  926. *!
  927. *!*****************************************************************************
  928. PROCEDURE import
  929. IF m.g_fromplatform = m.g_toplatform
  930.    RETURN
  931. ELSE
  932.    *   If we are converting everything, remove all records for the target
  933.    *   platform.
  934.    IF m.g_allobjects AND !emptyplatform(m.g_toplatform)
  935.       * We need to copy the records we want to a temporary file, clear our cursor
  936.       * and copy the records back since you can't pack a cursor and SELECT creates
  937.       * a read only cursor.
  938.       m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  939.       SELECT * FROM (m.g_scrnalias) ;
  940.          WHERE !DELETED() AND platform <> m.g_toplatform ;
  941.          INTO TABLE (m.g_tempalias)
  942.       SELECT (m.g_scrnalias)
  943.       ZAP
  944.       APPEND FROM (m.g_tempalias)
  945.       SELECT (m.g_tempalias)
  946.       USE
  947.       DELETE FILE (m.g_tempalias+".dbf")
  948.       DELETE FILE (m.g_tempalias+".fpt")
  949.       SELECT (m.g_scrnalias)
  950.    ENDIF
  951.    
  952.    *   Are we converting from graphics to a character
  953.    *   based screen?
  954.    m.g_tographic =  (m.g_toplatform = 'WINDOWS' OR m.g_toplatform = 'MAC') AND ;
  955.       (m.g_fromplatform = 'DOS' OR m.g_fromplatform = 'UNIX')
  956. ENDIF
  957.  
  958. IF g_filetype = c_report
  959.    m.g_norepeat = getcharsuppress()
  960. ENDIF
  961.  
  962. *  Pass control to the control routine appropriate for the direction we are converting.
  963. DO CASE
  964. CASE m.g_tographic
  965.    DO chartographic
  966. CASE !m.g_tographic
  967.    DO graphictochar
  968. ENDCASE
  969. RETURN
  970.  
  971. *
  972. * GraphicToChar - Converts everything, new objects or changed snippets from a grpahical
  973. *      platform to a character platform.
  974. *
  975. *!*****************************************************************************
  976. *!
  977. *!      Procedure: GRAPHICTOCHAR
  978. *!
  979. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  980. *!
  981. *!          Calls: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  982. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  983. *!               : STARTTHERM         (procedure in TRANSPRT.PRG)
  984. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  985. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  986. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  987. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  988. *!
  989. *!*****************************************************************************
  990. PROCEDURE graphictochar
  991. IF m.g_allobjects
  992.    *  Start the thermometer with the appropriate message.
  993.    DO starttherm WITH "Portiere ",m.g_filetype
  994.    
  995.    DO allgraphictochar
  996. ELSE
  997.    * Do a partial conversion, unless we're dealing with a label
  998.    IF m.g_filetype = c_label      && We only do complete label conversion
  999.       RETURN
  1000.    ENDIF
  1001.    
  1002.    DO selectobj   && figure out which ones to transport
  1003.    
  1004.    *  Start the thermometer with the appropriate message.
  1005.    DO starttherm WITH "Portiere",m.g_filetype
  1006.    
  1007.    m.g_mercury = 5
  1008.    DO updtherm WITH m.g_mercury
  1009.    
  1010.    DO putwinmsg WITH "Portiere " + LOWER(strippath(m.g_scrndbf))
  1011.    
  1012.    SELECT (m.g_scrnalias)
  1013.    
  1014.    IF m.g_snippets
  1015.       IF m.g_filetype = c_screen
  1016.          DO updatescreen
  1017.       ELSE
  1018.          DO updatereport
  1019.       ENDIF
  1020.    ENDIF
  1021.    IF m.g_newobjects
  1022.       DO newgraphictochar
  1023.    ENDIF
  1024. ENDIF
  1025.  
  1026. *
  1027. * CharToGraphic - Converts everything, new objects or changed snippets from a character
  1028. *      platform to a graphical platform.
  1029. *
  1030. *!*****************************************************************************
  1031. *!
  1032. *!      Procedure: CHARTOGRAPHIC
  1033. *!
  1034. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  1035. *!
  1036. *!          Calls: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1037. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  1038. *!               : STARTTHERM         (procedure in TRANSPRT.PRG)
  1039. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1040. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  1041. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  1042. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1043. *!
  1044. *!*****************************************************************************
  1045. PROCEDURE chartographic
  1046. IF m.g_allobjects
  1047.    *  Start the thermometer with the appropriate message.
  1048.    DO starttherm WITH "Portiere",m.g_filetype
  1049.    
  1050.    DO allchartographic
  1051. ELSE
  1052.    IF m.g_filetype = c_label      && We only do complete label convertsion
  1053.       RETURN
  1054.    ENDIF
  1055.    
  1056.    DO selectobj   && figure out which ones to transport
  1057.    
  1058.    *  Start the thermometer with the appropriate message.
  1059.    DO starttherm WITH "Portiere",m.g_filetype
  1060.    
  1061.    m.g_mercury = 5
  1062.    DO updtherm WITH m.g_mercury
  1063.  
  1064.    DO putwinmsg WITH "Portiere " + LOWER(strippath(m.g_scrndbf))
  1065.    
  1066.    SELECT (m.g_scrnalias)
  1067.    
  1068.    IF m.g_snippets
  1069.       IF m.g_filetype = c_screen
  1070.          DO updatescreen
  1071.       ELSE
  1072.          DO updatereport
  1073.       ENDIF
  1074.    ENDIF
  1075.    IF m.g_newobjects
  1076.       DO newchartographic
  1077.    ENDIF
  1078. ENDIF
  1079.  
  1080. *
  1081. * UpdateScreen - Copy any non-platform specific
  1082. *
  1083. *!*****************************************************************************
  1084. *!
  1085. *!      Procedure: UPDATESCREEN
  1086. *!
  1087. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1088. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1089. *!
  1090. *!          Calls: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  1091. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1092. *!               : MAPBUTTON()        (function  in TRANSPRT.PRG)
  1093. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1094. *!
  1095. *!           Uses: M.G_SCRNALIAS      
  1096. *!
  1097. *!        Indexes: ID                     (tag)
  1098. *!
  1099. *!*****************************************************************************
  1100. PROCEDURE updatescreen
  1101. PRIVATE m.thermstep
  1102.  
  1103. COUNT TO m.thermstep FOR platform = m.g_toplatform
  1104. IF m.g_newobjects
  1105.    m.thermstep = 40/m.thermstep
  1106. ELSE
  1107.    m.thermstep = 80/m.thermstep
  1108. ENDIF
  1109.  
  1110. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1111. SELECT * FROM (m.g_scrnalias) ;
  1112.    WHERE !DELETED() AND platform = m.g_fromplatform ;
  1113.    AND isselected(uniqueid,objtype,objcode) ;
  1114.    INTO CURSOR (m.g_tempalias)
  1115. INDEX ON uniqueid TAG id
  1116.  
  1117. SELECT (m.g_scrnalias)
  1118. SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  1119. LOCATE FOR .T.
  1120.  
  1121. SELECT (m.g_scrnalias)
  1122.  
  1123. * Check for flag to transport only code snippets
  1124. sniponly = .F.
  1125. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1126. IF FOUND()
  1127.    m.sniponly = getsnipflag(setupcode)
  1128. ENDIF
  1129.  
  1130. IF !m.sniponly
  1131.    DO updenviron WITH .T.
  1132. ENDIF
  1133.  
  1134. * Update everything else
  1135. SCAN FOR platform = m.g_toplatform AND !DELETED() ;
  1136.       AND (isobject(objtype) OR objtype = c_otheader)
  1137.    IF &g_tempalias..timestamp > timestamp
  1138.       IF !m.sniponly
  1139.          REPLACE name WITH &g_tempalias..name
  1140.          REPLACE expr WITH &g_tempalias..expr
  1141.          REPLACE STYLE WITH &g_tempalias..style
  1142.          IF INLIST(objtype,c_otradbut,c_ottxtbut)
  1143.             * Don't zap the whole set of buttons if there are just some new ones
  1144.             REPLACE PICTURE WITH mapbutton(&g_tempalias..picture,PICTURE)
  1145.          ELSE
  1146.             REPLACE PICTURE WITH &g_tempalias..picture
  1147.          ENDIF
  1148.          IF objtype <> c_otheader OR !m.g_tographic OR !EMPTY(order)
  1149.             * Icon file name is stored in Windows header, "order" field
  1150.             REPLACE ORDER WITH &g_tempalias..order
  1151.          ENDIF
  1152.          REPLACE UNIQUE WITH &g_tempalias..unique
  1153.          *REPLACE Environ WITH &g_tempalias..Environ
  1154.          REPLACE boxchar WITH &g_tempalias..boxchar
  1155.          REPLACE fillchar WITH &g_tempalias..fillchar
  1156.          REPLACE TAG WITH &g_tempalias..tag
  1157.          REPLACE tag2 WITH &g_tempalias..tag2
  1158.          REPLACE ruler WITH &g_tempalias..ruler
  1159.          REPLACE rulerlines WITH &g_tempalias..rulerlines
  1160.          REPLACE grid WITH &g_tempalias..grid
  1161.          REPLACE gridv WITH &g_tempalias..gridv
  1162.          REPLACE gridh WITH &g_tempalias..gridh
  1163.          REPLACE FLOAT WITH &g_tempalias..float
  1164.          REPLACE CLOSE WITH &g_tempalias..close
  1165.          REPLACE MINIMIZE WITH &g_tempalias..minimize
  1166.          REPLACE BORDER WITH &g_tempalias..border
  1167.          REPLACE SHADOW WITH &g_tempalias..shadow
  1168.          REPLACE CENTER WITH &g_tempalias..center
  1169.          REPLACE REFRESH WITH &g_tempalias..refresh
  1170.          REPLACE disabled WITH &g_tempalias..disabled
  1171.          REPLACE scrollbar WITH &g_tempalias..scrollbar
  1172.          REPLACE addalias WITH &g_tempalias..addalias
  1173.          REPLACE TAB WITH &g_tempalias..tab
  1174.          REPLACE initialval WITH &g_tempalias..initialval
  1175.          REPLACE initialnum WITH &g_tempalias..initialnum
  1176.          REPLACE spacing WITH &g_tempalias..spacing
  1177.          * Update width if it looks like a text object got longer in Windows
  1178.          IF !m.g_tographic AND objtype = c_ottext
  1179.             REPLACE width WITH MAX(width,LEN(CHRTRAN(expr,'"'+chr(39),'')))
  1180.          ENDIF
  1181.       ENDIF
  1182.       IF objtype = c_otfield  && watch out for SAYs changing to GETs
  1183.          REPLACE objcode WITH &g_tempalias..objcode
  1184.       ENDIF
  1185.       REPLACE lotype WITH &g_tempalias..lotype
  1186.       REPLACE rangelo WITH &g_tempalias..rangelo
  1187.       REPLACE hitype WITH &g_tempalias..hitype
  1188.       REPLACE rangehi WITH &g_tempalias..rangehi
  1189.       REPLACE whentype WITH &g_tempalias..whentype
  1190.       REPLACE WHEN WITH &g_tempalias..when
  1191.       REPLACE validtype WITH &g_tempalias..validtype
  1192.       REPLACE VALID WITH &g_tempalias..valid
  1193.       REPLACE errortype WITH &g_tempalias..errortype
  1194.       REPLACE ERROR WITH &g_tempalias..error
  1195.       REPLACE messtype WITH &g_tempalias..messtype
  1196.       REPLACE MESSAGE WITH &g_tempalias..message
  1197.       REPLACE showtype WITH &g_tempalias..showtype
  1198.       REPLACE SHOW WITH &g_tempalias..show
  1199.       REPLACE activtype WITH &g_tempalias..activtype
  1200.       REPLACE ACTIVATE WITH &g_tempalias..activate
  1201.       REPLACE deacttype WITH &g_tempalias..deacttype
  1202.       REPLACE DEACTIVATE WITH &g_tempalias..deactivate
  1203.       REPLACE proctype WITH &g_tempalias..proctype
  1204.       REPLACE proccode WITH &g_tempalias..proccode
  1205.       REPLACE setuptype WITH &g_tempalias..setuptype
  1206.       REPLACE setupcode WITH &g_tempalias..setupcode
  1207.       
  1208.       REPLACE timestamp WITH &g_tempalias..timestamp
  1209.       REPLACE platform WITH m.g_toplatform
  1210.    ENDIF
  1211.    
  1212.    m.g_mercury = m.g_mercury + m.thermstep
  1213.    DO updtherm WITH m.g_mercury
  1214.    
  1215. ENDSCAN
  1216.  
  1217. SELECT (m.g_tempalias)
  1218. USE
  1219. SELECT (m.g_scrnalias)
  1220.  
  1221. RETURN
  1222.  
  1223. *
  1224. * UpdateReport - Copy any "non-platform specific" information from one platform to another
  1225. *
  1226. *!*****************************************************************************
  1227. *!
  1228. *!      Procedure: UPDATEREPORT
  1229. *!
  1230. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1231. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1232. *!
  1233. *!          Calls: ADJRPTSUPPRESS     (procedure in TRANSPRT.PRG)
  1234. *!               : ADJRPTFLOAT        (procedure in TRANSPRT.PRG)
  1235. *!               : ADJRPTRESET        (procedure in TRANSPRT.PRG)
  1236. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1237. *!
  1238. *!           Uses: M.G_SCRNALIAS      
  1239. *!
  1240. *!        Indexes: ID                     (tag)
  1241. *!
  1242. *!*****************************************************************************
  1243. PROCEDURE updatereport
  1244. PRIVATE m.thermstep
  1245.  
  1246. COUNT TO m.thermstep FOR platform = m.g_toplatform
  1247. IF m.g_newobjects
  1248.    m.thermstep = 40/m.thermstep
  1249. ELSE
  1250.    m.thermstep = 80/m.thermstep
  1251. ENDIF
  1252.  
  1253. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1254. SELECT * FROM (m.g_scrnalias) ;
  1255.    WHERE platform = m.g_fromplatform AND !DELETED();
  1256.    AND isselected(uniqueid,objtype,objcode) ;
  1257.    INTO CURSOR (m.g_tempalias)
  1258. INDEX ON uniqueid TAG id
  1259.  
  1260. SELECT (m.g_scrnalias)
  1261. SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  1262. LOCATE FOR .T.
  1263.  
  1264. SELECT (m.g_scrnalias)
  1265. DO updenviron WITH .T.
  1266.  
  1267. SCAN FOR platform = m.g_toplatform AND ;
  1268.       (objtype = c_otheader OR objtype = c_otfield OR objtype = c_otpicture OR ;
  1269.       objtype = c_otrepfld OR objtype = c_otband OR objtype = c_otrepvar OR ;
  1270.       objtype = c_ottext OR objtype = c_otline OR objtype = c_otbox) AND !DELETED()
  1271.    IF &g_tempalias..timestamp > timestamp
  1272.       REPLACE name WITH &g_tempalias..name
  1273.       IF objtype = c_otrepvar AND !m.g_tographic
  1274.          REPLACE name WITH UPPER(name)
  1275.       ENDIF
  1276.       REPLACE expr WITH &g_tempalias..expr
  1277.       REPLACE STYLE WITH &g_tempalias..style
  1278.       REPLACE PICTURE WITH &g_tempalias..picture
  1279.       REPLACE ORDER WITH &g_tempalias..order
  1280.       REPLACE UNIQUE WITH &g_tempalias..unique
  1281.       REPLACE ENVIRON WITH &g_tempalias..environ
  1282.       REPLACE boxchar WITH &g_tempalias..boxchar
  1283.       REPLACE fillchar WITH &g_tempalias..fillchar
  1284.       REPLACE TAG WITH &g_tempalias..tag
  1285.       REPLACE tag2 WITH &g_tempalias..tag2
  1286.       REPLACE mode WITH &g_tempalias..mode
  1287.       REPLACE ruler WITH &g_tempalias..ruler
  1288.       REPLACE rulerlines WITH &g_tempalias..rulerlines
  1289.       REPLACE grid WITH &g_tempalias..grid
  1290.       REPLACE gridv WITH &g_tempalias..gridv
  1291.       REPLACE gridh WITH &g_tempalias..gridh
  1292.       REPLACE FLOAT WITH &g_tempalias..float
  1293.       REPLACE STRETCH WITH &g_tempalias..stretch
  1294.       REPLACE stretchtop WITH &g_tempalias..stretchtop
  1295.       REPLACE TOP WITH &g_tempalias..top
  1296.       REPLACE BOTTOM WITH &g_tempalias..bottom
  1297.       REPLACE suptype WITH &g_tempalias..suptype
  1298.       REPLACE suprest WITH &g_tempalias..suprest
  1299.       REPLACE norepeat WITH &g_tempalias..norepeat
  1300.       REPLACE resetrpt WITH &g_tempalias..resetrpt
  1301.       REPLACE pagebreak WITH &g_tempalias..pagebreak
  1302.       REPLACE colbreak WITH &g_tempalias..colbreak
  1303.       REPLACE resetpage WITH &g_tempalias..resetpage
  1304.       REPLACE GENERAL WITH &g_tempalias..general
  1305.       REPLACE spacing WITH &g_tempalias..spacing
  1306.       REPLACE DOUBLE WITH &g_tempalias..double
  1307.       REPLACE swapheader WITH &g_tempalias..swapheader
  1308.       REPLACE swapfooter WITH &g_tempalias..swapfooter
  1309.       REPLACE ejectbefor WITH &g_tempalias..ejectbefor
  1310.       REPLACE ejectafter WITH &g_tempalias..ejectafter
  1311.       REPLACE PLAIN WITH &g_tempalias..plain
  1312.       REPLACE SUMMARY WITH &g_tempalias..summary
  1313.       REPLACE addalias WITH &g_tempalias..addalias
  1314.       REPLACE offset WITH &g_tempalias..offset
  1315.       REPLACE topmargin WITH &g_tempalias..topmargin
  1316.       REPLACE botmargin WITH &g_tempalias..botmargin
  1317.       REPLACE totaltype WITH &g_tempalias..totaltype
  1318.       REPLACE resettotal WITH &g_tempalias..resettotal
  1319.       REPLACE resoid WITH &g_tempalias..resoid
  1320.       REPLACE curpos WITH &g_tempalias..curpos
  1321.       REPLACE supalways WITH &g_tempalias..supalways
  1322.       REPLACE supovflow WITH &g_tempalias..supovflow
  1323.       REPLACE suprpcol WITH &g_tempalias..suprpcol
  1324.       REPLACE supgroup WITH &g_tempalias..supgroup
  1325.       REPLACE supvalchng WITH &g_tempalias..supvalchng
  1326.       REPLACE supexpr WITH &g_tempalias..supexpr
  1327.       
  1328.       REPLACE timestamp WITH &g_tempalias..timestamp
  1329.       REPLACE platform WITH m.g_toplatform
  1330.       
  1331.       * Update width if it looks like a text object got longer in Windows
  1332.       IF !m.g_tographic AND objtype = c_ottext
  1333.          REPLACE width WITH MAX(width,LEN(CHRTRAN(expr,'"'+chr(39),'')))
  1334.       ENDIF
  1335.       
  1336.       DO adjrptsuppress
  1337.       DO adjrptfloat
  1338.       IF objtype = c_otrepvar OR (objtype = c_otrepfld AND totaltype > 0)
  1339.          DO adjrptreset
  1340.       ENDIF
  1341.    ENDIF
  1342.    
  1343.    m.g_mercury = m.g_mercury + m.thermstep
  1344.    DO updtherm WITH m.g_mercury
  1345. ENDSCAN
  1346.  
  1347. SELECT (m.g_tempalias)
  1348. USE
  1349. SELECT (m.g_scrnalias)
  1350.  
  1351. RETURN
  1352.  
  1353.  
  1354. *!*****************************************************************************
  1355. *!
  1356. *!      Procedure: UPDENVIRON
  1357. *!
  1358. *!*****************************************************************************
  1359. PROCEDURE updenviron
  1360. PARAMETER m.mustexist
  1361. * Update environment records if the user selected environment records for transport
  1362. * and if any of them have been updated.
  1363. IF EnvSelect() AND IsNewerEnv(m.mustexist)
  1364.    * Drop the old environment and put the new one in
  1365.    DELETE FOR IsEnviron(objtype) and platform = m.g_toplatform
  1366.    SCAN FOR platform = m.g_fromplatform AND IsEnviron(Objtype)
  1367.       SCATTER MEMVAR MEMO
  1368.       APPEND BLANK
  1369.       GATHER MEMVAR MEMO
  1370.       REPLACE platform WITH m.g_toplatform
  1371.       IF !g_tographic
  1372.          * DOS requires the alias name to be in upper case, while Windows doesn't
  1373.          REPLACE TAG WITH UPPER(TAG)
  1374.          REPLACE tag2 WITH UPPER(tag2)
  1375.       ENDIF
  1376.    ENDSCAN
  1377.    m.g_updenviron = .T.
  1378. ENDIF
  1379.  
  1380. *
  1381. * CONVERTPROJECT - Convert project file from 2.0 to 2.5 format
  1382. *
  1383. *!*****************************************************************************
  1384. *!
  1385. *!      Procedure: CONVERTPROJECT
  1386. *!
  1387. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  1388. *!
  1389. *!*****************************************************************************
  1390. PROCEDURE convertproject
  1391. PRIVATE m.i
  1392.  
  1393. SELECT (m.g_scrnalias)
  1394. ZAP
  1395.  
  1396. SELECT (m.g_20alias)
  1397. SCAN FOR !DELETED()
  1398.    SCATTER MEMVAR MEMO
  1399.    m.wasarranged = arranged
  1400.    RELEASE m.arranged         && to avoid type mismatch at GATHER time
  1401.    
  1402.    SELECT (m.g_scrnalias)
  1403.    APPEND BLANK
  1404.    GATHER MEMVAR MEMO
  1405.    DO CASE
  1406.    CASE type == "H"
  1407.       IF !EMPTY(devinfo)
  1408.          * Adjust developer info to support wider state code
  1409.          REPLACE devinfo WITH STUFF(devinfo,162,0,CHR(0)+CHR(0)+CHR(0))
  1410.          REPLACE devinfo WITH STUFF(devinfo,176,0,REPLICATE(CHR(0),46))
  1411.       ENDIF
  1412.       
  1413.    CASE type == "s"   && must be lowercase S
  1414.       * Adjust for the new method of storing cross-platform arrangement info
  1415.       * (ScrnRow = -999 for centered screens)
  1416.       REPLACE arranged WITH ;
  1417.           PADR("DOS",8);
  1418.          +IIF(m.wasarranged,"T","F");
  1419.          +IIF(m.scrnrow=-999,"T","F");
  1420.          +PADL(LTRIM(STR(m.scrnrow,4)),8) ;
  1421.          +PADL(LTRIM(STR(m.scrncol,4)),8) ;
  1422.          +PADR("WINDOWS",8);
  1423.          +IIF(m.wasarranged,"T","F");
  1424.          +IIF(m.scrnrow=-999,"T","F");
  1425.          +PADL(LTRIM(STR(m.scrnrow,4)),8) ;
  1426.          +PADL(LTRIM(STR(m.scrncol,4)),8)
  1427.    ENDCASE
  1428.    
  1429.    * Adjust the symbol table
  1430.    IF !EMPTY(symbols)
  1431.       FOR i = 1 TO INT((LEN(symbols)-4)/14)
  1432.          * Format of a 2.0 symbol table is
  1433.          *   4 bytes of header information
  1434.          *   n occurrences of this structure:
  1435.          *      TEXT symName[11]
  1436.          *      TEXT symType
  1437.          *      TEXT flags[2]
  1438.          * Format of a 2.5 symbol table is the same, except symName is now 13 bytes long
  1439.          REPLACE symbols WITH STUFF(symbols,(m.i-1)*16+15,0,CHR(0)+CHR(0))
  1440.          REPLACE ckval WITH VAL(sys(2007,symbols))
  1441.       ENDFOR
  1442.    ENDIF
  1443.    
  1444.    * Blank out the timestamp
  1445.    REPLACE timestamp WITH 0
  1446. ENDSCAN
  1447.  
  1448. *
  1449. * NewCharToGraphic - Take any new objects from the character platform and copy them
  1450. *      to the graphical platform.
  1451. *
  1452. *!*****************************************************************************
  1453. *!
  1454. *!      Procedure: NEWCHARTOGRAPHIC
  1455. *!
  1456. *!      Called by: CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1457. *!
  1458. *!          Calls: GETWINDFONT        (procedure in TRANSPRT.PRG)
  1459. *!               : NEWBANDS           (procedure in TRANSPRT.PRG)
  1460. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  1461. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1462. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  1463. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  1464. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1465. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  1466. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  1467. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1468. *!
  1469. *!           Uses: M.G_SCRNALIAS      
  1470. *!
  1471. *!*****************************************************************************
  1472. PROCEDURE newchartographic
  1473. PRIVATE m.thermstep, m.bandcount
  1474.  
  1475. SELECT (m.g_scrnalias)
  1476. SET ORDER TO
  1477.  
  1478. * Get the default font for the window in the "to" platform
  1479. IF m.g_tographic
  1480.    DO getwindfont
  1481. ENDIF
  1482.  
  1483. * Update the environment if it is new
  1484. DO updenviron WITH .F.
  1485.  
  1486. * Remember the window default font
  1487. SELECT (m.g_scrnalias)
  1488. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1489. IF FOUND()
  1490.    m.wfontface  = fontface
  1491.    m.wfontsize  = fontsize
  1492.    m.wfontstyle = fontstyle
  1493. ELSE
  1494.    m.wfontface  = m.g_fontface
  1495.    m.wfontsize  = m.g_fontsize
  1496.    m.wfontstyle = m.g_fontstyle
  1497. ENDIF
  1498.  
  1499. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1500. SELECT * FROM (m.g_scrnalias) ;
  1501.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1502.    isselected(uniqueid,objtype,objcode) AND ;
  1503.    uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  1504.    WHERE platform = m.g_toplatform) ;
  1505.    INTO CURSOR (m.g_tempalias)
  1506.  
  1507. IF m.g_snippets
  1508.    m.thermstep = 35/_TALLY
  1509. ELSE
  1510.    m.thermstep = 70/_TALLY
  1511. ENDIF
  1512.  
  1513. IF m.g_filetype = c_report
  1514.    DO newbands
  1515.    
  1516.    * We need to know where bands start and where they end in
  1517.    * both platforms.
  1518.    SELECT (m.g_scrnalias)
  1519.    COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  1520.    DIMENSION bands[m.bandCount,4]
  1521.    m.bandcount = bandinfo()
  1522.    SELECT (m.g_tempalias)
  1523. ENDIF
  1524.  
  1525. m.rightmost = 0
  1526. m.bottommost = 0
  1527.  
  1528. SCAN
  1529.    IF isobject(objtype)
  1530.       SCATTER MEMVAR MEMO
  1531.       SELECT (m.g_scrnalias)
  1532.       APPEND BLANK
  1533.       GATHER MEMVAR MEMO
  1534.  
  1535.       REPLACE platform WITH m.g_toplatform
  1536.  
  1537.       DO platformdefaults WITH 0
  1538.       DO fillininfo
  1539.  
  1540.       DO CASE
  1541.       CASE INLIST(objtype,c_otbox, c_otline)
  1542.          DO adjbox WITH c_adjbox
  1543.       ENDCASE   
  1544.  
  1545.       IF m.g_filetype = c_report
  1546.          DO rptobjconvert WITH m.bandcount
  1547.       ELSE
  1548.          REPLACE vpos WITH findlikevpos(vpos)
  1549.          REPLACE hpos WITH findlikehpos(hpos)
  1550.          
  1551.          m.rightmost = MAX(m.rightmost, hpos + width ;
  1552.           * FONTMETRIC(6,fontface,fontsize,whatstyle(fontstyle)) ;
  1553.           / FONTMETRIC(6,m.wfontface,m.wfontsize,whatstyle(m.wfontstyle)))
  1554.          m.bottommost = MAX(m.bottommost, vpos + height ;
  1555.           * FONTMETRIC(1,fontface,fontsize,whatstyle(fontstyle)) ;
  1556.           / FONTMETRIC(1,m.wfontface,m.wfontsize,whatstyle(m.wfontstyle)))
  1557.       ENDIF
  1558.    ENDIF
  1559.  
  1560.    SELECT (m.g_tempalias)
  1561.  
  1562.    m.g_mercury = m.g_mercury + m.thermstep
  1563.    DO updtherm WITH m.g_mercury
  1564. ENDSCAN
  1565.  
  1566. SELECT (m.g_tempalias)
  1567. USE
  1568. SELECT (m.g_scrnalias)
  1569. * Update screen width/height if necessary to hold the new objects
  1570. IF m.g_filetype = c_screen
  1571.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1572.    IF FOUND()
  1573.       * If the screen/report isn't big enough to hold the widest/tallest object, 
  1574.       * resize it.
  1575.       IF width < m.rightmost
  1576.          REPLACE width WITH m.rightmost + IIF(m.g_filetype = c_screen,2,2000)
  1577.       ENDIF
  1578.       IF height < m.bottommost AND m.g_filetype = c_screen
  1579.          REPLACE height WITH m.bottommost + IIF(m.g_filetype = c_screen,1,2000)
  1580.       ENDIF
  1581.    ENDIF      
  1582. ENDIF
  1583. RETURN
  1584.    
  1585. *
  1586. * NewGraphicToChar - Take any new objects from the graphic platform and copy them
  1587. *      to the character platform.
  1588. *
  1589. *!*****************************************************************************
  1590. *!
  1591. *!      Procedure: NEWGRAPHICTOCHAR
  1592. *!
  1593. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1594. *!
  1595. *!          Calls: NEWBANDS           (procedure in TRANSPRT.PRG)
  1596. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  1597. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1598. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  1599. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  1600. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  1601. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1602. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  1603. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  1604. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1605. *!               : MAKECHARFIT        (procedure in TRANSPRT.PRG)
  1606. *!
  1607. *!           Uses: M.G_SCRNALIAS      
  1608. *!
  1609. *!*****************************************************************************
  1610. PROCEDURE newgraphictochar
  1611. PRIVATE m.thermstep, m.bandcount
  1612.  
  1613. SELECT (m.g_scrnalias)
  1614. SET ORDER TO
  1615.  
  1616. * Update the environment if it is new
  1617. DO updenviron WITH .F.
  1618.  
  1619. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1620. *
  1621. * Get a cursor containing the records in the "to" platform that do not have
  1622. * counterparts in the "from" platform.  Exclude Windows report column headers
  1623. * and column footers (objtype = 9, objcode = 2 or 6) since they have no DOS analogs.
  1624. * Exclude boxes that are filled black.  They are probably used for shadow effects.
  1625. *
  1626. SELECT * FROM (m.g_scrnalias) ;
  1627.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1628.    !(objtype = c_otband AND INLIST(objcode,2,6)) AND ;
  1629.    isselected(uniqueid,objtype,objcode) AND ;
  1630.    !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  1631.    uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  1632.    WHERE platform = m.g_toplatform) ;
  1633.    INTO CURSOR (m.g_tempalias)
  1634.  
  1635. IF m.g_snippets
  1636.    m.thermstep = 35/_TALLY
  1637. ELSE
  1638.    m.thermstep = 70/_TALLY
  1639. ENDIF
  1640.  
  1641. IF m.g_filetype = c_report
  1642.    DO newbands
  1643.    
  1644.    * We need to know where bands start and where they end in
  1645.    * both platforms.
  1646.    SELECT (m.g_scrnalias)
  1647.    COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  1648.    DIMENSION bands[m.bandCount,4]
  1649.    m.bandcount = bandinfo()
  1650.    SELECT (m.g_tempalias)
  1651. ENDIF
  1652.  
  1653. LOCATE FOR .T.
  1654. DO WHILE !EOF()
  1655.    IF isobject(objtype) AND objtype <> c_otpicture
  1656.       SCATTER MEMVAR MEMO
  1657.       SELECT (m.g_scrnalias)
  1658.       APPEND BLANK
  1659.       GATHER MEMVAR MEMO
  1660.       
  1661.       REPLACE platform WITH m.g_toplatform
  1662.       
  1663.       DO platformdefaults WITH 0
  1664.       DO fillininfo
  1665.       
  1666.       IF m.g_filetype = c_screen
  1667.          DO adjheightandwidth
  1668.       ELSE
  1669.         DO rptobjconvert WITH m.bandcount
  1670.       ENDIF
  1671.       
  1672.       REPLACE vpos WITH findlikevpos(vpos)
  1673.       REPLACE hpos WITH findlikehpos(hpos)
  1674.    ENDIF
  1675.    
  1676.    SELECT (m.g_tempalias)
  1677.    SKIP
  1678.    
  1679.    m.g_mercury = m.g_mercury + m.thermstep
  1680.    DO updtherm WITH m.g_mercury
  1681. ENDDO
  1682.  
  1683. SELECT (m.g_tempalias)
  1684. USE
  1685. SELECT (m.g_scrnalias)
  1686.  
  1687. DO makecharfit
  1688.  
  1689. RETURN
  1690.  
  1691. *
  1692. * NewBands - Add any new band records.
  1693. *
  1694. *!*****************************************************************************
  1695. *!
  1696. *!      Procedure: NEWBANDS
  1697. *!
  1698. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1699. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  1700. *!
  1701. *!          Calls: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1702. *!               : BANDPOS()          (function  in TRANSPRT.PRG)
  1703. *!
  1704. *!*****************************************************************************
  1705. PROCEDURE newbands
  1706. PRIVATE m.prevband, m.bandstart, m.bandheight
  1707. * We need to have the groups in order to do report objects, so we do them seperately.
  1708.  
  1709. SCAN FOR objtype = c_otband
  1710.    SCATTER MEMVAR MEMO
  1711.    SELECT (m.g_scrnalias)
  1712.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.uniqueid
  1713.    SKIP -1
  1714.    m.prevband = uniqueid
  1715.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.prevband
  1716.    INSERT BLANK
  1717.    GATHER MEMVAR MEMO
  1718.    REPLACE platform WITH m.g_toplatform
  1719.    
  1720.    DO rptobjconvert WITH 0
  1721.    
  1722.    m.bandheight = HEIGHT + IIF(m.g_tographic, c_bandheight+(c_bandfudge/c_pixelsize), 0)
  1723.    m.bandstart = bandpos(m.uniqueid, m.g_toplatform)
  1724.    
  1725.    * Move all the lower bands down by the size of the one we just inserted.
  1726.    REPLACE ALL vpos WITH vpos + m.bandheight ;
  1727.       FOR platform = m.g_toplatform AND ;
  1728.       (objtype = c_otline OR objtype = c_otbox OR ;
  1729.       objtype = c_ottext OR objtype = c_otrepfld) AND ;
  1730.       vpos >= m.bandstart
  1731.    SELECT (m.g_tempalias)
  1732. ENDSCAN
  1733.  
  1734. *
  1735. * AllGraphicToChar - Convert from a graphic platform to a character platform assuming
  1736. *      that no records exist for the target platform.
  1737. *
  1738. *!*****************************************************************************
  1739. *!
  1740. *!      Procedure: ALLGRAPHICTOCHAR
  1741. *!
  1742. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1743. *!
  1744. *!          Calls: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  1745. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  1746. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  1747. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  1748. *!               : MERGELABELOBJECTS  (procedure in TRANSPRT.PRG)
  1749. *!               : LINESBETWEEN       (procedure in TRANSPRT.PRG)
  1750. *!               : MAKECHARFIT        (procedure in TRANSPRT.PRG)
  1751. *!               : SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  1752. *!
  1753. *!           Uses: M.G_SCRNALIAS      
  1754. *!
  1755. *!*****************************************************************************
  1756. PROCEDURE allgraphictochar
  1757. PRIVATE m.objindex
  1758.  
  1759. DO allenvirons
  1760.  
  1761. *
  1762. * Create a cursor with all the objects we have left to add.
  1763. *
  1764. m.g_fromobjonlyalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1765. SELECT *, RECNO() AS recnum FROM (m.g_scrnalias) ;
  1766.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1767.    objtype <> c_otrel AND objtype <> c_otworkar AND objtype <> c_otindex AND ;
  1768.    objtype <> c_otheader AND objtype <> c_otgroup AND ;
  1769.    objtype <> c_otpicture AND ;
  1770.    !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  1771.    !(m.g_filetype = c_label AND objtype = c_ot20label) AND ;
  1772.    !(objtype = c_ot20lbxobj AND EMPTY(expr)) AND;
  1773.    oktransport(comment) ;
  1774.    INTO CURSOR (m.g_fromobjonlyalias)
  1775. m.objindex = _TALLY
  1776.  
  1777. DO allothers WITH 80
  1778. DO allgroups WITH 10
  1779.  
  1780. DO CASE
  1781. CASE m.g_filetype = c_label
  1782.    ** Trim any records the character platforms won't deal with.
  1783.    DELETE FOR platform = m.g_toplatform AND ;
  1784.       ((objtype = c_otband AND objcode != 4) OR ;
  1785.       objtype = c_otrepvar OR objtype = c_otpicture OR ;
  1786.       objtype = c_otline OR objtype = c_otbox)
  1787.    DO rptconvert
  1788.    DO mergelabelobjects
  1789.    DO linesbetween
  1790.    
  1791. CASE m.g_filetype = c_report
  1792.    ** Trim any records the character platforms won't deal with.
  1793.    DELETE FOR platform = m.g_toplatform AND (objtype = c_otpicture)
  1794.    DO rptconvert
  1795.    DO makecharfit
  1796.    DO suppressblanklines
  1797.   
  1798. CASE m.g_filetype = c_screen
  1799.    DO makecharfit
  1800. ENDCASE
  1801.  
  1802. SELECT (m.g_fromobjonlyalias)
  1803. USE
  1804. SELECT (m.g_scrnalias)
  1805.  
  1806. RETURN
  1807.  
  1808. *
  1809. * AllCharToGraphic - Convert from a character platform to a graphic platform assuming
  1810. *      that no records exist for the target platform.
  1811. *
  1812. *!*****************************************************************************
  1813. *!
  1814. *!      Procedure: ALLCHARTOGRAPHIC
  1815. *!
  1816. *!      Called by: CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1817. *!
  1818. *!          Calls: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  1819. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  1820. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  1821. *!               : CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  1822. *!               : ADJITEMSINBOXES    (procedure in TRANSPRT.PRG)
  1823. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  1824. *!               : JOINLINES          (procedure in TRANSPRT.PRG)
  1825. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  1826. *!               : SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  1827. *!               : ADDGRAPHICALLABELGR(procedure in TRANSPRT.PRG)
  1828. *!               : LABELBANDS         (procedure in TRANSPRT.PRG)
  1829. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  1830. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1831. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  1832. *!               : STRETCHLINESTOBORDE(procedure in TRANSPRT.PRG)
  1833. *!
  1834. *!           Uses: M.G_SCRNALIAS      
  1835. *!
  1836. *!*****************************************************************************
  1837. PROCEDURE allchartographic
  1838. PRIVATE m.objindex
  1839.  
  1840. * Make equivalent screen/report records for the new platform.
  1841. DO allenvirons
  1842.  
  1843. m.g_fromobjonlyalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1844. SELECT *, RECNO() AS recnum FROM (m.g_scrnalias) ;
  1845.    WHERE !DELETED() AND platform = m.g_fromplatform AND objtype <> c_otrel AND ;
  1846.    objtype <> c_otworkar AND objtype <> c_otindex AND ;
  1847.    objtype <> c_otheader AND objtype <> c_otgroup AND ;
  1848.    !(m.g_filetype = c_label AND objtype = c_ot20label) AND ;
  1849.    !(objtype = c_ot20lbxobj AND EMPTY(expr)) AND;
  1850.    oktransport(comment) ;
  1851.    INTO CURSOR (m.g_fromobjonlyalias)
  1852.  
  1853. m.objindex = _TALLY
  1854. IF _TALLY = 0
  1855.    SELECT (m.g_fromobjonlyalias)
  1856.    USE
  1857.    SELECT (m.g_scrnalias)
  1858.    RETURN
  1859. ENDIF
  1860.  
  1861. DIMENSION objectpos[m.objindex, 9]
  1862.  
  1863. DO allothers WITH 25
  1864. DO allgroups WITH 5
  1865.  
  1866. * Attempt to adjust the position of objects to reflect the position
  1867. * in the previous platform.
  1868.  
  1869. DO CASE
  1870. CASE m.g_filetype = c_screen
  1871.    DO calcwindowdimensions
  1872.    DO adjitemsinboxes
  1873.    DO adjinvbtns
  1874.    SET ORDER TO
  1875.    
  1876.    IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  1877.       DO joinlines
  1878.    ENDIF
  1879.    
  1880. CASE m.g_filetype = c_report
  1881.    DO rptconvert
  1882.    DO joinlines
  1883.    DO suppressblanklines
  1884.    
  1885. CASE m.g_filetype = c_label
  1886.    IF m.g_fromplatform = "DOS" OR m.g_fromplatform = "UNIX"
  1887.       DO addgraphicallabelgroups
  1888.    ENDIF
  1889.    DO labelbands
  1890.    DO labellines
  1891. ENDCASE
  1892.  
  1893. m.g_mercury = m.g_mercury + 5
  1894. DO updtherm WITH m.g_mercury
  1895.  
  1896. IF m.g_filetype = c_screen
  1897.    IF m.g_allobjects
  1898.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader AND STYLE != 0
  1899.       IF FOUND()
  1900.          IF m.g_windheight - g_lastobjectline[1] - 3 = 0
  1901.             m.adjustment = .5
  1902.          ELSE
  1903.             m.adjustment = m.g_windheight - g_lastobjectline[1] - 3
  1904.          ENDIF
  1905.          
  1906.          IF m.adjustment < 0
  1907.             m.adjustment = m.adjustment + 1.5
  1908.          ENDIF
  1909.          
  1910.          IF m.adjustment > 0
  1911.             REPLACE HEIGHT WITH g_lastobjectline[2] + ;
  1912.                m.adjustment * (FONTMETRIC(1) / ;
  1913.                FONTMETRIC(1,fontface, fontsize, whatstyle(fontstyle)))
  1914.          ELSE
  1915.             REPLACE HEIGHT WITH g_lastobjectline[2] + 1
  1916.          ENDIF
  1917.       ENDIF
  1918.       DO stretchlinestoborders
  1919.    ENDIF
  1920. ENDIF
  1921.  
  1922. m.g_mercury = m.g_mercury + 5
  1923. DO updtherm WITH m.g_mercury
  1924.  
  1925. SELECT (m.g_fromobjonlyalias)
  1926. USE
  1927. SELECT (m.g_scrnalias)
  1928.  
  1929. *
  1930. * cvrt102FRX - Converts a DOS 1.02 report to DOS 2.5 format
  1931. *
  1932. *!*****************************************************************************
  1933. *!
  1934. *!       Function: CVRT102FRX
  1935. *!
  1936. *!      Called by: TRANSPRT.PRG                      
  1937. *!
  1938. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  1939. *!               : FORCEEXT()         (function  in TRANSPRT.PRG)
  1940. *!
  1941. *!*****************************************************************************
  1942. FUNCTION cvrt102frx
  1943. * Converts FoxPro 1.02 DOS report to FoxPro 2.5 DOS report
  1944. PARAMETER m.fname102, m.ftype
  1945. PRIVATE m.bakname, m.in_area
  1946.  
  1947. m.in_area = SELECT()
  1948. SELECT 0
  1949. * Create a database structure matching the tab delimited format
  1950. *  of a 1.02 report file.
  1951. CREATE CURSOR old ( ;
  1952.    objtype N(10,0), ;
  1953.    content N(10,0), ;
  1954.    fldcontent C(254), ;
  1955.    frmcontent C(254), ;
  1956.    vertpos N(10,0), ;
  1957.    horzpos N(10,0), ;
  1958.    HEIGHT N(10,0), ;
  1959.    WIDTH N(10,0), ;
  1960.    FONT N(10,0), ;
  1961.    fontsize N(10,0), ;
  1962.    STYLE N(10,0), ;
  1963.    penred N(10,0), ;
  1964.    pengreen N(10,0), ;
  1965.    penblue N(10,0), ;
  1966.    fillred N(10,0), ;
  1967.    fillgreen N(10,0), ;
  1968.    fillblue N(10,0), ;
  1969.    PICTURE C(254), ;
  1970.    rangeup N(10,0), ;
  1971.    rangelow N(10,0), ;
  1972.    VALID N(10,0), ;
  1973.    initc N(10,0), ;
  1974.    calcexp N(10,0) ;
  1975.    )
  1976.  
  1977. * Replace quote marks with \" so that APPEND won't strip them out.  They are our only
  1978. * way of distinguishing quoted text from, say, field names.
  1979. m.fpin  = fopen(m.fname102,2)   && open for read access
  1980. m.outname = forceext(m.fname102,"TMP")
  1981. m.fpout = fcreate(m.outname)
  1982.  
  1983. IF m.fpin > 0 AND m.fpout > 0
  1984.    DO WHILE !FEOF(m.fpin)
  1985.       m.buf = fgets(m.fpin)
  1986.       m.buf = STRTRAN(m.buf,'"','\+')
  1987.       =fputs(m.fpout,m.buf)
  1988.    ENDDO
  1989.    =fclose(m.fpin)
  1990.    =fclose(m.fpout)
  1991.  
  1992.    APPEND FROM (m.outname) TYPE DELIMITED WITH TAB
  1993.    
  1994.    * Drop the temporary output file
  1995.    IF FILE(m.outname)
  1996.       DELETE FILE (m.outname)
  1997.    ENDIF
  1998.    
  1999.    * Replace quote markers with quotes in the character fields
  2000.    REPLACE ALL fldcontent WITH STRTRAN(fldcontent,'\+','"'), ;
  2001.                frmcontent WITH STRTRAN(frmcontent,'\+','"'), ;
  2002.                picture    WITH STRTRAN(picture,   '\+','"')  ;
  2003.       FOR objtype = 17
  2004.    * Strip quotes from other object types, such as quoted strings.
  2005.    REPLACE ALL fldcontent WITH STRTRAN(fldcontent,'\+',''), ;
  2006.                frmcontent WITH STRTRAN(frmcontent,'\+',''), ;
  2007.                picture    WITH STRTRAN(picture,   '\+','')  ;
  2008.       FOR objtype <> 17
  2009.       
  2010. ELSE
  2011.    APPEND FROM (m.fname102) TYPE DELIMITED WITH TAB
  2012. ENDIF
  2013.  
  2014. * Create an empty 2.5 report file
  2015. DO docreate WITH "new", c_report
  2016.  
  2017. SELECT old
  2018. SCAN
  2019.    DO CASE
  2020.    CASE objtype = 1  && report record
  2021.       SELECT new
  2022.       APPEND BLANK
  2023.       SELECT old
  2024.       REPLACE new.platform WITH "DOS"
  2025.       REPLACE new.objtype WITH 1
  2026.       REPLACE new.objcode WITH c_25frx
  2027.       REPLACE new.topmargin WITH old.vertpos
  2028.       REPLACE new.botmargin WITH old.horzpos
  2029.       REPLACE new.height WITH old.height
  2030.       REPLACE new.width WITH old.width
  2031.       REPLACE new.offset WITH old.fontsize
  2032.       IF (old.initc > 0)
  2033.          REPLACE new.environ WITH .T.
  2034.       ENDIF
  2035.       IF (old.calcexp = 1 OR old.calcexp = 3)
  2036.          REPLACE new.ejectbefor WITH .T.
  2037.       ENDIF
  2038.       IF (old.calcexp = 2 OR old.calcexp = 3)
  2039.          REPLACE new.ejectafter WITH .T.
  2040.       ENDIF
  2041.       
  2042.    CASE objtype = 5  && text record
  2043.       SELECT new
  2044.       APPEND BLANK
  2045.       SELECT old
  2046.       REPLACE new.platform WITH "DOS"
  2047.       REPLACE new.objtype WITH 5
  2048.       REPLACE new.vpos WITH old.vertpos
  2049.       REPLACE new.hpos WITH old.horzpos
  2050.       REPLACE new.height WITH 1
  2051.       REPLACE new.width WITH old.width
  2052.       IF (old.rangelow > 0)
  2053.          REPLACE new.float WITH .T.
  2054.       ENDIF
  2055.       REPLACE new.expr WITH '"' + CPTRANS(m.g_tocodepage,m.g_fromcodepage,ALLTRIM(old.fldcontent)) + '"'
  2056.       
  2057.    CASE objtype = 7 && box record
  2058.       SELECT new
  2059.       APPEND BLANK
  2060.       SELECT old
  2061.       REPLACE new.platform WITH "DOS"
  2062.       REPLACE new.objtype WITH 7
  2063.       REPLACE new.vpos WITH old.vertpos
  2064.       REPLACE new.hpos WITH old.horzpos
  2065.       REPLACE new.height WITH old.height
  2066.       REPLACE new.width WITH old.width
  2067.       REPLACE new.objcode WITH old.content + 4
  2068.       IF (old.rangelow > 0)
  2069.          REPLACE new.float WITH .T.
  2070.       ENDIF
  2071.       IF (old.fontsize > 0)
  2072.          REPLACE new.boxchar WITH CHR(old.fontsize / 256)
  2073.       ENDIF
  2074.       
  2075.    CASE objtype = 17 && field record
  2076.       SELECT new
  2077.       APPEND BLANK
  2078.       SELECT old
  2079.       REPLACE new.platform WITH "DOS"
  2080.       REPLACE new.objtype WITH 8
  2081.       REPLACE new.vpos WITH old.vertpos
  2082.       REPLACE new.hpos WITH old.horzpos
  2083.       REPLACE new.height WITH 1
  2084.       REPLACE new.width WITH old.width
  2085.       REPLACE new.expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,TRIM(old.fldcontent))
  2086.       IF !EMPTY(old.picture)
  2087.          REPLACE new.picture WITH '"' + CPTRANS(m.g_tocodepage,m.g_fromcodepage,ALLTRIM(old.picture)) + '"'
  2088.       ENDIF
  2089.       REPLACE new.totaltype WITH old.valid
  2090.       REPLACE new.resettotal WITH old.initc
  2091.       IF (old.rangeup > 0)
  2092.          REPLACE new.norepeat WITH .T.
  2093.       ENDIF
  2094.       
  2095.       IF (old.rangelow > 1)
  2096.          WRAP = MAX(old.rangelow - 3, 0)
  2097.       ELSE
  2098.          WRAP = old.rangelow
  2099.       ENDIF
  2100.       
  2101.       IF (WRAP > 0)
  2102.          REPLACE new.stretch WITH .T.
  2103.       ENDIF
  2104.       
  2105.       IF (old.rangelow = 3 OR old.rangelow = 4)
  2106.          REPLACE new.float WITH .T.
  2107.       ENDIF
  2108.       
  2109.       REPLACE new.fillchar WITH ALLTRIM(old.frmcontent)
  2110.       
  2111.    CASE objtype = 18 && band record
  2112.       SELECT new
  2113.       APPEND BLANK
  2114.       SELECT old
  2115.       REPLACE new.platform WITH "DOS"
  2116.       REPLACE new.objtype WITH 9
  2117.       REPLACE new.objcode WITH old.content
  2118.       REPLACE new.expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,old.fldcontent)
  2119.       REPLACE new.height WITH old.height
  2120.       IF (old.vertpos > 0)
  2121.          REPLACE new.pagebreak WITH .T.
  2122.       ENDIF
  2123.       IF (old.fontsize > 0)
  2124.          REPLACE new.swapheader WITH .T.
  2125.       ENDIF
  2126.       IF (old.style > 0)
  2127.          REPLACE new.swapfooter WITH .T.
  2128.       ENDIF
  2129.    ENDCASE
  2130. ENDSCAN
  2131.  
  2132. * Discard the temporary cursor
  2133. SELECT old
  2134. USE
  2135.  
  2136. IF m.ftype = c_frx102repo
  2137.    * Back up the original report and copy the new information to the original file name
  2138.    m.bakname = forceext(m.fname102,"TBK")
  2139.    RENAME (m.fname102) TO (m.bakname)
  2140. ENDIF
  2141.  
  2142. * Write the new information on top of the original 1.02 report
  2143. SELECT new
  2144. COPY TO (m.fname102)
  2145. USE
  2146. SELECT (m.in_area)
  2147. RETURN m.fname102
  2148.  
  2149. *!*****************************************************************************
  2150. *!
  2151. *!      Procedure: CVRTFBPRPT
  2152. *!
  2153. *!      Called by: TRANSPRT.PRG                      
  2154. *!
  2155. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  2156. *!               : CVTSHORT()         (function  in TRANSPRT.PRG)
  2157. *!               : CVTBYTE()          (function  in TRANSPRT.PRG)
  2158. *!               : DOCREATE           (procedure in TRANSPRT.PRG)
  2159. *!               : EVALIMPORTEXPR     (procedure in TRANSPRT.PRG)
  2160. *!               : INITBANDS          (procedure in TRANSPRT.PRG)
  2161. *!               : BLDBREAKS          (procedure in TRANSPRT.PRG)
  2162. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2163. *!               : FORCEEXT()         (function  in TRANSPRT.PRG)
  2164. *!
  2165. *!*****************************************************************************
  2166. PROCEDURE cvrtfbprpt
  2167. * Convert a FoxBASE+ report to FoxPro 2.5 DOS format
  2168. PARAMETER m.fnamefbp, m.ftype
  2169. PRIVATE m.bakname, m.in_area, m.i, m.idbyte, m.objname, m.obj, m.rp_pool, ;
  2170.    m.rp_ltadr, m.rp_ltlen, m.rp_ssexno, m.rp_sbexno, m.rp_doublesp, ;
  2171.    m.rp_flds_width, m.rp_flds_exprno, m.rp_width, m.rp_flds_headno, ;
  2172.    m.rp_plain, m.band_rows, m.current_row, m.group_num, m.head_row
  2173.  
  2174. m.in_area = SELECT()
  2175. SELECT 0
  2176.  
  2177. m.objname       = ""
  2178. m.obj           = 0
  2179. m.rp_pool       = 0
  2180. m.rp_ltadr      = 0
  2181. m.rp_ltlen      = 0
  2182. m.rp_ssexno     = 0
  2183. m.rp_sbexno     = 0
  2184. m.rp_doublesp   = 0
  2185. m.rp_flds_width = 0
  2186. m.rp_flds_exprno= 0
  2187. m.rp_width      = 0
  2188. m.rp_flds_headno= 0
  2189. m.rp_plain      = 0
  2190. m.band_rows     = 0
  2191. m.current_row   = 0
  2192. m.group_num     = 0
  2193. m.head_row      = 0
  2194.  
  2195. * Create a set of parallel arrays to contain the report information we need to bring
  2196. * across to FoxPro 2.5 DOS.
  2197. DIMENSION rp_ltlen(maxliterals)
  2198. DIMENSION rp_ltadr(maxliterals)
  2199. DIMENSION rp_flds_width(maxrepflds)
  2200. DIMENSION rp_flds_type(maxrepflds)
  2201. DIMENSION rp_flds_totals(maxrepflds)
  2202. DIMENSION rp_flds_dp(maxrepflds)
  2203. DIMENSION rp_flds_exprno(maxrepflds)
  2204. DIMENSION rp_flds_headno(maxrepflds)
  2205. DIMENSION band_rows(10)
  2206. band_rows = 0
  2207.  
  2208. m.obj = FOPEN(m.g_scrndbf)
  2209. IF (m.obj < 1)
  2210.    DO errorhandler WITH "Berichtsvorlage aus FoxBASE+ kann nicht ge÷ffnet werden",LINENO(),c_error3
  2211. ENDIF
  2212.  
  2213. m.idbyte = cvtshort(FREAD(m.obj,2),0)
  2214.  
  2215. poolsize = cvtshort(FREAD(m.obj,2),0)
  2216. FOR i = 1 TO maxliterals
  2217.    rp_ltlen(i) = cvtshort(FREAD(m.obj,2),0)
  2218. ENDFOR
  2219. FOR i = 1 TO maxliterals
  2220.    rp_ltadr(i) = cvtshort(FREAD(m.obj,2),0)
  2221. ENDFOR
  2222. rp_pool = FREAD(m.obj,litpoolsize)
  2223. FOR i = 1 TO maxrepflds
  2224.    rp_flds_width(i) = cvtshort(FREAD(m.obj,2),0)
  2225.    =FREAD(m.obj,2)
  2226.    rp_flds_type(i) = FREAD(m.obj,1)
  2227.    rp_flds_totals(i) = FREAD(m.obj,1)
  2228.    rp_flds_dp(i) = cvtshort(FREAD(m.obj,2),0)
  2229.    rp_flds_exprno(i) = cvtshort(FREAD(m.obj,2),0)
  2230.    rp_flds_headno(i) = cvtshort(FREAD(m.obj,2),0)
  2231. ENDFOR
  2232. rp_pghdno = cvtshort(FREAD(m.obj,2),0)
  2233. rp_sbexno = cvtshort(FREAD(m.obj,2),0)
  2234. rp_ssexno = cvtshort(FREAD(m.obj,2),0)
  2235. rp_sbhdno = cvtshort(FREAD(m.obj,2),0)
  2236. rp_sshdno = cvtshort(FREAD(m.obj,2),0)
  2237. rp_width = cvtshort(FREAD(m.obj,2),0)
  2238. rp_length = cvtshort(FREAD(m.obj,2),0)
  2239. rp_lmarg = cvtshort(FREAD(m.obj,2),0)
  2240. rp_rmarg = cvtshort(FREAD(m.obj,2),0)
  2241. rp_fldcnt = cvtshort(FREAD(m.obj,2),0)
  2242. rp_doublesp = FREAD(m.obj,1)
  2243. rp_summary = FREAD(m.obj, 1)
  2244. rp_subeject = FREAD(m.obj,1)
  2245. rp_other = cvtbyte(FREAD(m.obj,1),0)
  2246. rp_pageno = cvtshort(FREAD(m.obj,2),0)
  2247. =FCLOSE(m.obj)
  2248. IF (rp_pageno != 2)
  2249.    =FCLOSE(m.obj)
  2250. ENDIF
  2251.  
  2252. * Create an empty 2.5 report file
  2253. DO docreate WITH "new", c_report
  2254.  
  2255. * Fill it in
  2256. DO evalimportexpr
  2257. DO initbands
  2258. DO bldbreaks
  2259. IF rp_fldcnt > 0
  2260.    DO blddetail
  2261. ENDIF
  2262.  
  2263. * Add the header data
  2264. SELECT new
  2265. GOTO TOP
  2266. REPLACE objtype WITH 1, objcode WITH c_25frx
  2267.  
  2268. IF m.ftype = c_fbprptrepo
  2269.    * Back up the original report and copy the new information to the original file name
  2270.    m.bakname = forceext(m.fnamefbp,"TBK")
  2271.    RENAME (m.fnamefbp) TO (m.bakname)
  2272. ENDIF
  2273.  
  2274. * Write the new information to a file with an FRX extension but the
  2275. * same base name as the original FoxBASE+ report
  2276. SELECT new
  2277. COPY TO (m.fnamefbp)
  2278. USE
  2279. SELECT (m.in_area)
  2280. RETURN m.fnamefbp
  2281.  
  2282.  
  2283. *!********************************************************************
  2284. *!
  2285. *!        Convert FoxPro 1.0 label to 2.0 format
  2286. *!
  2287. *!********************************************************************
  2288.  
  2289. PROCEDURE cvrt102lbx
  2290. PARAMETERS m.fname102, m.ftype
  2291. PRIVATE m.i, m.short, m.contlen, m.obj, m.remarks, m.height, m.lmargin, m.width, ;
  2292.    m.numacross, m.spacesbet, m.linesbet, m.bakname, m.in_area
  2293.    
  2294. m.in_area = SELECT()
  2295.  
  2296. m.lblname = m.fname102
  2297.  
  2298. m.obj = FOPEN(m.lblname)
  2299. =FREAD(m.obj,1)                && Skip revision
  2300. m.remarks = FREAD(m.obj,60)
  2301. m.height = cvtshort(FREAD(m.obj,2),0)
  2302. m.lmargin = cvtshort(FREAD(m.obj,2),0)
  2303. m.width = cvtshort(FREAD(m.obj,2),0)
  2304. m.numacross = cvtshort(FREAD(m.obj,2),0)
  2305. m.spacesbet = cvtshort(FREAD(m.obj,2),0)
  2306. m.linesbet = cvtshort(FREAD(m.obj,2),0)
  2307.  
  2308. * Read in label contents -- each line ends in a CR
  2309.  
  2310. m.contlen = cvtshort(FREAD(m.obj,2),0)
  2311. m.work = FREAD(m.obj, m.contlen)
  2312. =FCLOSE(m.obj)
  2313.  
  2314. DIMENSION lbllines[m.height]
  2315. m.start = 1
  2316. m.i = 1
  2317. FOR m.curlen = 1 TO m.contlen
  2318.    IF (SUBSTR(m.work, m.curlen, 1) = CHR(13))
  2319.       lbllines[m.i] = SUBSTR(m.work, m.start, m.curlen-m.start)
  2320.       m.start = m.curlen+1
  2321.       m.i = m.i + 1
  2322.    ENDIF
  2323. ENDFOR
  2324.  
  2325. DO WHILE (m.i <= m.height)
  2326.    lbllines[m.i] = ''
  2327.    m.i = m.i + 1
  2328. ENDDO
  2329.  
  2330. * Create an empty 2.0 label 
  2331. CREATE CURSOR new (objtype N(2), objcode N(2), ;
  2332.    name m, expr m, STYLE m, HEIGHT N(3), WIDTH N(3), lmargin N(3), ;
  2333.    numacross N(3), spacesbet N(3), linesbet N(3), ENVIRON l, ;
  2334.    ORDER m, UNIQUE l, TAG m, tag2 m, addalias l)
  2335.  
  2336. * Add the header data
  2337. SELECT new
  2338. APPEND BLANK
  2339. REPLACE new.objtype WITH 30
  2340. REPLACE new.name WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,m.remarks)
  2341.  
  2342. REPLACE new.height WITH m.height
  2343. REPLACE new.width WITH m.width
  2344. REPLACE new.lmargin WITH m.lmargin
  2345. REPLACE new.numacross WITH m.numacross
  2346. REPLACE new.spacesbet WITH m.spacesbet
  2347. REPLACE new.linesbet WITH m.linesbet
  2348.  
  2349. * Add the label contents
  2350.  
  2351. FOR m.i = 1 TO m.height
  2352.    APPEND BLANK
  2353.    REPLACE new.objtype WITH 19
  2354.    REPLACE new.expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,lbllines[m.i])
  2355. ENDFOR
  2356.  
  2357. IF m.ftype = c_lbx102repo
  2358.    * Back up the original label and copy the new information to the original file name
  2359.    m.bakname = forceext(m.fname102,"TBK")
  2360.    RENAME (m.fname102) TO (m.bakname)
  2361. ENDIF
  2362.  
  2363. * Write the new information on top of the original 1.02 label
  2364. SELECT new
  2365. COPY TO (m.fname102)
  2366. USE
  2367. SELECT (m.in_area)
  2368. RETURN m.fname102
  2369.  
  2370.  
  2371. RETURN
  2372.  
  2373. *!********************************************************************
  2374. *!
  2375. *!        Convert FoxBase+ label to 2.0 format
  2376. *!
  2377. *!********************************************************************
  2378.  
  2379. PROCEDURE cvrtfbplbl
  2380. PARAMETERS m.fnamefbp, m.ftype
  2381.  
  2382. PRIVATE m.width, m.height, m.lmargin, m.spacesbet, m.linesbet, m.numacross, m.obj, ;
  2383.    m.i, m.lblname, m.in_area, m.dummy
  2384.  
  2385. m.in_area = SELECT()
  2386.    
  2387. m.lblname = m.fnamefbp
  2388.    
  2389. m.width = 0
  2390. m.height = 0
  2391. m.lmargin = 0
  2392. m.spacesbet = 0
  2393. m.linesbet = 0
  2394. m.numacross = 0
  2395.  
  2396. m.obj = FOPEN(m.lblname)
  2397. =FREAD(m.obj,1)                && Skip revision
  2398. m.remarks = FREAD(m.obj,60)
  2399. m.height = cvtshort(FREAD(m.obj,2),0)
  2400. m.width = cvtshort(FREAD(m.obj,2),0)
  2401. m.lmargin = cvtshort(FREAD(m.obj,2),0)
  2402. m.linesbet = cvtshort(FREAD(m.obj,2),0)
  2403. m.spacesbet = cvtshort(FREAD(m.obj,2),0)
  2404. m.numacross = cvtshort(FREAD(m.obj,2),0)
  2405.  
  2406. *******************************************************
  2407. * Read the label contents -- strip spaces and add a CR
  2408. *******************************************************
  2409.  
  2410. DIMENSION lbllines[m.height]
  2411. lbllines = '""'
  2412. m.lastline = 0
  2413. FOR m.i = 1 TO m.height
  2414.    m.olen = 60
  2415.    m.work = FREAD(m.obj,m.olen)
  2416.    DO WHILE ((m.olen > 0) AND (SUBSTR(m.work, m.olen, 1) = ' '))
  2417.       m.olen = m.olen - 1
  2418.    ENDDO
  2419.    =STUFF(m.work, m.olen, 1, '\n')
  2420.    lbllines[m.i] = SUBSTR(m.work, 1, m.olen+1)
  2421.    IF EMPTY(lbllines[m.i])
  2422.       lbllines[m.i] = '""'
  2423.    ELSE
  2424.       m.lastline = m.i
  2425.    ENDIF
  2426. ENDFOR
  2427.  
  2428. =FCLOSE(m.obj)
  2429.  
  2430. CREATE CURSOR new (objtype N(2), objcode N(2), ;
  2431.    name m, expr m, STYLE m, HEIGHT N(3), WIDTH N(3), lmargin N(3), ;
  2432.    numacross N(3), spacesbet N(3), linesbet N(3), ENVIRON l, ;
  2433.   ORDER m, UNIQUE l, TAG m, tag2 m, addalias l)
  2434.  
  2435. * Add the header data
  2436. SELECT new
  2437. APPEND BLANK
  2438. REPLACE new.objtype WITH 30
  2439. REPLACE new.name WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,m.remarks)
  2440.  
  2441. REPLACE new.height WITH m.height
  2442. REPLACE new.width WITH m.width
  2443. REPLACE new.lmargin WITH m.lmargin
  2444. REPLACE new.numacross WITH m.numacross
  2445. REPLACE new.spacesbet WITH m.spacesbet
  2446. REPLACE new.linesbet WITH m.linesbet
  2447.  
  2448. FOR m.i = 1 TO m.lastline
  2449.    APPEND BLANK
  2450.    REPLACE new.objtype WITH 19
  2451.    REPLACE new.expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,lbllines[m.i])
  2452. ENDFOR
  2453.  
  2454. IF m.ftype = c_fbprptrepo
  2455.    * Back up the original report and copy the new information to the original file name
  2456.    m.bakname = forceext(m.fnamefbp,"TBK")
  2457.    RENAME (m.fnamefbp) TO (m.bakname)
  2458. ENDIF
  2459.  
  2460. * Write the new information to a file with an LBX extension but the
  2461. * same base name as the original FoxBASE+ label.
  2462. SELECT new
  2463. COPY TO (m.fnamefbp)
  2464. USE
  2465. SELECT (m.in_area)
  2466. RETURN m.fnamefbp
  2467.  
  2468. *!*****************************************************************************
  2469. *!
  2470. *!      Procedure: INITBANDS
  2471. *!
  2472. *!      Called by: cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  2473. *!
  2474. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2475. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2476. *!               : FLD_HEAD_EXIST()   (function  in TRANSPRT.PRG)
  2477. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2478. *!               : MAKEBAND           (procedure in TRANSPRT.PRG)
  2479. *!               : TOTALS_EXIST()     (function  in TRANSPRT.PRG)
  2480. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2481. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2482. *!               : GETHEADING()       (function  in TRANSPRT.PRG)
  2483. *!               : CENTER_COL()       (function  in TRANSPRT.PRG)
  2484. *!
  2485. *!*****************************************************************************
  2486. PROCEDURE initbands
  2487.  
  2488. APPEND BLANK
  2489. REPLACE new->platform WITH "DOS"
  2490. REPLACE new->WIDTH WITH m.rp_width
  2491. REPLACE new->HEIGHT WITH m.rp_length
  2492. REPLACE new->offset WITH m.rp_lmarg
  2493. REPLACE new->ejectbefor WITH .T.
  2494. m.rp_plain = 0
  2495. m.group_num = 0
  2496. IF ("Y" = m.rp_summary)
  2497.    REPLACE new->SUMMARY WITH .T.
  2498. ENDIF
  2499. IF (INLIST(m.rp_other,1,3,5,7))
  2500.    REPLACE new->ejectbefor WITH .F.
  2501. ENDIF
  2502. IF (INLIST(m.rp_other,3,6,7))
  2503.    REPLACE new->ejectafter WITH .T.
  2504. ENDIF
  2505. IF (INLIST(m.rp_other,4,5,6,7))
  2506.    REPLACE new->PLAIN WITH .T.
  2507.    m.rp_plain = 1
  2508. ENDIF
  2509. m.rp_totals = 0
  2510. m.current_row = 0
  2511.  
  2512. * header band
  2513.  
  2514. m.bandsize = 1
  2515. IF (m.rp_plain = 0)
  2516.    m.bandsize = m.bandsize + 2
  2517. ENDIF
  2518.  
  2519. m.string = ""
  2520. IF (getlitexpr(m.rp_pghdno, @m.string) <> 0)
  2521.    m.size = linesforheading(m.string)
  2522.    m.bandsize = m.bandsize + m.size
  2523. ENDIF
  2524.  
  2525. IF (fld_head_exist() = 1)
  2526.    m.size = howmanyheadings()
  2527.    m.bandsize = m.bandsize + m.size + 3
  2528. ELSE
  2529.    m.bandsize = m.bandsize + 3
  2530. ENDIF
  2531.  
  2532. DO makeband WITH h_page, m.bandsize, "", .F.
  2533.  
  2534. * group bands
  2535. m.bandstring = ""
  2536. IF (getlitexpr(m.rp_sbexno, @m.bandstring) <> 0)
  2537.    IF ("Y" = m.rp_subeject)
  2538.       m.newpage = .T.
  2539.    ELSE
  2540.       m.newpage = .F.
  2541.    ENDIF
  2542.    DO makeband WITH h_break, 2, m.bandstring, m.newpage
  2543.    m.rp_totals = m.rp_totals + 1
  2544.    IF (getlitexpr(m.rp_ssexno, @m.bandstring) <> 0)
  2545.       DO makeband WITH h_break, 2, m.bandstring, .F.
  2546.       m.rp_totals = m.rp_totals + 1
  2547.    ENDIF
  2548. ENDIF
  2549.  
  2550. group_num = rp_totals
  2551. m.numlines = 1
  2552. IF ("Y" = m.rp_doublesp)
  2553.    m.numlines = 2
  2554. ENDIF
  2555.  
  2556. * detail band
  2557. DO makeband WITH l_item, m.numlines, "", .F.
  2558.  
  2559. * break footer bands
  2560. IF (totals_exist() = 1)
  2561.    m.bandsize = 2
  2562. ELSE
  2563.    m.bandsize = 1
  2564. ENDIF
  2565.  
  2566. m.groupnum = m.rp_totals
  2567.  
  2568. FOR i = 1 TO m.rp_totals
  2569.    DO makeband WITH f_break, m.bandsize, "", .F.
  2570. ENDFOR
  2571.  
  2572. * page footer band
  2573. DO makeband WITH f_page, 1, "", .F.
  2574.  
  2575. * report footer band
  2576. DO makeband WITH f_rpt, m.bandsize, "", .F.
  2577.  
  2578. IF (rp_plain = 0)
  2579.    DO maketext WITH 9, 1, "SEITE ", band_rows(h_page)+1, 0
  2580.    DO makefield WITH 5, 1, "_PAGENO", band_rows(h_page)+1, 9, "C", .F., .F., 0, 0
  2581.    DO makefield WITH 8, 1, "DATE()", band_rows(h_page)+2, 0, "D", .F., .F., 0, 0
  2582.    m.head_row = 3
  2583. ELSE
  2584.    m.head_row = 0
  2585. ENDIF
  2586.  
  2587. IF (getlitexpr(m.rp_pghdno,@m.string) <> 0)
  2588.    m.string = m.string + ";"
  2589.    m.heading = ""
  2590.    DO WHILE .T.
  2591.       IF (getheading(@m.heading, @m.string) > 0)
  2592.          DO maketext WITH LEN(m.heading), 1, m.heading, m.head_row, center_col(LEN(m.heading))
  2593.          m.head_row = m.head_row + 1
  2594.       ELSE
  2595.          EXIT
  2596.       ENDIF
  2597.    ENDDO
  2598. ENDIF
  2599.  
  2600. m.head_row = m.head_row + 1
  2601.  
  2602. RETURN
  2603.  
  2604. *!*****************************************************************************
  2605. *!
  2606. *!      Procedure: BLDBREAKEXP
  2607. *!
  2608. *!      Called by: BLDBREAKS          (procedure in TRANSPRT.PRG)
  2609. *!
  2610. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2611. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2612. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2613. *!
  2614. *!*****************************************************************************
  2615. PROCEDURE bldbreakexp
  2616. PARAMETER m.exprno, m.headno, m.row, m.stars
  2617.  
  2618. PRIVATE m.string
  2619. m.string = ""
  2620. =getlitexpr(m.headno, @m.string)
  2621. m.string = m.stars + m.string
  2622. strlen = LEN(m.string)
  2623. DO maketext WITH m.strlen, 1, m.string, m.row, 0
  2624. =getlitexpr(m.exprno, @m.string)
  2625. DO makefield WITH rp_ltlen(m.exprno+1), 1, m.string, m.row, m.strlen + 1, "C", .F., .F., 0, 0
  2626. RETURN
  2627.  
  2628. *!*****************************************************************************
  2629. *!
  2630. *!      Procedure: BLDBREAKS
  2631. *!
  2632. *!      Called by: cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  2633. *!
  2634. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2635. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2636. *!
  2637. *!*****************************************************************************
  2638. PROCEDURE bldbreaks
  2639. IF (litexist(rp_sbexno) = 1)
  2640.    DO bldbreakexp WITH rp_sbexno, rp_sbhdno, band_rows(h_break) + 1, "** "
  2641.    IF (litexist(rp_ssexno) = 1)
  2642.       DO bldbreakexp WITH rp_ssexno, rp_sshdno, band_rows(h_break) + 3, "*"
  2643.    ENDIF
  2644. ENDIF
  2645. RETURN
  2646.  
  2647. *!*****************************************************************************
  2648. *!
  2649. *!      Procedure: BLDDETAIL
  2650. *!
  2651. *!      Called by: cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  2652. *!
  2653. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2654. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2655. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2656. *!               : GETHEADING()       (function  in TRANSPRT.PRG)
  2657. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2658. *!
  2659. *!*****************************************************************************
  2660. PROCEDURE blddetail
  2661. PRIVATE m.i, m.pg_row, m.istotal, m.fcol, m.row, m.string, m.col, m.heading
  2662.  
  2663. m.pg_row = 0
  2664. m.istotal = 0
  2665. m.fcol = 0
  2666. m.row = band_rows(l_item)
  2667. m.string = ""
  2668. FOR m.i = 1 TO rp_fldcnt
  2669.    IF (getlitexpr(rp_flds_exprno(m.i), @m.string) <> 0)
  2670.       m.row = band_rows(l_item)
  2671.       IF (m.fcol + rp_flds_width(m.i) > m.rp_width - 1)
  2672.          rp_flds_width(m.i) = rp_flds_width(m.i) - (m.fcol + rp_flds_width(m.i) - m.rp_width)
  2673.          IF (rp_flds_width(m.i) < 0)
  2674.             EXIT
  2675.          ENDIF
  2676.       ENDIF
  2677.       DO makefield WITH rp_flds_width(m.i), 1, m.string, m.row, m.fcol, rp_flds_type(m.i), .T., .T., 0, 0
  2678.       IF ("Y" = rp_flds_totals(m.i))
  2679.          DO makefield WITH rp_flds_width(m.i), 1, m.string, band_rows(f_rpt) + 1, m.fcol, "N", .F., .F., 2, 0
  2680.          IF (m.group_num > 0)
  2681.             IF (m.group_num > 1)
  2682.                DO addtotal WITH m.istotal, band_rows(f_break), m.fcol, rp_flds_width(m.i), m.string, "* Subsubtotal *", 4
  2683.                DO addtotal WITH m.istotal, band_rows(f_break) + 2, m.fcol, rp_flds_width(m.i), m.string, "** Subtotal **", 3
  2684.             ELSE
  2685.                DO addtotal WITH m.istotal, band_rows(f_break), m.fcol, rp_flds_width(m.i), m.string, "** Subtotal **", 3
  2686.             ENDIF
  2687.          ENDIF
  2688.          m.istotal = 1
  2689.       ENDIF
  2690.    ENDIF
  2691.    
  2692.    IF (getlitexpr(rp_flds_headno(m.i), @m.string) <> 0)
  2693.       m.string = m.string + ";"
  2694.       m.heading = ""
  2695.       m.hrow = m.head_row
  2696.       DO WHILE .T.
  2697.          IF (getheading(@m.heading, @m.string) > 0)
  2698.             IF (rp_flds_type(m.i) = "N")
  2699.                m.col = (m.fcol + rp_flds_width(m.i)) - LEN(m.heading)
  2700.             ELSE
  2701.                m.col = m.fcol
  2702.             ENDIF
  2703.             DO maketext WITH LEN(m.heading), 1, m.heading, m.hrow, m.col
  2704.             m.hrow = m.hrow + 1
  2705.          ELSE
  2706.             EXIT
  2707.          ENDIF
  2708.       ENDDO
  2709.    ENDIF
  2710.    m.fcol = m.fcol + rp_flds_width(m.i) + 1
  2711. ENDFOR
  2712.  
  2713. IF (m.istotal = 1)
  2714.    DO maketext WITH 13, 1, "*** Gesamt ***", band_rows(f_rpt), 0
  2715. ENDIF
  2716.  
  2717. RETURN
  2718.  
  2719. *!*****************************************************************************
  2720. *!
  2721. *!      Procedure: ADDTOTAL
  2722. *!
  2723. *!      Called by: BLDDETAIL          (procedure in TRANSPRT.PRG)
  2724. *!
  2725. *!          Calls: MAKETEXT           (procedure in TRANSPRT.PRG)
  2726. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2727. *!
  2728. *!*****************************************************************************
  2729. PROCEDURE addtotal
  2730. PARAMETER m.isfirst, m.row, m.col, m.wt, m.workstr, m.totalstr, m.reset
  2731. IF (m.isfirst = 0)
  2732.    DO maketext WITH LEN(m.totalstr), 1, m.totalstr, m.row, 0
  2733. ENDIF
  2734. DO makefield WITH m.wt, 1, m.workstr, m.row+1, m.col, "N", .F., .F., 2, m.reset
  2735. RETURN
  2736.  
  2737.  
  2738. *!*****************************************************************************
  2739. *!
  2740. *!       Function: LITEXIST
  2741. *!
  2742. *!      Called by: BLDBREAKS          (procedure in TRANSPRT.PRG)
  2743. *!               : GETLITEXPR()       (function  in TRANSPRT.PRG)
  2744. *!               : FLD_HEAD_EXIST()   (function  in TRANSPRT.PRG)
  2745. *!
  2746. *!*****************************************************************************
  2747. FUNCTION litexist
  2748. PARAMETER m.idx
  2749. PRIVATE m.flag
  2750. m.flag = 0
  2751. IF m.idx != 65535
  2752.    IF "" <> SUBSTR(rp_pool, rp_ltadr(m.idx+1)+1, 1)
  2753.       m.flag = 1
  2754.    ENDIF
  2755. ENDIF
  2756. RETURN m.flag
  2757.  
  2758. *!*****************************************************************************
  2759. *!
  2760. *!       Function: GETLITEXPR
  2761. *!
  2762. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2763. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2764. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2765. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2766. *!               : EVALIMPORTEXPR     (procedure in TRANSPRT.PRG)
  2767. *!
  2768. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2769. *!
  2770. *!*****************************************************************************
  2771. FUNCTION getlitexpr
  2772. PARAMETER m.idx, m.string
  2773. m.flag = 0
  2774. IF (litexist(m.idx) = 1)
  2775.    m.string = SUBSTR(m.rp_pool, rp_ltadr(m.idx+1)+1, rp_ltlen(m.idx+1) - 1)
  2776.    m.flag = 1
  2777. ELSE
  2778.    m.string = ""
  2779. ENDIF
  2780. RETURN m.flag
  2781.  
  2782. *!*****************************************************************************
  2783. *!
  2784. *!      Procedure: MAKEBAND
  2785. *!
  2786. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2787. *!
  2788. *!*****************************************************************************
  2789. PROCEDURE makeband
  2790. PARAMETER m.type, m.size, m.string, m.newpage
  2791. APPEND BLANK
  2792. REPLACE new->platform WITH "DOS"
  2793. REPLACE new->objtype WITH 9
  2794. REPLACE new->objcode WITH m.type
  2795. REPLACE new->expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,m.string)
  2796. REPLACE new->HEIGHT WITH m.size
  2797. REPLACE new->pagebreak WITH m.newpage
  2798. IF (band_rows(m.type) = 0)
  2799.    band_rows(m.type) = m.current_row
  2800. ENDIF
  2801. m.current_row = m.current_row + m.size
  2802. RETURN
  2803.  
  2804. *!*****************************************************************************
  2805. *!
  2806. *!      Procedure: MAKETEXT
  2807. *!
  2808. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2809. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2810. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2811. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2812. *!
  2813. *!*****************************************************************************
  2814. PROCEDURE maketext
  2815. PARAMETER  wt, ht, string, ROW, COL
  2816. IF m.wt > 0 
  2817.    APPEND BLANK
  2818.    REPLACE new->platform WITH "DOS"
  2819.    REPLACE new->expr WITH '"' + CPTRANS(m.g_tocodepage,m.g_fromcodepage,m.string) + '"'
  2820.    REPLACE new->objtype WITH 5
  2821.    REPLACE new->HEIGHT WITH ht
  2822.    REPLACE new->WIDTH WITH wt
  2823.    REPLACE new->vpos WITH ROW
  2824.    REPLACE new->hpos WITH COL
  2825. ENDIF   
  2826. RETURN
  2827.  
  2828. *!*****************************************************************************
  2829. *!
  2830. *!      Procedure: MAKEFIELD
  2831. *!
  2832. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2833. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2834. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2835. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2836. *!
  2837. *!*****************************************************************************
  2838. PROCEDURE makefield
  2839. PARAMETER m.wt, m.ht, m.string, m.row, m.col, m.fldchar, m.strch, m.flt, m.total, m.reset
  2840.  
  2841. APPEND BLANK
  2842. REPLACE new->platform WITH "DOS"
  2843. REPLACE new->objtype WITH 8
  2844. REPLACE new->expr WITH CPTRANS(m.g_tocodepage,m.g_fromcodepage,m.string)
  2845. REPLACE new->HEIGHT WITH m.ht
  2846. REPLACE new->WIDTH WITH m.wt
  2847. REPLACE new->vpos WITH m.row
  2848. REPLACE new->hpos WITH m.col
  2849. REPLACE new->fillchar WITH m.fldchar
  2850. REPLACE new->STRETCH WITH m.strch
  2851. REPLACE new->FLOAT WITH m.flt
  2852. REPLACE new->totaltype WITH m.total
  2853. REPLACE new->resettotal WITH m.reset
  2854. RETURN
  2855.  
  2856. *!*****************************************************************************
  2857. *!
  2858. *!       Function: GETHEADING
  2859. *!
  2860. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2861. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2862. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2863. *!
  2864. *!*****************************************************************************
  2865. FUNCTION getheading
  2866. PARAMETER m.heading, m.string
  2867. PRIVATE m.flag, m.x, m.heading
  2868. m.flag = 0
  2869. m.x = AT(';',m.string)
  2870. m.heading = SUBSTR(m.string, 1, m.x-1)
  2871. m.string = SUBSTR(m.string, m.x+1)
  2872. IF (LEN(m.string) > 0)   && more left
  2873.    m.flag = 1
  2874. ENDIF
  2875. IF (LEN(m.heading) > 0)
  2876.    m.flag = 1
  2877. ENDIF
  2878. RETURN m.flag
  2879.  
  2880. *!*****************************************************************************
  2881. *!
  2882. *!       Function: LINESFORHEADING
  2883. *!
  2884. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2885. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2886. *!
  2887. *!          Calls: GETHEADING()       (function  in TRANSPRT.PRG)
  2888. *!
  2889. *!*****************************************************************************
  2890. FUNCTION linesforheading
  2891. PARAMETER m.string
  2892. PRIVATE m.retval, m.string2, m.heading
  2893. m.string2 = m.string + ";"
  2894. m.heading = ""
  2895. m.retval = 0
  2896. DO WHILE .T.
  2897.    IF (getheading(@m.heading, @m.string2) > 0)
  2898.       m.retval = m.retval + 1
  2899.    ELSE
  2900.       EXIT
  2901.    ENDIF
  2902. ENDDO
  2903. RETURN m.retval
  2904.  
  2905. *!*****************************************************************************
  2906. *!
  2907. *!       Function: HOWMANYHEADINGS
  2908. *!
  2909. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2910. *!
  2911. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2912. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2913. *!
  2914. *!*****************************************************************************
  2915. FUNCTION howmanyheadings
  2916. PRIVATE m.retval, m.i, m.newval
  2917. m.retval = 0
  2918. FOR m.i = 1 TO m.rp_fldcnt
  2919.    IF (getlitexpr(rp_flds_headno, @m.string) <> 0)
  2920.       m.newval = linesforheading(m.string)
  2921.       m.retval = MAX(m.newval, m.retval)
  2922.    ENDIF
  2923. ENDFOR
  2924. RETURN m.retval
  2925.  
  2926. *!*****************************************************************************
  2927. *!
  2928. *!       Function: FLD_HEAD_EXIST
  2929. *!
  2930. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2931. *!
  2932. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2933. *!
  2934. *!*****************************************************************************
  2935. FUNCTION fld_head_exist
  2936. PRIVATE m.flag, m.i
  2937. m.flag = 0
  2938. FOR m.i = 1 TO m.rp_fldcnt
  2939.    IF (litexist(rp_flds_headno(m.i)) = 1)
  2940.       m.flag = 1
  2941.       EXIT
  2942.    ENDIF
  2943. ENDFOR
  2944. RETURN m.flag
  2945.  
  2946. *!*****************************************************************************
  2947. *!
  2948. *!       Function: TOTALS_EXIST
  2949. *!
  2950. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2951. *!
  2952. *!*****************************************************************************
  2953. FUNCTION totals_exist
  2954. PRIVATE m.flag, m.i
  2955. m.flag = 0
  2956. FOR m.i = 1 TO m.rp_fldcnt
  2957.    IF ("Y" = rp_flds_totals(m.i))
  2958.       m.flag = 1
  2959.       EXIT
  2960.    ENDIF
  2961. ENDFOR
  2962. RETURN m.flag
  2963.  
  2964. *!*****************************************************************************
  2965. *!
  2966. *!       Function: CENTER_COL
  2967. *!
  2968. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2969. *!
  2970. *!*****************************************************************************
  2971. FUNCTION center_col
  2972. PARAMETER m.length
  2973. RETURN (MAX(0, ((m.rp_width - m.rp_lmarg - m.rp_rmarg) - m.length)/2))
  2974.  
  2975. *!*****************************************************************************
  2976. *!
  2977. *!      Procedure: EVALIMPORTEXPR
  2978. *!
  2979. *!      Called by: cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  2980. *!
  2981. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2982. *!
  2983. *!*****************************************************************************
  2984. PROCEDURE evalimportexpr
  2985. PRIVATE string
  2986. m.string = ""
  2987. FOR i = 1 TO rp_fldcnt
  2988.    IF (getlitexpr(rp_flds_exprno(i), @string) <> 0)
  2989.       rp_flds_type(i) = TYPE(m.string)
  2990.       IF ("U" = rp_flds_type(i))
  2991.          rp_flds_type = "C"
  2992.       ENDIF
  2993.    ENDIF
  2994. ENDFOR
  2995. RETURN
  2996.  
  2997. *!*****************************************************************************
  2998. *!
  2999. *!       Function: GETOLDREPORTTYPE
  3000. *!
  3001. *!      Called by: TRANSPRT.PRG                      
  3002. *!
  3003. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  3004. *!
  3005. *!*****************************************************************************
  3006. FUNCTION getoldreporttype
  3007. * Open the main file and see what kind of file it is.  At this point, all we know
  3008. * is that it is either a FoxPro 1.02 report or a FoxBASE+ report.
  3009.  
  3010. PRIVATE m.fp, m.reptotals, m.retcode
  3011. m.retcode = m.tp_filetype
  3012.  
  3013. m.fp = FOPEN(m.g_scrndbf)
  3014. IF fp > 0
  3015.    m.reptotals = cvtshort(FREAD(m.fp,2),0)
  3016.    DO CASE
  3017.    CASE (m.reptotals == 2)   && FoxBASE+ report
  3018.       DO CASE
  3019.       CASE m.tp_filetype = c_frx102modi
  3020.          m.retcode= c_fbprptmodi
  3021.       CASE m.tp_filetype = c_frx102repo
  3022.          m.retcode = c_fbprptrepo
  3023.       OTHERWISE
  3024.          m.retcode = c_fbprptrepo
  3025.       ENDCASE
  3026.    OTHERWISE
  3027.       m.retcode = m.tp_filetype
  3028.    ENDCASE
  3029.    =FCLOSE(m.fp)
  3030. ENDIF
  3031. RETURN m.retcode
  3032. *!*****************************************************************************
  3033. *!
  3034. *!       Function: GETOLDLABELTYPE
  3035. *!
  3036. *!      Called by: TRANSPRT.PRG                      
  3037. *!
  3038. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  3039. *!
  3040. *!*****************************************************************************
  3041. FUNCTION getoldlabeltype
  3042. * Open the main file and see what kind of file it is.  At this point, all we know
  3043. * is that it is either a FoxPro 1.02 report or a FoxBASE+ label.
  3044.  
  3045. PRIVATE m.fp, m.reptotals, m.retcode
  3046. m.retcode = m.tp_filetype
  3047.  
  3048. m.fp = FOPEN(m.g_scrndbf)
  3049. IF fp > 0
  3050.    m.reptotals = cvtbyte(FREAD(m.fp,1),0)
  3051.    m.dummy     = FREAD(m.fp,1)   && skip this one
  3052.    DO CASE
  3053.    CASE (m.reptotals == 2)   && FoxBASE+ label
  3054.       DO CASE
  3055.       CASE m.tp_filetype = c_lbx102modi
  3056.          m.retcode= c_fbplblmodi
  3057.       CASE m.tp_filetype = c_lbx102repo
  3058.          m.retcode = c_fbplblrepo
  3059.       OTHERWISE
  3060.          m.retcode = c_fbplblrepo
  3061.       ENDCASE
  3062.    OTHERWISE
  3063.       m.retcode = m.tp_filetype
  3064.    ENDCASE
  3065.    =FCLOSE(m.fp)
  3066. ENDIF
  3067. RETURN m.retcode
  3068.  
  3069. *
  3070. * MAPBUTTON - Compare two sets of buttons
  3071. *
  3072. *!*****************************************************************************
  3073. *!
  3074. *!       Function: MAPBUTTON
  3075. *!
  3076. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  3077. *!
  3078. *!          Calls: SCATTERBUTTONS     (procedure in TRANSPRT.PRG)
  3079. *!
  3080. *!*****************************************************************************
  3081. FUNCTION mapbutton
  3082. PARAMETER frombtn, tobtn
  3083. PRIVATE m.endpos, m.outstrg, m.topos, m.i. m.pictclau
  3084. m.pictclau = LEFT(m.tobtn,AT(' ',m.tobtn)-1)
  3085. DO CASE
  3086. CASE !m.g_tographic
  3087.    * Strip out the BMP extensions, if present
  3088.    m.frombtn = STRTRAN(m.frombtn,".BMP","")
  3089.    m.frombtn = STRTRAN(m.frombtn,".bmp","")
  3090.    
  3091. CASE ".BMP" $ UPPER(m.tobtn)
  3092.    * Add back in the bitmap extensions, if the to platform already has some.  The 
  3093.    * strategy is to mark all existing bitmap extensions, then add one to each of the 
  3094.    * atoms in the picture clause.
  3095.    DO CASE
  3096.    CASE RIGHT(m.tobtn,1) = '"' OR RIGHT(m.tobtn,1) = "'"
  3097.       m.tobtn = STUFF(m.tobtn,LEN(m.tobtn),0,';')
  3098.    OTHERWISE
  3099.       m.tobtn = m.tobtn + ';'
  3100.    ENDCASE
  3101.    
  3102.    * 'brlfq' is just a marker for where a semicolon needs to go.  Mark all the existing
  3103.    * BMP extensions.
  3104.    m.tobtn = STRTRAN(m.tobtn,".BMP;",".BMPbrlfq")
  3105.    m.tobtn = STRTRAN(m.tobtn,".bmp;",".BMPbrlfq")
  3106.    
  3107.    * Add a new BMP extension where there wasn't one before.
  3108.    m.tobtn = STRTRAN(m.tobtn,";",".BMPbrlfq")
  3109.    
  3110.    * Put the semicolons back
  3111.    m.tobtn = STRTRAN(m.tobtn,"brlfq",";")
  3112.    
  3113.    * Remove trailing semicolons
  3114.    DO WHILE RIGHT(m.tobtn,2) = ';"' OR RIGHT(m.tobtn,2) = ";'"
  3115.       m.tobtn = STUFF(m.tobtn,LEN(m.tobtn)-1,1,"")
  3116.    ENDDO
  3117.    
  3118.    * Now make sure there is a 'B' in the picture clause
  3119.    IF !("B" $ m.pictclau) AND ("@" $ m.pictclau)
  3120.       m.tobtn = STUFF(m.tobtn,AT("@",m.tobtn)+2,0,"B")
  3121.       m.pictclau = m.pictclau + "B"
  3122.    ENDIF
  3123. ENDCASE
  3124.  
  3125. DO CASE
  3126. CASE m.frombtn == m.tobtn
  3127.    RETURN m.frombtn
  3128. CASE OCCURS(';',m.frombtn) = OCCURS(';',m.tobtn)
  3129.    IF m.g_tographic AND ("B" $ m.pictclau)
  3130.       * Return the newly modified "to" string in this case.
  3131.       RETURN m.tobtn
  3132.    ELSE
  3133.       RETURN m.frombtn
  3134.    ENDIF
  3135. CASE OCCURS(';',m.frombtn) > OCCURS(';',m.tobtn)
  3136.    * Are these bitmap buttons?
  3137.    IF ("B" $ m.pictclau)
  3138.       * Just add a blank one to the end
  3139.       m.endpos = RAT('"',m.tobtn)
  3140.       IF endpos > 1
  3141.          RETURN STUFF(m.tobtn,m.endpos,0,';NEW.BMP')
  3142.       ELSE
  3143.          RETURN m.tobtn + ';'
  3144.       ENDIF
  3145.    ELSE
  3146.       * Not bitmaps.
  3147.       RETURN m.frombtn
  3148.    ENDIF
  3149. OTHERWISE
  3150.    RETURN m.frombtn
  3151.    
  3152.    * An alternative strategy is to try to preserve as many as possible of the
  3153.    * destination buttons, especially since they might contain bitmaps, etc.
  3154.    
  3155.    * Populate two arrays with the button prompts.  Then scan through the
  3156.    * 'from' array seeing if we can match it up against something in the 'to'
  3157.    * array.  If so, emit the 'to' array picture.  Otherwise, emit the 'from'
  3158.    * one.
  3159.    DIMENSION fromarray[1], toarray[1]
  3160.    DO scatterbuttons WITH m.frombtn, fromarray
  3161.    DO scatterbuttons WITH m.tobtn, toarray
  3162.    outstrg = ""
  3163.    FOR m.i = 1 TO ALEN(fromarray)
  3164.       m.topos = ASCAN(toarray,fromarray[i])
  3165.       IF m.topos > 0
  3166.          m.outstrg = m.outstrg + IIF(EMPTY(m.outstrg),'',';') + toarray[m.topos]
  3167.       ELSE
  3168.          m.outstrg = m.outstrg + IIF(EMPTY(m.outstrg),'',';') + fromarray[m.i]
  3169.       ENDIF
  3170.    ENDFOR
  3171.    m.outstrg = LEFT(m.frombtn,AT(' ',m.frombtn)) + m.outstrg + '"'
  3172.    RETURN m.outstrg
  3173. ENDCASE
  3174.  
  3175. *!*****************************************************************************
  3176. *!
  3177. *!      Procedure: SCATTERBUTTONS
  3178. *!
  3179. *!      Called by: MAPBUTTON()        (function  in TRANSPRT.PRG)
  3180. *!
  3181. *!*****************************************************************************
  3182. PROCEDURE scatterbuttons
  3183. PARAMETERS btnlist, destarray
  3184. PRIVATE m.i, m.fromstrg, m.num, m.theword
  3185. m.fromstrg = SUBSTR(m.btnlist,AT(' ',m.btnlist)+1)
  3186. m.fromstrg = CHRTRAN(m.fromstrg,CHR(34)+CHR(39),"")
  3187. m.num = OCCURS(';',m.fromstrg)
  3188. DIMENSION destarray[m.num+1]
  3189. FOR m.i = 1 TO m.num + 1
  3190.    DO CASE
  3191.    CASE m.i = 1    && first button
  3192.       m.theword = LEFT(m.fromstrg,AT(';',m.fromstrg)-1)
  3193.    CASE m.i = m.num + 1   && last button
  3194.       m.theword = SUBSTR(m.fromstrg,AT(';',m.fromstrg,m.num)+1)
  3195.    OTHERWISE
  3196.       m.theword = SUBSTR(m.fromstrg,AT(';',m.fromstrg,m.i-1)+1, ;
  3197.          AT(';',m.fromstrg,m.i) - AT(';',m.fromstrg,m.i-1))
  3198.    ENDCASE
  3199.    destarray[m.i] = UPPER(ALLTRIM(m.theword))
  3200. ENDFOR
  3201.  
  3202. *
  3203. * FindLikeVpos - Tries to find an object in the from platform with a vpos that matches the vpos
  3204. *      of a new object we are adding.  If it finds one, we return that objects Vpos in the to
  3205. *      platform.  This gives us a reasonable chance of coming close to where the user will want
  3206. *      an object that is being added to a pre-converted screen.
  3207. *
  3208. *!*****************************************************************************
  3209. *!
  3210. *!      Procedure: FINDLIKEVPOS
  3211. *!
  3212. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3213. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3214. *!
  3215. *!          Calls: ISOBJECT()         (function  in TRANSPRT.PRG)
  3216. *!
  3217. *!*****************************************************************************
  3218. PROCEDURE findlikevpos
  3219. PARAMETER m.oldvpos
  3220. PRIVATE m.objid, m.saverec, m.retval
  3221. m.saverec = RECNO()
  3222. m.retval = m.oldvpos
  3223.  
  3224. LOCATE FOR platform = m.g_fromplatform AND vpos = m.oldvpos AND isobject(objtype)
  3225. IF FOUND()
  3226.    m.objid = uniqueid
  3227.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  3228.    IF FOUND()
  3229.       m.retval = vpos
  3230.    ENDIF
  3231. ENDIF
  3232.  
  3233. GOTO RECORD (m.saverec)
  3234. RETURN m.retval
  3235.  
  3236. *
  3237. * FindLikeHpos - Tries to find an object in the from platform with an hpos that matches the hpos
  3238. *      of a new object we are adding.  If it finds one, we return that objects Hpos in the to
  3239. *      platform.  This gives us a reasonable chance of coming close to where the user will want
  3240. *      an object that is being added to a pre-converted screen.
  3241. *
  3242. *!*****************************************************************************
  3243. *!
  3244. *!      Procedure: FINDLIKEHPOS
  3245. *!
  3246. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3247. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3248. *!
  3249. *!          Calls: ISOBJECT()         (function  in TRANSPRT.PRG)
  3250. *!
  3251. *!*****************************************************************************
  3252. PROCEDURE findlikehpos
  3253. PARAMETER m.oldhpos
  3254. PRIVATE m.objid, m.saverec, m.retval
  3255. m.saverec = RECNO()
  3256. m.retval = m.oldhpos
  3257.  
  3258. LOCATE FOR platform = m.g_fromplatform AND hpos = m.oldhpos AND isobject(objtype)
  3259. IF FOUND()
  3260.    m.objid = uniqueid
  3261.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  3262.    IF FOUND()
  3263.       m.retval = hpos
  3264.    ENDIF
  3265. ENDIF
  3266.  
  3267. GOTO RECORD (m.saverec)
  3268. RETURN m.retval
  3269.  
  3270. *
  3271. * MakeCharFit - Makes sure that a report or screen is large enough to hold all of its objects.
  3272. *
  3273. *!*****************************************************************************
  3274. *!
  3275. *!      Procedure: MAKECHARFIT
  3276. *!
  3277. *!      Called by: NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3278. *!               : ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3279. *!
  3280. *!          Calls: GETRIGHTMOST       (procedure in TRANSPRT.PRG)
  3281. *!               : GETLOWEST          (procedure in TRANSPRT.PRG)
  3282. *!
  3283. *!*****************************************************************************
  3284. PROCEDURE makecharfit
  3285. PRIVATE m.right, m.bottom
  3286.  
  3287. m.right = CEILING(getrightmost(m.g_toplatform))+2
  3288. m.bottom = CEILING(getlowest(m.g_toplatform))+2
  3289.  
  3290. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  3291. IF FOUND()
  3292.    IF WIDTH < m.right
  3293.       REPLACE WIDTH WITH m.right
  3294.    ENDIF
  3295.    
  3296.    IF HEIGHT < m.bottom AND m.g_filetype = c_screen
  3297.       REPLACE HEIGHT WITH m.bottom
  3298.    ENDIF
  3299. ENDIF
  3300.  
  3301. *
  3302. * allenvirons - Process all the screen and environment records first.
  3303. *
  3304. *!*****************************************************************************
  3305. *!
  3306. *!      Procedure: ALLENVIRONS
  3307. *!
  3308. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3309. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3310. *!
  3311. *!          Calls: ADJCOLOR           (procedure in TRANSPRT.PRG)
  3312. *!               : ADJOBJCODE         (procedure in TRANSPRT.PRG)
  3313. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3314. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3315. *!
  3316. *!*****************************************************************************
  3317. PROCEDURE allenvirons
  3318. PRIVATE m.recno
  3319.  
  3320. SCAN FOR platform = m.g_fromplatform AND !DELETED() AND ;
  3321.       (objtype = c_otheader OR objtype = c_otrel OR objtype = c_otworkar OR objtype = c_otindex OR ;
  3322.       (m.g_filetype = c_label AND objtype = c_ot20label))
  3323.    m.recno = RECNO()
  3324.    
  3325.    SCATTER MEMVAR MEMO
  3326.    APPEND BLANK
  3327.    GATHER MEMVAR MEMO
  3328.    
  3329.    REPLACE platform WITH m.g_toplatform
  3330.    IF IsEnviron(objtype) AND !g_tographic
  3331.       * DOS requires the alias name to be in upper case, while Windows doesn't
  3332.       REPLACE TAG WITH UPPER(TAG)
  3333.       REPLACE tag2 WITH UPPER(tag2)
  3334.    ENDIF
  3335.    
  3336.    IF objtype = c_otheader OR (m.g_filetype = c_label AND objtype = c_ot20label)
  3337.       m.g_windheight = HEIGHT
  3338.       m.g_windwidth = WIDTH
  3339.       
  3340.       DO CASE
  3341.       CASE m.g_filetype = c_screen
  3342.          DO adjcolor
  3343.          
  3344.       CASE m.g_filetype = c_report
  3345.          IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3346.             REPLACE vpos WITH 1
  3347.             REPLACE WIDTH WITH -1.0
  3348.             REPLACE ruler WITH 1
  3349.             REPLACE rulerlines WITH 1
  3350.             REPLACE gridv WITH 9
  3351.             REPLACE gridh WITH 9
  3352.             REPLACE penred   WITH 60
  3353.             REPLACE pengreen WITH 80
  3354.             REPLACE penblue    WITH 0
  3355.          ELSE
  3356.             REPLACE HEIGHT WITH c_charrptheight
  3357.             REPLACE WIDTH WITH c_charrptwidth
  3358.          ENDIF
  3359.          
  3360.       CASE m.g_filetype = c_label
  3361.          IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3362.             REPLACE objtype WITH c_otheader
  3363.             REPLACE ruler WITH 1
  3364.             REPLACE rulerlines WITH 1
  3365.             REPLACE grid WITH .T.
  3366.             REPLACE gridv WITH 12
  3367.             REPLACE gridh WITH 12
  3368.             REPLACE penred   WITH -1
  3369.             REPLACE pengreen WITH 65535
  3370.             REPLACE stretchtop WITH .F.
  3371.             REPLACE TOP WITH .F.
  3372.             REPLACE BOTTOM WITH .T.
  3373.             REPLACE curpos WITH .F.
  3374.          ELSE
  3375.             REPLACE objtype WITH c_ot20label
  3376.             *REPLACE vpos WITH (vpos * c_charsperinch)/10000
  3377.             REPLACE hpos WITH (hpos * c_charsperinch)/10000
  3378.             REPLACE HEIGHT WITH (HEIGHT * c_linesperinch)/10000
  3379.             REPLACE WIDTH WITH (WIDTH * c_charsperinch)/10000
  3380.             IF WIDTH < 0
  3381.                REPLACE WIDTH WITH c_charrptwidth
  3382.             ENDIF
  3383.          ENDIF
  3384.       ENDCASE
  3385.       
  3386.       DO adjobjcode
  3387.       DO adjfont
  3388.    ENDIF
  3389.    
  3390.    GOTO RECORD m.recno
  3391. ENDSCAN
  3392. m.g_mercury = m.g_mercury + 5
  3393. DO updtherm WITH m.g_mercury
  3394.  
  3395. *
  3396. * allothers - Process all other records.
  3397. *
  3398. *!*****************************************************************************
  3399. *!
  3400. *!      Procedure: ALLOTHERS
  3401. *!
  3402. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3403. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3404. *!
  3405. *!          Calls: CALCPOSITIONS      (procedure in TRANSPRT.PRG)
  3406. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3407. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3408. *!
  3409. *!*****************************************************************************
  3410. PROCEDURE allothers
  3411. PARAMETER m.thermpart
  3412. PRIVATE m.recno, m.numothers, m.thermstep, m.i
  3413.  
  3414. m.thermstep = m.thermpart / m.objindex
  3415.  
  3416. SELECT (m.g_fromobjonlyalias)
  3417. SET RELATION TO recnum INTO m.g_scrnalias ADDITIVE
  3418. LOCATE FOR .T.
  3419. m.i = 1
  3420.  
  3421. SCAN FOR !DELETED()
  3422.    
  3423.    m.recno = RECNO()
  3424.    
  3425.    SCATTER MEMVAR MEMO
  3426.    
  3427.    IF m.g_tographic
  3428.       DO calcpositions WITH m.i
  3429.       m.i = m.i + 1
  3430.    ENDIF
  3431.    
  3432.    SELECT (m.g_scrnalias)
  3433.    APPEND BLANK
  3434.    GATHER MEMVAR MEMO
  3435.    
  3436.    REPLACE platform WITH m.g_toplatform
  3437.    
  3438.    DO fillininfo
  3439.    
  3440.    SELECT (m.g_fromobjonlyalias)
  3441.    GOTO RECORD m.recno
  3442.    
  3443.    m.g_mercury = m.g_mercury + m.thermstep
  3444.    DO updtherm WITH m.g_mercury
  3445.       
  3446. ENDSCAN
  3447.  
  3448. *
  3449. * FillInInfo - Fill in information for the fields in SCX/FRX database.
  3450. *
  3451. *!*****************************************************************************
  3452. *!
  3453. *!      Procedure: FILLININFO
  3454. *!
  3455. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3456. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3457. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  3458. *!
  3459. *!          Calls: ADJRPTSUPPRESS     (procedure in TRANSPRT.PRG)
  3460. *!               : ADJRPTFLOAT        (procedure in TRANSPRT.PRG)
  3461. *!               : ADJRPTRESET        (procedure in TRANSPRT.PRG)
  3462. *!               : OBJ2BASEFONT()     (function  in TRANSPRT.PRG)
  3463. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  3464. *!               : ADJPEN             (procedure in TRANSPRT.PRG)
  3465. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  3466. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3467. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  3468. *!
  3469. *!*****************************************************************************
  3470. PROCEDURE fillininfo
  3471. IF m.g_filetype = c_report
  3472.    DO adjrptsuppress
  3473.    DO adjrptfloat
  3474. ENDIF
  3475.  
  3476. DO CASE
  3477. CASE m.g_tographic
  3478.    DO CASE
  3479.    CASE objtype = c_otpopup
  3480.       * Popups are a special case since the arrow control counts against the width
  3481.       * under Windows.
  3482.       REPLACE WIDTH WITH WIDTH + 2
  3483.    CASE INLIST(objtype,c_otrepvar,c_otrepfld)
  3484.       DO adjrptreset
  3485.       IF fillchar = "N"
  3486.          REPLACE offset WITH 1      && Change alignment for numerics.
  3487.       ENDIF
  3488.    ENDCASE
  3489. CASE !m.g_tographic
  3490.    DO CASE
  3491.    CASE objtype = c_ottext
  3492.       REPLACE HEIGHT WITH MAX(height,1), width WITH MAX(width,1)
  3493.    CASE objtype = c_otspinner
  3494.       * Map spinners to regular fields
  3495.       REPLACE objtype   WITH c_otfield, ;
  3496.          HEIGHT    WITH 1, ;
  3497.          fillchar  WITH "N"
  3498.    CASE objtype = c_otline
  3499.       * Map Windows lines to DOS boxes
  3500.       REPLACE objtype WITH c_otbox
  3501.       REPLACE HEIGHT  WITH MAX(HEIGHT,1), WIDTH WITH MAX(WIDTH,1)
  3502.       IF pensize >= 6
  3503.          REPLACE boxchar WITH "█"
  3504.       ENDIF
  3505.    CASE INLIST(objtype,c_otradbut,c_ottxtbut)
  3506.       * Remove the BMP extension from bitmap buttons
  3507.       REPLACE PICTURE WITH STRTRAN(PICTURE,".BMP","")
  3508.       REPLACE PICTURE WITH STRTRAN(PICTURE,".bmp","")
  3509.    CASE objtype = c_otfield AND ;
  3510.          (objcode = 2  OR (INLIST(objcode,0,1) AND WIDTH > 25))
  3511.       * Adjust widths of edit fields and very long GET/SAY fields to account
  3512.       * for font differences between the object and the base font.
  3513.       REPLACE WIDTH WITH MAX(obj2basefont(WIDTH,g_fontface,g_fontsize,g_fontstyle,;
  3514.          fontface,fontsize,whatstyle(fontstyle)),1)
  3515.    CASE objtype = c_otbox AND (objcode = 4)
  3516.       IF pensize >= 6
  3517.          REPLACE boxchar WITH "█"
  3518.       ENDIF
  3519.    CASE INLIST(objtype,c_otrepvar,c_otrepfld)
  3520.       DO adjrptreset
  3521.       IF objtype = c_otrepvar
  3522.          * DOS report variable names have to be in upper case
  3523.          REPLACE name WITH UPPER(name)
  3524.       ENDIF
  3525.    ENDCASE
  3526. ENDCASE
  3527.  
  3528. IF objtype <> c_otbox AND objtype <> c_otline
  3529.    DO adjpen
  3530. ENDIF
  3531.  
  3532. DO adjcolor
  3533. DO adjfont
  3534. IF m.g_filetype = c_screen
  3535.    DO adjheightandwidth
  3536. ENDIF
  3537.  
  3538. *
  3539. * adjrptfloat - Convert float/stretch/relative postion types between
  3540. *      character and graphical positions
  3541. *
  3542. *!*****************************************************************************
  3543. *!
  3544. *!      Procedure: ADJRPTFLOAT
  3545. *!
  3546. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3547. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3548. *!
  3549. *!*****************************************************************************
  3550. PROCEDURE adjrptfloat
  3551. IF m.g_tographic
  3552.    DO CASE
  3553.    CASE FLOAT AND (objtype = c_otbox AND HEIGHT > 1)
  3554.       * Box or a vertical line--float as band stretches translates to Top--stretch w/ band.
  3555.       * Use the height > 1 test because DOS boxes haven't been translated into Windows
  3556.       * lines yet.
  3557.       REPLACE stretchtop WITH .T.
  3558.       REPLACE TOP WITH .F.
  3559.       REPLACE BOTTOM WITH .F.
  3560.    CASE FLOAT AND STRETCH
  3561.       REPLACE stretchtop WITH .T.
  3562.       REPLACE TOP WITH .F.
  3563.       REPLACE BOTTOM WITH .F.
  3564.    CASE FLOAT
  3565.       REPLACE BOTTOM WITH .T.
  3566.       REPLACE TOP WITH .F.
  3567.       REPLACE stretchtop WITH .F.
  3568.    ENDCASE
  3569. ELSE
  3570.    DO CASE
  3571.    CASE objtype = c_otrepfld AND (stretchtop OR STRETCH)
  3572.       REPLACE FLOAT WITH .T.
  3573.       REPLACE STRETCH WITH .T.
  3574.    CASE BOTTOM
  3575.       REPLACE FLOAT WITH .T.
  3576.       REPLACE STRETCH WITH .F.
  3577.    CASE TOP
  3578.       REPLACE FLOAT WITH .F.
  3579.       REPLACE STRETCH WITH .F.
  3580.    CASE stretchtop OR STRETCH
  3581.       REPLACE FLOAT WITH .T.
  3582.       REPLACE STRETCH WITH .F.
  3583.    ENDCASE
  3584. ENDIF
  3585.  
  3586. *
  3587. * adjrptSuppress - Convert Suppression types between 2.5 platforms.
  3588. *
  3589. *!*****************************************************************************
  3590. *!
  3591. *!      Procedure: ADJRPTSUPPRESS
  3592. *!
  3593. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3594. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3595. *!
  3596. *!*****************************************************************************
  3597. PROCEDURE adjrptsuppress
  3598. * Handle suppression of repeated values.
  3599. *
  3600. * In DOS 2.0, the value of the detail record "norepeat" determines whether repeated values
  3601. * are suppressed, if this is a field object, or whether group headings are repeated,
  3602. * if this is a group header.  The main screen header record "norepeat" field determines
  3603. * whether blank lines are suppressed in the detail band.
  3604. *
  3605. * In 2.5, the norepeat field is used just for suppression of blank lines.
  3606. * We are positioned on a detail record now.
  3607. *
  3608. IF m.g_tographic
  3609.    IF objtype = c_otband
  3610.       * The meaning for DOS is reversed from Windows
  3611.       REPLACE norepeat WITH !norepeat
  3612.    ELSE
  3613.       IF norepeat            && suppress repeated values
  3614.          REPLACE supvalchng WITH .T.
  3615.          REPLACE supovflow WITH .F.
  3616.          DO CASE
  3617.          CASE resetrpt = 0
  3618.             REPLACE suprpcol WITH 0
  3619.             REPLACE supgroup WITH 0
  3620.          CASE resetrpt = 1
  3621.             REPLACE suprpcol WITH 3
  3622.             REPLACE supgroup WITH 0
  3623.          OTHERWISE
  3624.             REPLACE suprpcol WITH 0
  3625.             REPLACE supgroup WITH resetrpt+3
  3626.          ENDCASE
  3627.       ELSE                   && no suppression of repeated values
  3628.          REPLACE supalways WITH .T.
  3629.          REPLACE supvalchng WITH .F.
  3630.          REPLACE supovflow WITH .F.
  3631.          REPLACE suprpcol WITH 3
  3632.          REPLACE supgroup WITH 0
  3633.       ENDIF
  3634.    ENDIF
  3635. ELSE
  3636.    IF supvalchng AND !supalways
  3637.       REPLACE norepeat WITH .T.
  3638.       IF supgroup > 0
  3639.          REPLACE resetrpt WITH supgroup - 3
  3640.       ELSE
  3641.          IF suprpcol = 3
  3642.             REPLACE resetrpt WITH 1
  3643.          ELSE
  3644.             REPLACE resetrpt WITH 0
  3645.          ENDIF
  3646.       ENDIF
  3647.    ELSE
  3648.       REPLACE norepeat WITH .F.
  3649.    ENDIF
  3650. ENDIF
  3651.  
  3652. *
  3653. * adjrptreset - Convert the reset values between 2.0 and 2.5.
  3654. *
  3655. *!*****************************************************************************
  3656. *!
  3657. *!      Procedure: ADJRPTRESET
  3658. *!
  3659. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3660. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3661. *!
  3662. *!*****************************************************************************
  3663. PROCEDURE adjrptreset
  3664. IF m.g_tographic
  3665.    DO CASE
  3666.    CASE resettotal = 0
  3667.       REPLACE resettotal WITH 1
  3668.    CASE resettotal = 1
  3669.       REPLACE resettotal WITH 2
  3670.    OTHERWISE
  3671.       REPLACE resettotal WITH resettotal+3
  3672.    ENDCASE
  3673. ELSE
  3674.    DO CASE
  3675.    CASE resettotal = 1
  3676.       REPLACE resettotal WITH 0
  3677.    CASE resettotal = 2 OR resettotal = 3
  3678.       REPLACE resettotal WITH 1
  3679.    OTHERWISE
  3680.       REPLACE resettotal WITH resettotal-3
  3681.    ENDCASE
  3682. ENDIF
  3683.  
  3684. *
  3685. * GetCharSuppress - Gets the global setting of blank line Suppression for a report. (This is
  3686. *      only valid for character mode reports).
  3687. *
  3688. *!*****************************************************************************
  3689. *!
  3690. *!       Function: GETCHARSUPPRESS
  3691. *!
  3692. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  3693. *!
  3694. *!*****************************************************************************
  3695. FUNCTION getcharsuppress
  3696. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  3697. IF FOUND()
  3698.    RETURN norepeat
  3699. ELSE
  3700.    RETURN .F.
  3701. ENDIF
  3702.  
  3703. *
  3704. * SuppressBlankLines - Looks through the from platform to see if any
  3705. *      object is marked to Suppress blank lines.  If one is, we
  3706. *      make the entire "to" report (which is assumed to be character)
  3707. *      Suppress blank lines.
  3708. *
  3709. *!*****************************************************************************
  3710. *!
  3711. *!      Procedure: SUPPRESSBLANKLINES
  3712. *!
  3713. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3714. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3715. *!
  3716. *!          Calls: GETBANDCODE()      (function  in TRANSPRT.PRG)
  3717. *!
  3718. *!*****************************************************************************
  3719. PROCEDURE suppressblanklines
  3720. PRIVATE m.supcount
  3721. DO CASE
  3722. CASE m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  3723.    COUNT TO m.supcount FOR platform = m.g_fromplatform AND objtype = c_otrepfld
  3724.    IF m.supcount > 0
  3725.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  3726.       IF FOUND()
  3727.          REPLACE norepeat WITH .T.
  3728.       ENDIF
  3729.    ENDIF
  3730. CASE m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3731.    * DOS suppression of blank lines only applies to detail lines.  Only mark graphical
  3732.    * objects in the detail band as suppressed.
  3733.    SCAN FOR platform = m.g_toplatform AND objtype <> c_otband AND objtype <> c_otheader
  3734.       myexpr = expr
  3735.       IF objtype = 8
  3736.          WAIT CLEAR
  3737.       ENDIF
  3738.       bcode  = getbandcode(vpos)
  3739.       IF bcode = 4     && detail band
  3740.          REPLACE norepeat WITH m.g_norepeat
  3741.       ELSE
  3742.          REPLACE norepeat WITH .F.
  3743.       ENDIF
  3744.    ENDSCAN
  3745. ENDCASE
  3746.  
  3747. *
  3748. * allGroups - Process all Group records.
  3749. *
  3750. *!*****************************************************************************
  3751. *!
  3752. *!      Procedure: ALLGROUPS
  3753. *!
  3754. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3755. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3756. *!
  3757. *!          Calls: UPDTHERM           (procedure in TRANSPRT.PRG)
  3758. *!
  3759. *!*****************************************************************************
  3760. PROCEDURE allgroups
  3761. PARAMETER m.thermpart
  3762. PRIVATE m.recno, m.numothers, m.thermstep
  3763.  
  3764. m.thermstep = m.thermpart / m.objindex
  3765. SELECT (m.g_scrnalias)
  3766.  
  3767. SCAN FOR platform = m.g_fromplatform AND objtype = c_otgroup
  3768.    m.recno = RECNO()
  3769.    
  3770.    SCATTER MEMVAR MEMO
  3771.    APPEND BLANK
  3772.    GATHER MEMVAR MEMO
  3773.    
  3774.    REPLACE platform WITH m.g_toplatform
  3775.    
  3776.    GOTO RECORD m.recno
  3777.    
  3778.    m.g_mercury = m.g_mercury + m.thermstep
  3779.    DO updtherm WITH m.g_mercury
  3780. ENDSCAN
  3781.  
  3782. *
  3783. * RptConvert - Converts entire reports between platforms.
  3784. *
  3785. *!*****************************************************************************
  3786. *!
  3787. *!      Procedure: RPTCONVERT
  3788. *!
  3789. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3790. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3791. *!
  3792. *!          Calls: ISREPTOBJECT()     (function  in TRANSPRT.PRG)
  3793. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  3794. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3795. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  3796. *!               : CLONEBAND          (procedure in TRANSPRT.PRG)
  3797. *!
  3798. *!*****************************************************************************
  3799. PROCEDURE rptconvert
  3800. PRIVATE m.thermstep
  3801.  
  3802. COUNT TO m.thermstep FOR platform = m.g_toplatform AND ;
  3803.    (isreptobject(objtype) OR objtype = c_otband)
  3804.  
  3805. IF m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  3806.    m.thermstep = 25 / m.thermstep
  3807. ELSE
  3808.    m.thermstep = 50 / m.thermstep
  3809. ENDIF
  3810.  
  3811. * We need to do bands before any other object.
  3812. SCAN FOR platform = m.g_toplatform AND objtype = c_otband
  3813.    DO rptobjconvert WITH 0
  3814.    m.g_mercury = m.g_mercury + m.thermstep
  3815.    DO updtherm WITH m.g_mercury
  3816. ENDSCAN
  3817.  
  3818. * We need to know where bands start and where they end in
  3819. * both platforms.
  3820. COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  3821. GOTO TOP
  3822.  
  3823. DIMENSION bands[m.bandCount,4]
  3824. m.bandcount = bandinfo()
  3825.  
  3826. * Make sure that the band headers and footers match on Windows
  3827. IF m.g_tographic
  3828.    DO cloneband
  3829. ENDIF
  3830.  
  3831. SCAN FOR platform = m.g_toplatform AND ;
  3832.       (objtype = c_otrepfld OR objtype = c_ottext OR ;
  3833.       objtype = c_otbox OR objtype = c_otline)
  3834.    
  3835.    DO rptobjconvert WITH m.bandcount
  3836.    
  3837.    m.g_mercury = m.g_mercury + m.thermstep
  3838.    DO updtherm WITH m.g_mercury
  3839. ENDSCAN
  3840.  
  3841. *
  3842. * RptObjConvert - Converts the size and postion of a given record in a report/label
  3843. *
  3844. *!*****************************************************************************
  3845. *!
  3846. *!      Procedure: RPTOBJCONVERT
  3847. *!
  3848. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3849. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3850. *!               : NEWBANDS           (procedure in TRANSPRT.PRG)
  3851. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  3852. *!
  3853. *!          Calls: EMPTYBAND()        (function  in TRANSPRT.PRG)
  3854. *!               : CVTREPORTVERTICAL()(function  in TRANSPRT.PRG)
  3855. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  3856. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  3857. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3858. *!               : GETBANDINDEX       (procedure in TRANSPRT.PRG)
  3859. *!               : CVTREPORTHORIZONTAL(function  in TRANSPRT.PRG)
  3860. *!               : CVTRPTLINES()      (function  in TRANSPRT.PRG)
  3861. *!               : ADJTEXT            (procedure in TRANSPRT.PRG)
  3862. *!
  3863. *!*****************************************************************************
  3864. PROCEDURE rptobjconvert
  3865. PARAMETER m.bandcount
  3866. PRIVATE m.bandindex, m.endindex, m.posinband, m.saverec, m.objid, m.origvpos, m.lineheight
  3867.  
  3868. IF objtype = c_otband
  3869.    * Map height and width of band to proper values
  3870.    
  3871.    IF m.g_tographic AND emptyband(uniqueid)
  3872.       REPLACE HEIGHT WITH 0
  3873.    ELSE
  3874.       m.lineheight = cvtreportvertical(HEIGHT)
  3875.       IF !m.g_tographic AND BETWEEN(m.lineheight,1.00,1.10) AND objcode = 4
  3876.          * This is a heuristic rule to make quick reports and other reports with 
  3877.          * a single-line detail band transport to DOS correctly.  Sometimes the bands
  3878.          * will be just a little larger than one line in Windows.
  3879.          REPLACE HEIGHT WITH 1
  3880.       ELSE
  3881.          REPLACE HEIGHT WITH CEILING(m.lineheight)
  3882.       ENDIF
  3883.    ENDIF
  3884.    
  3885.    IF m.g_tographic
  3886.       * Map DOS offset field to Windows "if lines less than".  These fields control
  3887.       * when the data grouping decides to start a new page.  This data is stored in "width".
  3888.       REPLACE WIDTH WITH 10000 * offset / c_linesperinch
  3889.    ELSE
  3890.       REPLACE HEIGHT WITH MAX(1, HEIGHT)
  3891.       REPLACE offset WITH ROUND(WIDTH/10000, 0) * c_linesperinch
  3892.    ENDIF
  3893. ELSE
  3894.    * Converting a regular object such as a field or line.
  3895.    m.origvpos   = vpos
  3896.    m.origheight = HEIGHT
  3897.    
  3898.    IF (m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC") AND objtype = c_otbox
  3899.       DO adjbox WITH 0
  3900.       DO adjcolor
  3901.       DO adjfont
  3902.    ENDIF
  3903.    
  3904.    * Find which band in the "from" platform this object came from
  3905.    * Use a vpos expressed in "from" units for this function.
  3906.    m.bandindex = getbandindex(m.origvpos, m.bandcount)
  3907.    
  3908.    * Since keeping objects in the proper bands is our highest
  3909.    * priority, we calculate the new Vpos by determining how many
  3910.    * lines into its band an object lies and adding this
  3911.    * value (converted) to that band's Vpos in the from platform.
  3912.    m.posinband = MAX(cvtreportvertical((vpos - bands[m.bandIndex, c_fmbandvpos])),0)
  3913.    REPLACE vpos WITH bands[m.bandIndex, c_tobandvpos] + m.posinband
  3914.    
  3915.    * Since vertical lines and boxes can stretch across bands, we need to
  3916.    * watch their ending positions.
  3917.    IF (objtype = c_otbox AND cvtreportvertical(HEIGHT) > 1) ;
  3918.          OR (objtype = c_otline AND WIDTH < HEIGHT)
  3919.       m.endindex = getbandindex(IIF(m.g_tographic,m.origvpos+m.origheight-1,;
  3920.          m.origvpos + m.origheight), m.bandcount)
  3921.       IF m.endindex <> m.bandindex
  3922.          *m.endinband = IIF(m.g_tographic, m.origvpos+m.origheight-.25, m.origvpos+m.origheight) ;
  3923.          *   - bands[m.endIndex, c_fmbandvpos]
  3924.          m.endinband = m.origvpos+m.origheight - bands[m.endIndex, c_fmbandvpos]
  3925.          IF m.g_tographic
  3926.             * Allow for the fact that box characters in DOS appear in the middle of
  3927.             * the line, but always stick out into the "end" band a little bit.
  3928.             m.endinband = MAX(m.endinband - 0.5,0.25)
  3929.          ENDIF
  3930.          m.endinband = cvtreportvertical(m.endinband)
  3931.          REPLACE HEIGHT WITH bands[m.endIndex, c_tobandvpos] + m.endinband - vpos
  3932.       ELSE
  3933.          REPLACE HEIGHT WITH cvtreportvertical(HEIGHT)
  3934.       ENDIF
  3935.    ELSE
  3936.       REPLACE HEIGHT WITH cvtreportvertical(HEIGHT)
  3937.    ENDIF
  3938.    
  3939.    REPLACE hpos WITH cvtreporthorizontal(hpos)
  3940.    REPLACE WIDTH WITH cvtreporthorizontal(WIDTH)
  3941.    IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3942.       IF objtype = c_otline AND WIDTH > HEIGHT
  3943.          * Handle horizontal lines separately.  They are very sensitive to line
  3944.          * height.
  3945.          REPLACE HEIGHT WITH cvtrptlines(HEIGHT)
  3946.       ENDIF
  3947.    ELSE
  3948.       IF objtype = c_otbox AND ROUND(HEIGHT,0) <> 1
  3949.          DO adjbox WITH 0
  3950.       ENDIF
  3951.       
  3952.       REPLACE vpos WITH ROUND(vpos,0)
  3953.       REPLACE hpos WITH ROUND(hpos,0)
  3954.       REPLACE HEIGHT WITH ROUND(HEIGHT,0)
  3955.       REPLACE WIDTH WITH ROUND(WIDTH,0)
  3956.       
  3957.       * Make sure that this object will not extend past the end of the last
  3958.       * band, which leads to "invalid report" errors on DOS.
  3959.       IF m.bandindex = m.bandcount AND ;
  3960.             (vpos + HEIGHT ;
  3961.             > bands[m.bandIndex,c_tobandvpos] ;
  3962.             + bands[m.bandIndex,c_tobandheight])
  3963.          * Can we move the object up so that it fits?
  3964.          IF HEIGHT <= bands[m.bandIndex, c_tobandheight]
  3965.             * It will fit if we scootch it up a little.
  3966.             REPLACE vpos WITH vpos -;
  3967.                (bands[m.bandIndex,c_tobandheight] - HEIGHT)
  3968.          ELSE
  3969.             * No room for it at all.  Crop the height.  Make as much fit as possible.
  3970.             REPLACE vpos   WITH bands[m.bandIndex,c_tobandvpos]
  3971.             REPLACE HEIGHT WITH bands[m.bandIndex,c_tobandheight]
  3972.          ENDIF
  3973.       ENDIF
  3974.       
  3975.       DO CASE
  3976.       CASE objtype = c_ottext
  3977.          REPLACE HEIGHT WITH 1
  3978.          DO adjtext WITH WIDTH
  3979.          REPLACE WIDTH WITH LEN(expr)-2
  3980.          
  3981.       CASE objtype = c_otrepfld AND HEIGHT < 1
  3982.          REPLACE HEIGHT WITH 1
  3983.          
  3984.       ENDCASE
  3985.       IF ROUND(hpos,0) = -1
  3986.          REPLACE hpos WITH 0
  3987.       ENDIF
  3988.    ENDIF
  3989.    
  3990.    * Guarantee that we are in the right band.
  3991.    IF vpos > bands[m.bandIndex,c_tobandvpos] ;
  3992.          + bands[m.bandIndex,c_tobandheight] - 1
  3993.       REPLACE vpos WITH bands[m.bandIndex,c_tobandvpos] ;
  3994.          + bands[m.bandIndex,c_tobandheight] - 1
  3995.    ENDIF
  3996.    
  3997.    IF vpos < 0
  3998.       REPLACE vpos WITH 0
  3999.    ENDIF
  4000. ENDIF
  4001.  
  4002. IF HEIGHT <= 0
  4003.    REPLACE HEIGHT WITH 1
  4004. ENDIF
  4005.  
  4006. RETURN
  4007.  
  4008. *
  4009. * GetBandIndex - Given a Vpos (from platform), this function returns the
  4010. *      index in the Band array of the band which this Vpos lies in.
  4011. *
  4012. *!*****************************************************************************
  4013. *!
  4014. *!      Procedure: GETBANDINDEX
  4015. *!
  4016. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4017. *!
  4018. *!*****************************************************************************
  4019. PROCEDURE getbandindex
  4020. PARAMETER m.vpos, m.bandcount
  4021. PRIVATE m.loop
  4022. FOR m.loop = 1 TO m.bandcount
  4023.    IF m.vpos >= bands[m.loop,c_fmbandvpos] ;
  4024.          AND m.vpos < bands[m.loop,c_fmbandvpos]+bands[m.loop,c_fmbandheight]
  4025.       RETURN m.loop
  4026.    ENDIF
  4027. ENDFOR
  4028. RETURN m.bandcount    && drop them into the bottom band as a default
  4029.  
  4030. *
  4031. * BandInfo - Fills a predefined array named Band as follows.
  4032. *   bands[1] = Start Position in To platform.
  4033. *   bands[2] = Height in To platform.
  4034. *   bands[3] = Start Position in From platform.
  4035. *   bands[4] = Height in From platform.
  4036. *
  4037. *!*****************************************************************************
  4038. *!
  4039. *!       Function: BANDINFO
  4040. *!
  4041. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4042. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  4043. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  4044. *!
  4045. *!          Calls: RESIZEBAND         (procedure in TRANSPRT.PRG)
  4046. *!
  4047. *!*****************************************************************************
  4048. FUNCTION bandinfo
  4049. PRIVATE m.saverec, m.bandcount, m.loop, ;
  4050.    m.pagefooter, m.pageheader, m.colheader, m.colfooter, ;
  4051.    m.toposition, m.fromposition, m.objcode, m.expr
  4052.  
  4053. m.toposition   = 0
  4054. m.fromposition = 0
  4055. m.bandcount    = 0
  4056. m.colheader    = 0
  4057. m.colfooter    = 0
  4058. m.pageheader   = 0
  4059. m.pagefooter   = 0
  4060.  
  4061. SCAN FOR platform = m.g_toplatform AND objtype = c_otband
  4062.    m.bandcount = m.bandcount + 1
  4063.    
  4064.    DO CASE
  4065.    CASE objcode = 1
  4066.       m.pageheader = m.bandcount
  4067.    CASE objcode = 2
  4068.       m.colheader  = m.bandcount
  4069.    CASE objcode = 6
  4070.       m.colfooter  = m.bandcount
  4071.    CASE objcode = 7
  4072.       m.pagefooter = m.bandcount
  4073.    ENDCASE
  4074.    
  4075.    * The To fields are already converted at this point
  4076.    bands[m.bandCount,c_tobandvpos] = m.toposition
  4077.    IF m.g_tographic
  4078.       bands[m.bandCount,c_tobandheight] ;
  4079.          = HEIGHT + c_bandheight + (c_bandfudge/c_pixelsize)
  4080.    ELSE
  4081.       bands[m.bandCount,c_tobandheight] = HEIGHT
  4082.    ENDIF
  4083.    
  4084.    
  4085.    m.objcode = objcode
  4086.    m.expr    = expr
  4087.    m.saverec = RECNO()
  4088.    
  4089.    IF !EMPTY(expr)
  4090.       LOCATE FOR platform = m.g_fromplatform AND ;
  4091.          objtype = c_otband AND objcode = m.objcode AND expr = m.expr
  4092.    ELSE
  4093.       * The expression is empty, which means this is probably a group footer.  There could
  4094.       * be many of them, all empty.  We have to find the right one.
  4095.       GOTO TOP
  4096.       * Figure out which occurrence this one is.
  4097.       COUNT TO m.seq FOR platform = m.g_toplatform AND ;
  4098.          objtype = c_otband AND objcode = m.objcode AND EMPTY(expr) ;
  4099.          AND RECNO() <= m.saverec
  4100.       GOTO TOP
  4101.       * Now find the corresponding band in the "from" platform
  4102.       LOCATE FOR platform = m.g_fromplatform AND ;
  4103.          objtype = c_otband AND objcode = m.objcode AND EMPTY(expr)
  4104.       m.i = 1
  4105.       DO WHILE FOUND() AND m.i < m.seq
  4106.          m.i = m.i + 1
  4107.          CONTINUE
  4108.       ENDDO
  4109.    ENDIF
  4110.    IF FOUND()
  4111.       bands[m.bandCount,c_fmbandvpos] = m.fromposition
  4112.       IF m.g_tographic   && so coming from DOS
  4113.          bands[m.bandCount,c_fmbandheight] = HEIGHT
  4114.       ELSE
  4115.          bands[m.bandCount,c_fmbandheight] = HEIGHT + c_bandheight
  4116.       ENDIF
  4117.       
  4118.       m.fromposition = m.fromposition + bands[m.bandCount,c_fmbandheight]
  4119.       
  4120.       IF !g_tographic
  4121.          * Resize 'to' band if necessary to account for boxes that narrowly
  4122.          * surround text on a graphic platform.  Sometimes the box can be
  4123.          * tightly against the text such that the graphical band appears to
  4124.          * be only two rows high.  We need three rows to display the box in
  4125.          * a character platform
  4126.          bands[m.bandCount,c_tobandheight] = ;
  4127.             resizeband(bands[m.bandCount,c_tobandheight], ;
  4128.             bands[m.bandCount,c_fmbandvpos  ], ;
  4129.             bands[m.bandCount,c_fmbandheight])
  4130.       ENDIF
  4131.    ELSE
  4132.       bands[m.bandCount,c_fmbandvpos] = 9999999
  4133.       bands[m.bandCount,c_fmbandheight] = 9999999
  4134.    ENDIF
  4135.    
  4136.    
  4137.    m.toposition = m.toposition + bands[m.bandCount,c_tobandheight]
  4138.    
  4139.    GOTO RECORD (m.saverec)
  4140.    
  4141.    IF !g_tographic
  4142.       * Stuff the newly recomputed height into the DOS record
  4143.       REPLACE HEIGHT WITH bands[m.bandCount,c_tobandheight]
  4144.    ENDIF
  4145.    
  4146. ENDSCAN
  4147.  
  4148. * We don't want to have any column headers/footers in the character
  4149. * products so we need to combine them with the page headers/footers.
  4150. IF m.colfooter > 0 AND m.pagefooter > 0
  4151.    bands[m.pageFooter,c_tobandvpos] = bands[m.colFooter,c_tobandvpos]
  4152.    bands[m.pageFooter,c_tobandheight];
  4153.       = bands[m.pageFooter,c_tobandheight] ;
  4154.       + bands[m.colFooter,c_tobandheight]
  4155.    bands[m.pageFooter,c_fmbandvpos] = bands[m.colFooter,c_fmbandvpos]
  4156.    bands[m.pageFooter,c_fmbandheight] ;
  4157.       = bands[m.pageFooter,c_fmbandheight] ;
  4158.       + bands[m.colFooter,c_fmbandheight]
  4159.    
  4160.    LOCATE FOR platform = m.g_toplatform ;
  4161.       AND objtype = c_otband AND objcode = 6
  4162.    IF FOUND()
  4163.       DELETE
  4164.    ENDIF
  4165.    
  4166.    LOCATE FOR platform = m.g_toplatform ;
  4167.       AND objtype = c_otband AND objcode = 7
  4168.    IF FOUND()
  4169.       REPLACE HEIGHT WITH HEIGHT + bands[m.colFooter,c_tobandheight]
  4170.    ENDIF
  4171.    
  4172.    =ADEL(bands,m.colfooter)
  4173.    m.bandcount = m.bandcount - 1
  4174. ENDIF
  4175.  
  4176. IF m.colheader > 0 AND m.pageheader > 0
  4177.    bands[m.pageHeader,c_tobandheight];
  4178.       = bands[m.pageHeader,c_tobandheight] ;
  4179.       + bands[m.colHeader,c_tobandheight]
  4180.    bands[m.pageHeader,c_fmbandheight] ;
  4181.       = bands[m.pageHeader,c_fmbandheight] ;
  4182.       + bands[m.colHeader,c_fmbandheight]
  4183.    
  4184.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 2
  4185.    IF FOUND()
  4186.       DELETE
  4187.    ENDIF
  4188.    
  4189.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 1
  4190.    IF FOUND()
  4191.       REPLACE HEIGHT WITH HEIGHT + bands[m.colHeader,c_tobandheight]
  4192.    ENDIF
  4193.    
  4194.    =ADEL(bands,m.colheader)
  4195.    m.bandcount = m.bandcount - 1
  4196. ENDIF
  4197. RETURN m.bandcount
  4198.  
  4199.  
  4200. *!*****************************************************************************
  4201. *!
  4202. *!      Procedure: CLONEBAND
  4203. *!
  4204. *!      Called by: RPTCONVERT         (procedure in TRANSPRT.PRG)
  4205. *!
  4206. *!*****************************************************************************
  4207. PROCEDURE cloneband
  4208. * Copy the band header record data into the respective footer bands.  Data in band header
  4209. * and footer records must match on Windows.  The main data that needs to match is the
  4210. * group expression and things like how many spaces to require after a heading
  4211. * before doing a page break.
  4212. PRIVATE m.in_area, m.in_rec, m.pivot, m.ouniqid, m.ovpos, m.ohpos, m.owidth, m.oheight,;
  4213.    m.oobjcode, m.headband
  4214. IF m.g_tographic
  4215.    m.in_area = SELECT()
  4216.    m.in_rec = RECNO()
  4217.    * First find the detail band.  It acts as a pivot.
  4218.    GOTO TOP
  4219.    LOCATE FOR platform = m.g_toplatform ;
  4220.       AND objtype = c_otband ;
  4221.       AND objcode = 4     && detail band has code = 4
  4222.    IF !FOUND()
  4223.       * Return and make the best of it
  4224.       RETURN
  4225.    ENDIF
  4226.    m.pivot = RECNO()
  4227.    
  4228.    * Scan for each of the header bands
  4229.    SCAN FOR platform = m.g_toplatform ;
  4230.          AND objtype = c_otband ;
  4231.          AND objcode < 4 AND objcode > 0
  4232.       SCATTER MEMVAR MEMO
  4233.       
  4234.       m.headband = RECNO()
  4235.       
  4236.       * Go to the matching footer band record
  4237.       GOTO (m.pivot + (m.pivot - RECNO()))
  4238.       
  4239.       * Store the values we don't want to copy from the header
  4240.       m.ouniqid  = uniqueid
  4241.       m.ovpos    = vpos
  4242.       m.ohpos    = hpos
  4243.       m.oheight  = HEIGHT
  4244.       m.oobjcode = objcode
  4245.       
  4246.       * Stuff header data into this footer band
  4247.       GATHER MEMVAR MEMO
  4248.       
  4249.       * Restore the data we didn't want to copy from the header
  4250.       REPLACE vpos WITH m.ovpos, hpos WITH m.ohpos, ;
  4251.          HEIGHT WITH m.oheight, objcode WITH m.oobjcode, ;
  4252.          uniqueid WITH m.ouniqid
  4253.       
  4254.       GOTO (m.headband)
  4255.       
  4256.    ENDSCAN
  4257.    SELECT (m.in_area)
  4258.    GOTO (MIN(m.in_rec,RECCOUNT()))
  4259. ENDIF
  4260.  
  4261. RETURN
  4262.  
  4263. *
  4264. * RESIZEBAND - Resize the character mode report band to accommodate
  4265. * boxes, etc.
  4266. *
  4267. *!*****************************************************************************
  4268. *!
  4269. *!      Procedure: RESIZEBAND
  4270. *!
  4271. *!      Called by: BANDINFO()         (function  in TRANSPRT.PRG)
  4272. *!
  4273. *!          Calls: CVTREPORTVERTICAL()(function  in TRANSPRT.PRG)
  4274. *!
  4275. *!*****************************************************************************
  4276. PROCEDURE resizeband
  4277. PARAMETER tobandheight, fmbandvpos, fmbandheight
  4278.  
  4279. PRIVATE in_rec, minbandheight
  4280. m.in_rec = RECNO()
  4281. m.minbandheight = m.tobandheight
  4282. IF !g_tographic
  4283.    * Search for boxes that lie entirely within this band.
  4284.    SCAN FOR platform = m.g_fromplatform ;
  4285.          AND objtype = c_otbox AND vpos >= m.fmbandvpos ;
  4286.          AND vpos + HEIGHT <= m.fmbandvpos + m.fmbandheight
  4287.       * The box needs to be expanded
  4288.       m.minbandheight = MAX(m.minbandheight,cvtreportvertical(HEIGHT)+1)
  4289.       * If there is a box in the band, always make it at least three rows
  4290.       m.minbandheight = MAX(m.minbandheight,3)
  4291.    ENDSCAN
  4292. ENDIF
  4293. GOTO RECORD (m.in_rec)
  4294. RETURN CEILING(m.minbandheight)
  4295.  
  4296. *
  4297. * BandHeight - Given a band ID and platform, this function reurns the band's
  4298. *      starting position in that platform.
  4299. *
  4300. *!*****************************************************************************
  4301. *!
  4302. *!       Function: BANDPOS
  4303. *!
  4304. *!      Called by: NEWBANDS           (procedure in TRANSPRT.PRG)
  4305. *!               : EMPTYBAND()        (function  in TRANSPRT.PRG)
  4306. *!
  4307. *!*****************************************************************************
  4308. FUNCTION bandpos
  4309. PARAMETER m.objid, m.platform
  4310. PRIVATE m.saverec, m.bandstart
  4311. m.saverec = RECNO()
  4312. m.bandstart = 0
  4313.  
  4314. SCAN FOR platform = m.platform AND objtype = c_otband
  4315.    IF uniqueid <> m.objid
  4316.       IF m.platform = "DOS" OR m.platform = "UNIX"
  4317.          m.bandstart = m.bandstart + HEIGHT
  4318.       ELSE
  4319.          m.bandstart = m.bandstart + HEIGHT + c_bandheight + (c_bandfudge/c_pixelsize)
  4320.       ENDIF
  4321.    ELSE
  4322.       LOCATE FOR .F.
  4323.    ENDIF
  4324. ENDSCAN
  4325.  
  4326. GOTO RECORD (m.saverec)
  4327. RETURN m.bandstart
  4328.  
  4329. *
  4330. * EmptyBand - Given a band ID, this funtion determines if the band is empty.
  4331. *
  4332. *!*****************************************************************************
  4333. *!
  4334. *!       Function: EMPTYBAND
  4335. *!
  4336. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4337. *!
  4338. *!          Calls: BANDPOS()          (function  in TRANSPRT.PRG)
  4339. *!
  4340. *!*****************************************************************************
  4341. FUNCTION emptyband
  4342. PARAMETER m.id
  4343. PRIVATE m.saverec, m.bandstart, m.bandheight, m.retval
  4344. IF m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  4345.    RETURN .F.
  4346. ENDIF
  4347.  
  4348. m.saverec = RECNO()
  4349. m.retval = .F.
  4350.  
  4351. LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.id
  4352. IF FOUND()
  4353.    m.bandheight = HEIGHT
  4354.    m.bandstart = bandpos(m.id, m.g_fromplatform)
  4355.    * Look for objects in this band
  4356.    LOCATE FOR platform = m.g_fromplatform AND ;
  4357.       (objtype = c_otline OR objtype = c_otbox OR ;
  4358.       objtype = c_ottext OR objtype = c_otrepfld) AND ;
  4359.       vpos >= m.bandstart AND vpos < m.bandstart + m.bandheight
  4360.    IF !FOUND() AND m.g_tographic
  4361.       * Look for a DOS box or line that ends in the band
  4362.       GOTO TOP
  4363.       LOCATE FOR platform = m.g_fromplatform AND ;
  4364.          INLIST(objtype,c_otbox, c_otline) AND ;
  4365.          vpos + HEIGHT - 1 >= m.bandstart AND vpos + HEIGHT - 1 < m.bandstart + m.bandheight
  4366.    ENDIF
  4367.    m.retval = !FOUND()
  4368. ENDIF
  4369.  
  4370. GOTO RECORD (m.saverec)
  4371. RETURN m.retval
  4372.  
  4373. *
  4374. * GETBANDCODE - returns band objcode given a vpos
  4375. *
  4376. *!*****************************************************************************
  4377. *!
  4378. *!       Function: GETBANDCODE
  4379. *!
  4380. *!      Called by: SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  4381. *!
  4382. *!*****************************************************************************
  4383. FUNCTION getbandcode
  4384. PARAMETER m.thisvpos
  4385. PRIVATE m.in_num, m.retcode
  4386. retcode = -1
  4387. m.in_num = RECNO()
  4388. m.startvpos = 0
  4389.  
  4390. IF INLIST(objtype,c_otheader, c_otband, c_otrel, c_otworkar, c_otindex)
  4391.    RETURN -1
  4392. ENDIF
  4393.  
  4394. SET FILTER TO platform = m.g_toplatform AND (objtype = c_otband)
  4395. GOTO TOP
  4396. DO WHILE m.startvpos <= m.thisvpos AND !EOF()
  4397.    IF m.startvpos + HEIGHT +c_bandheight > m.thisvpos
  4398.       retcode = objcode
  4399.       EXIT
  4400.    ELSE
  4401.       m.startvpos = m.startvpos + HEIGHT + c_bandheight
  4402.       SKIP
  4403.    ENDIF
  4404. ENDDO
  4405. SET FILTER TO
  4406. GOTO m.in_num
  4407. RETURN retcode
  4408.  
  4409. *
  4410. * CvtReportVertical - Convert report vertical dimensions between 10000ths of an inch and characters
  4411. *      depending on the to platform.  (This function is for vertical dimensions only).
  4412. *
  4413. *!*****************************************************************************
  4414. *!
  4415. *!       Function: CVTREPORTVERTICAL
  4416. *!
  4417. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4418. *!               : RESIZEBAND         (procedure in TRANSPRT.PRG)
  4419. *!
  4420. *!*****************************************************************************
  4421. FUNCTION cvtreportvertical
  4422. PARAMETER m.units
  4423. DO CASE
  4424. CASE !m.g_tographic
  4425.    RETURN m.units/10000 * c_linesperinch
  4426. CASE g_tographic
  4427.    RETURN (m.units * m.g_rptlinesize) + (5000/c_pixelsize)
  4428. OTHERWISE
  4429.    RETURN m.units
  4430. ENDCASE
  4431.  
  4432. *
  4433. * CvtReportWidth - Convert report horizontal dimensions between 10000ths of an inch
  4434. *      and chanracters depending on the to platform.
  4435. *
  4436. *!*****************************************************************************
  4437. *!
  4438. *!       Function: CVTREPORTHORIZONTAL
  4439. *!
  4440. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4441. *!
  4442. *!*****************************************************************************
  4443. FUNCTION cvtreporthorizontal
  4444. PARAMETER m.units
  4445. DO CASE
  4446. CASE !m.g_tographic
  4447.    RETURN m.units/10000 * c_charsperinch
  4448. CASE m.g_tographic
  4449.    RETURN m.units * m.g_rptcharsize
  4450. OTHERWISE
  4451.    RETURN m.units
  4452. ENDCASE
  4453. *!*****************************************************************************
  4454. *!
  4455. *!       Function: CVTRPTLINES
  4456. *!
  4457. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4458. *!
  4459. *!*****************************************************************************
  4460. FUNCTION cvtrptlines
  4461. * Adjust the height of horizontal lines
  4462. PARAMETER m.height
  4463. DO CASE
  4464. CASE g_tographic
  4465.    DO CASE
  4466.    CASE BETWEEN(m.height,0,200)
  4467.       RETURN 104
  4468.    CASE BETWEEN(m.height,200,600)
  4469.       RETURN 520
  4470.    CASE BETWEEN(m.height,600,850)
  4471.       RETURN 850
  4472.    OTHERWISE
  4473.       RETURN m.height
  4474.    ENDCASE
  4475. OTHERWISE
  4476.    RETURN m.height
  4477. ENDCASE
  4478.  
  4479. *
  4480. * MergeLabelObjects - Combines report objects which lie on the same line
  4481. *      when going from a graphical platform to a character platform.
  4482. *
  4483. *!*****************************************************************************
  4484. *!
  4485. *!      Procedure: MERGELABELOBJECTS
  4486. *!
  4487. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  4488. *!
  4489. *!          Calls: LABELOBJMERGE      (procedure in TRANSPRT.PRG)
  4490. *!
  4491. *!        Indexes: TEMP                   (tag)
  4492. *!
  4493. *!*****************************************************************************
  4494. PROCEDURE mergelabelobjects
  4495. INDEX ON platform+STR(vpos,3)+STR(hpos,3) TAG temp
  4496.  
  4497. SCAN FOR platform = m.g_toplatform AND !DELETED() AND ;
  4498.       (objtype = c_otrepfld OR objtype = c_ottext OR objtype = c_otbox OR objtype = c_otline)
  4499.    DO labelobjmerge WITH RECNO()
  4500. ENDSCAN
  4501.  
  4502. DELETE TAG temp
  4503. RETURN
  4504.  
  4505. *
  4506. * LabelObjMerge - Given a record which is a report object, this function tries to find a label
  4507. *      object on the same line and combine them.  If no label object exists on the line, the
  4508. *      record is turned into one.
  4509. *
  4510. *!*****************************************************************************
  4511. *!
  4512. *!      Procedure: LABELOBJMERGE
  4513. *!
  4514. *!      Called by: MERGELABELOBJECTS  (procedure in TRANSPRT.PRG)
  4515. *!
  4516. *!*****************************************************************************
  4517. PROCEDURE labelobjmerge
  4518. PARAMETER m.recno
  4519. PRIVATE m.saverec, m.vpos, m.hpos, m.width, m.height, m.expr, m.type, m.picture
  4520.  
  4521. m.saverec = RECNO()
  4522. GOTO RECORD (m.recno)
  4523.  
  4524. m.vpos = vpos
  4525. m.width = WIDTH
  4526. m.expr = expr
  4527. m.type = fillchar
  4528. m.picture = PICTURE
  4529. DELETE
  4530.  
  4531. LOCATE FOR platform = m.g_toplatform AND !DELETED() AND ;
  4532.    objtype = c_ot20lbxobj AND vpos = m.vpos
  4533. IF FOUND()
  4534.    REPLACE expr WITH expr + "," + m.expr
  4535. ELSE
  4536.    GOTO RECORD (m.recno)
  4537.    RECALL
  4538.    REPLACE objtype WITH c_ot20lbxobj
  4539. ENDIF
  4540.  
  4541. GOTO RECORD (m.saverec)
  4542.  
  4543. *
  4544. * AddLabelBlanks - Adds sufficient blank lines to make the converted lines
  4545. *
  4546. *!*****************************************************************************
  4547. *!
  4548. *!      Procedure: ADDLABELBLANKS
  4549. *!
  4550. *!           Uses: M.G_SCRNALIAS      
  4551. *!
  4552. *!*****************************************************************************
  4553. PROCEDURE addlabelblanks
  4554. PRIVATE m.linecount, m.last, m.scanloop
  4555. SELECT vpos FROM m.g_scrnalias ;
  4556.    WHERE !DELETED() AND platform = m.g_toplatform AND objtype = c_ot20lbxobj ;
  4557.    ORDER BY vpos ;
  4558.    INTO ARRAY lines
  4559.  
  4560. m.linecount = _TALLY
  4561. m.last = 0
  4562. FOR m.scanloop = 1 TO lines[m.linecount]
  4563.    IF ASCAN(lines, m.scanloop) = 0
  4564.       APPEND BLANK
  4565.       REPLACE platform WITH m.g_toplatform
  4566.       REPLACE objtype WITH c_ot20lbxobj
  4567.       REPLACE vpos WITH m.lines
  4568.    ENDIF
  4569. ENDFOR
  4570. RETURN
  4571.  
  4572. *
  4573. * LinesBetween - Removes all the whitespace from the bottom of the detail
  4574. *      band and puts it in lines between.
  4575. *
  4576. *!*****************************************************************************
  4577. *!
  4578. *!      Procedure: LINESBETWEEN
  4579. *!
  4580. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  4581. *!
  4582. *!*****************************************************************************
  4583. PROCEDURE linesbetween
  4584. PRIVATE m.linecount, m.blanklines
  4585. COUNT TO m.linecount FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4586.  
  4587. LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 4
  4588. IF FOUND() AND m.linecount < HEIGHT
  4589.    m.blanklines = HEIGHT - m.linecount
  4590.    REPLACE HEIGHT WITH m.linecount
  4591.    LOCATE FOR platform = m.g_toplatform AND objtype = c_ot20label
  4592.    IF FOUND()
  4593.       REPLACE penblue WITH m.blanklines
  4594.    ENDIF
  4595. ENDIF
  4596.  
  4597. *
  4598. * labelBands - Adds the group records needed by a graphical label
  4599. *
  4600. *!*****************************************************************************
  4601. *!
  4602. *!      Procedure: LABELBANDS
  4603. *!
  4604. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4605. *!
  4606. *!*****************************************************************************
  4607. PROCEDURE labelbands
  4608. PRIVATE m.lbxheight, m.lbxwidth, m.lbxlinesbet
  4609.  
  4610. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otband AND objcode = 4
  4611. IF FOUND()
  4612.    m.lbxheight = HEIGHT
  4613. ENDIF
  4614.  
  4615. LOCATE FOR platform = m.g_fromplatform AND objtype = c_ot20label
  4616. IF FOUND()
  4617.    DO CASE
  4618.    CASE name = '3 1/2" x 15/16" x 1' AND penblue = 1 AND ;
  4619.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4620.       m.lbxheight = (15/16) * 10000
  4621.       m.lbxwidth = -1
  4622.       m.lbxlinesbet = m.lbxheight / 5
  4623.       
  4624.    CASE name = '3 1/2" x 15/16" x 2' AND penblue = 1 AND ;
  4625.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 2 AND hpos = 0 AND HEIGHT = 2
  4626.       m.lbxheight = (15/16) * 10000
  4627.       m.lbxwidth = (3 + (1/2)) * 10000
  4628.       m.lbxlinesbet = m.lbxheight / 5
  4629.       
  4630.    CASE name = '3 1/2" x 15/16" x 3' AND penblue = 1 AND ;
  4631.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 3 AND hpos = 0 AND HEIGHT = 2
  4632.       m.lbxheight = (15/16) * 10000
  4633.       m.lbxwidth = (3 + (1/2)) * 10000
  4634.       m.lbxlinesbet = m.lbxheight / 5
  4635.       
  4636.    CASE name = '3 2/10" x 11/12" x 3 (Cheshire)' AND penblue = 1 AND ;
  4637.          WIDTH = 32 AND m.lbxheight = 5 AND vpos = 3 AND hpos = 0 AND HEIGHT = 2
  4638.       m.lbxheight = (11/12) * 10000
  4639.       m.lbxwidth = (3 + (2/10)) * 10000
  4640.       m.lbxlinesbet = m.lbxheight / 5
  4641.       
  4642.    CASE name = '3" x 5 Rolodex' AND penblue = 4 AND ;
  4643.          WIDTH = 50 AND m.lbxheight = 14 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4644.       m.lbxheight = 5 * 10000
  4645.       m.lbxwidth = -1
  4646.       m.lbxlinesbet = 4 * (m.lbxheight / 14)
  4647.       
  4648.    CASE name = '4" x 1 7/16" x 1' AND penblue = 1 AND ;
  4649.          WIDTH = 40 AND m.lbxheight = 8 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4650.       m.lbxheight = (1 + (7/16)) * 10000
  4651.       m.lbxwidth = -1
  4652.       m.lbxlinesbet = m.lbxheight / 8
  4653.       
  4654.    CASE name = '4" x 2 1/4 Rolodex' AND penblue = 1 AND ;
  4655.          WIDTH = 40 AND m.lbxheight = 10 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4656.       m.lbxheight = (2 + (1/4)) * 10000
  4657.       m.lbxwidth = -1
  4658.       m.lbxlinesbet = m.lbxheight / 10
  4659.       
  4660.    CASE name = '6 1/2" x 3 5/8 Envelope' AND penblue = 8 AND ;
  4661.          WIDTH = 65 AND m.lbxheight = 14 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4662.       m.lbxheight = (3 + (5/8)) * 10000
  4663.       m.lbxwidth = -1
  4664.       m.lbxlinesbet = 8 * (m.lbxheight / 14)
  4665.       
  4666.    CASE name = '9 7/8" x 7 1/8 Envelope' AND penblue = 8 AND ;
  4667.          WIDTH = 78 AND m.lbxheight = 17 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4668.       m.lbxheight = (7 + (1/8)) * 10000
  4669.       m.lbxwidth = -1
  4670.       m.lbxlinesbet = 8 * (m.lbxheight / 17)
  4671.       
  4672.    OTHERWISE
  4673.       m.lbxheight = m.lbxheight * m.g_rptlinesize
  4674.       m.lbxwidth = IIF(vpos > 1, WIDTH * m.g_rptcharsize, -1)
  4675.       m.lbxlinesbet = penblue * m.g_rptlinesize
  4676.    ENDCASE
  4677. ELSE
  4678.    RETURN
  4679. ENDIF
  4680.  
  4681. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  4682. IF FOUND()
  4683.    REPLACE vpos WITH IIF(vpos > 1, vpos * m.g_rptlinesize, 1)
  4684.    REPLACE WIDTH WITH m.lbxwidth
  4685.    REPLACE hpos WITH hpos * m.g_rptcharsize      && Left margin
  4686.    REPLACE HEIGHT WITH HEIGHT * m.g_rptcharsize   && Spaces Between Columns
  4687. ENDIF
  4688.  
  4689. LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 4
  4690. IF FOUND()
  4691.    REPLACE HEIGHT WITH m.lbxheight + m.lbxlinesbet
  4692. ENDIF
  4693.  
  4694. *
  4695. * labelLines - Converts the character style label objects to graphical report objects
  4696. *
  4697. *!*****************************************************************************
  4698. *!
  4699. *!      Procedure: LABELLINES
  4700. *!
  4701. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4702. *!
  4703. *!          Calls: ADJFONT            (procedure in TRANSPRT.PRG)
  4704. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  4705. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4706. *!
  4707. *!*****************************************************************************
  4708. PROCEDURE labellines
  4709. PRIVATE m.bandstart, m.linecount, m.thermstep, m.lbxwidth, ;
  4710.    m.saverec, m.nextexpr, m.loop
  4711.  
  4712. COUNT TO m.thermstep FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4713. m.thermstep = 45 / m.thermstep
  4714. m.bandstart = 4166.667
  4715.  
  4716. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  4717. IF WIDTH != -1
  4718.    m.lbxwidth = WIDTH
  4719. ELSE
  4720.    LOCATE FOR platform = m.g_fromplatform AND objtype = c_ot20label
  4721.    m.lbxwidth = WIDTH * m.g_rptcharsize
  4722. ENDIF
  4723.  
  4724. m.linecount = 0
  4725.  
  4726. SCAN FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj AND !DELETED()
  4727.    REPLACE expr WITH ALLTRIM(expr)
  4728.    REPLACE objtype WITH c_otrepfld
  4729.    REPLACE objcode WITH 0
  4730.    REPLACE vpos WITH m.bandstart + (m.linecount * m.g_rptlinesize)
  4731.    REPLACE hpos WITH 0
  4732.    REPLACE HEIGHT WITH m.g_rptlinesize
  4733.    REPLACE WIDTH WITH m.lbxwidth
  4734.    REPLACE fillchar WITH "C"
  4735.    REPLACE FLOAT WITH .F.
  4736.    REPLACE STRETCH WITH .F.
  4737.    REPLACE spacing WITH 12
  4738.    REPLACE offset WITH 0
  4739.    REPLACE totaltype WITH 0
  4740.    REPLACE TOP WITH .T.
  4741.    REPLACE resettotal WITH 1
  4742.    REPLACE supalways WITH .T.
  4743.    REPLACE supovflow WITH .F.
  4744.    REPLACE suprpcol WITH 3
  4745.    REPLACE supgroup WITH 0
  4746.    REPLACE supvalchng WITH .F.
  4747.    
  4748.    DO adjfont
  4749.    DO adjcolor
  4750.    
  4751.    m.loop = (RIGHT(expr,1) = ";")
  4752.    DO WHILE m.loop
  4753.       m.saverec = RECNO()
  4754.       SKIP
  4755.       DO WHILE platform = m.g_toplatform AND objtype = c_ot20lbxobj AND DELETED()
  4756.          SKIP
  4757.       ENDDO
  4758.       IF platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4759.          DELETE
  4760.          m.nextexpr = expr
  4761.          GOTO RECORD (m.saverec)
  4762.          REPLACE expr WITH expr + m.nextexpr
  4763.          REPLACE HEIGHT WITH HEIGHT + m.g_rptlinesize
  4764.          m.loop = (RIGHT(expr,1) = ";")
  4765.       ELSE
  4766.          GOTO RECORD (m.saverec)
  4767.          m.loop = .F.
  4768.       ENDIF
  4769.    ENDDO
  4770.    
  4771.    m.linecount = m.linecount + 1
  4772.    
  4773.    m.g_mercury = m.g_mercury + m.thermstep
  4774.    DO updtherm WITH m.g_mercury
  4775. ENDSCAN
  4776.  
  4777. *
  4778. * calcpositions - Calculate each objects position as a percentage across
  4779. *            and down the window.
  4780. *
  4781. *!*****************************************************************************
  4782. *!
  4783. *!      Procedure: CALCPOSITIONS
  4784. *!
  4785. *!      Called by: ALLOTHERS          (procedure in TRANSPRT.PRG)
  4786. *!
  4787. *!*****************************************************************************
  4788. PROCEDURE calcpositions
  4789. PARAMETER m.index
  4790. PRIVATE m.record, m.vert, m.horiz, m.width, m.numothers, m.thermstep, m.i
  4791. *
  4792. * Search for the original platform records and establish the horizontal
  4793. * and vertical positioning percentages.
  4794. *
  4795.  
  4796. objectpos[m.index, 1] = hpos / m.g_windwidth
  4797. objectpos[m.index, 2] = vpos / m.g_windheight
  4798. objectpos[m.index, 3] = uniqueid
  4799. objectpos[m.index, 4] = objtype
  4800. objectpos[m.index, 5] = .F.                && right aligned with object above or below?
  4801. objectpos[m.index, 6] = hpos
  4802. objectpos[m.index, 7] = WIDTH
  4803. objectpos[m.index, 8] = spacing
  4804. objectpos[m.index, 9] = PICTURE
  4805.  
  4806. IF objtype = c_ottext
  4807.    m.record = RECNO()
  4808.    m.vert1 = vpos
  4809.    m.horiz = hpos
  4810.    m.endpos = hpos + WIDTH
  4811.    
  4812.    LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4813.       m.vert1 - 1 = vpos AND hpos + WIDTH = m.endpos
  4814.    IF FOUND()
  4815.       objectpos[m.index,5] = .T.
  4816.       DO WHILE FOUND()
  4817.          IF objectpos[m.index, 7] < WIDTH
  4818.             objectpos[m.index, 7] = WIDTH
  4819.          ENDIF
  4820.          m.vert = vpos
  4821.          LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4822.             m.vert - 1 = vpos AND hpos + WIDTH = m.endpos
  4823.       ENDDO
  4824.    ENDIF
  4825.    LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4826.       m.vert1 + 1 = vpos AND hpos + WIDTH = m.endpos
  4827.    
  4828.    IF FOUND()
  4829.       objectpos[m.index,5] = .T.
  4830.       DO WHILE FOUND()
  4831.          IF objectpos[m.index, 7] < WIDTH
  4832.             objectpos[m.index, 7] = WIDTH
  4833.          ENDIF
  4834.          m.vert = vpos
  4835.          LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4836.             m.vert + 1 = vpos AND hpos + WIDTH = m.endpos
  4837.       ENDDO
  4838.    ENDIF
  4839.    
  4840.    GOTO RECORD m.record
  4841.    IF objectpos[m.index, 5]
  4842.       objectpos[m.index, 6] = hpos + WIDTH - 1
  4843.       objectpos[m.index, 1] = (hpos + WIDTH) / m.g_windwidth
  4844.    ENDIF
  4845.    
  4846. ENDIF
  4847.  
  4848. *
  4849. * calcwindowdimensions - Calculate the needed Height and Width for the new window
  4850. *
  4851. *!*****************************************************************************
  4852. *!
  4853. *!      Procedure: CALCWINDOWDIMENSIONS
  4854. *!
  4855. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4856. *!
  4857. *!          Calls: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  4858. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  4859. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4860. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  4861. *!
  4862. *!        Indexes: UNIQUEID               (tag)
  4863. *!
  4864. *!*****************************************************************************
  4865. PROCEDURE calcwindowdimensions
  4866. PRIVATE m.i, m.curline, m.largestobj, m.lineheight, m.adjwindowwidth, m.thermstep
  4867.  
  4868. INDEX ON uniqueid + platform TAG uniqueid OF (m.g_tempindex) ADDITIVE
  4869.  
  4870. SELECT (m.g_fromobjonlyalias)
  4871. SET RELATION OFF INTO (m.g_scrnalias)
  4872. SET RELATION TO uniqueid+m.g_toplatform INTO (m.g_scrnalias) ADDITIVE
  4873. SELECT (m.g_scrnalias)
  4874.  
  4875. m.adjwindwidth = 0
  4876. DO findwiderobjects WITH m.adjwindwidth
  4877.  
  4878. =ASORT(objectpos,2)
  4879. STORE 0 TO m.curline, m.largestobj, m.lineheight, m.adjheight
  4880. m.thermstep = 10 / m.objindex
  4881.  
  4882. FOR m.i = 1 TO m.objindex
  4883.    
  4884.    IF objectpos[m.i,2] != m.curline
  4885.       m.adjheight = m.adjheight + m.lineheight
  4886.       STORE 0 TO m.lineheight, m.largestobj
  4887.       m.curline = objectpos[m.i,2]
  4888.    ENDIF
  4889.    
  4890.    IF m.largestobj != 3
  4891.       DO CASE
  4892.       CASE objectpos[m.i, 4] = c_ottxtbut AND m.largestobj < 3
  4893.          IF !horizbutton(objectpos[m.i, 9])
  4894.             m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4895.             m.lineheight = c_adjtbtn * m.numitems
  4896.          ELSE
  4897.             m.lineheight = c_adjtbtn
  4898.          ENDIF
  4899.          m.largestobj = 3
  4900.          
  4901.       CASE (objectpos[m.i, 4] = c_otradbut AND m.largestobj < 2) ;
  4902.             OR (objectpos[m.i, 4] = c_otchkbox AND m.largestobj < 2)
  4903.          IF objectpos[m.i, 4] = c_otradbut AND !horizbutton(objectpos[m.i, 9])
  4904.             m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4905.             m.lineheight = c_adjrbtn * m.numitems
  4906.          ELSE
  4907.             m.lineheight = c_adjrbtn
  4908.          ENDIF
  4909.          m.largestobj = 2
  4910.          
  4911.       CASE (objectpos[m.i, 4] = c_otlist AND m.largestobj < 1) ;
  4912.             OR (objectpos[m.i, 4] = c_otfield AND m.largestobj < 1)
  4913.          m.lineheight = c_adjlist
  4914.          m.largestobj = 1
  4915.          
  4916.       ENDCASE
  4917.    ENDIF
  4918.    m.g_mercury = m.g_mercury + m.thermstep
  4919.    DO updtherm WITH m.g_mercury
  4920.    
  4921. ENDFOR
  4922. m.adjheight = m.adjheight + m.lineheight
  4923. LOCATE FOR platform = m.g_toplatform AND objtype = 1
  4924. IF FOUND()
  4925.    REPLACE WIDTH WITH WIDTH + m.adjwindwidth
  4926.    DO repoobjects WITH HEIGHT + m.adjheight
  4927. ENDIF
  4928.  
  4929. RETURN
  4930.  
  4931. *
  4932. * findWiderObjects - Find objects which have changed in size
  4933. *
  4934. *!*****************************************************************************
  4935. *!
  4936. *!      Procedure: FINDWIDEROBJECTS
  4937. *!
  4938. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  4939. *!
  4940. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  4941. *!               : SGN()              (function  in TRANSPRT.PRG)
  4942. *!               : ADJHPOS            (procedure in TRANSPRT.PRG)
  4943. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4944. *!
  4945. *!*****************************************************************************
  4946. PROCEDURE findwiderobjects
  4947. PARAMETER m.adjwindowwidth
  4948. PRIVATE m.curcol, m.adjcol, m.i, m.rightalignflag, m.numitems, ;
  4949.    m.olduniqueid, m.oldwidth, m.buttonflag, m.newwidth, m.adjust, m.thermstep
  4950.  
  4951. m.thermstep = 10 / m.objindex
  4952.  
  4953. =ASORT(objectpos,6)   && sort on hpos
  4954. STORE 0 TO m.curcol, m.adjcol
  4955. m.rightalignflag = .F.
  4956.  
  4957. FOR m.i = 1 TO m.objindex
  4958.    * Start at the leftmost object
  4959.    IF objectpos[m.i,6] != m.curcol
  4960.       m.adjcol = 0
  4961.       m.rightalignflag = .F.
  4962.       m.curcol = objectpos[m.i,6]
  4963.    ENDIF
  4964.    
  4965.    DO CASE
  4966.    CASE objectpos[m.i, 4] = c_ottxtbut OR objectpos[m.i, 4] = c_otradbut
  4967.       * Count the objects in push buttons and radio buttons
  4968.       m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4969.       m.olduniqueid = objectpos[m.i, 3]
  4970.       
  4971.       IF horizbutton(objectpos[m.i, 9])
  4972.          m.oldwidth = (objectpos[m.i, 7] * m.numitems) + ;
  4973.             (objectpos[m.i, 8] * (m.numitems - 1))
  4974.          m.buttonflag = .T.
  4975.       ELSE
  4976.          m.buttonflag = .F.
  4977.          m.oldwidth = objectpos[m.i, 7]
  4978.       ENDIF
  4979.       
  4980.    OTHERWISE
  4981.       m.buttonflag = .F.
  4982.       m.oldwidth = objectpos[m.i, 7]
  4983.       m.olduniqueid = objectpos[m.i, 3]
  4984.       
  4985.    ENDCASE
  4986.    
  4987.    LOCATE FOR uniqueid = m.olduniqueid AND platform = m.g_toplatform
  4988.    IF FOUND()
  4989.       IF m.buttonflag
  4990.          m.newwidth = (WIDTH * m.numitems) + ;
  4991.             (spacing * (m.numitems - 1))
  4992.       ELSE
  4993.          m.newwidth = WIDTH
  4994.       ENDIF
  4995.       IF m.oldwidth != m.newwidth AND ;
  4996.             !(objtype = c_ottext ;
  4997.             AND ASC(SUBSTR(expr,2,1))>=179 ;
  4998.             AND ASC(SUBSTR(expr,2,1))<=218)
  4999.          m.adjust = m.newwidth - m.oldwidth
  5000.          IF ABS(m.adjust) > ABS(m.adjcol) OR sgn(m.adjust) <> sgn(m.adjcol)
  5001.             IF (!objectpos[m.i,5] OR !m.rightalignflag) AND m.adjust > 0
  5002.                * Move everything over
  5003.                DO adjhpos WITH m.adjust - m.adjcol, ;
  5004.                   IIF(objectpos[m.i,5], objectpos[m.i, 6], ;
  5005.                   objectpos[m.i, 6] + objectpos[m.i, 7] - 1)
  5006.                
  5007.                * Expand the window
  5008.                m.adjwindowwidth = m.adjwindowwidth + m.adjust - m.adjcol
  5009.                
  5010.                * AdjCol contains the cumulative adjustment
  5011.                m.adjcol = m.adjust
  5012.                
  5013.                IF objectpos[m.i, 5]
  5014.                   m.rightalignflag = .T.
  5015.                   REPLACE hpos WITH hpos + m.adjust - m.adjcol
  5016.                ENDIF
  5017.             ENDIF
  5018.          ENDIF
  5019.       ENDIF
  5020.    ENDIF
  5021.    m.g_mercury = m.g_mercury + m.thermstep
  5022.    DO updtherm WITH m.g_mercury
  5023. ENDFOR
  5024.  
  5025. *
  5026. * adjHpos - Adjust the horizontal position of objects across as other objects
  5027. *       become bigger or smaller.
  5028. *
  5029. *!*****************************************************************************
  5030. *!
  5031. *!      Procedure: ADJHPOS
  5032. *!
  5033. *!      Called by: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  5034. *!
  5035. *!*****************************************************************************
  5036. PROCEDURE adjhpos
  5037. PARAMETER m.adjustment, m.position
  5038.  
  5039. SELECT (m.g_fromobjonlyalias)
  5040. SCAN FOR platform = m.g_fromplatform AND hpos >= m.position
  5041.    REPLACE &g_scrnalias..hpos WITH &g_scrnalias..hpos + m.adjustment
  5042. ENDSCAN
  5043.  
  5044. * Stretch lines that begin before the wider object and end after it starts.
  5045. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND HEIGHT = 1 AND ;
  5046.       hpos < m.position AND hpos + WIDTH - 1 >= m.position
  5047.    REPLACE &g_scrnalias..width WITH &g_scrnalias..width + m.adjustment
  5048. ENDSCAN
  5049. SELECT (m.g_scrnalias)
  5050.  
  5051. *!*****************************************************************************
  5052. *!
  5053. *!       Function: SGN
  5054. *!
  5055. *!      Called by: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  5056. *!
  5057. *!*****************************************************************************
  5058. FUNCTION sgn
  5059. PARAMETER num
  5060. DO CASE
  5061. CASE num = 0
  5062.    RETURN 0
  5063. CASE num > 0
  5064.    RETURN 1
  5065. CASE num < 0
  5066.    RETURN -1
  5067. ENDCASE
  5068.  
  5069.  
  5070. *
  5071. * repoObjects - Reposition objects to the relative positions on the new window.
  5072. *      This procedure assumes that the array objectpos is sorted on rows ([m.i, 2]).
  5073. *
  5074. *!*****************************************************************************
  5075. *!
  5076. *!      Procedure: REPOOBJECTS
  5077. *!
  5078. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  5079. *!
  5080. *!          Calls: GETLASTOBJECTLINE()(function  in TRANSPRT.PRG)
  5081. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5082. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  5083. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  5084. *!
  5085. *!*****************************************************************************
  5086. PROCEDURE repoobjects
  5087. PARAMETER m.windheight
  5088. PRIVATE m.windwidth, m.thermstep, m.rightalign, m.saverec, ;
  5089.    m.adjust, m.buttonadjust, m.numrb
  5090.  
  5091. m.saverec = RECNO()
  5092. m.windwidth = WIDTH
  5093. m.thermstep = 10 / m.objindex
  5094. STORE 0 TO m.adjust, m.buttonadjust, m.numrb
  5095.  
  5096. FOR m.i = 1 TO m.objindex
  5097.    
  5098.    IF objectpos[m.i,2] != m.curline
  5099.       IF m.numrb > 0
  5100.          m.adjust = m.adjust + c_vradbtn
  5101.          m.numrb = m.numrb - 1
  5102.       ENDIF
  5103.       m.adjust = m.adjust + m.buttonadjust
  5104.       STORE 0 TO m.buttonadjust
  5105.       m.curline = objectpos[m.i,2]
  5106.    ENDIF
  5107.    
  5108.    LOCATE FOR platform = m.g_toplatform AND uniqueid = objectpos[m.i,3]
  5109.    IF FOUND()
  5110.       
  5111.       g_lastobjectline[1] = getlastobjectline(g_lastobjectline[1], ;
  5112.          m.windheight * objectpos[m.i, 2] + m.adjust)
  5113.       
  5114.       REPLACE vpos WITH m.windheight * objectpos[m.i, 2] + m.adjust
  5115.       
  5116.       IF objectpos[m.i,5]
  5117.          m.rightalign = (m.windwidth * objectpos[m.i,1]) - WIDTH
  5118.          REPLACE hpos WITH IIF(m.rightalign < 0, 0, m.rightalign)
  5119.       ENDIF
  5120.       
  5121.       DO CASE
  5122.       CASE objectpos[m.i,4] = c_otfield
  5123.          REPLACE hpos WITH hpos + c_adjfld
  5124.          
  5125.       CASE objectpos[m.i,4] = c_otlist
  5126.          REPLACE vpos WITH vpos + c_vlist
  5127.          REPLACE HEIGHT WITH HEIGHT - c_listht
  5128.          
  5129.       CASE objectpos[m.i,4] = c_ottxtbut
  5130.          IF horizbutton(objectpos[m.i, 9])
  5131.             m.buttonadjust = c_adjtbtn
  5132.          ENDIF
  5133.          
  5134.       CASE objectpos[m.i,4] = c_otradbut
  5135.          IF m.buttonadjust < c_adjrbtn
  5136.             m.buttonadjust = c_adjrbtn
  5137.          ENDIF
  5138.          REPLACE vpos WITH vpos - c_vradbtn
  5139.          
  5140.       CASE objectpos[m.i,4] = c_otchkbox
  5141.          REPLACE vpos WITH vpos - c_vchkbox
  5142.          
  5143.       CASE objectpos[m.i,4] = c_otpopup
  5144.          REPLACE vpos WITH MAX(vpos + c_vpopup,0)
  5145.          REPLACE hpos WITH MAX(hpos + c_hpopup,0)
  5146.          
  5147.       CASE objectpos[m.i,4] = c_otbox
  5148.          DO adjbox WITH m.adjust
  5149.       ENDCASE
  5150.       
  5151.    ENDIF
  5152.    m.g_mercury = m.g_mercury + m.thermstep
  5153.    DO updtherm WITH m.g_mercury
  5154. ENDFOR
  5155. GOTO RECORD m.saverec
  5156.  
  5157. *
  5158. * adjItemsInBoxes - Adjust the location of objects within boxes
  5159. *
  5160. *!*****************************************************************************
  5161. *!
  5162. *!      Procedure: ADJITEMSINBOXES
  5163. *!
  5164. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5165. *!
  5166. *!          Calls: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  5167. *!
  5168. *!*****************************************************************************
  5169. PROCEDURE adjitemsinboxes
  5170. PRIVATE m.subflag, m.emptybox, m.newlastline
  5171.  
  5172. DIMENSION boxdimension[4,2]
  5173. && 1 - Topmost
  5174. && 2 - Leftmost
  5175. && 3 - Bottommost
  5176. && 4 - Rightmost
  5177.  
  5178. SELECT (m.g_fromobjonlyalias)
  5179.  
  5180. SCAN FOR objtype = c_otbox AND HEIGHT != 1 AND WIDTH != 1
  5181.    STORE 999 TO boxdimension[1,1], boxdimension[2,1]
  5182.    STORE 0 TO boxdimension[3,1], boxdimension[4,1], boxdimension[4,2]
  5183.    STORE .F. TO m.subflag, m.emptybox, m.shrinkbox
  5184.    
  5185.    DO itemsinboxes WITH vpos, hpos, ;
  5186.       vpos + HEIGHT -1, hpos + WIDTH -1, m.emptybox, m.shrinkbox
  5187.    
  5188.    IF vpos + HEIGHT - 1 >= g_lastobjectline[1]
  5189.       m.newlastline = vpos + HEIGHT -1
  5190.       m.flag = .T.
  5191.       m.shrinkbox = .F.
  5192.    ELSE
  5193.       m.flag = .F.
  5194.    ENDIF
  5195.    
  5196.    boxdimension[1,1] = boxdimension[1,1] - vpos -.5
  5197.    boxdimension[2,1] = boxdimension[2,1] - hpos -.5
  5198.    boxdimension[3,1] = vpos + HEIGHT - 1 - boxdimension[3,1] - IIF(m.shrinkbox, .5 + c_vpopup, .5)
  5199.    boxdimension[4,1] = hpos + WIDTH - boxdimension[4,1] - 1.5
  5200.    
  5201.    SELECT (m.g_scrnalias)
  5202.    m.thisid = uniqueid
  5203.    LOCATE FOR uniqueid = m.thisid AND platform = m.g_toplatform
  5204.    IF FOUND() AND NOT m.emptybox
  5205.       REPLACE vpos WITH boxdimension[1,2] - boxdimension[1,1]
  5206.       REPLACE hpos WITH boxdimension[2,2] - boxdimension[2,1]
  5207.       REPLACE HEIGHT WITH boxdimension[3,2] - vpos + boxdimension[3,1]
  5208.       REPLACE WIDTH WITH boxdimension[4,2] - hpos + boxdimension[4,1]
  5209.       IF m.flag AND vpos + HEIGHT >= g_lastobjectline[2]
  5210.          g_lastobjectline[1] = m.newlastline
  5211.          g_lastobjectline[2] = vpos + HEIGHT
  5212.       ENDIF
  5213.    ENDIF
  5214.    
  5215.    SELECT (m.g_fromobjonlyalias)
  5216.    
  5217. ENDSCAN
  5218. SELECT (m.g_scrnalias)
  5219.  
  5220. *
  5221. * itemsInBoxes - Adjust objects which are within a box
  5222. *
  5223. *!*****************************************************************************
  5224. *!
  5225. *!      Procedure: ITEMSINBOXES
  5226. *!
  5227. *!      Called by: ADJITEMSINBOXES    (procedure in TRANSPRT.PRG)
  5228. *!
  5229. *!          Calls: FINDOTHERSONLINE() (function  in TRANSPRT.PRG)
  5230. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  5231. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5232. *!               : GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  5233. *!
  5234. *!           Uses: M.G_FROMOBJONLYALIA
  5235. *!
  5236. *!*****************************************************************************
  5237. PROCEDURE itemsinboxes
  5238. PARAMETER m.top, m.left, m.bottom, m.right, m.emptybox, m.shrinkbox
  5239. PRIVATE m.rec, m.wasapopup, m.oldbottom, m.newbottom, m.twidth
  5240.  
  5241. m.rec = RECNO()
  5242. m.g_boxeditemsalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  5243.  
  5244. SELECT vpos, hpos, HEIGHT, WIDTH, uniqueid, spacing, objtype, PICTURE, platform ;
  5245.    FROM (m.g_fromobjonlyalias) ;
  5246.    WHERE (vpos > m.top AND vpos < m.bottom) ;
  5247.    AND (hpos > m.left AND hpos < m.right) AND ;
  5248.    objtype <> c_otbox AND !(LEN(expr)=3 ;
  5249.    AND ASC(SUBSTR(CPTCOND(c_doscp,c_wincp,expr),2,1)) >= 179 ;
  5250.     AND ASC(SUBSTR(CPTCOND(c_doscp,c_wincp,expr),2,1)) <= 218);
  5251.    INTO CURSOR (m.g_boxeditemsalias)
  5252.  
  5253. STORE 0 TO m.oldbottom, m.newbottom
  5254. IF _TALLY > 0
  5255.    SET RELATION TO uniqueid+m.g_toplatform INTO (m.g_scrnalias) ADDITIVE
  5256.    LOCATE FOR .T.
  5257.    m.wasapopup = .F.
  5258.    
  5259.    DO WHILE NOT EOF()
  5260.       IF vpos < boxdimension[1,1] OR (m.wasapopup AND vpos = boxdimension[1,1])
  5261.          boxdimension[1,1] = vpos
  5262.          boxdimension[1,2] = &g_scrnalias..vpos
  5263.          IF objtype = c_otpopup
  5264.             m.wasapopup = .T.
  5265.          ELSE
  5266.             m.wasapopup = .F.
  5267.          ENDIF
  5268.       ENDIF
  5269.       
  5270.       IF hpos < boxdimension[2,1]
  5271.          boxdimension[2,1]= hpos
  5272.          boxdimension[2,2] = &g_scrnalias..hpos
  5273.       ENDIF
  5274.       
  5275.       DO CASE
  5276.       CASE objtype = c_ottext OR objtype = c_otchkbox ;
  5277.             OR (objtype = c_otfield AND HEIGHT = 1)
  5278.          IF vpos > m.oldbottom
  5279.             m.shrinkbox = .F.
  5280.             IF !findothersonline(vpos, @m.newbottom, @m.oldbottom, objtype)
  5281.                m.oldbottom = vpos + HEIGHT
  5282.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5283.             ENDIF
  5284.          ENDIF
  5285.          
  5286.          * Check TXTWIDTH for text strings
  5287.          IF m.g_tographic AND objtype = c_ottext
  5288.             m.twidth = TXTWIDTH(&g_scrnalias..expr,g_fontface,g_fontsize,whatstyle(g_boldstyle))
  5289.          ELSE
  5290.             m.twidth = &g_scrnalias..width
  5291.          ENDIF
  5292.          
  5293.          IF &g_scrnalias..hpos + m.twidth > boxdimension[4,2]
  5294.             boxdimension[4,1] = hpos + WIDTH - 1
  5295.             boxdimension[4,2] = &g_scrnalias..hpos + m.twidth
  5296.          ENDIF
  5297.          
  5298.       CASE objtype = c_otradbut OR objtype = c_ottxtbut OR objtype = c_otinvbut
  5299.          m.numitems = OCCURS(';',PICTURE) + 1
  5300.          
  5301.          IF horizbutton(PICTURE)
  5302.             
  5303.             IF vpos > m.oldbottom
  5304.                m.shrinkbox = .F.
  5305.                IF findothersonline(vpos, @m.newbottom, @m.oldbottom, ;
  5306.                      objtype)
  5307.                   IF objtype = c_ottxtbut
  5308.                      REPLACE &g_scrnalias..vpos WITH &g_scrnalias..vpos - 0.312
  5309.                   ENDIF
  5310.                ENDIF
  5311.                m.oldbottom = vpos + HEIGHT - 1
  5312.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5313.             ENDIF
  5314.             
  5315.             IF (hpos -1 + (WIDTH +spacing) * m.numitems - spacing) >= ;
  5316.                   boxdimension[4,1]
  5317.                boxdimension[4,1] = hpos - 1 + ;
  5318.                   getobjwidth(objtype, ;
  5319.                   PICTURE, ;
  5320.                   WIDTH, ;
  5321.                   spacing, ;
  5322.                   m.g_toplatform)
  5323.                boxdimension[4,2] = &g_scrnalias..hpos + ;
  5324.                   getobjwidth(&g_scrnalias..objtype, ;
  5325.                   &g_scrnalias..picture, ;
  5326.                   &g_scrnalias..width, ;
  5327.                   &g_scrnalias..spacing, ;
  5328.                   m.g_toplatform)
  5329.             ENDIF
  5330.             
  5331.          ELSE
  5332.             m.shrinkbox = .F.
  5333.             IF (vpos -1 + m.numitems + (spacing * (m.numitems -1))) >= ;
  5334.                   m.oldbottom
  5335.                m.oldbottom = vpos -1 + m.numitems + ;
  5336.                   (spacing * (m.numitems -1)) - 1
  5337.                m.newbottom = &g_scrnalias..vpos  + m.numitems + ;
  5338.                   (&g_scrnalias..spacing * (m.numitems -1))
  5339.             ENDIF
  5340.             
  5341.             IF hpos -1 + WIDTH >= boxdimension[4,1]
  5342.                boxdimension[4,1] = hpos -1 + WIDTH
  5343.                boxdimension[4,2] = &g_scrnalias..hpos  + ;
  5344.                   &g_scrnalias..width
  5345.             ENDIF
  5346.          ENDIF
  5347.          
  5348.       CASE objtype = c_otpopup
  5349.          IF vpos + HEIGHT - 2 > m.oldbottom
  5350.             IF !findothersonline(vpos + 1, @m.newbottom, @m.oldbottom, objtype)
  5351.                m.oldbottom = vpos + HEIGHT - 2
  5352.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5353.             ENDIF
  5354.             m.shrinkbox = IIF(m.bottom -1 = vpos + HEIGHT -1, .T., .F.)
  5355.          ENDIF
  5356.          
  5357.          IF hpos + WIDTH - 1 > boxdimension[4,1])
  5358.             boxdimension[4,1] = hpos + WIDTH - 1
  5359.             boxdimension[4,2] = &g_scrnalias..hpos + &g_scrnalias..width
  5360.          ENDIF
  5361.          
  5362.       CASE objtype = c_otfield OR ;
  5363.             objtype = c_otlist OR objtype = c_otbox
  5364.          
  5365.          IF vpos + HEIGHT - 1 > m.oldbottom
  5366.             m.shrinkbox = .F.
  5367.             IF !findothersonline(vpos, @m.newbottom, @m.oldbottom, objtype)
  5368.                m.oldbottom = vpos + HEIGHT - 1
  5369.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5370.             ENDIF
  5371.          ENDIF
  5372.          
  5373.          IF hpos + WIDTH - 1 > boxdimension[4,1])
  5374.             boxdimension[4,1] = hpos + WIDTH - 1
  5375.             boxdimension[4,2] = &g_scrnalias..hpos + &g_scrnalias..width
  5376.          ENDIF
  5377.          
  5378.       ENDCASE
  5379.       SKIP
  5380.    ENDDO
  5381.    
  5382.    m.emptybox = .F.
  5383.    boxdimension[3,1] = m.oldbottom
  5384.    boxdimension[3,2] = m.newbottom
  5385. ELSE
  5386.    m.emptybox = .T.
  5387. ENDIF
  5388.  
  5389. USE
  5390. SELECT (m.g_fromobjonlyalias)
  5391. GOTO RECORD m.rec
  5392.  
  5393. *
  5394. * findOthersOnLine - Find any other objects in the box and on the line with a text button
  5395. *
  5396. *!*****************************************************************************
  5397. *!
  5398. *!       Function: FINDOTHERSONLINE
  5399. *!
  5400. *!      Called by: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  5401. *!
  5402. *!*****************************************************************************
  5403. FUNCTION findothersonline
  5404. PARAMETER m.lineno, m.newbottom, m.oldbottom, m.curtype
  5405. PRIVATE m.saverec, m.prevtype, m.flag
  5406.  
  5407. m.prevtype = 0
  5408. m.flag = .F.
  5409. m.saverec = RECNO()
  5410. LOCATE FOR (objtype != c_otpopup AND vpos = m.lineno) OR ;
  5411.    (m.curtype != c_otpopup AND objtype = c_otpopup AND m.lineno = vpos + 1)
  5412.  
  5413. IF !FOUND()
  5414.    GOTO RECORD (m.saverec)
  5415.    RETURN m.flag
  5416. ENDIF
  5417.  
  5418. DO WHILE FOUND()
  5419.    DO CASE
  5420.    CASE objtype = c_ottxtbut
  5421.       IF m.curtype != objtype
  5422.          m.flag = .T.
  5423.          m.oldbottom = vpos + HEIGHT -1
  5424.          m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5425.          GOTO RECORD (m.saverec)
  5426.          RETURN m.flag
  5427.       ENDIF
  5428.       
  5429.    CASE objtype = c_otpopup
  5430.       m.flag = .T.
  5431.       m.oldbottom = vpos + HEIGHT - 2
  5432.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5433.       m.prevtype = c_otpopup
  5434.       
  5435.    CASE (objtype = c_otfield OR objtype = c_otlist OR objtype = c_otline) AND ;
  5436.          (m.prevtype != c_otpopup)
  5437.       m.flag = .T.
  5438.       m.oldbottom = vpos + HEIGHT - 1
  5439.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5440.       m.prevtype = objtype
  5441.       
  5442.    OTHERWISE
  5443.       m.flag = .T.
  5444.       m.oldbottom = vpos
  5445.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5446.       
  5447.    ENDCASE
  5448.    
  5449.    CONTINUE
  5450. ENDDO
  5451. GOTO RECORD (m.saverec)
  5452. RETURN m.flag
  5453.  
  5454. *
  5455. * StretchLinesToBorders - This procedure makes sure that any lines which stretched to the
  5456. *      edge of the from platform window will stretch to the edge of the to platform window.
  5457. *
  5458. *!*****************************************************************************
  5459. *!
  5460. *!      Procedure: ADJINVBTNS
  5461. *!
  5462. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5463. *!
  5464. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5465. *!               : ADJPOSTINV         (procedure in TRANSPRT.PRG)
  5466. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  5467. *!
  5468. *!*****************************************************************************
  5469. PROCEDURE adjinvbtns
  5470. PRIVATE m.saverec, m.loop, m.horizontal, m.btnid, m.objid, m.flag, m.thermstep, m.leftmost, ;
  5471.    m.label, m.btnvpos, m.btnhpos, m.btnwidth, m.btnheight, m.btnspacing, m.btncount, ;
  5472.    m.ybtn, m.vbtn, m.xbtn, m.hbtn, m.defwidth, m.defwidthindex, m.defheight, m.defheightindex, ;
  5473.    m.topmargin, m.bottommargin, m.leftmargin, m.rightmargin, m.adjustment, m.totadjust, m.newhpos
  5474.  
  5475. m.saverec = RECNO()
  5476. m.totadjust = 0
  5477. m.leftmost = 0
  5478.  
  5479. COUNT TO m.thermstep FOR platform = m.g_fromplatform AND objtype = c_otinvbut
  5480. m.thermstep = 5/m.thermstep
  5481.  
  5482. SCAN FOR platform = m.g_fromplatform AND objtype = c_otinvbut
  5483.    m.horizontal = horizbutton(PICTURE)
  5484.    m.btnvpos = vpos
  5485.    m.btnhpos = hpos
  5486.    m.btnheight = HEIGHT
  5487.    m.btnwidth = WIDTH
  5488.    m.btnspacing = spacing
  5489.    m.btncount = OCCURS(";", PICTURE) + 1
  5490.    m.btnid = uniqueid
  5491.    
  5492.    STORE 0 TO m.defwidth, m.defwidthindex, m.defheight, m.defheightindex
  5493.    
  5494.    * This array is used to keep track of the rectangle which bounds the objects which
  5495.    * lie on top of each invisible button in the set.
  5496.    *
  5497.    *   sizes[x,1] = Minimum row on the FROM platform.
  5498.    *   sizes[x,2] = Minimum colum on the FROM platform.
  5499.    *   sizes[x,3] = Maximum row on the FROM platform.
  5500.    *   sizes[x,4] = Maximum colum on the FROM platform.
  5501.    *   sizes[x,5] = Minimum row on the TO platform.
  5502.    *   sizes[x,6] = Minimum colum on the TO platform.
  5503.    *   sizes[x,7] = Maximum row on the TO platform.
  5504.    *   sizes[x,8] = Maximum colum on the TO platform.
  5505.    *   sizes[x,9] = Comma delimeted list of uniqueid's for objects positioned on
  5506.    *               the button face.
  5507.    DIMENSION sizes[m.btnCount,9]
  5508.    
  5509.    FOR m.loop = 1 TO m.btncount
  5510.       m.ybtn = IIF(m.horizontal, m.btnvpos, m.btnvpos + ((m.loop-1) * m.btnheight) + ((m.loop-1) * m.btnspacing))
  5511.       m.vbtn = m.ybtn + m.btnheight
  5512.       m.xbtn = IIF(m.horizontal, m.btnhpos + ((m.loop-1) * m.btnwidth) + ((m.loop-1) * m.btnspacing), m.btnhpos)
  5513.       m.hbtn = m.xbtn + m.btnwidth
  5514.       
  5515.       STORE 0 TO sizes[m.loop,3], sizes[m.loop,4], sizes[m.loop,7], sizes[m.loop,8]
  5516.       STORE 99999999 TO sizes[m.loop,1], sizes[m.loop,2], sizes[m.loop,5], sizes[m.loop,6]
  5517.       
  5518.       sizes[m.loop,9] = ""
  5519.       
  5520.       SCAN FOR platform = m.g_fromplatform AND (objtype = c_ottext OR objtype = c_otfield  OR ;
  5521.             objtype = c_otbox OR objtype = c_otline) AND ;
  5522.             vpos >= m.ybtn AND vpos+HEIGHT <= m.vbtn AND hpos >= m.xbtn AND hpos+WIDTH <= m.hbtn
  5523.          m.objid = uniqueid
  5524.          sizes[m.loop,1] = MIN(sizes[m.loop,1], vpos)
  5525.          sizes[m.loop,2] = MIN(sizes[m.loop,2], hpos)
  5526.          sizes[m.loop,3] = MAX(sizes[m.loop,3], vpos+HEIGHT)
  5527.          sizes[m.loop,4] = MAX(sizes[m.loop,4], hpos+WIDTH)
  5528.          sizes[m.loop,9] = sizes[m.loop,9] + ;
  5529.             IIF(LEN(sizes[m.loop,9]) = 0, uniqueid, ","+uniqueid)
  5530.          
  5531.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5532.          IF FOUND()
  5533.             sizes[m.loop,5] = MIN(sizes[m.loop,5], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5534.                vpos-c_adjbox, vpos))
  5535.             sizes[m.loop,6] = MIN(sizes[m.loop,6], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5536.                hpos-c_adjbox, hpos))
  5537.             sizes[m.loop,7] = MAX(sizes[m.loop,7], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5538.                vpos+HEIGHT+c_adjbox, vpos+HEIGHT))
  5539.             sizes[m.loop,8] = MAX(sizes[m.loop,8], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5540.                hpos+WIDTH+c_adjbox, hpos+WIDTH))
  5541.          ENDIF
  5542.          
  5543.          LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.objid
  5544.       ENDSCAN
  5545.       
  5546.       * The tallest button region will define where the button set gets
  5547.       * placed so we want to remember which region that was.
  5548.       IF (sizes[m.loop,7] - sizes[m.loop,5]) > m.defheight
  5549.          m.defheight      = sizes[m.loop,7] - sizes[m.loop,5]
  5550.          m.defheightindex = m.loop
  5551.          m.topmargin      = sizes[m.loop,1] - m.ybtn
  5552.          m.bottommargin   = m.vbtn - sizes[m.loop,3]
  5553.       ENDIF
  5554.       
  5555.       * The widest button region will define where the button set gets
  5556.       * placed so we want to remember which region that was.
  5557.       IF (sizes[m.loop,8] - sizes[m.loop,6]) > m.defwidth
  5558.          m.defwidth      = sizes[m.loop,8] - sizes[m.loop,6]
  5559.          m.defwidthindex = m.loop
  5560.          m.leftmargin    = sizes[m.loop,2] - m.xbtn
  5561.          m.rightmargin   = m.hbtn - sizes[m.loop,4]
  5562.       ENDIF
  5563.    ENDFOR
  5564.    
  5565.    IF m.defheightindex != 0 AND m.defwidthindex != 0
  5566.       LOCATE FOR platform = m.g_toplatform AND uniqueid = m.btnid
  5567.       IF FOUND()
  5568.          IF m.horizontal
  5569.             REPLACE vpos WITH sizes[m.defHeightIndex,5] - m.topmargin
  5570.          ELSE
  5571.             REPLACE hpos WITH sizes[m.defWidthIndex,6] - m.leftmargin
  5572.          ENDIF
  5573.          
  5574.          REPLACE HEIGHT WITH (sizes[m.defHeightIndex,7] - sizes[m.defHeightIndex,5]) + m.topmargin + m.bottommargin
  5575.          REPLACE WIDTH WITH (sizes[m.defWidthIndex,8] - sizes[m.defWidthIndex,6]) + m.leftmargin + m.rightmargin
  5576.       ENDIF
  5577.       
  5578.       IF m.horizontal AND WIDTH > m.btnwidth
  5579.          m.adjustment = WIDTH - m.btnwidth
  5580.          IF spacing > 1
  5581.             IF m.adjustment <= spacing-1
  5582.                REPLACE spacing WITH spacing - m.adjustment
  5583.             ELSE
  5584.                m.adjustment = m.adjustment - (spacing-1)
  5585.                REPLACE spacing WITH 1
  5586.                m.leftmost = MAX(m.leftmost, hpos + (m.btncount*WIDTH) + ((m.btncount-1)*spacing))
  5587.                
  5588.                m.totadjust = MAX(m.totadjust, m.btncount * m.adjustment)
  5589.                
  5590.                DO adjpostinv WITH vpos, vpos+HEIGHT, ;
  5591.                   m.btnhpos + (m.btncount*m.btnwidth) + ((m.btncount-1)*m.btnspacing), ;
  5592.                   m.btncount * m.adjustment
  5593.                
  5594.                FOR m.loop = 2 TO m.btncount
  5595.                   DO WHILE LEN(sizes[m.loop,9]) > 0
  5596.                      IF AT(",", sizes[m.loop,9]) != 0
  5597.                         m.label = LEFT(sizes[m.loop,9], AT(",", sizes[m.loop,9])-1)
  5598.                         sizes[m.loop,9] = SUBSTR(sizes[m.loop,9], AT(",", sizes[m.loop,9])+1)
  5599.                      ELSE
  5600.                         m.label = sizes[m.loop,9]
  5601.                         sizes[m.loop,9] = ""
  5602.                      ENDIF
  5603.                      
  5604.                      LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.label
  5605.                      IF FOUND()
  5606.                         m.newhpos = hpos + (m.adjustment * (m.loop-1))
  5607.                         LOCATE FOR platform = m.g_toplatform AND uniqueid = m.label
  5608.                         IF FOUND()
  5609.                            REPLACE hpos WITH IIF(objtype = c_otbox OR objtype = c_otline, ;
  5610.                               m.newhpos+c_adjbox, m.newhpos)
  5611.                         ENDIF
  5612.                      ENDIF
  5613.                   ENDDO
  5614.                ENDFOR
  5615.             ENDIF
  5616.          ENDIF
  5617.       ENDIF
  5618.    ENDIF
  5619.    
  5620.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  5621.    IF FOUND()
  5622.       IF m.totadjust > 0
  5623.          REPLACE WIDTH WITH WIDTH + m.totadjust
  5624.       ENDIF
  5625.       
  5626.       IF WIDTH < m.leftmost
  5627.          REPLACE WIDTH WITH m.leftmost + 1
  5628.       ENDIF
  5629.    ENDIF
  5630.    
  5631.    
  5632.    m.g_mercury = m.g_mercury + m.thermstep
  5633.    DO updtherm WITH m.g_mercury
  5634.    
  5635.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.btnid
  5636. ENDSCAN
  5637.  
  5638. IF m.saverec <= RECCOUNT()
  5639.    GOTO RECORD (m.saverec)
  5640. ELSE
  5641.    LOCATE FOR .F.
  5642. ENDIF
  5643.  
  5644. *
  5645. * adjPostInv - This procedure moves objects which lie to the right of a set of horizontal
  5646. *      invisible buttons so that they won't overlap.
  5647. *
  5648. *!*****************************************************************************
  5649. *!
  5650. *!      Procedure: ADJPOSTINV
  5651. *!
  5652. *!      Called by: ADJINVBTNS         (procedure in TRANSPRT.PRG)
  5653. *!
  5654. *!          Calls: FINDALIGNEND()     (function  in TRANSPRT.PRG)
  5655. *!
  5656. *!*****************************************************************************
  5657. PROCEDURE adjpostinv
  5658. PARAMETER m.ystart, m.yend, m.xstart, m.adjustment
  5659. PRIVATE m.saverec, m.saveid
  5660.  
  5661. m.saverec = RECNO()
  5662.  
  5663. m.ystart = findalignend(m.ystart, m.xstart, -1)
  5664. m.yend = findalignend(m.yend, m.xstart, 1)
  5665.  
  5666. SCAN FOR platform = m.g_fromplatform AND hpos >= m.xstart AND vpos >= m.ystart AND vpos <= m.yend AND ;
  5667.       (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5668.       objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5669.       objtype = c_otinvbut)
  5670.    m.saveid = uniqueid
  5671.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.saveid
  5672.    IF FOUND()
  5673.       REPLACE hpos WITH hpos + m.adjustment
  5674.    ENDIF
  5675.    
  5676.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.saveid
  5677. ENDSCAN
  5678.  
  5679. IF m.saverec <= RECCOUNT()
  5680.    GOTO RECORD m.saverec
  5681. ELSE
  5682.    LOCATE FOR .F.
  5683. ENDIF
  5684.  
  5685. *
  5686. * FindAlignEnd - Given a position to start with and a direction, this routine looks for the
  5687. *      last line where right aligned objects extend to from the starting position.
  5688. *
  5689. *!*****************************************************************************
  5690. *!
  5691. *!       Function: FINDALIGNEND
  5692. *!
  5693. *!      Called by: ADJPOSTINV         (procedure in TRANSPRT.PRG)
  5694. *!
  5695. *!*****************************************************************************
  5696. FUNCTION findalignend
  5697. PARAMETER m.ystart, m.xstart, m.increment
  5698. PRIVATE m.saverec, m.ytemp, m.xtemp, m.result
  5699.  
  5700. m.result = m.ystart
  5701.  
  5702. SCAN FOR platform = m.g_fromplatform AND hpos >= m.xstart AND vpos = m.ystart
  5703.    m.saverec = RECNO()
  5704.    
  5705.    m.ytemp = vpos + m.increment
  5706.    m.xtemp = hpos
  5707.    LOCATE FOR platform = m.g_fromplatform AND vpos = m.ytemp AND hpos = m.xtemp AND ;
  5708.       (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5709.       objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5710.       objtype = c_otinvbut)
  5711.    DO WHILE FOUND()
  5712.       m.result = IIF(m.increment < 0, MIN(m.result, m.ytemp), MAX(m.result, m.ytemp))
  5713.       m.ytemp = m.ytemp + m.increment
  5714.       LOCATE FOR platform = m.g_fromplatform AND vpos = m.ytemp AND hpos = m.xtemp AND ;
  5715.          (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5716.          objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5717.          objtype = c_otinvbut)
  5718.    ENDDO
  5719.    GOTO RECORD m.saverec
  5720. ENDSCAN
  5721.  
  5722. RETURN m.result
  5723.  
  5724. *
  5725. * StretchLinesToBorders - This procedure makes sure that any lines which stretched to the
  5726. *      edge of the from platform window will stretch to the edge of the to platform window.
  5727. *
  5728. *!*****************************************************************************
  5729. *!
  5730. *!      Procedure: STRETCHLINESTOBORDERS
  5731. *!
  5732. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5733. *!
  5734. *!*****************************************************************************
  5735. PROCEDURE stretchlinestoborders
  5736. PRIVATE m.saverec, m.objid, m.objrec, m.objwidth, m.fromheight, m.fromwidth
  5737.  
  5738. IF m.g_filetype = c_report OR m.g_filetype = c_label
  5739.    RETURN
  5740. ENDIF
  5741.  
  5742. m.saverec = RECNO()
  5743.  
  5744. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  5745. IF FOUND()
  5746.    IF BORDER = 0 OR STYLE = 0
  5747.       m.fromheight = HEIGHT
  5748.       m.fromwidth = WIDTH
  5749.    ELSE
  5750.       m.fromheight = HEIGHT - 2
  5751.       m.fromwidth = WIDTH - 2
  5752.    ENDIF
  5753.    
  5754.    SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND ;
  5755.          ((WIDTH = 1 AND vpos+HEIGHT = m.fromheight) OR (HEIGHT = 1 AND hpos+WIDTH = m.fromwidth))
  5756.       
  5757.       m.objrec = RECNO()
  5758.       m.objid = uniqueid
  5759.       m.objwidth = WIDTH
  5760.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  5761.       IF FOUND()
  5762.          m.toheight = HEIGHT
  5763.          m.towidth = WIDTH
  5764.          
  5765.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5766.          IF FOUND()
  5767.             IF m.objwidth = 1
  5768.                REPLACE HEIGHT WITH m.toheight-vpos
  5769.             ELSE
  5770.                REPLACE WIDTH WITH m.towidth-hpos
  5771.             ENDIF
  5772.          ENDIF
  5773.       ENDIF
  5774.       
  5775.       GOTO RECORD m.objrec
  5776.    ENDSCAN
  5777. ENDIF
  5778.  
  5779. IF m.saverec > RECCOUNT()
  5780.    LOCATE FOR .F.
  5781. ELSE
  5782.    GOTO RECORD m.saverec
  5783. ENDIF
  5784. RETURN
  5785.  
  5786. *
  5787. * JoinLines -This procedure examines each line to see where it meets other lines in the
  5788. *      from platform and constructs an array of these positons.  This array can then
  5789. *      be used to make the lines/boxes meet in the from platform.
  5790. *
  5791. *!*****************************************************************************
  5792. *!
  5793. *!      Procedure: JOINLINES
  5794. *!
  5795. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5796. *!
  5797. *!          Calls: UPDTHERM           (procedure in TRANSPRT.PRG)
  5798. *!               : JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  5799. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  5800. *!               : MEETBOXCHAR        (procedure in TRANSPRT.PRG)
  5801. *!               : ZAPBOXCHAR         (procedure in TRANSPRT.PRG)
  5802. *!               : REJOINBOXES        (procedure in TRANSPRT.PRG)
  5803. *!
  5804. *!*****************************************************************************
  5805. PROCEDURE joinlines
  5806. PRIVATE m.saverec, m.joincount, m.linerec, m.lineid, m.i, m.thermstep, ;
  5807.    m.objvpos, m.objhpos, m.objright, m.objbottom, m.objid, m.objrec, m.objcode, ;
  5808.    m.fromvpos, m.fromhpos, m.fromheight, m.fromwidth, m.fromend, m.fromcode, ;
  5809.    m.tovpos, m.tohpos, m.toheight, m.towidth, ;
  5810.    m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5811.  
  5812. DIMENSION joins[1,5]
  5813. && Joins[X,2] - toVpos
  5814. && Joins[X,3] - toHpos
  5815. && Joins[X,4] - Vpos match level
  5816. && Joins[X,5] - Hpos match level
  5817. m.joincount = 0
  5818. m.saverec = RECNO()
  5819.  
  5820. COUNT TO m.thermstep FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH=1 OR HEIGHT=1)
  5821. IF m.thermstep <> 0
  5822.    m.thermstep = 10 / m.thermstep
  5823. ELSE
  5824.    m.g_mercury = m.g_mercury + 10
  5825.    DO updtherm WITH m.g_mercury
  5826. ENDIF
  5827.  
  5828. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH=1 OR HEIGHT=1)
  5829.    m.fromvpos = vpos
  5830.    m.fromhpos = hpos
  5831.    m.fromheight = HEIGHT
  5832.    m.fromwidth = WIDTH
  5833.    m.fromcode = objcode
  5834.    m.lineid = uniqueid
  5835.    m.linerec = RECNO()
  5836.    
  5837.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.lineid
  5838.    IF FOUND()
  5839.       m.tovpos = vpos
  5840.       m.tohpos = hpos
  5841.       m.toheight = HEIGHT
  5842.       m.towidth = WIDTH
  5843.       
  5844.       SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.lineid
  5845.          IF m.fromheight = 1 AND HEIGHT <> 1 AND (m.fromvpos >= vpos AND m.fromvpos <= vpos+HEIGHT-1)
  5846.             m.fromend = m.fromhpos + m.fromwidth - 1
  5847.             
  5848.             ** Horizontal line which starts on a vertical line/box side.
  5849.             IF m.fromhpos = hpos OR m.fromhpos = hpos+WIDTH-1
  5850.                DO joinhorizontal WITH m.fromvpos, m.fromhpos, m.fromhpos, m.tovpos, m.toheight, m.fromcode
  5851.             ENDIF
  5852.             
  5853.             ** Horizontal line which ends on a vertical line/box side.
  5854.             IF m.fromend = hpos OR m.fromend = hpos+WIDTH-1
  5855.                DO joinhorizontal WITH m.fromvpos, m.fromend, m.fromend, m.tovpos, m.toheight, m.fromcode
  5856.             ENDIF
  5857.             
  5858.             ** Horizontal line which starts one to the right of a vertical line/box side
  5859.             IF m.fromhpos-1 = hpos OR m.fromhpos = hpos+WIDTH
  5860.                DO joinhorizontal WITH m.fromvpos, m.fromhpos-1, m.fromhpos, m.tovpos, m.toheight, m.fromcode
  5861.             ENDIF
  5862.             
  5863.             ** Horizontal line which ends one left of a vertical line/box side
  5864.             IF m.fromend+1 = hpos OR  m.fromend = hpos+WIDTH-2
  5865.                DO joinhorizontal WITH m.fromvpos, m.fromend+1, m.fromend, m.tovpos, m.toheight, m.fromcode
  5866.             ENDIF
  5867.          ENDIF
  5868.          
  5869.          IF m.fromwidth = 1 AND WIDTH <> 1 AND (m.fromhpos >= hpos AND m.fromhpos <= hpos+WIDTH-1)
  5870.             m.fromend = m.fromvpos + m.fromheight - 1
  5871.             
  5872.             ** Vertical line which starts on a horizontical line/box side.
  5873.             IF m.fromvpos = vpos OR m.fromvpos = vpos+HEIGHT-1
  5874.                DO joinvertical WITH m.fromvpos, m.fromvpos, m.fromhpos, m.tohpos, m.fromcode
  5875.             ENDIF
  5876.             
  5877.             ** Vertical line which ends on a horizontical line/box side.
  5878.             IF m.fromend = vpos OR m.fromend = vpos+HEIGHT-1
  5879.                DO joinvertical WITH m.fromend, m.fromend, m.fromhpos, m.tohpos, m.fromcode
  5880.             ENDIF
  5881.             
  5882.             ** Vertical line which starts one below a horizontal line/box side
  5883.             IF m.fromvpos-1 = vpos OR m.fromvpos = vpos+HEIGHT
  5884.                DO joinvertical WITH m.fromvpos-1, m.fromvpos, m.fromhpos, m.tohpos, m.fromcode
  5885.             ENDIF
  5886.             
  5887.             ** Vertical line which ends one above a horizontal line/box side
  5888.             IF m.fromend+1 = vpos OR m.fromend = vpos+HEIGHT-2
  5889.                DO joinvertical WITH m.fromend+1, m.fromend, m.fromhpos, m.tohpos, m.fromcode
  5890.             ENDIF
  5891.          ENDIF
  5892.       ENDSCAN
  5893.    ENDIF
  5894.    
  5895.    m.g_mercury = m.g_mercury + m.thermstep
  5896.    DO updtherm WITH m.g_mercury
  5897.    
  5898.    GOTO RECORD m.linerec
  5899. ENDSCAN
  5900.  
  5901. DO meetboxchar
  5902. DO zapboxchar
  5903.  
  5904. m.thermstep = 10/m.joincount
  5905. FOR m.i = 1 TO m.joincount
  5906.    DO rejoinboxes WITH VAL(LEFT(joins[m.i, 1], 3)), VAL(RIGHT(joins[m.i, 1], 3)), joins[m.i, 2], joins[m.i, 3]
  5907.    
  5908.    m.g_mercury = m.g_mercury + m.thermstep
  5909.    DO updtherm WITH m.g_mercury
  5910. ENDFOR
  5911.  
  5912. IF m.saverec > RECCOUNT()
  5913.    LOCATE FOR .F.
  5914. ELSE
  5915.    GOTO RECORD m.saverec
  5916. ENDIF
  5917. RETURN
  5918.  
  5919. *
  5920. * joinHorizontal - This procedure adds a join for a horizontal line which has been determined to
  5921. *               intersect something vertical.
  5922. *
  5923. *!*****************************************************************************
  5924. *!
  5925. *!      Procedure: JOINHORIZONTAL
  5926. *!
  5927. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  5928. *!
  5929. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  5930. *!               : ADDJOIN            (procedure in TRANSPRT.PRG)
  5931. *!
  5932. *!*****************************************************************************
  5933. PROCEDURE joinhorizontal
  5934. PARAMETER m.fromvpos, m.oldhpos1, m.oldhpos2, m.tovpos, m.tothickness, m.fromcode
  5935. PRIVATE m.objvpos, m.objhpos, m.objright, m.objbottom, m.objcode, m.objid, m.objrec
  5936.  
  5937. m.objvpos = vpos
  5938. m.objhpos = hpos
  5939. m.objright = hpos + WIDTH - 1
  5940. m.objbottom = vpos + HEIGHT - 1
  5941. m.objcode = objcode
  5942. m.objid = uniqueid
  5943. m.objrec = RECNO()
  5944.  
  5945. LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5946. IF FOUND()
  5947.    DO CASE
  5948.    CASE m.fromvpos = m.objvpos OR m.fromvpos = m.objbottom
  5949.       IF objtype = c_otline
  5950.          m.joinvpos = m.tovpos - c_adjbox + (m.tothickness/2)
  5951.          STORE 2 TO m.vlevel, m.hlevel
  5952.       ELSE
  5953.          IF m.fromvpos = m.objvpos
  5954.             m.joinvpos = vpos - c_adjbox + (getlinewidth(m.objcode, .T.)/2)
  5955.          ELSE
  5956.             m.joinvpos = vpos+HEIGHT - c_adjbox - (getlinewidth(m.objcode, .T.)/2)
  5957.          ENDIF
  5958.          STORE 4 TO m.vlevel, m.hlevel
  5959.       ENDIF
  5960.       
  5961.    OTHERWISE
  5962.       m.joinvpos = m.tovpos - c_adjbox + (getlinewidth(m.fromcode, .T.)/2)
  5963.       m.vlevel = 0
  5964.       m.hlevel = IIF(objtype = c_otline, 1, 3)
  5965.    ENDCASE
  5966.    
  5967.    IF m.oldhpos1 = m.objhpos OR objtype = c_otline
  5968.       m.joinhpos = hpos - c_adjbox + (getlinewidth(m.objcode, .F.)/2)
  5969.    ELSE
  5970.       m.joinhpos = hpos+WIDTH - c_adjbox - (getlinewidth(m.objcode, .F.)/2)
  5971.    ENDIF
  5972.    
  5973.    DO addjoin WITH m.fromvpos, m.oldhpos1, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5974.    IF m.oldhpos1 <> m.oldhpos2
  5975.       DO addjoin WITH m.fromvpos, m.oldhpos2, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5976.    ENDIF
  5977. ENDIF
  5978.  
  5979. GOTO RECORD m.objrec
  5980. RETURN
  5981.  
  5982. *
  5983. * joinVertical - This procedure adds a join for a vertical line which has been determined to
  5984. *               intersect something horizontal.
  5985. *
  5986. *!*****************************************************************************
  5987. *!
  5988. *!      Procedure: JOINVERTICAL
  5989. *!
  5990. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  5991. *!
  5992. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  5993. *!               : ADDJOIN            (procedure in TRANSPRT.PRG)
  5994. *!
  5995. *!*****************************************************************************
  5996. PROCEDURE joinvertical
  5997. PARAMETER m.oldvpos1, m.oldvpos2, m.fromhpos, m.tohpos, m.fromcode
  5998. PRIVATE m.objvpos, m.objhpos, m.objright, m.objbottom, m.objcode, m.objid, m.objrec
  5999.  
  6000. m.objvpos = vpos
  6001. m.objhpos = hpos
  6002. m.objright = hpos + WIDTH - 1
  6003. m.objbottom = vpos + HEIGHT - 1
  6004. m.objcode = objcode
  6005. m.objid = uniqueid
  6006. m.objrec = RECNO()
  6007.  
  6008. LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6009. IF FOUND()
  6010.    DO CASE
  6011.    CASE m.fromhpos = m.objhpos OR m.fromhpos = m.objright
  6012.       IF objtype = c_otline
  6013.          m.joinhpos = IIF(m.fromhpos = m.objhpos, hpos, hpos+WIDTH-1)
  6014.          STORE 2 TO m.vlevel, m.hlevel
  6015.       ELSE
  6016.          IF m.fromhpos = m.objhpos
  6017.             m.joinhpos = hpos - c_adjbox + (getlinewidth(m.objcode, .F.)/2)
  6018.          ELSE
  6019.             m.joinhpos = hpos+WIDTH - c_adjbox - (getlinewidth(m.objcode, .F.)/2)
  6020.          ENDIF
  6021.          STORE 4 TO m.vlevel, m.hlevel
  6022.       ENDIF
  6023.       
  6024.    OTHERWISE
  6025.       m.joinhpos = m.tohpos - c_adjbox + (getlinewidth(m.fromcode, .F.)/2)
  6026.       m.vlevel = IIF(objtype = c_otline, 1, 3)
  6027.       m.hlevel = 0
  6028.    ENDCASE
  6029.    
  6030.    IF m.oldvpos1 = m.objvpos OR objtype = c_otline
  6031.       m.joinvpos = vpos - c_adjbox + (getlinewidth(m.objcode, .T.)/2)
  6032.    ELSE
  6033.       m.joinvpos = vpos+HEIGHT - c_adjbox - (getlinewidth(m.objcode, .T.)/2)
  6034.    ENDIF
  6035.    
  6036.    DO addjoin WITH m.oldvpos1, m.fromhpos, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  6037.    IF m.oldvpos1 <> m.oldvpos2
  6038.       DO addjoin WITH m.oldvpos2, m.fromhpos, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  6039.    ENDIF
  6040. ENDIF
  6041. GOTO RECORD m.objrec
  6042.  
  6043. *
  6044. * MeetBoxChar - This procedure looks at suspected box join characters and adds a join position for each
  6045. *            line which ends one short of it.
  6046. *
  6047. *!*****************************************************************************
  6048. *!
  6049. *!      Procedure: MEETBOXCHAR
  6050. *!
  6051. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6052. *!
  6053. *!          Calls: ADDJOIN            (procedure in TRANSPRT.PRG)
  6054. *!
  6055. *!*****************************************************************************
  6056. PROCEDURE meetboxchar
  6057. PRIVATE m.saverec, m.fromvpos, m.fromhpos, m.tovpos, m.tohpos, m.joinrec, m.joinid
  6058. m.saverec = RECNO()
  6059.  
  6060. SCAN FOR platform = m.g_fromplatform AND objtype = c_ottext AND LEN(expr)=3 AND ;
  6061.       ASC(SUBSTR(CPTCOND(c_doscp,c_wincp,expr),2,1)) >= 179 ;
  6062.       AND ASC(SUBSTR(CPTCOND(c_doscp,c_wincp,expr),2,1)) <= 218
  6063.    m.fromvpos = vpos
  6064.    m.fromhpos = hpos
  6065.    m.joinid = uniqueid
  6066.    m.joinrec = RECNO()
  6067.    
  6068.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.joinid
  6069.    IF FOUND()
  6070.       m.tovpos = vpos
  6071.       m.tohpos = hpos
  6072.       
  6073.       SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH = 1 OR HEIGHT = 1)
  6074.          IF WIDTH = 1 AND hpos = m.fromhpos
  6075.             DO CASE
  6076.             CASE vpos = m.fromvpos + 1
  6077.                DO addjoin WITH vpos, hpos, m.tovpos, m.tohpos, 2, 2
  6078.                
  6079.             CASE vpos+HEIGHT = m.fromvpos
  6080.                DO addjoin WITH vpos+HEIGHT-1, hpos, m.tovpos, m.tohpos, 2, 2
  6081.             ENDCASE
  6082.          ENDIF
  6083.          
  6084.          IF HEIGHT = 1 AND vpos = m.fromvpos
  6085.             DO CASE
  6086.             CASE hpos = m.fromhpos + 1
  6087.                DO addjoin WITH vpos, hpos, m.tovpos, m.tohpos, 2, 2
  6088.                
  6089.             CASE hpos+WIDTH = m.fromhpos
  6090.                DO addjoin WITH vpos, hpos+WIDTH-1, m.tovpos, m.tohpos, 2, 2
  6091.             ENDCASE
  6092.          ENDIF
  6093.       ENDSCAN
  6094.    ENDIF
  6095.    
  6096.    GOTO RECORD m.joinrec
  6097. ENDSCAN
  6098.  
  6099. IF m.saverec > RECCOUNT()
  6100.    LOCATE FOR .F.
  6101. ELSE
  6102.    GOTO RECORD m.saverec
  6103. ENDIF
  6104. RETURN
  6105.  
  6106. *
  6107. * zapBoxChar - This procedure looks for any text record which is probably a box join
  6108. *            character and replaces it with a transparent space.
  6109. *
  6110. *!*****************************************************************************
  6111. *!
  6112. *!      Procedure: ZAPBOXCHAR
  6113. *!
  6114. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6115. *!
  6116. *!*****************************************************************************
  6117. PROCEDURE zapboxchar
  6118. PRIVATE m.recno, m.fromvpos, m.fromhpos
  6119. m.recno = RECNO()
  6120.  
  6121. * See if we can find any single text box/line joining characters in a group.
  6122. SCAN FOR platform = m.g_toplatform AND objtype = c_ottext ;
  6123.       AND boxjoin(objtype,recno(),platform)
  6124.    REPLACE expr WITH '" "'
  6125.    REPLACE mode WITH 1
  6126. ENDSCAN
  6127.  
  6128. IF m.recno > RECCOUNT()
  6129.    GOTO RECCOUNT()
  6130.    SKIP
  6131. ELSE
  6132.    GOTO RECORD m.recno
  6133. ENDIF
  6134.  
  6135. *
  6136. * AddJoin - This routine adds the position for a join character, or modifies a previous join
  6137. *      at the same from position if it has a lower priority.
  6138. *
  6139. *!*****************************************************************************
  6140. *!
  6141. *!      Procedure: ADDJOIN
  6142. *!
  6143. *!      Called by: JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  6144. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  6145. *!               : MEETBOXCHAR        (procedure in TRANSPRT.PRG)
  6146. *!
  6147. *!*****************************************************************************
  6148. PROCEDURE addjoin
  6149. PARAMETER m.fromvpos, m.fromhpos, m.tovpos, m.tohpos, m.vmatch, m.hmatch
  6150. PRIVATE m.row, m.key
  6151. m.key = STR(m.fromvpos, 3)+STR(m.fromhpos, 3)
  6152. m.row = ASCAN(joins, m.key)
  6153. IF m.row = 0
  6154.    m.joincount = m.joincount + 1
  6155.    DIMENSION joins[m.joinCount, 5]
  6156.    joins[m.joinCount, 1] = m.key
  6157.    joins[m.joinCount, 2] = m.tovpos
  6158.    joins[m.JoinCount, 3] = m.tohpos
  6159.    joins[m.JoinCount, 4] = m.vmatch
  6160.    joins[m.JoinCount, 5] = m.hmatch
  6161. ELSE
  6162.    m.row = ASUBSCRIPT(joins, m.row, 1)
  6163.    
  6164.    IF m.vmatch > joins[m.row, 4]
  6165.       joins[m.row, 2] = m.tovpos
  6166.       joins[m.row, 4] = m.vmatch
  6167.    ENDIF
  6168.    
  6169.    IF m.hmatch > joins[m.JoinCount, 5]
  6170.       joins[m.row, 3] = m.tohpos
  6171.       joins[m.row, 5] = m.hmatch
  6172.    ENDIF
  6173. ENDIF
  6174.  
  6175. RETURN
  6176.  
  6177. *
  6178. * RejoinBoxes - This routine stretches lines so that they meet the join characters
  6179. *      they did in the from platform.
  6180. *
  6181. *!*****************************************************************************
  6182. *!
  6183. *!      Procedure: REJOINBOXES
  6184. *!
  6185. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6186. *!
  6187. *!          Calls: JOINLINEWIDTH()    (function  in TRANSPRT.PRG)
  6188. *!               : GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  6189. *!
  6190. *!*****************************************************************************
  6191. PROCEDURE rejoinboxes
  6192. PARAMETER m.fromvpos, m.fromhpos, m.tovpos, m.tohpos
  6193. PRIVATE m.objectcode, m.objend, m.saverecno, m.objid, m.joinwidth, m.objrec
  6194.  
  6195. m.saverecno = RECNO()
  6196.  
  6197. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox
  6198.    IF WIDTH = 1 OR HEIGHT = 1
  6199.       m.objid = uniqueid
  6200.       m.objectcode = objcode
  6201.       m.objrec = RECNO()
  6202.       
  6203.       DO CASE
  6204.          ** A Vertical line which starts at a join character
  6205.       CASE m.fromvpos = vpos AND m.fromhpos = hpos AND WIDTH = 1
  6206.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6207.          IF FOUND()
  6208.             m.objend = vpos + HEIGHT
  6209.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .T., m.objid)
  6210.             REPLACE vpos WITH m.tovpos + c_adjbox - (m.joinwidth/2)
  6211.             REPLACE HEIGHT WITH m.objend - vpos
  6212.             REPLACE hpos WITH m.tohpos + c_adjbox - (getlinewidth(m.objectcode, .F.)/2)
  6213.          ENDIF
  6214.          
  6215.          ** A Horizontal line which starts at a join character
  6216.       CASE m.fromvpos = vpos AND m.fromhpos = hpos AND HEIGHT = 1
  6217.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6218.          IF FOUND()
  6219.             m.objend = hpos + WIDTH
  6220.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .F., m.objid)
  6221.             REPLACE hpos WITH m.tohpos + c_adjbox - (m.joinwidth/2)
  6222.             REPLACE WIDTH WITH m.objend - hpos
  6223.             REPLACE vpos WITH m.tovpos + c_adjbox - (getlinewidth(m.objectcode, .T.)/2)
  6224.          ENDIF
  6225.          
  6226.          ** A Vertical line which ends at a join character
  6227.       CASE m.fromvpos = (vpos+HEIGHT-1) AND m.fromhpos = hpos AND WIDTH = 1
  6228.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6229.          IF FOUND()
  6230.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .T., m.objid)
  6231.             REPLACE HEIGHT WITH (m.tovpos + c_adjbox + (m.joinwidth/2)) - vpos
  6232.             REPLACE hpos WITH m.tohpos + c_adjbox - (getlinewidth(m.objectcode, .F.)/2)
  6233.          ENDIF
  6234.          
  6235.          ** A Horizontal line which ends at a join character
  6236.       CASE m.fromhpos = (hpos+WIDTH-1) AND m.fromvpos = vpos AND HEIGHT = 1
  6237.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6238.          IF FOUND()
  6239.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .F., m.objid)
  6240.             REPLACE WIDTH WITH (m.tohpos + c_adjbox + (m.joinwidth/2)) - hpos
  6241.             REPLACE vpos WITH m.tovpos + c_adjbox - (getlinewidth(m.objectcode, .T.)/2)
  6242.          ENDIF
  6243.       ENDCASE
  6244.       
  6245.       GOTO RECORD m.objrec
  6246.    ENDIF
  6247. ENDSCAN
  6248.  
  6249. IF m.saverecno > RECCOUNT()
  6250.    LOCATE FOR .F.
  6251. ELSE
  6252.    GOTO RECORD m.saverecno
  6253. ENDIF
  6254.  
  6255. RETURN
  6256.  
  6257. *
  6258. * JoinLineWidth - Looks for the thickest line or box which goes through a given point and
  6259. *      Returns either its horizontal or vertical Width.
  6260. *
  6261. *!*****************************************************************************
  6262. *!
  6263. *!       Function: JOINLINEWIDTH
  6264. *!
  6265. *!      Called by: REJOINBOXES        (procedure in TRANSPRT.PRG)
  6266. *!
  6267. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  6268. *!
  6269. *!*****************************************************************************
  6270. FUNCTION joinlinewidth
  6271. PARAMETERS m.joinvpos, m.joinhpos, m.horizontal, m.skipid
  6272. PRIVATE m.i, m.saverecno, m.thickness
  6273. m.saverecno = RECNO()
  6274. m.thickness = 0
  6275.  
  6276. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.skipid
  6277.    DO CASE
  6278.    CASE m.horizontal AND WIDTH <> 1 AND ;
  6279.          (ABS(m.joinvpos - vpos) <= 1 OR ABS(m.joinvpos - (vpos+HEIGHT-1)) <= 1) AND ;
  6280.          (m.joinhpos >= hpos AND m.joinhpos <= (hpos+WIDTH-1))
  6281.       m.thickness = MAX(getlinewidth(objcode, .T.), m.thickness)
  6282.       
  6283.    CASE !m.horizontal AND HEIGHT <> 1 AND ;
  6284.          (ABS(m.joinhpos - hpos) <= 1 OR ABS(m.joinhpos - (hpos+WIDTH-1)) <= 1) AND ;
  6285.          (m.joinvpos >= vpos AND m.joinvpos <= (vpos+WIDTH-1))
  6286.       m.thickness = MAX(getlinewidth(objcode, .F.), m.thickness)
  6287.    ENDCASE
  6288. ENDSCAN
  6289.  
  6290. IF m.thickness = 0
  6291.    SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.skipid
  6292.       IF (HEIGHT = 1 OR WIDTH = 1) AND ;
  6293.             (ABS(m.joinvpos - vpos) <= 1 OR ABS(m.joinvpos - (vpos+HEIGHT-1)) <= 1) AND ;
  6294.             (ABS(m.joinhpos - hpos) <= 1 OR ABS(m.joinhpos - (hpos+WIDTH-1)) <= 1)
  6295.          m.thickness = MAX(getlinewidth(objcode, m.horizontal), m.thickness)
  6296.       ENDIF
  6297.    ENDSCAN
  6298. ENDIF
  6299.  
  6300. GOTO RECORD m.saverecno
  6301. RETURN m.thickness
  6302.  
  6303. *
  6304. * getLastObjectLine - Determine if this object is the lowest object.
  6305. *
  6306. *!*****************************************************************************
  6307. *!
  6308. *!       Function: GETLASTOBJECTLINE
  6309. *!
  6310. *!      Called by: REPOOBJECTS        (procedure in TRANSPRT.PRG)
  6311. *!
  6312. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  6313. *!
  6314. *!*****************************************************************************
  6315. FUNCTION getlastobjectline
  6316. PARAMETER m.currentlastline, m.newposition
  6317. PRIVATE m.numitems, m.max
  6318.  
  6319. DO CASE
  6320. CASE objtype = c_ottext OR objtype = c_otchkbox
  6321.    IF vpos > m.currentlastline
  6322.       g_lastobjectline[2] = m.newposition + HEIGHT
  6323.       RETURN vpos + HEIGHT
  6324.    ELSE
  6325.       RETURN m.currentlastline
  6326.    ENDIF
  6327.    
  6328. CASE objtype = c_otradbut OR objtype = c_ottxtbut OR objtype = c_otinvbut
  6329.    IF horizbutton(PICTURE)
  6330.       IF vpos + HEIGHT >= m.currentlastline
  6331.          g_lastobjectline[2] = m.newposition + HEIGHT
  6332.          RETURN vpos
  6333.       ELSE
  6334.          RETURN m.currentlastline
  6335.       ENDIF
  6336.    ELSE
  6337.       m.numitems = OCCURS(';',PICTURE)
  6338.       m.max = vpos + m.numitems + (m.numitems * spacing)
  6339.       IF m.max >= m.currentlastline AND (objtype = c_ottxtbut OR objtype = c_otinvbut) OR ;
  6340.             m.max > m.currentlastline AND objtype = c_otradbut
  6341.          g_lastobjectline[2] = m.newposition + (HEIGHT * (m.numitems + 1)) + ;
  6342.             (spacing * m.numitems)
  6343.          RETURN m.max + 1
  6344.       ELSE
  6345.          RETURN m.currentlastline
  6346.       ENDIF
  6347.    ENDIF
  6348.    
  6349. CASE objtype = c_otpopup
  6350.    IF vpos + 2 > m.currentlastline
  6351.       g_lastobjectline[2] = m.newposition + 2
  6352.       RETURN vpos +1
  6353.    ELSE
  6354.       RETURN m.currentlastline
  6355.    ENDIF
  6356.    
  6357. CASE objtype = c_otfield
  6358.    IF vpos + HEIGHT -1 > m.currentlastline
  6359.       g_lastobjectline[2] = m.newposition + HEIGHT
  6360.       RETURN vpos + HEIGHT -1
  6361.    ELSE
  6362.       RETURN m.currentlastline
  6363.    ENDIF
  6364.    
  6365. CASE objtype = c_otlist OR ;
  6366.       objtype = c_otbox OR objtype = c_otline
  6367.    IF vpos + HEIGHT - 1 > m.currentlastline
  6368.       g_lastobjectline[2] = m.newposition + HEIGHT
  6369.       RETURN vpos + HEIGHT - 1
  6370.    ELSE
  6371.       RETURN m.currentlastline
  6372.    ENDIF
  6373.    
  6374. OTHERWISE
  6375.    RETURN m.currentlastline
  6376.    
  6377. ENDCASE
  6378.  
  6379. *
  6380. * adjobjcode - Adjust object code field for Objtype = 1.
  6381. *
  6382. *!*****************************************************************************
  6383. *!
  6384. *!      Procedure: ADJOBJCODE
  6385. *!
  6386. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6387. *!
  6388. *!*****************************************************************************
  6389. PROCEDURE adjobjcode
  6390. * Stuff the right version code into the object code field for the header record
  6391. DO CASE
  6392. CASE objtype = c_otheader OR (m.g_filetype=c_label AND objtype = c_ot20label)
  6393.    REPLACE objcode WITH IIF(m.g_filetype=c_screen,c_25scx,c_25frx)
  6394. CASE objtype = c_otgroup
  6395.    REPLACE objcode WITH 0
  6396. ENDCASE
  6397.  
  6398. *!*****************************************************************************
  6399. *!
  6400. *!      Procedure: GETWINDFONT
  6401. *!
  6402. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  6403. *!
  6404. *!          Calls: WHATSTYLE()        (function  in TRANSPRT.PRG)
  6405. *!
  6406. *!*****************************************************************************
  6407. PROCEDURE getwindfont
  6408. * Get the default font for this window, if one has been defined
  6409. IF m.g_tographic
  6410.    * Get font information from header
  6411.    GOTO TOP
  6412.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  6413.    IF FOUND() AND !EMPTY(fontface)
  6414.       m.g_fontface  = fontface
  6415.       m.g_fontsize  = fontsize
  6416.       m.g_fontstyle = whatstyle(fontstyle)
  6417.    ENDIF
  6418. ENDIF
  6419.  
  6420. *
  6421. * adjHeightAndWidth - Adjust the Height and width of objects.
  6422. *
  6423. *!*****************************************************************************
  6424. *!
  6425. *!      Procedure: ADJHEIGHTANDWIDTH
  6426. *!
  6427. *!      Called by: NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  6428. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6429. *!
  6430. *!          Calls: WHATSTYLE()        (function  in TRANSPRT.PRG)
  6431. *!               : DOSSIZE()          (function  in TRANSPRT.PRG)
  6432. *!               : COLUMNAR()         (function  in TRANSPRT.PRG)
  6433. *!               : ADJTEXT            (procedure in TRANSPRT.PRG)
  6434. *!               : ADJBITMAPCTRL      (procedure in TRANSPRT.PRG)
  6435. *!               : MAXBTNWIDTH()      (function  in TRANSPRT.PRG)
  6436. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  6437. *!
  6438. *!*****************************************************************************
  6439. PROCEDURE adjheightandwidth
  6440. PRIVATE m.txtwidthratio, m.boldtxtratio, m.chkboxwidth, m.saverec, ;
  6441.    m.oldwidth, m.newheight, m.newwidth, ;
  6442.    m.wndface, m.wndsize, m.wndstyle, m.alignment
  6443.  
  6444. IF m.g_tographic
  6445.    m.saverec = RECNO()
  6446.    * Get font information from header
  6447.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  6448.    IF FOUND()
  6449.       m.wndface  = fontface
  6450.       m.wndsize  = fontsize
  6451.       m.wndstyle = fontstyle
  6452.    ELSE
  6453.       m.wndface  = m.g_fontface
  6454.       m.wndsize  = m.g_fontsize
  6455.       m.wndstyle = m.g_fontstyle
  6456.    ENDIF
  6457.    GOTO m.saverec
  6458.    
  6459.    * This is the ratio of character size for the window font to that for the current object font
  6460.    m.txtwidthratio = FONTMETRIC(6, m.wndface, m.wndsize, whatstyle(m.wndstyle)) / ;
  6461.       FONTMETRIC(6,fontface,fontsize,whatstyle(fontstyle))
  6462.    m.boldtxtratio = FONTMETRIC(6, m.wndface, m.wndsize, whatstyle(m.wndstyle)) / ;
  6463.       FONTMETRIC(6,m.g_fontface,m.g_fontsize,whatstyle(m.g_boldstyle))
  6464.    m.chkboxwidth = c_chkpixel / FONTMETRIC(6,m.g_fontface,m.g_fontsize,whatstyle(m.g_boldstyle))
  6465.    m.chkboxwidth = m.chkboxwidth + (m.chkboxwidth / 2)
  6466. ELSE
  6467.    m.saverec = RECNO()
  6468.    LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  6469.    IF FOUND()
  6470.       m.wndface = fontface
  6471.       m.wndsize = fontsize
  6472.       m.wndstyle = fontstyle
  6473.    ELSE
  6474.       m.wndface  = "MS Sans Serif"
  6475.       m.wndsize  = 8
  6476.       m.wndstyle = "B"
  6477.    ENDIF
  6478.    GOTO m.saverec
  6479. ENDIF
  6480.  
  6481. DO CASE
  6482. CASE objtype = c_ottext
  6483.    IF m.g_tographic
  6484.       m.oldwidth = WIDTH
  6485.       REPLACE WIDTH WITH TXTWIDTH(SUBSTR(expr, 2,LEN(expr)-2), fontface, ;
  6486.          fontsize, whatstyle(fontstyle)) && * m.txtwidthratio
  6487.    ELSE
  6488.       m.oldwidth = ROUND(dossize(WIDTH, fontsize, m.wndsize), 0)
  6489.       m.newheight = 1
  6490.       m.newwidth = LEN(expr)-2
  6491.       
  6492.       m.alignment = columnar(vpos, hpos, WIDTH, objtype)
  6493.       DO CASE
  6494.       CASE m.alignment = 2
  6495.          REPLACE hpos WITH hpos + WIDTH - m.newwidth
  6496.          
  6497.       CASE m.alignment = 0
  6498.          REPLACE vpos WITH vpos + ((HEIGHT - m.newheight) / 2)
  6499.          REPLACE hpos WITH hpos + ((WIDTH - m.newwidth) / 2)
  6500.       ENDCASE
  6501.       
  6502.       REPLACE HEIGHT WITH MAX(m.newheight,1)
  6503.       REPLACE WIDTH WITH MAX(m.newwidth,1)
  6504.       
  6505.       DO adjtext WITH m.oldwidth
  6506.    ENDIF
  6507.    
  6508. CASE objtype = c_otchkbox
  6509.    IF m.g_tographic
  6510.       m.oldwidth = WIDTH
  6511.       REPLACE WIDTH WITH (TXTWIDTH(SUBSTR(PICTURE, 6,LEN(PICTURE)-6) + SPACE(1), fontface, ;
  6512.          fontsize, whatstyle(fontstyle)) * m.boldtxtratio) + m.chkboxwidth
  6513.       REPLACE HEIGHT WITH c_chkhght
  6514.    ELSE
  6515.       DO adjbitmapctrl
  6516.       
  6517.       REPLACE HEIGHT WITH 1
  6518.       REPLACE WIDTH WITH maxbtnwidth(PICTURE, "", "", "")+4
  6519.    ENDIF
  6520.    
  6521. CASE objtype = c_otradbut
  6522.    IF m.g_tographic
  6523.       m.oldwidth = WIDTH
  6524.       DO adjbitmapctrl
  6525.       REPLACE HEIGHT WITH c_radhght
  6526.    ELSE
  6527.       REPLACE HEIGHT WITH 1
  6528.       REPLACE spacing WITH ROUND(dossize(spacing, fontsize, m.wndsize), 0)
  6529.       REPLACE WIDTH WITH MAX(maxbtnwidth(PICTURE, "", "", "")+4, dossize(WIDTH, fontsize, m.wndsize))
  6530.    ENDIF
  6531.    
  6532. CASE objtype = c_otpopup
  6533.    IF m.g_tographic
  6534.       REPLACE HEIGHT WITH c_pophght
  6535.    ELSE
  6536.       m.newheight = 3
  6537.       REPLACE vpos WITH MAX(vpos + ((HEIGHT - m.newheight) / 2),0)
  6538.       REPLACE HEIGHT WITH m.newheight
  6539.       REPLACE WIDTH WITH dossize(WIDTH, fontsize, m.wndsize)
  6540.    ENDIF
  6541.    
  6542. CASE objtype = c_ottxtbut
  6543.    IF m.g_tographic
  6544.       REPLACE HEIGHT WITH HEIGHT + c_adjtbtn
  6545.    ELSE
  6546.       DO adjbitmapctrl
  6547.       
  6548.       REPLACE HEIGHT WITH 1
  6549.       REPLACE spacing WITH ROUND(dossize(spacing, fontsize, m.wndsize), 0)
  6550.       REPLACE WIDTH WITH MAX(maxbtnwidth(PICTURE, "", "", "")+2, dossize(WIDTH, fontsize, m.wndsize))
  6551.    ENDIF
  6552.    
  6553. CASE objtype = c_otfield
  6554.    IF m.g_tographic
  6555.       REPLACE HEIGHT WITH HEIGHT + c_adjfld
  6556.    ELSE
  6557.       IF INLIST(objcode,0,1)
  6558.          REPLACE height WITH 1
  6559.       ELSE
  6560.          REPLACE HEIGHT WITH MAX(dossize(HEIGHT, fontsize, m.wndsize),1)
  6561.       ENDIF
  6562.       REPLACE WIDTH WITH MAX(dossize(WIDTH, fontsize, m.wndsize),1)
  6563.    ENDIF
  6564.    
  6565. CASE objtype = c_otline OR objtype = c_otbox
  6566.    IF !m.g_tographic
  6567.       DO adjbox
  6568.    ENDIF
  6569. ENDCASE
  6570.  
  6571. IF !g_tographic
  6572.    REPLACE vpos WITH MAX(vpos,0)
  6573.    REPLACE hpos WITH MAX(hpos,0)
  6574. ENDIF
  6575.  
  6576. *
  6577. * Columnar - This function takes and object and checks to see if it
  6578. *      is right or left aligned with other objects in a column.
  6579. *      Return values are:
  6580. *         0 - Not aligned
  6581. *         1 - Left aligned
  6582. *         2 - Right aligned
  6583. *
  6584. *!*****************************************************************************
  6585. *!
  6586. *!       Function: COLUMNAR
  6587. *!
  6588. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6589. *!
  6590. *!*****************************************************************************
  6591. FUNCTION columnar
  6592. PARAMETER m.vpos, m.hpos, m.type, m.otype
  6593. PRIVATE m.saverec
  6594.  
  6595. m.saverec = RECNO()
  6596.  
  6597. LOCATE FOR platform = m.g_fromplatform AND objtype = m.type AND ;
  6598.    hpos = m.hpos AND ABS(vpos - m.vpos) < m.vpos * 2
  6599. IF FOUND()
  6600.    GOTO RECORD (m.saverec)
  6601.    RETURN 1
  6602. ENDIF
  6603.  
  6604. LOCATE FOR platform = m.g_fromplatform AND objtype = m.type AND ;
  6605.    hpos + WIDTH = m.hpos + m.width  AND ;
  6606.    ABS(vpos - m.vpos) < m.vpos * 2
  6607. IF FOUND()
  6608.    GOTO RECORD (m.saverec)
  6609.    RETURN 2
  6610. ENDIF
  6611.  
  6612. GOTO RECORD (m.saverec)
  6613. RETURN 0
  6614.  
  6615. *
  6616. * DOSSize - This function attempts to normalize a dimension of an object to the font used for the
  6617. *      window it lies in.  Unfortunately, we can't use FONTMETRIC since this needs to run on a character
  6618. *      platform.  We use the ratio of point sizes.
  6619. *
  6620. *!*****************************************************************************
  6621. *!
  6622. *!       Function: DOSSIZE
  6623. *!
  6624. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6625. *!
  6626. *!*****************************************************************************
  6627. FUNCTION dossize
  6628. PARAMETER m.size, m.objsize, m.scrnsize
  6629. RETURN m.size * (m.objsize / m.scrnsize)
  6630.  
  6631. *
  6632. * AdjBitmapCtrl - Take the Picture clause for a control, see if it is a bitmap and
  6633. *      turn it into something that a character platform can handle.
  6634. *
  6635. *!*****************************************************************************
  6636. *!
  6637. *!      Procedure: ADJBITMAPCTRL
  6638. *!
  6639. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6640. *!
  6641. *!          Calls: STRIPPATH()        (function  in TRANSPRT.PRG)
  6642. *!
  6643. *!*****************************************************************************
  6644. PROCEDURE adjbitmapctrl
  6645. PRIVATE m.function, m.oldpicture, m.newpicture, m.temp
  6646.  
  6647. m.function = ALLTRIM(SUBSTR(PICTURE, 1, AT(" ", PICTURE)))
  6648.  
  6649. IF AT("B", m.function) <> 0
  6650.    m.function = CHRTRAN(m.function, "B", "")
  6651.    m.oldpicture = ALLTRIM(SUBSTR(PICTURE, AT(" ", PICTURE)))
  6652.    m.newpicture = ""
  6653.    
  6654.    DO WHILE LEN(m.oldpicture) > 0
  6655.       IF AT(";", m.oldpicture) = 0
  6656.          m.temp = LEFT(m.oldpicture, LEN(m.oldpicture)-1)
  6657.          m.oldpicture = ""
  6658.       ELSE
  6659.          m.temp = LEFT(m.oldpicture, AT(";", m.oldpicture)-1)
  6660.          m.oldpicture = SUBSTR(m.oldpicture, AT(";", m.oldpicture)+1)
  6661.       ENDIF
  6662.       
  6663.       IF LEN(m.newpicture) = 0
  6664.          m.newpicture = ALLTRIM(strippath(m.temp))
  6665.       ELSE
  6666.          m.newpicture = m.newpicture + ";" + ALLTRIM(strippath(m.temp))
  6667.       ENDIF
  6668.    ENDDO
  6669.    
  6670.    REPLACE PICTURE WITH m.function + " " + m.newpicture + '"'
  6671. ENDIF
  6672.  
  6673. RETURN
  6674. *
  6675. * AdjColor - Adjust color fields in the database.
  6676. *
  6677. *!*****************************************************************************
  6678. *!
  6679. *!      Procedure: ADJCOLOR
  6680. *!
  6681. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6682. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6683. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  6684. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  6685. *!
  6686. *!          Calls: CONVERTCOLORPAIR   (procedure in TRANSPRT.PRG)
  6687. *!               : RGBTOX()           (function  in TRANSPRT.PRG)
  6688. *!
  6689. *!*****************************************************************************
  6690. PROCEDURE adjcolor
  6691. IF m.g_tographic
  6692.    IF m.g_filetype = c_report OR m.g_filetype = c_label OR EMPTY(colorpair)
  6693.       IF m.g_filetype = c_screen
  6694.          REPLACE colorpair WITH ""
  6695.          REPLACE penred    WITH -1
  6696.          REPLACE pengreen  WITH -1
  6697.          REPLACE penblue   WITH -1
  6698.          REPLACE fillred   WITH -1
  6699.          REPLACE fillgreen WITH -1
  6700.          REPLACE fillblue  WITH -1
  6701.       ELSE
  6702.          REPLACE penred    WITH 0
  6703.          REPLACE pengreen  WITH 0
  6704.          REPLACE penblue   WITH 0
  6705.          IF objtype = c_otline
  6706.             REPLACE fillred   WITH 0
  6707.             REPLACE fillgreen WITH 0
  6708.             REPLACE fillblue  WITH 0
  6709.          ELSE
  6710.             REPLACE fillred   WITH 255
  6711.             REPLACE fillgreen WITH 255
  6712.             REPLACE fillblue  WITH 255
  6713.          ENDIF
  6714.       ENDIF
  6715.    ELSE
  6716.       DO convertcolorpair
  6717.    ENDIF
  6718. ELSE
  6719.    IF m.g_filetype = c_screen
  6720.       DO CASE
  6721.       CASE objtype = c_otheader
  6722.          DO CASE
  6723.          CASE STYLE = c_user
  6724.             IF SCHEME + scheme2 = 0
  6725.                REPLACE SCHEME WITH 1
  6726.                REPLACE scheme2 WITH 2
  6727.             ENDIF
  6728.             
  6729.          CASE STYLE = c_system
  6730.             REPLACE SCHEME WITH 8
  6731.             REPLACE scheme2 WITH 9
  6732.             
  6733.          CASE STYLE = c_dialog
  6734.             REPLACE SCHEME WITH 5
  6735.             REPLACE scheme2 WITH 6
  6736.             
  6737.          CASE STYLE = c_alert
  6738.             REPLACE SCHEME WITH 7
  6739.             REPLACE SCHEME WITH 12
  6740.          ENDCASE
  6741.          
  6742.       CASE c_maptextcolor AND INLIST(objtype,c_otbox, c_otline,c_ottext)
  6743.          IF penred <> -1 OR fillred <> -1
  6744.             REPLACE colorpair WITH rgbtox(penred, penblue, pengreen) + "/" + ;
  6745.                rgbtox(fillred, fillblue, fillgreen)
  6746.             * Don't let it map to black on black
  6747.             IF colorpair = "N/N" OR TRIM(colorpair) == "/"
  6748.                REPLACE colorpair WITH ""
  6749.             ENDIF
  6750.          ENDIF
  6751.       OTHERWISE
  6752.           REPLACE scheme WITH 0   && default color scheme for everything else
  6753.       ENDCASE
  6754.    ENDIF
  6755. ENDIF
  6756.  
  6757. *
  6758. * RGBToX - Convert an RGB triplet to a traditional xBase color letter
  6759. *
  6760. *!*****************************************************************************
  6761. *!
  6762. *!       Function: RGBTOX
  6763. *!
  6764. *!      Called by: ADJCOLOR           (procedure in TRANSPRT.PRG)
  6765. *!
  6766. *!*****************************************************************************
  6767. FUNCTION rgbtox
  6768. PARAMETERS m.red, m.blue, m.green
  6769. PRIVATE m.color
  6770.  
  6771. *
  6772. * If it is automatic, we skip it.
  6773. *
  6774. IF m.red < 0 OR m.blue < 0 OR m.green < 0
  6775.    RETURN ""
  6776. ENDIF
  6777.  
  6778. *
  6779. * We use a special triplet for Light Gray which makes it a special case.
  6780. *
  6781. IF m.red = 192 AND m.blue = 192 AND m.green = 192
  6782.    RETURN "W"
  6783. ENDIF
  6784.  
  6785. *
  6786. * This division makes sure that we give a letter for any possible triplet
  6787. *
  6788. m.red   = ROUND(m.red / 127, 0)
  6789. m.blue = ROUND(m.blue / 127, 0)
  6790. m.green = ROUND(m.green / 127, 0)
  6791.  
  6792. *
  6793. * Save some time by getting a number we can make a single comparison against
  6794. *
  6795. m.color = (m.red * 100) + (m.blue * 10) + m.green
  6796.  
  6797. DO CASE
  6798. CASE m.color = 222      && White
  6799.    RETURN "W+"
  6800. CASE m.color = 0        && Black
  6801.    RETURN "N"
  6802. CASE m.color = 111      && Dark Gray
  6803.    RETURN "N+"
  6804. CASE m.color = 200      && Light Red
  6805.    RETURN "R+"
  6806. CASE m.color = 100      && Dark Red
  6807.    RETURN "R"
  6808. CASE m.color = 220      && Yellow
  6809.    RETURN "GR+"
  6810. CASE m.color = 110      && Brown
  6811.    RETURN "GR"
  6812. CASE m.color = 2        && Light green
  6813.    RETURN "G+"
  6814. CASE m.color = 1        && Dark Green
  6815.    RETURN "G"
  6816. CASE m.color = 22       && Light Magenta
  6817.    RETURN "BG+"
  6818. CASE m.color = 11       && Dark Magenta
  6819.    RETURN "BG"
  6820. CASE m.color = 20       && Light Blue
  6821.    RETURN "B+"
  6822. CASE m.color = 10       && Dark Blue
  6823.    RETURN "B"
  6824. CASE m.color = 202      && Light Purple
  6825.    RETURN "RB+"
  6826. CASE m.color = 101      && Dark Purple
  6827.    RETURN "RB"
  6828. ENDCASE
  6829.  
  6830. RETURN ""      && It shouldn't be possible to reach this point.
  6831.  
  6832. *
  6833. * \ - Adjust pen attributes.
  6834. *
  6835. *!*****************************************************************************
  6836. *!
  6837. *!      Procedure: ADJPEN
  6838. *!
  6839. *!      Called by: FILLININFO         (procedure in TRANSPRT.PRG)
  6840. *!
  6841. *!*****************************************************************************
  6842. PROCEDURE adjpen
  6843. IF m.g_tographic
  6844.    DO CASE
  6845.    CASE objtype = c_ottext
  6846.       REPLACE pensize WITH 1
  6847.       REPLACE penpat  WITH 0
  6848.       REPLACE fillpat WITH 0
  6849.       
  6850.    OTHERWISE
  6851.       REPLACE pensize WITH 0
  6852.       REPLACE penpat  WITH 0
  6853.       REPLACE fillpat WITH 0
  6854.    ENDCASE
  6855. ENDIF
  6856.  
  6857. *
  6858. * adjfont - Adjust font fields in the SCX or FRX database.
  6859. *
  6860. *!*****************************************************************************
  6861. *!
  6862. *!      Procedure: ADJFONT
  6863. *!
  6864. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6865. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6866. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  6867. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  6868. *!
  6869. *!*****************************************************************************
  6870. PROCEDURE adjfont
  6871. PRIVATE m.i
  6872.  
  6873. IF m.g_tographic
  6874.    DO CASE
  6875.    CASE objtype = c_ottxtbut OR ;
  6876.          objtype = c_otradbut OR ;
  6877.          objtype = c_otchkbox OR ;
  6878.          objtype = c_otheader OR ;
  6879.          objtype = c_otinvbut OR ;
  6880.          objtype = c_otspinner OR ;
  6881.          objtype = c_otbox OR ;
  6882.          objtype = c_otline
  6883.       
  6884.       REPLACE fontface  WITH m.g_cfontface
  6885.       REPLACE fontsize  WITH m.g_cfontsize
  6886.       REPLACE fontstyle WITH m.g_boldstyle
  6887.       
  6888.    CASE objtype = c_otpopup
  6889.       REPLACE fontface  WITH m.g_cfontface
  6890.       REPLACE fontsize  WITH m.g_cfontsize
  6891.       REPLACE fontstyle WITH m.g_normstyle
  6892.       
  6893.    CASE objtype = c_ottext
  6894.       REPLACE fontface  WITH m.g_fontface
  6895.       REPLACE fontsize  WITH m.g_fontsize
  6896.       REPLACE fontstyle WITH m.g_boldstyle
  6897.       
  6898.    CASE objtype = c_otfield
  6899.       REPLACE fontface  WITH m.g_fontface
  6900.       REPLACE fontsize  WITH m.g_fontsize
  6901.       REPLACE fontstyle WITH m.g_normstyle
  6902.       
  6903.    OTHERWISE
  6904.       REPLACE fontface  WITH m.g_fontface
  6905.       REPLACE fontsize  WITH m.g_fontsize
  6906.       REPLACE fontstyle WITH m.g_normstyle
  6907.    ENDCASE
  6908. ENDIF
  6909.  
  6910. *
  6911. * convertColorPair - Convert the color pair to appropriate RGB pen
  6912. *               and fill values.
  6913. *
  6914. *!*****************************************************************************
  6915. *!
  6916. *!      Procedure: CONVERTCOLORPAIR
  6917. *!
  6918. *!      Called by: ADJCOLOR           (procedure in TRANSPRT.PRG)
  6919. *!
  6920. *!          Calls: GETCOLOR()         (function  in TRANSPRT.PRG)
  6921. *!
  6922. *!*****************************************************************************
  6923. PROCEDURE convertcolorpair
  6924. PRIVATE m.oldscheme, m.rgbvalue, m.comma, m.frg, m.bkg
  6925.  
  6926. * Translate foreground colors
  6927. m.frg = UPPER(CHRTRAN(LEFT(colorpair,AT('/',colorpair)-1),'-*/, ',''))
  6928. REPLACE penred    WITH -1
  6929. REPLACE pengreen  WITH -1
  6930. REPLACE penblue   WITH -1
  6931. IF "W" $ m.frg
  6932.    REPLACE penred    WITH IIF('+' $ m.frg,255,128)
  6933.    REPLACE pengreen  WITH IIF('+' $ m.frg,255,128)
  6934.    REPLACE penblue   WITH IIF('+' $ m.frg,255,128)
  6935. ENDIF
  6936. IF "N" $ m.frg
  6937.    REPLACE penred    WITH 0
  6938.    REPLACE pengreen  WITH 0
  6939.    REPLACE penblue   WITH 0
  6940. ENDIF
  6941. IF "R" $ m.frg    && red
  6942.    REPLACE penred    WITH IIF('+' $ m.frg,255,128)
  6943. ENDIF
  6944. IF "G" $ m.frg    && green
  6945.    REPLACE pengreen  WITH IIF('+' $ m.frg,255,128)
  6946. ENDIF
  6947. IF "B" $ m.frg    && blue
  6948.    REPLACE penblue   WITH IIF('+' $ m.frg,255,128)
  6949. ENDIF
  6950. REPLACE penred   WITH IIF(penred < 0,0,penred)
  6951. REPLACE pengreen WITH IIF(pengreen < 0,0,pengreen)
  6952. REPLACE penblue  WITH IIF(penblue < 0,0,penblue)
  6953.  
  6954. m.bkg = UPPER(CHRTRAN(SUBSTR(colorpair,AT('/',colorpair)+1,3),'-*/, ',''))
  6955. REPLACE fillred    WITH -1
  6956. REPLACE fillgreen  WITH -1
  6957. REPLACE fillblue   WITH -1
  6958. DO CASE
  6959. CASE m.bkg = "W" OR m.bkg = "W+"    && white
  6960.    REPLACE fillred    WITH IIF('+' $ m.bkg,255,128)
  6961.    REPLACE fillgreen  WITH IIF('+' $ m.bkg,255,128)
  6962.    REPLACE fillblue   WITH IIF('+' $ m.bkg,255,128)
  6963. CASE m.bkg = "N" OR m.bkg = "N+"    && black
  6964.    REPLACE fillred    WITH 0
  6965.    REPLACE fillgreen  WITH 0
  6966.    REPLACE fillblue   WITH 0
  6967. CASE "R" $ m.bkg OR "G" $ m.bkg OR "B" $ m.bkg
  6968.    IF "R" $ m.bkg    && red
  6969.       REPLACE fillred    WITH IIF('+' $ m.bkg,255,128)
  6970.    ENDIF
  6971.    IF "G" $ m.bkg    && green
  6972.       REPLACE fillgreen  WITH IIF('+' $ m.bkg,255,128)
  6973.    ENDIF
  6974.    IF "B" $ m.bkg    && blue
  6975.       REPLACE fillblue   WITH IIF('+' $ m.bkg,255,128)
  6976.    ENDIF
  6977.    REPLACE fillred   WITH IIF(fillred < 0,0,fillred)
  6978.    REPLACE fillgreen WITH IIF(fillgreen < 0,0,fillgreen)
  6979.    REPLACE fillblue  WITH IIF(fillblue < 0,0,fillblue)
  6980. ENDCASE
  6981. RETURN
  6982.  
  6983. * getColor - Return the color value for a specified RGB value.
  6984. *
  6985. *!*****************************************************************************
  6986. *!
  6987. *!       Function: GETCOLOR
  6988. *!
  6989. *!      Called by: CONVERTCOLORPAIR   (procedure in TRANSPRT.PRG)
  6990. *!
  6991. *!*****************************************************************************
  6992. FUNCTION getcolor
  6993. PARAMETER m.rgbstring, m.occurence
  6994. PRIVATE m.comma, m.value
  6995. m.comma = ATC(',', m.rgbstring, m.occurence)
  6996. m.value = SUBSTR(m.rgbstring, m.comma +1, ;
  6997.    ATC(',', m.rgbstring, m.occurence + 1)-m.comma -1)
  6998. RETURN m.value
  6999.  
  7000. *
  7001. *whatStyle - Return the style string which corresponds to the style
  7002. *         stored in screen database.
  7003. *
  7004. *!*****************************************************************************
  7005. *!
  7006. *!       Function: WHATSTYLE
  7007. *!
  7008. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  7009. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  7010. *!               : ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  7011. *!               : GETWINDFONT        (procedure in TRANSPRT.PRG)
  7012. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7013. *!
  7014. *!*****************************************************************************
  7015. FUNCTION whatstyle
  7016. PARAMETER m.stylenum
  7017. DO CASE
  7018. CASE TYPE("m.stylenum") = "C"
  7019.    * already a character.  Do nothing.
  7020.    RETURN m.stylenum
  7021. CASE !EMPTY(stylenum)
  7022.    DO CASE
  7023.    CASE m.stylenum = 1
  7024.       RETURN "B"
  7025.    CASE m.stylenum = 2
  7026.       RETURN "I"
  7027.    CASE m.stylenum = 3
  7028.       RETURN "BI"
  7029.    ENDCASE
  7030. OTHERWISE
  7031.    RETURN ""
  7032. ENDCASE
  7033.  
  7034. *
  7035. * AdjText - Takes the current record and, if it is a multi-line text object, converts it into
  7036. *      multiple single line text objects.
  7037. *
  7038. *!*****************************************************************************
  7039. *!
  7040. *!      Procedure: ADJTEXT
  7041. *!
  7042. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  7043. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7044. *!
  7045. *!*****************************************************************************
  7046. PROCEDURE adjtext
  7047. PARAMETER m.oldwidth
  7048.  
  7049. PRIVATE m.saverec
  7050.  
  7051. IF objtype <> c_ottext OR AT(CHR(13), expr) = 0 OR ;
  7052.       m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7053.    RETURN
  7054. ENDIF
  7055.  
  7056. m.saverec = RECNO()
  7057. SCATTER MEMVAR MEMO
  7058.  
  7059. * Update the original records
  7060. m.expr = SUBSTR(m.expr, 2, LEN(m.expr)-2)
  7061. m.pos = AT(CHR(13), m.expr)
  7062. REPLACE expr WITH '"' + LEFT(m.expr, m.pos-1) + '"'
  7063. REPLACE WIDTH WITH LEN(expr)-2
  7064. DO CASE
  7065. CASE m.picture = '"@J"'                        && Right aligned
  7066.    REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7067. CASE m.picture = '"@I"'                        && Centered
  7068.    REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7069. ENDCASE
  7070. m.expr = SUBSTR(m.expr, m.pos+1)
  7071. m.pos = AT(CHR(13), m.expr)
  7072. REPLACE hpos WITH MAX(0,hpos)
  7073.  
  7074. * Write all records but the last
  7075. DO WHILE m.pos > 0
  7076.    m.vpos = m.vpos + IIF(spacing = 1, m.height * 2, m.height)
  7077.    APPEND BLANK
  7078.    GATHER MEMVAR MEMO
  7079.    REPLACE platform WITH LOWER(platform)
  7080.    REPLACE uniqueid WITH SYS(2015)
  7081.    REPLACE expr WITH '"' + LEFT(m.expr, m.pos-1) + '"'
  7082.    REPLACE WIDTH WITH LEN(expr)-2
  7083.    DO CASE
  7084.    CASE m.picture = '"@J"'                     && Right aligned
  7085.       REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7086.    CASE m.picture = '"@I"'                     && Centered
  7087.       REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7088.    ENDCASE
  7089.    
  7090.    m.expr = SUBSTR(m.expr, m.pos+1)
  7091.    m.pos = AT(CHR(13), m.expr)
  7092.    REPLACE hpos WITH MAX(0,hpos)
  7093. ENDDO
  7094.  
  7095. * Write the last record.
  7096. IF LEN(ALLTRIM(m.expr)) <> 0
  7097.    m.vpos = m.vpos + IIF(spacing = 1, m.height * 2, m.height)
  7098.    APPEND BLANK
  7099.    GATHER MEMVAR MEMO
  7100.    REPLACE platform WITH LOWER(platform)
  7101.    REPLACE uniqueid WITH SYS(2015)
  7102.    REPLACE expr WITH '"' + m.expr + '"'
  7103.    REPLACE WIDTH WITH LEN(expr)-2
  7104.    DO CASE
  7105.    CASE m.picture = '"@J"'                     && Right aligned
  7106.       REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7107.    CASE m.picture = '"@I"'                     && Centered
  7108.       REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7109.    ENDCASE
  7110.    REPLACE hpos WITH MAX(0,hpos)
  7111. ENDIF
  7112.  
  7113. GOTO m.saverec
  7114.  
  7115. *
  7116. *
  7117. * AdjBox - Converts a box/line record from character to graphic or graphic to character
  7118. *
  7119. *!*****************************************************************************
  7120. *!
  7121. *!      Procedure: ADJBOX
  7122. *!
  7123. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  7124. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  7125. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7126. *!
  7127. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  7128. *!
  7129. *!*****************************************************************************
  7130. PROCEDURE adjbox
  7131. PARAMETER m.adjust
  7132. IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7133.    DO CASE
  7134.    CASE objcode = c_sgboxd
  7135.       REPLACE pensize WITH 4
  7136.    CASE objcode = c_sgboxp
  7137.       REPLACE pensize WITH 6
  7138.    OTHERWISE
  7139.       REPLACE pensize WITH 1
  7140.    ENDCASE
  7141.    
  7142.    DO CASE
  7143.    CASE HEIGHT = 1
  7144.       REPLACE HEIGHT WITH getlinewidth(objcode, .T.)
  7145.       REPLACE vpos WITH vpos + c_adjbox - (HEIGHT/2)
  7146.       IF m.g_filetype = c_screen
  7147.          REPLACE STYLE WITH c_lnhorizontal
  7148.       ENDIF
  7149.       
  7150.       REPLACE penpat  WITH 8
  7151.       REPLACE fillpat WITH 0
  7152.       REPLACE objtype WITH c_otline
  7153.       REPLACE objcode WITH 0
  7154.       
  7155.    CASE WIDTH = 1
  7156.       REPLACE WIDTH WITH getlinewidth(objcode, .F.)
  7157.       REPLACE hpos WITH hpos + c_adjbox - (WIDTH/2)
  7158.       IF m.g_filetype = c_screen
  7159.          REPLACE STYLE WITH c_lnvertical
  7160.       ENDIF
  7161.       
  7162.       REPLACE penpat  WITH 8
  7163.       REPLACE fillpat WITH 0
  7164.       REPLACE objtype WITH c_otline
  7165.       REPLACE objcode WITH 0
  7166.       
  7167.    OTHERWISE
  7168.       REPLACE vpos WITH vpos + c_adjbox - (getlinewidth(objcode, .T.)/2) + m.adjust
  7169.       REPLACE hpos WITH hpos + c_adjbox - (getlinewidth(objcode, .F.)/2) + m.adjust
  7170.       REPLACE HEIGHT WITH HEIGHT + getlinewidth(objcode, .T.) - 1
  7171.       REPLACE WIDTH WITH WIDTH + getlinewidth(objcode, .F.) - 1
  7172.       
  7173.       REPLACE penpat  WITH 8
  7174.       REPLACE fillpat WITH 0
  7175.       REPLACE objcode WITH 4
  7176.    ENDCASE
  7177.    
  7178.    IF m.g_filetype = c_screen
  7179.       IF BORDER > 4
  7180.          REPLACE BORDER WITH 1
  7181.       ELSE
  7182.          REPLACE BORDER WITH 0
  7183.       ENDIF
  7184.    ENDIF
  7185. ELSE
  7186.    ******************* Start Graphic to Character Conversion ******************
  7187.    IF fillpat = 0
  7188.       REPLACE fillchar WITH CHR(0)
  7189.    ELSE
  7190.       REPLACE fillchar WITH " "
  7191.    ENDIF
  7192.    
  7193.    DO CASE
  7194.    CASE pensize = 4
  7195.       REPLACE objcode WITH c_sgboxd
  7196.    CASE pensize = 6
  7197.       REPLACE objcode WITH c_sgboxp
  7198.    OTHERWISE
  7199.       REPLACE objcode WITH c_sgbox
  7200.    ENDCASE
  7201.    
  7202.    DO CASE
  7203.    CASE (m.g_filetype = c_screen AND objtype = c_otline and style = c_lnhorizontal) ;
  7204.         OR (objtype = c_otbox and height <=1)
  7205.       REPLACE vpos WITH vpos - c_adjbox
  7206.       REPLACE HEIGHT WITH 1
  7207.       
  7208.    CASE (m.g_filetype = c_screen AND objtype = c_otline and style = c_lnvertical) ;
  7209.         OR (objtype = c_otbox and width <=1)
  7210.       REPLACE hpos WITH hpos-c_adjbox
  7211.       REPLACE width WITH 1
  7212.       
  7213.    OTHERWISE
  7214.       REPLACE vpos WITH vpos-c_adjbox
  7215.       REPLACE hpos WITH hpos-c_adjbox
  7216.       REPLACE HEIGHT WITH HEIGHT+(c_adjbox*2)
  7217.       REPLACE WIDTH WITH WIDTH+(c_adjbox*2)
  7218.    ENDCASE
  7219. ENDIF
  7220.  
  7221. *
  7222. * GetLineWidth - Given an object code for a box or line and a flag indicating
  7223. *      if we want the thickness of a horizontal or vertical size, we return
  7224. *      the thickness of the side.
  7225. *
  7226. *!*****************************************************************************
  7227. *!
  7228. *!       Function: GETLINEWIDTH
  7229. *!
  7230. *!      Called by: JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  7231. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  7232. *!               : REJOINBOXES        (procedure in TRANSPRT.PRG)
  7233. *!               : JOINLINEWIDTH()    (function  in TRANSPRT.PRG)
  7234. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  7235. *!
  7236. *!*****************************************************************************
  7237. FUNCTION getlinewidth
  7238. PARAMETERS m.objcode, m.horizontal
  7239.  
  7240. IF _WINDOWS OR _MAC
  7241.    DO CASE
  7242.    CASE m.objcode = c_sgboxd
  7243.       IF m.g_filetype = c_report
  7244.          RETURN 4 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7245.       ELSE
  7246.          RETURN 4 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7247.       ENDIF
  7248.       
  7249.    CASE m.objcode = c_sgboxp
  7250.       IF m.g_filetype = c_report
  7251.          RETURN 6 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7252.       ELSE
  7253.          RETURN 6 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7254.       ENDIF
  7255.       
  7256.    OTHERWISE
  7257.       IF m.g_filetype = c_report
  7258.          RETURN 1 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7259.       ELSE
  7260.          RETURN 1 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7261.       ENDIF
  7262.    ENDCASE
  7263. ELSE
  7264.    RETURN 1
  7265. ENDIF
  7266.  
  7267. *
  7268. * HorizButton - Will return a .T. if the ojbect passed in is a series of
  7269. *            horizontal buttons.  If they are vertical buttons, it
  7270. *            returns .F.
  7271. *
  7272. *!*****************************************************************************
  7273. *!
  7274. *!       Function: HORIZBUTTON
  7275. *!
  7276. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  7277. *!               : FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  7278. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  7279. *!               : ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  7280. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  7281. *!               : GETLASTOBJECTLINE()(function  in TRANSPRT.PRG)
  7282. *!               : GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  7283. *!               : GETOBJHEIGHT()     (function  in TRANSPRT.PRG)
  7284. *!
  7285. *!*****************************************************************************
  7286. FUNCTION horizbutton
  7287. PARAMETER m.pictclause
  7288.  
  7289. IF OCCURS(';', m.pictclause) = 0 OR ;
  7290.       AT("H", LEFT(m.pictclause, AT(" ", m.pictclause))) != 0
  7291.    RETURN .T.
  7292. ELSE
  7293.    RETURN .F.
  7294. ENDIF
  7295.  
  7296. *
  7297. * MaxBtnWidth - Given the Picture clause for a set of buttons (text or
  7298. *      radio) along with its font information and returns the Width in
  7299. *      foxels of the widest label.
  7300. *
  7301. *!*****************************************************************************
  7302. *!
  7303. *!       Function: MAXBTNWIDTH
  7304. *!
  7305. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7306. *!
  7307. *!*****************************************************************************
  7308. FUNCTION maxbtnwidth
  7309. PARAMETERS m.picture, m.face, m.size, m.style
  7310. PRIVATE m.max, m.label
  7311.  
  7312. m.max = 0
  7313. m.picture = SUBSTR(m.picture, AT(" ", m.picture))
  7314.  
  7315. m.picture = STRTRAN(m.picture, "\\", "")
  7316. m.picture = STRTRAN(m.picture, "\<", "")
  7317. m.picture = STRTRAN(m.picture, "\!", "")
  7318. m.picture = STRTRAN(m.picture, "\?", "")
  7319.  
  7320. DO WHILE LEN(m.picture) != 0
  7321.    IF AT(";", m.picture) != 0
  7322.       m.label = ALLTRIM(LEFT(m.picture, AT(";", m.picture)-1))
  7323.       m.picture = SUBSTR(m.picture, AT(";", m.picture)+1)
  7324.    ELSE
  7325.       m.label = ALLTRIM(LEFT(m.picture, LEN(m.picture)-1))
  7326.       m.picture = ""
  7327.    ENDIF
  7328.    
  7329.    IF m.g_tographic
  7330.       m.max = MAX(m.max, TXTWIDTH(m.label, m.face, m.size, m.style))
  7331.    ELSE
  7332.       m.max = MAX(m.max, LEN(m.label))
  7333.    ENDIF
  7334. ENDDO
  7335.  
  7336. RETURN m.max
  7337.  
  7338. *
  7339. * GetObjWidth - Given a screen object, this function returns its Width.
  7340. *
  7341. *!*****************************************************************************
  7342. *!
  7343. *!       Function: GETOBJWIDTH
  7344. *!
  7345. *!      Called by: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  7346. *!               : GETRIGHTMOST       (procedure in TRANSPRT.PRG)
  7347. *!
  7348. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  7349. *!
  7350. *!*****************************************************************************
  7351. FUNCTION getobjwidth
  7352. PARAMETERS m.objtype, m.picture, m.width, m.spacing, m.platform
  7353. PRIVATE m.numitems
  7354.  
  7355. DO CASE
  7356. CASE m.objtype = c_ottext OR m.objtype = c_otfield OR ;
  7357.       m.objtype = c_otline OR m.objtype = c_otbox OR ;
  7358.       m.objtype = c_otlist OR m.objtype = c_otchkbox OR ;
  7359.       m.objtype = c_otpopup OR m.objtype = c_otpicture OR ;
  7360.       m.objtype = c_otspinner OR m.objtype = c_otrepfld
  7361.    RETURN m.width
  7362.    
  7363. CASE m.objtype = c_ottxtbut OR m.objtype = c_otradbut OR m.objtype = c_otinvbut
  7364.    m.numitems = OCCURS(";", m.picture) + 1
  7365.    IF !horizbutton(m.picture) OR m.numitems = 1
  7366.       RETURN m.width
  7367.    ELSE
  7368.       RETURN (m.width * m.numitems) + (m.spacing * (m.numitems - 1))
  7369.    ENDIF
  7370.    
  7371. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7372.       (m.platform = "MAC" OR m.platform = "WINDOWS")
  7373.    RETURN m.width
  7374.    
  7375. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7376.       (m.platform = "DOS" OR m.platform = "UNIX")
  7377.    RETURN m.width-1
  7378.    
  7379. OTHERWISE
  7380.    RETURN m.width
  7381. ENDCASE
  7382.  
  7383. *
  7384. * GetObjHeight - Given a screen object, this function returns its Height.
  7385. *
  7386. *!*****************************************************************************
  7387. *!
  7388. *!       Function: GETOBJHEIGHT
  7389. *!
  7390. *!      Called by: GETLOWEST          (procedure in TRANSPRT.PRG)
  7391. *!
  7392. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  7393. *!
  7394. *!*****************************************************************************
  7395. FUNCTION getobjheight
  7396. PARAMETERS m.objtype, m.picture, m.height, m.spacing, m.platform
  7397. PRIVATE m.numitems
  7398.  
  7399. DO CASE
  7400. CASE m.objtype = c_ottext OR m.objtype = c_otfield OR ;
  7401.       m.objtype = c_otline OR m.objtype = c_otbox OR ;
  7402.       m.objtype = c_otlist OR m.objtype = c_otchkbox OR ;
  7403.       m.objtype = c_otpopup OR m.objtype = c_otpicture OR ;
  7404.       m.objtype = c_otspinner OR m.objtype = c_otrepfld
  7405.    RETURN m.height
  7406.    
  7407. CASE m.objtype = c_ottxtbut OR m.objtype = c_otradbut OR ;
  7408.       m.objtype = c_otinvbut
  7409.    m.numitems = OCCURS(";", m.picture) + 1
  7410.    
  7411.    IF horizbutton(m.picture) OR m.numitems = 1
  7412.       RETURN m.height
  7413.    ELSE
  7414.       RETURN (m.height * m.numitems) + (m.spacing * (m.numitems - 1))
  7415.    ENDIF
  7416.    
  7417. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7418.       (m.platform = "MAC" OR m.platform = "WINDOWS")
  7419.    RETURN m.height
  7420.    
  7421. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7422.       (m.platform = "DOS" OR m.platform = "UNIX")
  7423.    RETURN m.height-1
  7424.    
  7425. OTHERWISE
  7426.    RETURN m.height
  7427. ENDCASE
  7428.  
  7429. *
  7430. * GetRightmost - Takes a platform and returns the rightmost position occupied by an object
  7431. *      in that platform
  7432. *!*****************************************************************************
  7433. *!
  7434. *!      Procedure: GETRIGHTMOST
  7435. *!
  7436. *!      Called by: MAKECHARFIT        (procedure in TRANSPRT.PRG)
  7437. *!
  7438. *!          Calls: GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  7439. *!
  7440. *!*****************************************************************************
  7441. PROCEDURE getrightmost
  7442. PARAMETER m.platform
  7443. PRIVATE m.right
  7444.  
  7445. m.right = 0
  7446.  
  7447. SCAN FOR platform = m.platform AND !DELETED() AND ;
  7448.       (objtype = c_ottext OR objtype = c_otline OR ;
  7449.       objtype = c_otbox OR objtype = c_otrepfld OR ;
  7450.       objtype = c_otlist OR objtype = c_ottxtbut OR ;
  7451.       objtype = c_otradbut OR objtype = c_otchkbox OR ;
  7452.       objtype = c_otfield OR objtype = c_otpopup OR ;
  7453.       objtype = c_otpicture OR objtype = c_otinvbut OR ;
  7454.       objtype = c_otspinner)
  7455.    m.right = MAX(m.right, hpos + getobjwidth(objtype, PICTURE, WIDTH, spacing, m.g_toplatform))
  7456. ENDSCAN
  7457.  
  7458. RETURN m.right
  7459.  
  7460. *
  7461. * GetLowest - Takes a platform and returns the lowest position occupied by an object
  7462. *      in that platform
  7463. *!*****************************************************************************
  7464. *!
  7465. *!      Procedure: GETLOWEST
  7466. *!
  7467. *!      Called by: MAKECHARFIT        (procedure in TRANSPRT.PRG)
  7468. *!
  7469. *!          Calls: GETOBJHEIGHT()     (function  in TRANSPRT.PRG)
  7470. *!
  7471. *!*****************************************************************************
  7472. PROCEDURE getlowest
  7473. PARAMETER m.platform
  7474. PRIVATE m.bottom
  7475.  
  7476. m.bottom = 0
  7477.  
  7478. SCAN FOR platform = m.platform AND !DELETED() AND ;
  7479.       (objtype = c_ottext OR objtype = c_otline OR ;
  7480.       objtype = c_otbox OR objtype = c_otrepfld OR ;
  7481.       objtype = c_otlist OR objtype = c_ottxtbut OR ;
  7482.       objtype = c_otradbut OR objtype = c_otchkbox OR ;
  7483.       objtype = c_otfield OR objtype = c_otpopup OR ;
  7484.       objtype = c_otpicture OR objtype = c_otinvbut OR ;
  7485.       objtype = c_otspinner)
  7486.    m.bottom = MAX(m.bottom, vpos + getobjheight(objtype, PICTURE, HEIGHT, spacing, m.g_toplatform))
  7487. ENDSCAN
  7488.  
  7489. RETURN m.bottom
  7490.  
  7491. *
  7492. * DoCreate - Creates an empty cursor with either a report or screen structure and a given name.
  7493. *
  7494. *!*****************************************************************************
  7495. *!
  7496. *!      Procedure: DOCREATE
  7497. *!
  7498. *!      Called by: cvrt102FRX()    (function  in TRANSPRT.PRG)
  7499. *!               : cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  7500. *!               : MAKECURSOR         (procedure in TRANSPRT.PRG)
  7501. *!               : WRITERESULT        (procedure in TRANSPRT.PRG)
  7502. *!
  7503. *!*****************************************************************************
  7504. PROCEDURE docreate
  7505. PARAMETER m.name, m.type
  7506. DO CASE
  7507. CASE m.type = c_screen
  7508.    CREATE CURSOR (m.name) (platform C(8), uniqueid C(10), timestamp N(10), objtype N(2), objcode N(3), ;
  7509.       name m, expr m, vpos N(7,3), hpos N(7,3), HEIGHT N(7,3), WIDTH N(7,3), ;
  7510.       STYLE N(2), PICTURE m, ORDER m, UNIQUE l, comment m, ENVIRON l, ;
  7511.       boxchar C(1), fillchar C(1), TAG m, tag2 m, penred N(5), pengreen N(5), ;
  7512.       penblue N(5), fillred N(5), fillgreen N(5), fillblue N(5), pensize N(5), ;
  7513.       penpat N(5), fillpat N(5), fontface m, fontstyle N(3), fontsize N(3), ;
  7514.       mode N(3), ruler N(1), rulerlines N(1), grid l, gridv N(2), gridh N(2), ;
  7515.       SCHEME N(2), scheme2 N(2), colorpair C(8), lotype N(1), rangelo m, ;
  7516.       hitype N(1), rangehi m, whentype N(1), WHEN m, validtype N(1), VALID m, ;
  7517.       errortype N(1), ERROR m, messtype N(1), MESSAGE m, showtype N(1), SHOW m, ;
  7518.       activtype N(1), ACTIVATE m, deacttype N(1), DEACTIVATE m, proctype N(1), ;
  7519.       proccode m, setuptype N(1), setupcode m, FLOAT l, CLOSE l, MINIMIZE l, ;
  7520.       BORDER N(1), SHADOW l, CENTER l, REFRESH l, disabled l, scrollbar l, ;
  7521.       addalias l, TAB l, initialval m, initialnum N(3), spacing N(6,3), curpos l)
  7522.    
  7523. CASE m.type = c_report OR m.type = c_label
  7524.    CREATE CURSOR (m.name) (platform C(8), uniqueid C(10), timestamp N(10), objtype N(2), objcode N(3), ;
  7525.       name m, expr m, vpos N(9,3), hpos N(9,3), HEIGHT N(9,3), WIDTH N(9,3), ;
  7526.       STYLE m, PICTURE m, ORDER m, UNIQUE l, comment m, ENVIRON l, ;
  7527.       boxchar C(1), fillchar C(1), TAG m, tag2 m, penred N(5), pengreen N(5), ;
  7528.       penblue N(5), fillred N(5), fillgreen N(5), fillblue N(5), pensize N(5), ;
  7529.       penpat N(5), fillpat N(5), fontface m, fontstyle N(3), fontsize N(3), ;
  7530.       mode N(3), ruler N(1), rulerlines N(1), grid l, gridv N(2), gridh N(2), ;
  7531.       FLOAT l, STRETCH l, stretchtop l, TOP l, BOTTOM l, suptype N(1), suprest N(1), ;
  7532.       norepeat l, resetrpt N(2), pagebreak l, colbreak l, resetpage l, GENERAL N(3), ;
  7533.       spacing N(3), DOUBLE l, swapheader l, swapfooter l, ejectbefor l, ejectafter l, ;
  7534.       PLAIN l, SUMMARY l, addalias l, offset N(3), topmargin N(3), botmargin N(3), ;
  7535.       totaltype N(2), resettotal N(2), resoid N(3), curpos l, supalways l, supovflow l, ;
  7536.       suprpcol N(1), supgroup N(2), supvalchng l, supexpr m)
  7537. CASE m.type = c_project
  7538.    CREATE CURSOR (m.name) ;
  7539.       (name m, ;
  7540.       TYPE C(1), ;
  7541.       timestamp N(10), ;
  7542.       outfile m, ;
  7543.       homedir m, ;
  7544.       setid N(4), ;
  7545.       exclude l, ;
  7546.       mainprog l, ;
  7547.       arranged m, ;
  7548.       savecode l, ;
  7549.       defname l, ;
  7550.       openfiles l, ;
  7551.       closefiles l, ;
  7552.       defwinds l, ;
  7553.       relwinds l, ;
  7554.       readcycle l, ;
  7555.       multreads l, ;
  7556.       NOLOCK l, ;
  7557.       MODAL l, ;
  7558.       assocwinds m, ;
  7559.       DEBUG l, ;
  7560.       ENCRYPT l, ;
  7561.       nologo l, ;
  7562.       scrnorder N(3), ;
  7563.       cmntstyle N(1), ;
  7564.       objrev N(5), ;
  7565.       commands m, ;
  7566.       devinfo m, ;
  7567.       symbols m, ;
  7568.       OBJECT m, ;
  7569.       ckval N(6) ;
  7570.       )
  7571. ENDCASE
  7572.  
  7573. *
  7574. * makecursor - Create a cursor with the structure we need for this file on the 2.5 platform.
  7575. *
  7576. *!*****************************************************************************
  7577. *!
  7578. *!      Procedure: MAKECURSOR
  7579. *!
  7580. *!      Called by: TRANSPRT.PRG                      
  7581. *!               : CONVERTER          (procedure in TRANSPRT.PRG)
  7582. *!
  7583. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  7584. *!
  7585. *!*****************************************************************************
  7586. PROCEDURE makecursor
  7587. PRIVATE m.temp20alias, m.in_del
  7588.  
  7589. m.temp20alias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  7590. DO docreate WITH m.temp20alias, m.g_filetype
  7591. m.in_del = SET("DELETED")
  7592. SET DELETED ON
  7593. APPEND FROM (m.g_scrndbf)
  7594. SET DELETED &in_del
  7595.  
  7596. m.g_20alias = m.g_scrnalias
  7597. m.g_scrnalias = m.temp20alias
  7598.  
  7599.  
  7600. *
  7601. * AddGraphicalLabelGroups - Add page and column header records for a label.
  7602. *
  7603. *!*****************************************************************************
  7604. *!
  7605. *!      Procedure: ADDGRAPHICALLABELGROUPS
  7606. *!
  7607. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  7608. *!               : UPDATELABELDATA    (procedure in TRANSPRT.PRG)
  7609. *!
  7610. *!*****************************************************************************
  7611. PROCEDURE addgraphicallabelgroups
  7612.  
  7613. IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7614.    * First make sure that we don't already have these headers.  Check for a page header.
  7615.    LOCATE FOR objtype = c_otband AND objcode = 1
  7616.    IF FOUND()
  7617.       * We already have a page header.  We don't want two.  Reports, like people, function
  7618.       * best with only a single head.
  7619.       RETURN
  7620.    ENDIF
  7621.    
  7622.    APPEND BLANK
  7623.    REPLACE objtype WITH c_otband
  7624.    REPLACE objcode WITH 1
  7625.    REPLACE HEIGHT WITH 0
  7626.    REPLACE pagebreak WITH .F.
  7627.    REPLACE colbreak WITH .F.
  7628.    REPLACE resetpage WITH .F.
  7629.    REPLACE platform WITH m.g_toplatform
  7630.    REPLACE uniqueid WITH SYS(2015)
  7631.    
  7632.    APPEND BLANK
  7633.    REPLACE objtype WITH c_otband
  7634.    REPLACE objcode WITH 2
  7635.    REPLACE HEIGHT WITH 0
  7636.    REPLACE pagebreak WITH .F.
  7637.    REPLACE colbreak WITH .F.
  7638.    REPLACE resetpage WITH .F.
  7639.    REPLACE platform WITH m.g_toplatform
  7640.    REPLACE uniqueid WITH SYS(2015)
  7641.    
  7642.    APPEND BLANK
  7643.    REPLACE objtype WITH c_otband
  7644.    REPLACE objcode WITH 6
  7645.    REPLACE HEIGHT WITH 0
  7646.    REPLACE pagebreak WITH .F.
  7647.    REPLACE colbreak WITH .F.
  7648.    REPLACE resetpage WITH .F.
  7649.    REPLACE platform WITH m.g_toplatform
  7650.    REPLACE uniqueid WITH SYS(2015)
  7651.    
  7652.    APPEND BLANK
  7653.    REPLACE objtype WITH c_otband
  7654.    REPLACE objcode WITH 7
  7655.    REPLACE HEIGHT WITH 0
  7656.    REPLACE pagebreak WITH .F.
  7657.    REPLACE colbreak WITH .F.
  7658.    REPLACE resetpage WITH .F.
  7659.    REPLACE platform WITH m.g_toplatform
  7660.    REPLACE uniqueid WITH SYS(2015)
  7661. ENDIF
  7662.  
  7663. *
  7664. * UpdateLabelData - Labels live in report dataases now and we need to add at least one band
  7665. *            record if we are coming from a 2.0 label.
  7666. *
  7667. *!*****************************************************************************
  7668. *!
  7669. *!      Procedure: UPDATELABELDATA
  7670. *!
  7671. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7672. *!
  7673. *!          Calls: ADDGRAPHICALLABELGR(procedure in TRANSPRT.PRG)
  7674. *!
  7675. *!*****************************************************************************
  7676. PROCEDURE updatelabeldata
  7677. PARAMETER m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight
  7678.  
  7679. DO addgraphicallabelgroups
  7680.  
  7681. * We need a detail band for any platform.
  7682. APPEND BLANK
  7683. REPLACE objtype WITH c_otband
  7684. REPLACE objcode WITH 4
  7685. REPLACE HEIGHT WITH m.lbxheight
  7686. REPLACE pagebreak WITH .F.
  7687. REPLACE colbreak WITH .F.
  7688. REPLACE resetpage WITH .F.
  7689.  
  7690. LOCATE FOR objtype = c_ot20label
  7691. IF FOUND()
  7692.    REPLACE vpos WITH m.lbxnumacross
  7693.    REPLACE hpos WITH m.lbxlmargin
  7694.    REPLACE HEIGHT WITH m.lbxspacesbet
  7695.    REPLACE penblue WITH m.lbxlinesbet
  7696. ENDIF
  7697.  
  7698. *
  7699. * PlatformDefaults - Writes information to a record that would not exist on the source platform and
  7700. *         we don't add elsewhere.
  7701. *
  7702. *!*****************************************************************************
  7703. *!
  7704. *!      Procedure: PLATFORMDEFAULTS
  7705. *!
  7706. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7707. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  7708. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  7709. *!
  7710. *!*****************************************************************************
  7711. PROCEDURE platformdefaults
  7712. PARAMETER m.timestamp
  7713.  
  7714. IF m.timestamp > 0
  7715.    REPLACE uniqueid WITH SYS(2015)
  7716.    REPLACE timestamp WITH m.timestamp
  7717.    REPLACE platform WITH m.g_fromplatform
  7718. ENDIF
  7719.  
  7720. IF m.g_toplatform = "MAC" OR m.g_toplatform = "WINDOWS"
  7721.    REPLACE ruler WITH 1             && inches
  7722.    REPLACE rulerlines WITH 1
  7723.    REPLACE grid WITH .T.
  7724.    REPLACE gridv WITH 9
  7725.    REPLACE gridh WITH 9
  7726. ENDIF
  7727.  
  7728. *
  7729. * converter - Convert a 2.0 screen or report to 2.5 format and fill in the
  7730. *            appropriate fields.
  7731. *
  7732. *!*****************************************************************************
  7733. *!
  7734. *!      Procedure: CONVERTER
  7735. *!
  7736. *!      Called by: TRANSPRT.PRG                      
  7737. *!
  7738. *!          Calls: MAKECURSOR         (procedure in TRANSPRT.PRG)
  7739. *!               : UPDATELABELDATA    (procedure in TRANSPRT.PRG)
  7740. *!               : CONVERTPROJECT     (procedure in TRANSPRT.PRG)
  7741. *!               : STAMPVAL()         (function  in TRANSPRT.PRG)
  7742. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  7743. *!               : UPDATEVERSION      (procedure in TRANSPRT.PRG)
  7744. *!
  7745. *!*****************************************************************************
  7746. PROCEDURE converter
  7747. PRIVATE m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight, m.timestamp
  7748.  
  7749. DO CASE
  7750. CASE m.g_filetype = c_label
  7751.    LOCATE FOR objtype = c_ot20label
  7752.    IF FOUND()
  7753.       m.lbxnumacross   = numacross
  7754.       m.lbxlmargin     = lmargin
  7755.       m.lbxspacesbet   = spacesbet
  7756.       m.lbxlinesbet    = linesbet
  7757.       m.lbxheight      = HEIGHT
  7758.    ENDIF
  7759. ENDCASE
  7760.  
  7761. DO makecursor
  7762.  
  7763. DO CASE
  7764. CASE m.g_filetype = c_label
  7765.    DO updatelabeldata WITH m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight
  7766. CASE m.g_filetype = c_project
  7767.    DO convertproject
  7768.    RETURN
  7769. ENDCASE
  7770.  
  7771. m.timestamp = stampval()
  7772. SCAN
  7773.    DO platformdefaults WITH m.timestamp
  7774. ENDSCAN
  7775.  
  7776. DO updateversion
  7777.  
  7778. *
  7779. * UpdateVersion - Places the correct version number in the m.g_fromPlatfrom
  7780. *      records.
  7781. *!*****************************************************************************
  7782. *!
  7783. *!      Procedure: UPDATEVERSION
  7784. *!
  7785. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7786. *!
  7787. *!*****************************************************************************
  7788. PROCEDURE updateversion
  7789. LOCATE FOR platform = "DOS" AND objtype = c_otheader
  7790. IF FOUND()
  7791.    DO CASE
  7792.    CASE m.g_filetype = c_screen
  7793.       REPLACE objcode WITH c_25scx
  7794.    OTHERWISE
  7795.       REPLACE objcode WITH c_25frx
  7796.    ENDCASE
  7797. ENDIF
  7798.  
  7799. *
  7800. * SynchTime - Takes the names of two platforms and makes the timestamp of the header (objectype = 1)
  7801. *      record for the first platfrom match the timestamp of the header record of the second.
  7802. *
  7803. *!*****************************************************************************
  7804. *!
  7805. *!      Procedure: SYNCHTIME
  7806. *!
  7807. *!      Called by: TRANSPRT.PRG                      
  7808. *!
  7809. *!*****************************************************************************
  7810. PROCEDURE synchtime
  7811. PARAMETER m.convertedplatform, m.matchplatform
  7812. PRIVATE m.timestamp
  7813. LOCATE FOR platform = m.matchplatform AND objtype = c_otheader
  7814. IF FOUND()
  7815.    m.timestamp = timestamp
  7816.    LOCATE FOR platform = m.convertedplatform AND objtype = c_otheader
  7817.    IF FOUND()
  7818.       REPLACE timestamp WITH m.timestamp
  7819.    ENDIF
  7820. ENDIF
  7821.  
  7822. *
  7823. * Get a timestamp value based on the current date and time.
  7824. *
  7825. *!*****************************************************************************
  7826. *!
  7827. *!       Function: STAMPVAL
  7828. *!
  7829. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7830. *!
  7831. *!          Calls: SHIFTL()           (function  in TRANSPRT.PRG)
  7832. *!               : SHIFTR()           (function  in TRANSPRT.PRG)
  7833. *!
  7834. *!*****************************************************************************
  7835. FUNCTION stampval
  7836. PRIVATE m.dateval, m.timeval
  7837.  
  7838. m.dateval = DAY(DATE()) + ;
  7839.    shiftl(MONTH(DATE()), 5) + ;
  7840.    shiftl(YEAR(DATE())-1980, 9)
  7841.  
  7842. m.timeval = shiftr(VAL(RIGHT(TIME(),2)),1) + ;
  7843.    shiftl(VAL(SUBSTR(TIME(),3,2)),5) + ;
  7844.    shiftl(VAL(LEFT(TIME(),2)),11)
  7845.  
  7846. RETURN shiftl(m.dateval,16)+m.timeval
  7847.  
  7848. *
  7849. * Shift a value x times to the left.  (This isn't a true match for
  7850. * a shift since we keep extending the value without truncating it,
  7851. * but it works for us.)
  7852. *
  7853. *!*****************************************************************************
  7854. *!
  7855. *!       Function: SHIFTL
  7856. *!
  7857. *!      Called by: STAMPVAL()         (function  in TRANSPRT.PRG)
  7858. *!
  7859. *!*****************************************************************************
  7860. FUNCTION shiftl
  7861. PARAMETER m.value, m.times
  7862. PRIVATE m.loop
  7863.  
  7864. FOR m.loop = 1 TO m.times
  7865.    m.value = m.value * 2
  7866. ENDFOR
  7867. RETURN m.value
  7868.  
  7869. *
  7870. * Shift a value x times to the right.  (This isn't a true match for
  7871. * a shift since we keep extending the value without truncating it,
  7872. * but it works for us.)
  7873. *
  7874. *!*****************************************************************************
  7875. *!
  7876. *!       Function: SHIFTR
  7877. *!
  7878. *!      Called by: STAMPVAL()         (function  in TRANSPRT.PRG)
  7879. *!
  7880. *!*****************************************************************************
  7881. FUNCTION shiftr
  7882. PARAMETER m.value, m.times
  7883. PRIVATE m.loop
  7884.  
  7885. FOR m.loop = 1 TO m.times
  7886.    m.value = INT(m.value / 2)
  7887. ENDFOR
  7888. RETURN m.value
  7889.  
  7890. *
  7891. * EmptyPlatform - Takes a platform ID and returns .T. if no records for that platform
  7892. *       are in the file or .F. if some are present.
  7893. *
  7894. *!*****************************************************************************
  7895. *!
  7896. *!       Function: EMPTYPLATFORM
  7897. *!
  7898. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  7899. *!
  7900. *!*****************************************************************************
  7901. FUNCTION emptyplatform
  7902. PARAMETER m.platform
  7903. PRIVATE m.count
  7904. SELECT (m.g_scrnalias)
  7905.  
  7906. IF (FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld OR FCOUNT() = c_20lbxfld)
  7907.    RETURN .T.
  7908. ENDIF
  7909.  
  7910. COUNT TO m.count FOR platform = m.platform
  7911. IF m.count > 0
  7912.    RETURN .F.
  7913. ELSE
  7914.    RETURN .T.
  7915. ENDIF
  7916.  
  7917. **
  7918. ** Code Associated With Displaying the 2.0 to 2.5 conversion dialog.
  7919. **
  7920. *!*****************************************************************************
  7921. *!
  7922. *!       Function: STRUCTDIALOG
  7923. *!
  7924. *!      Called by: DOUPDATE()         (function  in TRANSPRT.PRG)
  7925. *!
  7926. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  7927. *!               : CURPOS()           (function  in TRANSPRT.PRG)
  7928. *!
  7929. *!*****************************************************************************
  7930. FUNCTION structdialog
  7931. PARAMETER m.textline
  7932. PRIVATE m.choice, m.ftype
  7933.  
  7934. DO CASE
  7935. CASE m.g_filetype = c_screen
  7936.    m.ftype = "screen "
  7937. CASE m.g_filetype = c_report
  7938.    m.ftype = "report "
  7939. CASE m.g_filetype = c_label
  7940.    m.ftype = "label "
  7941. CASE m.g_filetype = c_project
  7942.    m.ftype = "project "
  7943. OTHERWISE
  7944.    m.ftype = ""
  7945. ENDCASE
  7946.  
  7947. DO CASE
  7948. CASE m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7949.    IF NOT WEXIST("_q3p0w5ixe")
  7950.       DEFINE WINDOW _q3p0w5ixe ;
  7951.          AT 0,0 ;
  7952.          SIZE 5.076,58.333 ;
  7953.          TITLE "Konvertierung" ;
  7954.          FONT c_dlgface, c_dlgsize ;
  7955.          STYLE c_dlgstyle ;
  7956.          FLOAT ;
  7957.          CLOSE ;
  7958.          MINIMIZE ;
  7959.          SYSTEM
  7960.       MOVE WINDOW _q3p0w5ixe CENTER
  7961.    ENDIF
  7962.    
  7963.    IF WVISIBLE("_q3p0w5ixe")
  7964.       ACTIVATE WINDOW _q3p0w5ixe SAME
  7965.    ELSE
  7966.       ACTIVATE WINDOW _q3p0w5ixe NOSHOW
  7967.    ENDIF
  7968.    
  7969.    @ 1.000, (58.333 - TXTWIDTH(m.textline, c_dlgface, c_dlgsize, c_dlgstyle)) / 2 ;
  7970.       SAY m.textline ;
  7971.       SIZE 1.154,TXTWIDTH(m.textline, c_dlgface, c_dlgsize, c_dlgstyle) ;
  7972.       FONT c_dlgface, c_dlgsize ;
  7973.       STYLE c_dlgstyle
  7974.    
  7975.    @ 2.750,13.512 GET m.choice ;
  7976.       PICTURE "@*HT \!\<Ja;\?\<Abbrechen" ;
  7977.       SIZE 1.769,13.500,4.308 ;
  7978.       DEFAULT 1 ;
  7979.       FONT c_dlgface, 9 ;
  7980.       STYLE c_dlgstyle
  7981.    
  7982. CASE m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  7983.    IF NOT WEXIST("_q3p0w5ixe")
  7984.       DEFINE WINDOW _q3p0w5ixe ;
  7985.          FROM INT((SROW()-7)/2),INT((SCOL()-47)/2) ;
  7986.          TO INT((SROW()-7)/2)+7,INT((SCOL()-47)/2)+46 ;
  7987.          FLOAT ;
  7988.          NOCLOSE ;
  7989.          SHADOW ;
  7990.          DOUBLE ;
  7991.          COLOR SCHEME 7
  7992.    ENDIF
  7993.    
  7994.    IF WVISIBLE("_q3p0w5ixe")
  7995.       ACTIVATE WINDOW _q3p0w5ixe SAME
  7996.    ELSE
  7997.       ACTIVATE WINDOW _q3p0w5ixe NOSHOW
  7998.    ENDIF
  7999.    
  8000.    * Format the file name for display
  8001.    m.msg = "Datei: "+m.g_scrndbf
  8002.    IF LEN(m.msg) > 44
  8003.       m.msg = m.g_scrndbf
  8004.       IF LEN(m.msg) > 44
  8005.          m.msg = justfname(m.g_scrndbf)
  8006.       ENDIF
  8007.    ENDIF
  8008.    
  8009.    @ 1,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8010.    @ 2,(WCOLS()-LEN(m.textline))/2 SAY m.textline
  8011.    @ 4,2 GET m.choice ;
  8012.       PICTURE "@*HT \<Ja;\!\?\<Nein" ;
  8013.       SIZE 1,12,18 ;
  8014.       DEFAULT 1
  8015.    
  8016. OTHERWISE
  8017.    DO errorhandler WITH "Unbekannte Version.", LINENO(), c_error3
  8018.    RETURN .F.
  8019. ENDCASE
  8020.  
  8021. IF NOT WVISIBLE("_q3p0w5ixe")
  8022.    ACTIVATE WINDOW _q3p0w5ixe
  8023. ENDIF
  8024.  
  8025. READ CYCLE MODAL WHEN curpos()
  8026.  
  8027. RELEASE WINDOW _q3p0w5ixe
  8028.  
  8029. IF m.choice = 1
  8030.    RETURN .T.
  8031. ELSE
  8032.    RETURN .F.
  8033. ENDIF
  8034. RETURN
  8035.  
  8036. *!*****************************************************************************
  8037. *!
  8038. *!       Function: CURPOS
  8039. *!
  8040. *!      Called by: STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  8041. *!
  8042. *!*****************************************************************************
  8043. FUNCTION curpos
  8044. IF _DOS OR _UNIX
  8045.    _CUROBJ = 2
  8046. ENDIF
  8047. RETURN .T.
  8048.  
  8049. **
  8050. ** Code Associated With Displaying the Screen Convert Dialog Box
  8051. **
  8052. *!*****************************************************************************
  8053. *!
  8054. *!       Function: SCXFRXDIALOG
  8055. *!
  8056. *!      Called by: CONVERTTYPE()      (function  in TRANSPRT.PRG)
  8057. *!
  8058. *!          Calls: HASRECORDS()       (function  in TRANSPRT.PRG)
  8059. *!               : STRIPPATH()        (function  in TRANSPRT.PRG)
  8060. *!               : SCRNCTRL()         (function  in TRANSPRT.PRG)
  8061. *!               : TRANSPRMPT()       (function  in TRANSPRT.PRG)
  8062. *!               : PVALID()           (function  in TRANSPRT.PRG)
  8063. *!               : ASKFONT()          (function  in TRANSPRT.PRG)
  8064. *!               : ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8065. *!               : RDVALID()          (function  in TRANSPRT.PRG)
  8066. *!               : DEACCLAU()         (function  in TRANSPRT.PRG)
  8067. *!               : SHOWCLAU()         (function  in TRANSPRT.PRG)
  8068. *!
  8069. *!*****************************************************************************
  8070. FUNCTION scxfrxdialog
  8071. PARAMETER ftype
  8072. PRIVATE m.choice, m.fromplatform, m.dlgnum
  8073. m.choice = 0
  8074. DO CASE
  8075. CASE (_WINDOWS OR _MAC)
  8076.    IF m.ftype <> "LBX" AND (hasrecords("WINDOWS") OR hasrecords("MAC"))
  8077.       * No partial transport of labels
  8078.       
  8079.       m.fromplatform = "FoxPro fⁿr MS-DOS"
  8080.       m.dlgnum = 1
  8081.       m.g_allobjects = .F.
  8082.       
  8083.       * already contains some records for Windows or Mac
  8084.       DEFINE WINDOW transdlg ;
  8085.          AT  0.000, 0.000  ;
  8086.          SIZE 22.385,83.167 ;
  8087.          TITLE " Portieren" ;
  8088.          FONT c_dlgface, c_dlgsize ;
  8089.          STYLE c_dlgsty1;
  8090.          FLOAT ;
  8091.          CLOSE ;
  8092.          NOMINIMIZE ;
  8093.          DOUBLE 
  8094.       MOVE WINDOW transdlg CENTER
  8095.       
  8096.       IF WVISIBLE("transdlg")
  8097.          ACTIVATE WINDOW transdlg SAME
  8098.       ELSE
  8099.          ACTIVATE WINDOW transdlg NOSHOW
  8100.       ENDIF
  8101.       
  8102.       @ 14.077,1.667 TO 21.385,56.167 ;
  8103.          PEN 1, 8 ;
  8104.          STYLE "T"
  8105.       @ 13.615,2.667 SAY "Portieren" ;
  8106.          SIZE 1.000, 9.167, 0.000 ;
  8107.          FONT c_dlgface, c_dlgsize ;
  8108.          STYLE c_dlgsty1
  8109.       @ 1.000,2.667 SAY IIF(m.ftype = "SCX","Maskendatei:","Berichtsdatei:") ;
  8110.          SIZE 1.000,14.500, 0.000 ;
  8111.          FONT c_dlgface, c_dlgsize ;
  8112.          STYLE c_dlgstyle
  8113.       @ 1.000,17.667 SAY LOWER(strippath(m.g_scrndbf)) ;
  8114.          SIZE 1.000,21.833 ;
  8115.          FONT c_dlgface, c_dlgsize ;
  8116.          STYLE c_dlgsty1
  8117.       @ 3.077,2.667 SAY "In dieser Datei sind Objekte definiert, " + CHR(13) + ;
  8118.          "die nicht fⁿr die Plattform Windows sind." ;
  8119.          SIZE 2.000,54.000, 0.000 ;
  8120.          FONT c_dlgface, c_dlgsize ;
  8121.          STYLE c_dlgsty1
  8122.       @ 8.077,2.667 SAY "Durch Portieren dieser Datei werden Windows-Definitionen" + CHR(13) + ;
  8123.          "fⁿr Objekte in der Datei hinzugefⁿgt, aktualisiert oder ersetzt." ;
  8124.          SIZE 2.000,58.167, 0.000 ;
  8125.          FONT c_dlgface, c_dlgsize ;
  8126.          STYLE c_dlgsty1
  8127.       @ 11.385,2.667 SAY "Objekte portieren von: " ;
  8128.          SIZE 1.000,23.500 ;
  8129.          FONT c_dlgface, c_dlgsize ;
  8130.          STYLE c_dlgsty1
  8131.       @ 5.615,2.667 SAY "Die Objekte sind neu fⁿr Windows oder wurden " + CHR(13) + ;
  8132.          "spΣter verΣndert als ihre Windows-Entsprechungen." ;
  8133.          SIZE 2.000,54.833 ;
  8134.          FONT c_dlgface, c_dlgsize ;
  8135.          STYLE c_dlgsty1
  8136.       @ 17.846,7.500 SAY "als in der Windows-Version vorhandene Objekte" ;
  8137.          SIZE 1.000,43.667 ;
  8138.          FONT c_dlgface, c_dlgsize ;
  8139.          STYLE c_dlgsty1
  8140.       @ 11.231,25.833 GET m.fromplatform ;
  8141.          PICTURE "@^ FoxPro fⁿr MS-DOS;\FoxPro fⁿr Macintosh;\FoxPro fⁿr UNIX" ;
  8142.          SIZE 1.538,24.333 ;
  8143.          DEFAULT 1 ;
  8144.          FONT c_dlgface, c_dlgsize ;
  8145.          STYLE c_dlgsty1
  8146.       @ 14.923,4.500 GET m.g_newobjects ;
  8147.          PICTURE "@*C Fⁿr Windows neue Objekte" ;
  8148.          SIZE 1.308,28.167 ;
  8149.          DEFAULT .T. ;
  8150.          FONT c_dlgface, c_dlgsize ;
  8151.          STYLE c_dlgsty1 ;
  8152.          VALID scrnctrl()
  8153.       @ 16.538,4.500 GET m.g_snippets ;
  8154.          PICTURE "@*C Objekte, die spΣter geΣndert wurden" ;
  8155.          SIZE 1.308,43.667 ;
  8156.          DEFAULT .T. ;
  8157.          FONT c_dlgface, c_dlgsize ;
  8158.          STYLE c_dlgsty1 ;
  8159.          VALID scrnctrl()
  8160.       @ 19.385,4.500 GET m.g_allobjects ;
  8161.          PICTURE "@*C Alle Objekte -- Vorhandene Definitionen ersetzen" ;
  8162.          SIZE 1.308,43.833 ;
  8163.          DEFAULT .F. ;
  8164.          FONT c_dlgface, c_dlgsize ;
  8165.          STYLE c_dlgsty1 ;
  8166.          VALID scrnctrl()
  8167.       @ 0.615,58.667 GET m.choice ;
  8168.          PICTURE "@*VNT "+transprmpt()+";UnverΣndert ÷ffnen;\?Abbrechen" ;
  8169.          SIZE 1.769,23.000,0.308 ;
  8170.          DEFAULT 1 ;
  8171.          FONT c_dlgface, c_dlgsize ;
  8172.          STYLE c_dlgsty1 ;
  8173.          VALID pvalid()
  8174.       @ 14.077,58.667 GET m.g_askfont ;
  8175.          PICTURE "@*VN Schriftart..." ;
  8176.          SIZE 1.769,23.000,0.308 ;
  8177.          DEFAULT 1 ;
  8178.          FONT c_dlgface, c_dlgsize ;
  8179.          STYLE c_dlgsty1 ;
  8180.          VALID askfont()
  8181.    ELSE    && no existing WINDOWS/MAC records
  8182.       m.fromplatform = "FoxPro fⁿr MS-DOS"
  8183.       m.dlgnum = 2
  8184.       DEFINE WINDOW transdlg ;
  8185.          AT 0.000, 0.000 ;
  8186.          SIZE 13.077,72.167 ;
  8187.          FONT c_dlgface, c_dlgsize ;
  8188.          STYLE c_dlgsty1 ;
  8189.          TITLE " Portieren" ;
  8190.          FLOAT ;
  8191.          CLOSE ;
  8192.          NOMINIMIZE ;
  8193.          DOUBLE
  8194.       MOVE WINDOW transdlg CENTER
  8195.       
  8196.       IF WVISIBLE("transdlg")
  8197.          ACTIVATE WINDOW transdlg SAME
  8198.       ELSE
  8199.          ACTIVATE WINDOW transdlg NOSHOW
  8200.       ENDIF
  8201.       
  8202.       @ 1.000,2.667 SAY IIF(m.ftype = "SCX","Maskendatei:",;
  8203.          IIF(m.ftype = "FRX","Berichtsdatei:","Etikettendatei:")) ;
  8204.          SIZE 1.000,14.500, 0.000 ;
  8205.          FONT c_dlgface, c_dlgsize ;
  8206.          STYLE c_dlgstyle
  8207.       @ 1.000,17.667 SAY LOWER(strippath(m.g_scrndbf)) ;
  8208.          SIZE 1.000,21.833 ;
  8209.          FONT c_dlgface, c_dlgsize ;
  8210.          STYLE c_dlgsty1
  8211.       @ 3.077,2.667 SAY "In dieser Datei sind Objekte, die nicht " + CHR(13) + ;
  8212.          "fⁿr die Plattform Windows definiert wurden." ;
  8213.          SIZE 2.000,42.000, 0.000 ;
  8214.          FONT c_dlgface, c_dlgsize ;
  8215.          STYLE c_dlgstyle
  8216.       @ 5.923,2.667 SAY "Durch Portieren dieser Datei werden Windows-" + CHR(13) + ;
  8217.          "Definitionen fⁿr diese Objekte erstellt." ;
  8218.          SIZE 2.000,44.833, 0.000 ;
  8219.          FONT c_dlgface, c_dlgsize ;
  8220.          STYLE c_dlgstyle
  8221.       @ 8.923,2.667 SAY "Objekte portieren von: " ;
  8222.          SIZE 1.000,23.500, 0.000 ;
  8223.          FONT c_dlgface, c_dlgsize ;
  8224.          STYLE c_dlgsty1
  8225.       @ 10.154,2.667 GET m.fromplatform ;
  8226.          PICTURE "@^ FoxPro fⁿr MS-DOS;\FoxPro fⁿr Macintosh;\FoxPro fⁿr UNIX" ;
  8227.          SIZE 1.538,24.333 ;
  8228.          FONT c_dlgface, c_dlgsize ;
  8229.          STYLE c_dlgsty1
  8230.       @ 7.846,47.833 GET m.g_askfont ;
  8231.          PICTURE "@*VN Schriftart..." ;
  8232.          SIZE 1.769,23.000,0.308 ;
  8233.          DEFAULT 1 ;
  8234.          FONT c_dlgface, c_dlgsize ;
  8235.          STYLE c_dlgsty1 ;
  8236.          VALID askfont()
  8237.       @ 0.615,47.833 GET m.choice ;
  8238.          PICTURE "@*VNT "+transprmpt()+";\?Abbrechen" ;
  8239.          SIZE 1.769,23.000,0.308 ;
  8240.          DEFAULT 1 ;
  8241.          FONT c_dlgface, c_dlgsize ;
  8242.          STYLE c_dlgsty1 ;
  8243.          VALID pvalid()
  8244.    ENDIF
  8245. CASE _DOS OR _UNIX
  8246.    m.fromplatform = "FoxPro fⁿr Windows"
  8247.    IF m.ftype <> "LBX" AND (hasrecords("DOS") OR hasrecords("UNIX"))
  8248.       m.dlgnum = 1
  8249.       m.g_allobjects = .F.
  8250.       
  8251.       DEFINE WINDOW transdlg ;
  8252.          FROM INT((SROW()-21)/2),INT((SCOL()-69)/2) ;
  8253.          TO INT((SROW()-21)/2)+20,INT((SCOL()-69)/2)+68 ;
  8254.          FLOAT ;
  8255.          CLOSE ;
  8256.          SHADOW ;
  8257.          NOMINIMIZE ;
  8258.          DOUBLE ;
  8259.          COLOR SCHEME 5
  8260.       
  8261.       IF WVISIBLE("transdlg")
  8262.          ACTIVATE WINDOW transdlg SAME
  8263.       ELSE
  8264.          ACTIVATE WINDOW transdlg NOSHOW
  8265.       ENDIF
  8266.       
  8267.       @ 11,2 TO 16,57
  8268.       @ 1,2 SAY IIF(m.g_filetype = c_screen,"Maskendatei:","Berichtsdatei:") ;
  8269.          SIZE 1,15, 0
  8270.       @ 1,16 SAY UPPER(strippath(m.g_scrndbf)) ;
  8271.          SIZE 1,19
  8272.       @ 3,2 SAY "In dieser Datei sind Objekte definiert," ;
  8273.          SIZE 1,39, 0
  8274.       @ 4,2 SAY "die nicht fⁿr die Plattform MS-DOS sind." ;
  8275.          SIZE 1,40, 0
  8276.       @ 9,4 SAY "Objekte portieren von:" ;
  8277.          SIZE 1,23, 0
  8278.       @ 8,29 GET m.fromplatform ;
  8279.          PICTURE "@^ FoxPro fⁿr Windows;\FoxPro for Macintosh;\FoxPro for UNIX" ;
  8280.          SIZE 3,24 ;
  8281.          DEFAULT "FoxPro fⁿr Windows" ;
  8282.          COLOR SCHEME 5, 6
  8283.       @ 1,46 GET m.choice ;
  8284.          PICTURE "@*VNT \!Portieren & ÷ffnen;UnverΣndert ÷ffnen;\?Abbrechen" ;
  8285.          SIZE 1,20,1 ;
  8286.          DEFAULT 1 ;
  8287.          VALID pvalid()
  8288.       @ 11,4 SAY "Portieren" ;
  8289.          SIZE 1,9, 0
  8290.       @ 12,4 GET m.g_newobjects ;
  8291.          PICTURE "@*C Fⁿr MS-DOS neue Objekte" ;
  8292.          SIZE 1,25 ;
  8293.          DEFAULT .T. ;
  8294.          VALID scrnctrl()
  8295.       @ 13,4 GET m.g_snippets ;
  8296.          PICTURE "@*C Objekte, die spΣter geΣndert wurden" ;
  8297.          SIZE 1,34 ;
  8298.          DEFAULT .T. ;
  8299.          VALID scrnctrl()
  8300.       @ 14,8 SAY "als in der MS-DOS-Version vorhandene Objekte" ;
  8301.          SIZE 1,30, 0
  8302.       @ 15,4 GET m.g_allobjects ;
  8303.          PICTURE "@*C Alle Objekte -- Vorhandene Definitionen ersetzen" ;
  8304.          SIZE 1,47 ;
  8305.          DEFAULT .F. ;
  8306.          VALID scrnctrl()
  8307.       @ 7,2 SAY "hinzugefⁿgt, aktualisiert oder ersetzt." ;
  8308.          SIZE 1,40, 0
  8309.       @ 5,2 SAY "Durch Portieren dieser Datei, werden " ;
  8310.          SIZE 1,40, 0
  8311.       @ 6,2 SAY "MS-DOS-Definitionen fⁿr Objekte in der Datei" ;
  8312.          SIZE 1,44, 0
  8313.       
  8314.       IF NOT WVISIBLE("transdlg")
  8315.          ACTIVATE WINDOW transdlg
  8316.       ENDIF
  8317.    ELSE
  8318.       m.dlgnum = 2
  8319.       
  8320.       DEFINE WINDOW transdlg ;
  8321.          FROM INT((SROW()-15)/2),INT((SCOL()-68)/2) ;
  8322.          TO INT((SROW()-15)/2)+14,INT((SCOL()-68)/2)+67 ;
  8323.          FLOAT ;
  8324.          NOCLOSE ;
  8325.          SHADOW ;
  8326.          NOMINIMIZE ;
  8327.          DOUBLE ;
  8328.          COLOR SCHEME 5
  8329.       
  8330.       IF WVISIBLE("transdlg")
  8331.          ACTIVATE WINDOW transdlg SAME
  8332.       ELSE
  8333.          ACTIVATE WINDOW transdlg NOSHOW
  8334.       ENDIF
  8335.       
  8336.       @ 1,2 SAY IIF(m.g_filetype = c_screen,"Maskendatei:","Berichtsdatei:") ;
  8337.          SIZE 1,15, 0
  8338.       @ 1,16 SAY UPPER(strippath(m.g_scrndbf)) ;
  8339.          SIZE 1,19
  8340.       @ 3,2 SAY "In dieser Datei sind Objekte definiert," ;
  8341.          SIZE 1,39, 0
  8342.       @ 4,2 SAY "die nicht fⁿr die Plattform MS-DOS sind." ;
  8343.          SIZE 1,40, 0
  8344.       @ 8,4 SAY "Objekte portieren aus:" ;
  8345.          SIZE 1,23, 0
  8346.       @ 9,4 GET m.fromplatform ;
  8347.          PICTURE "@^ FoxPro fⁿr Windows;\FoxPro fⁿr Macintosh;\FoxPro fⁿr UNIX" ;
  8348.          SIZE 3,24 ;
  8349.          DEFAULT "FoxPro fⁿr Windows" ;
  8350.          COLOR SCHEME 5, 6
  8351.       @ 1,45 GET m.choice ;
  8352.          PICTURE "@*VNT \!Portieren & ÷ffnen;\?Abbrechen" ;
  8353.          SIZE 1,20,1 ;
  8354.          DEFAULT 1 ;
  8355.          VALID pvalid()
  8356.       @ 5,2 SAY "Durch Portieren dieser Datei, werden" ;
  8357.          SIZE 1,39, 0
  8358.       @ 6,2 SAY "MS-DOS-Definitionen fⁿr diese Objekte erstellt." ;
  8359.          SIZE 1,47, 0
  8360.       
  8361.       IF NOT WVISIBLE("transdlg")
  8362.          ACTIVATE WINDOW transdlg
  8363.       ENDIF
  8364.    ENDIF
  8365. OTHERWISE
  8366.    DO errorhandler WITH "Unbekannte Version von FoxPro.", LINENO(), c_error3
  8367.    RETURN .F.
  8368. ENDCASE
  8369.  
  8370. IF NOT WVISIBLE("transdlg")
  8371.    ACTIVATE WINDOW transdlg
  8372. ENDIF
  8373.  
  8374. READ CYCLE MODAL ;
  8375.    VALID rdvalid(m.dlgnum) ;
  8376.    DEACTIVATE deacclau() ;
  8377.    SHOW showclau()
  8378.  
  8379. RELEASE WINDOW transdlg
  8380.  
  8381. *
  8382. * We could simply return m.choice, but this way we can mess with the dialog without changing
  8383. * the defines.
  8384. *
  8385. DO CASE
  8386. CASE m.choice = 1
  8387.    RETURN c_yes
  8388. CASE m.choice = 2 AND m.dlgnum = 1
  8389.    RETURN c_no
  8390. OTHERWISE
  8391.    RETURN c_cancel
  8392. ENDCASE
  8393. RETURN
  8394.  
  8395. *
  8396. * TRANSPRMPT - Determine the prompt for the transport button
  8397. *
  8398. *!*****************************************************************************
  8399. *!
  8400. *!       Function: TRANSPRMPT
  8401. *!
  8402. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8403. *!
  8404. *!*****************************************************************************
  8405. FUNCTION transprmpt
  8406. * Debts must be paid
  8407. HOUR = LEFT(TIME(),2)
  8408. IF (DOW(DATE()) = 7 AND HOUR >= "23" AND HOUR < "24") OR ATC("ENERGIZE",GETENV("TRANSPRT")) > 0
  8409.    g_energize = .T.
  8410.    RETURN "\!Aktivieren"       && Beam me up
  8411. ELSE
  8412.    RETURN "\!Portieren und ÷ffnen"
  8413. ENDIF
  8414.  
  8415. *
  8416. * RDVALID() - Prompts for overwriting all objects if g_allobjects is true
  8417. *
  8418. *!*****************************************************************************
  8419. *!
  8420. *!       Function: RDVALID
  8421. *!
  8422. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8423. *!
  8424. *!          Calls: VERSIONCAP()       (function  in TRANSPRT.PRG)
  8425. *!
  8426. *!*****************************************************************************
  8427. FUNCTION rdvalid
  8428. PARAMETER dlgnum
  8429. IF m.g_allobjects AND m.dlgnum = 1 AND m.choice = 1
  8430.    IF _WINDOWS OR _MAC
  8431.       DEFINE WINDOW msgscrn ;
  8432.          AT 0.000, 0.000 ;
  8433.          SIZE 7.308,45.667 ;
  8434.          FONT c_dlgface, c_dlgsize ;
  8435.          STYLE c_dlgsty1 ;
  8436.          NOFLOAT ;
  8437.          NOCLOSE ;
  8438.          NOMINIMIZE ;
  8439.          DOUBLE
  8440.       MOVE WINDOW msgscrn CENTER
  8441.       
  8442.       IF WVISIBLE("msgscrn")
  8443.          ACTIVATE WINDOW msgscrn SAME
  8444.       ELSE
  8445.          ACTIVATE WINDOW msgscrn NOSHOW
  8446.       ENDIF
  8447.       
  8448.       @ 0.923,2.833 SAY "Das Portieren aller Objekte wird alle in der" + CHR(13) + ;
  8449.          "Datei vorhandenen Objektdefinitionen" + CHR(13) + ;
  8450.          "aus "+versioncap(m.g_toplatform)+" ⁿberschreiben." ;
  8451.          SIZE 3.000,41.833, 0.000 ;
  8452.          PICTURE "@I" ;
  8453.          FONT c_dlgface, c_dlgsize ;
  8454.          STYLE c_dlgstyle
  8455.       @ 4.769,10.833 GET m.okcancl ;
  8456.          PICTURE "@*HNT OK;Abbrechen" ;
  8457.          SIZE 1.769,12.667,0.667 ;
  8458.          DEFAULT 1 ;
  8459.          FONT c_dlgface,c_dlgsize ;
  8460.          STYLE c_dlgstyle
  8461.    ELSE
  8462.       DEFINE WINDOW msgscrn ;
  8463.          FROM INT((SROWS()-8)/2),19 ;
  8464.          TO INT((SROWS()+8)/2),62 ;
  8465.          NOFLOAT ;
  8466.          NOCLOSE ;
  8467.          NOMINIMIZE ;
  8468.          DOUBLE ;
  8469.          COLOR SCHEME 7
  8470.       MOVE WINDOW msgscrn CENTER
  8471.       
  8472.       IF WVISIBLE("msgscrn")
  8473.          ACTIVATE WINDOW msgscrn SAME
  8474.       ELSE
  8475.          ACTIVATE WINDOW msgscrn NOSHOW
  8476.       ENDIF
  8477.       
  8478.       @ 1,0 SAY PADC("Das Portieren aller Objekte wird alle in",WCOLS())
  8479.       @ 2,0 SAY PADC("der Datei vorhandenen Objektdefinitionen",WCOLS())
  8480.       @ 3,0 SAY PADC("aus "+versioncap(m.g_toplatform)+" ⁿberschreiben.",WCOLS())
  8481.       
  8482.       
  8483.       @ 5,8 GET m.okcancl ;
  8484.          PICTURE "@*HNT OK;Abbrechen" ;
  8485.          SIZE 1,13 ;
  8486.          DEFAULT 1
  8487.    ENDIF
  8488.    
  8489.    IF NOT WVISIBLE("msgscrn")
  8490.       ACTIVATE WINDOW msgscrn
  8491.    ENDIF
  8492.    
  8493.    READ CYCLE
  8494.    
  8495.    RELEASE WINDOW msgscrn
  8496.    
  8497.    IF okcancl = 2
  8498.       RETURN .F.
  8499.    ELSE
  8500.       RETURN .T.
  8501.    ENDIF
  8502. ENDIF
  8503.  
  8504. *
  8505. * DEACCLAU - Deactivate clause code.  Clear current read if window closes.
  8506. *
  8507. *!*****************************************************************************
  8508. *!
  8509. *!       Function: DEACCLAU
  8510. *!
  8511. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8512. *!
  8513. *!*****************************************************************************
  8514. FUNCTION deacclau
  8515. CLEAR READ
  8516. RETURN .T.
  8517.  
  8518. *
  8519. * SHOWCLAU - Refresh GETS
  8520. *
  8521. *!*****************************************************************************
  8522. *!
  8523. *!       Function: SHOWCLAU
  8524. *!
  8525. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8526. *!
  8527. *!*****************************************************************************
  8528. FUNCTION showclau
  8529. IF m.dlgnum = 2
  8530.    RETURN
  8531. ENDIF
  8532.  
  8533. IF g_snippets=.T. OR g_newobjects = .T.
  8534.    SHOW GET g_allobjects DISABLE
  8535. ELSE
  8536.    SHOW GET g_allobjects ENABLE
  8537. ENDIF
  8538.  
  8539. IF g_allobjects
  8540.    SHOW GET g_snippets   DISABLE
  8541.    SHOW GET g_newobjects DISABLE
  8542.    DO CASE
  8543.    CASE (_WINDOWS OR _MAC) AND RGBSCHEME(1,10) <> "RGB(0,0,0,255,255,255)"
  8544.       @ 17.846,7.500 SAY "als in der Windows-Version vorhandene Objekte" ;
  8545.          COLOR (RGBSCHEME(1,10))
  8546.    CASE (_WINDOWS OR _MAC) AND RGBSCHEME(1,10) == "RGB(0,0,0,255,255,255)"
  8547.       @ 17.846,7.500 SAY "als in der Windows-Version vorhandene Objekte" ;
  8548.          COLOR RGB(192,192,192,255,255,255)
  8549.    OTHERWISE
  8550.       @ 14,8 SAY "als in der MS-DOS-Version vorhandene Objekte" ;
  8551.          COLOR (SCHEME(5,10))
  8552.    ENDCASE
  8553. ELSE
  8554.    SHOW GET g_snippets   ENABLE
  8555.    SHOW GET g_newobjects ENABLE
  8556.    IF _WINDOWS OR _MAC
  8557.       @ 17.846,7.500 SAY "als in der Windows-Version vorhandene Objekte"
  8558.    ELSE
  8559.       @ 14,8 SAY "als in der MS-DOS-Version vorhandene Objekte"
  8560.    ENDIF
  8561. ENDIF
  8562.  
  8563. IF !g_allobjects AND g_snippets = .F. AND g_newobjects = .F.
  8564.    SHOW GET m.choice,1 DISABLE
  8565. ELSE
  8566.    SHOW GET m.choice,1 ENABLE
  8567. ENDIF
  8568.  
  8569. *
  8570. * SCRNCTRL - Called for check box validation from the first dialog
  8571. *
  8572. *!*****************************************************************************
  8573. *!
  8574. *!       Function: SCRNCTRL
  8575. *!
  8576. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8577. *!
  8578. *!*****************************************************************************
  8579. FUNCTION scrnctrl
  8580. SHOW GETS OFF
  8581. RETURN .T.
  8582.  
  8583. *
  8584. * Makes sure the proper options are enabled based on the setting of m.g_allobjects
  8585. *
  8586. *!*****************************************************************************
  8587. *!
  8588. *!       Function: ENABLEPROC
  8589. *!
  8590. *!*****************************************************************************
  8591. FUNCTION enableproc
  8592. IF m.g_allobjects
  8593.    SHOW GET m.g_newobjects DISABLE
  8594.    SHOW GET m.g_snippets DISABLE
  8595. ELSE
  8596.    SHOW GET m.g_newobjects ENABLE
  8597.    SHOW GET m.g_snippets ENABLE
  8598. ENDIF
  8599.  
  8600. *
  8601. * Fills the m.g_fromplatform global variable when the user leaves the dialog.
  8602. *
  8603. *!*****************************************************************************
  8604. *!
  8605. *!       Function: PVALID
  8606. *!
  8607. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8608. *!
  8609. *!*****************************************************************************
  8610. FUNCTION pvalid
  8611. DO CASE
  8612. CASE ATC('DOS',m.fromplatform) > 0
  8613.    m.g_fromplatform = 'DOS'
  8614. CASE ATC('WINDOWS',m.fromplatform) > 0
  8615.    m.g_fromplatform = 'WINDOWS'
  8616. CASE ATC('MAC',m.fromplatform) > 0
  8617.    m.g_fromplatform = 'MAC'
  8618. CASE ATC('UNIX',m.fromplatform) > 0
  8619.    m.g_fromplatform = 'UNIX'
  8620. ENDCASE
  8621.  
  8622. **
  8623. ** Code Associated With Displaying of the Thermometer
  8624. **
  8625.  
  8626. *!*****************************************************************************
  8627. *!
  8628. *!      Procedure: STARTTHERM
  8629. *!
  8630. *!      Called by: TRANSPRT.PRG                      
  8631. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  8632. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  8633. *!
  8634. *!          Calls: ACTTHERM           (procedure in TRANSPRT.PRG)
  8635. *!
  8636. *!*****************************************************************************
  8637. PROCEDURE starttherm
  8638. PARAMETER VERB,filetype
  8639. *  Start the thermometer with the appropriate message.
  8640. DO CASE
  8641. CASE m.filetype = c_screen
  8642.    DO acttherm WITH VERB+' Maske: '
  8643. CASE m.filetype = c_report
  8644.    DO acttherm WITH VERB+' Bericht: '
  8645. CASE m.filetype  = c_label
  8646.    DO acttherm WITH VERB+' Etikett: '
  8647. ENDCASE
  8648.  
  8649. *
  8650. * ACTTHERM(<text>) - Activate thermometer.
  8651. *
  8652. * Activates thermometer.  Update the thermometer with UPDTHERM().
  8653. * Thermometer window is named "thermometer."  Be sure to RELEASE
  8654. * this window when done with thermometer.  Creates the global
  8655. * m.g_thermwidth.
  8656. *
  8657. *!*****************************************************************************
  8658. *!
  8659. *!      Procedure: ACTTHERM
  8660. *!
  8661. *!      Called by: STARTTHERM         (procedure in TRANSPRT.PRG)
  8662. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  8663. *!
  8664. *!*****************************************************************************
  8665. PROCEDURE acttherm
  8666. PARAMETER m.text
  8667. PRIVATE m.prompt
  8668.  
  8669. IF _WINDOWS OR _MAC
  8670.    m.prompt = LOWER(m.g_scrndbf)
  8671.    IF TXTWIDTH(m.prompt, c_dlgface, c_dlgsize, c_dlgstyle) > 43
  8672.       DO WHILE TXTWIDTH(m.prompt+"...", c_dlgface, c_dlgsize, c_dlgstyle) > 43
  8673.          m.prompt = LEFT(m.prompt, LEN(m.prompt)-1)
  8674.       ENDDO
  8675.       m.prompt = m.prompt + "..."
  8676.    ENDIF
  8677.    
  8678.    IF !WEXIST("thermomete")
  8679.       DEFINE WINDOW thermomete ;
  8680.          AT 0,0 ;
  8681.          SIZE 5.615,63.833 ;
  8682.          FONT c_dlgface, c_dlgsize ;
  8683.          STYLE c_dlgstyle ;
  8684.          NOFLOAT ;
  8685.          NOCLOSE ;
  8686.          NONE ;
  8687.          COLOR RGB(0, 0, 0, 192, 192, 192)
  8688.    ENDIF
  8689.    MOVE WINDOW thermomete CENTER
  8690.    ACTIVATE WINDOW thermomete NOSHOW
  8691.    
  8692.    @ 0.5,3 SAY m.text FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  8693.    @ 1.5,3 SAY m.prompt FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  8694.    @ 0.000,0.000 TO 0.000,63.833 ;
  8695.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8696.    @ 0.000,0.000 TO 5.615,0.000 ;
  8697.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8698.    @ 0.385,0.667 TO 5.231,0.667 ;
  8699.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8700.    @ 0.308,0.667 TO 0.308,63.167 ;
  8701.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8702.    @ 0.385,63.000 TO 5.308,63.000 ;
  8703.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8704.    @ 5.231,0.667 TO 5.231,63.167 ;
  8705.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8706.    @ 5.538,0.000 TO 5.538,63.833 ;
  8707.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8708.    @ 0.000,63.667 TO 5.615,63.667 ;
  8709.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8710.    @ 3.000,3.333 TO 4.231,3.333 ;
  8711.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8712.    @ 3.000,60.333 TO 4.308,60.333 ;
  8713.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8714.    @ 3.000,3.333 TO 3.000,60.333 ;
  8715.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8716.    @ 4.231,3.333 TO 4.231,60.500 ;
  8717.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8718.    m.g_thermwidth = 56.269
  8719.    
  8720.    SHOW WINDOW thermomete TOP
  8721. ELSE
  8722.    m.prompt = SUBSTR(SYS(2014,m.g_scrndbf),1,48)+;
  8723.       IIF(LEN(m.g_scrndbf)>48,"...","")
  8724.    IF !WEXIST("thermomete")
  8725.       DEFINE WINDOW thermomete;
  8726.          FROM INT((SROW()-7)/2), INT((SCOL()-57)/2) ;
  8727.          TO INT((SROW()-7)/2) + 6, INT((SCOL()-57)/2) + 57;
  8728.          DOUBLE COLOR SCHEME 5
  8729.    ENDIF
  8730.    ACTIVATE WINDOW thermomete NOSHOW
  8731.    
  8732.    m.g_thermwidth = 50
  8733.    @ 0,3 SAY m.text
  8734.    @ 1,3 SAY UPPER(m.prompt)
  8735.    @ 2,1 TO 4,m.g_thermwidth+4 &g_boxstrg
  8736.    
  8737.    SHOW WINDOW thermomete TOP
  8738. ENDIF
  8739.  
  8740. *
  8741. * UPDTHERM(<percent>) - Update thermometer.
  8742. *
  8743. *!*****************************************************************************
  8744. *!
  8745. *!      Procedure: UPDTHERM
  8746. *!
  8747. *!      Called by: TRANSPRT.PRG                      
  8748. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  8749. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  8750. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  8751. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  8752. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  8753. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  8754. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  8755. *!               : ALLENVIRONS        (procedure in TRANSPRT.PRG)
  8756. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  8757. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  8758. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  8759. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  8760. *!               : CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  8761. *!               : FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  8762. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  8763. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  8764. *!               : JOINLINES          (procedure in TRANSPRT.PRG)
  8765. *!               : WRITERESULT        (procedure in TRANSPRT.PRG)
  8766. *!
  8767. *!          Calls: ACTTHERM           (procedure in TRANSPRT.PRG)
  8768. *!
  8769. *!*****************************************************************************
  8770. PROCEDURE updtherm
  8771. PARAMETER m.percent
  8772. PRIVATE m.nblocks, m.percent
  8773.  
  8774. IF m.percent > 100
  8775.    m.percent = 100
  8776. ENDIF
  8777. IF !WEXIST("thermomete")
  8778.    DO acttherm WITH ""
  8779. ENDIF
  8780. ACTIVATE WINDOW thermomete
  8781. m.nblocks = (m.percent/100) * (m.g_thermwidth)
  8782. IF _WINDOWS OR _MAC
  8783.    @ 3.000,3.333 TO 4.231,m.nblocks + 3.333 ;
  8784.       PATTERN 1 COLOR RGB(128, 128, 128, 128, 128, 128)
  8785. ELSE
  8786.    @ 3,3 SAY REPLICATE("█",m.nblocks)
  8787. ENDIF
  8788.  
  8789. *
  8790. * deactTherm - Deactivate and Release thermometer window.
  8791. *
  8792. *!*****************************************************************************
  8793. *!
  8794. *!      Procedure: DEACTTHERM
  8795. *!
  8796. *!      Called by: CLEANUP            (procedure in TRANSPRT.PRG)
  8797. *!
  8798. *!*****************************************************************************
  8799. PROCEDURE deacttherm
  8800. IF WEXIST("thermomete")
  8801.    RELEASE WINDOW thermomete
  8802. ENDIF
  8803.  
  8804. *
  8805. * ERRORHANDLER - Error Processing Center.
  8806. *
  8807. *!*****************************************************************************
  8808. *!
  8809. *!      Procedure: ERRORHANDLER
  8810. *!
  8811. *!      Called by: TRANSPRT.PRG                      
  8812. *!               : SETVERSION         (procedure in TRANSPRT.PRG)
  8813. *!               : cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  8814. *!               : STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  8815. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8816. *!
  8817. *!          Calls: CLEANUP            (procedure in TRANSPRT.PRG)
  8818. *!               : ERRSHOW            (procedure in TRANSPRT.PRG)
  8819. *!               : CLEANWIND          (procedure in TRANSPRT.PRG)
  8820. *!
  8821. *!*****************************************************************************
  8822. PROCEDURE errorhandler
  8823. PARAMETERS m.msg, m.linenum, errcode
  8824. IF ERROR() = 22
  8825.    ON ERROR &onerror
  8826.    m.g_status = 1
  8827.    DO cleanup
  8828.    CANCEL
  8829. ENDIF
  8830. SET MESSAGE TO
  8831. DO CASE
  8832. CASE errcode == c_error1
  8833.    m.g_status = 1
  8834. CASE errcode == c_error2
  8835.    DO errshow WITH m.msg, m.linenum
  8836.    m.g_status = 2
  8837.    ON ERROR &onerror
  8838. CASE errcode == c_error3
  8839.    ON ERROR &onerror
  8840.    DO errshow WITH m.msg, m.linenum
  8841.    DO cleanwind
  8842.    m.g_status = 3
  8843.    m.g_returncode = c_cancel
  8844.    DO cleanup WITH .T.
  8845. ENDCASE
  8846.  
  8847. *
  8848. * CLEANWIND - Release windows that might still be open
  8849. *
  8850. *!*****************************************************************************
  8851. *!
  8852. *!      Procedure: CLEANWIND
  8853. *!
  8854. *!      Called by: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8855. *!               : ESCHANDLER         (procedure in TRANSPRT.PRG)
  8856. *!
  8857. *!*****************************************************************************
  8858. PROCEDURE cleanwind
  8859. IF WEXIST("transdlg") AND WVISIBLE("transdlg")
  8860.    RELEASE WINDOW transdlg
  8861. ENDIF
  8862. IF WEXIST("lblwind") AND WVISIBLE("lblwind")
  8863.    RELEASE WINDOW lblwind
  8864. ENDIF
  8865. IF WEXIST("msgscrn") AND WVISIBLE("msgscrn")
  8866.    RELEASE WINDOW msgscrn
  8867. ENDIF
  8868. IF WEXIST("Thermomete") AND WVISIBLE("Thermomete")
  8869.    RELEASE WINDOW thermomete
  8870. ENDIF
  8871. IF WEXIST("tpselect") AND WVISIBLE("tpselect")
  8872.    RELEASE WINDOW tpselect
  8873. ENDIF
  8874.  
  8875. *
  8876. * ESCHANDLER - Escape handler.
  8877. *
  8878. *!*****************************************************************************
  8879. *!
  8880. *!      Procedure: ESCHANDLER
  8881. *!
  8882. *!      Called by: SETALL             (procedure in TRANSPRT.PRG)
  8883. *!
  8884. *!          Calls: CLEANWIND          (procedure in TRANSPRT.PRG)
  8885. *!               : CLEANUP            (procedure in TRANSPRT.PRG)
  8886. *!
  8887. *!*****************************************************************************
  8888. PROCEDURE eschandler
  8889. ON ERROR &onerror
  8890. m.g_status = 1
  8891. DO cleanwind
  8892. DO cleanup
  8893. CANCEL
  8894.  
  8895. *
  8896. * ERRSHOW - Show error in an alert box on the screen.
  8897. *
  8898. *!*****************************************************************************
  8899. *!
  8900. *!      Procedure: ERRSHOW
  8901. *!
  8902. *!      Called by: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8903. *!
  8904. *!*****************************************************************************
  8905. PROCEDURE errshow
  8906. PARAMETER m.msg, m.lineno
  8907. PRIVATE m.curcursor
  8908.  
  8909. IF _WINDOWS OR _MAC
  8910.    DEFINE WINDOW ALERT ;
  8911.       AT 0,0 ;
  8912.       SIZE 5.615,63.833 ;
  8913.       FONT c_dlgface, c_dlgsize ;
  8914.       STYLE c_dlgstyle ;
  8915.       NOCLOSE ;
  8916.       DOUBLE ;
  8917.       TITLE "Fehler im Portierungsprogramm"
  8918.    MOVE WINDOW ALERT CENTER
  8919.    ACTIVATE WINDOW ALERT NOSHOW
  8920.    
  8921.    m.msg = SUBSTR(m.msg,1,44)+IIF(LEN(m.msg)>44,"...","")
  8922.    @ 1,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8923.    
  8924.    m.msg = "Zeilennummer: "+LTRIM(STR(m.lineno,5))
  8925.    @ 2,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8926.    
  8927.    m.msg = "Mit beliebiger Taste Umgebung wiederherstellen und beenden..."
  8928.    @ 3,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8929. ELSE
  8930.    DEFINE WINDOW ALERT;
  8931.       FROM INT((SROW()-6)/2), INT((SCOL()-50)/2) ;
  8932.       TO INT((SROW()-6)/2) + 6, INT((SCOL()-50)/2) + 50;
  8933.       FLOAT NOGROW NOCLOSE NOZOOM   SHADOW DOUBLE;
  8934.       COLOR SCHEME 7
  8935.    
  8936.    ACTIVATE WINDOW ALERT NOSHOW
  8937.    
  8938.    m.msg = SUBSTR(m.msg,1,44)+IIF(LEN(m.msg)>44,"...","")
  8939.    @ 1,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8940.    
  8941.    m.msg = "Zeilennummer: "+STR(m.lineno, 5)
  8942.    @ 2,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8943.    
  8944.    m.msg = "Mit beliebiger Taste Umgebung wiederherstellen und beenden..."
  8945.    @ 3,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8946. ENDIF
  8947.  
  8948. m.curcursor = SET( "CURSOR" )
  8949. SET CURSOR OFF
  8950. SHOW WINDOW ALERT
  8951.  
  8952. =INKEY(0, "M")
  8953.  
  8954. RELEASE WINDOW ALERT
  8955. SET CURSOR &curcursor
  8956.  
  8957. *
  8958. * JUSTSTEM - Returns just the stem name of the file
  8959. *
  8960. *!*****************************************************************************
  8961. *!
  8962. *!       Function: JUSTSTEM
  8963. *!
  8964. *!*****************************************************************************
  8965. FUNCTION juststem
  8966. * Return just the stem name from "filname"
  8967. PARAMETERS m.filname
  8968. PRIVATE ALL
  8969. IF RAT('\',m.filname) > 0
  8970.    m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
  8971. ENDIF
  8972. IF AT(':',m.filname) > 0
  8973.    m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255)
  8974. ENDIF
  8975. IF AT('.',m.filname) > 0
  8976.    m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1)
  8977. ENDIF
  8978. RETURN ALLTRIM(UPPER(m.filname))
  8979.  
  8980. *
  8981. * STRIPPATH - Strip the path from a file name.
  8982. *
  8983. * Description:
  8984. * Find positions of backslash in the name of the file.  If there is one
  8985. * take everything to the right of its position and make it the new file
  8986. * name.  If there is no slash look for colon.  Again if found, take
  8987. * everything to the right of it as the new name.  If neither slash
  8988. * nor colon are found then return the name unchanged.
  8989. *
  8990. * Parameters:
  8991. * filename - character string representing a file name
  8992. *
  8993. * Return value:
  8994. * The string "filename" with any path removed
  8995. *
  8996. *!*****************************************************************************
  8997. *!
  8998. *!       Function: STRIPPATH
  8999. *!
  9000. *!      Called by: TRANSPRT.PRG                      
  9001. *!               : ADJBITMAPCTRL      (procedure in TRANSPRT.PRG)
  9002. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  9003. *!
  9004. *!*****************************************************************************
  9005. FUNCTION strippath
  9006. PARAMETER m.filename
  9007. PRIVATE m.slashpos, m.namelen, m.colonpos
  9008. m.slashpos = RAT("\", m.filename)
  9009. IF m.slashpos > 0
  9010.    m.namelen  = LEN(m.filename) - m.slashpos
  9011.    m.filename = RIGHT(m.filename, m.namelen)
  9012. ELSE
  9013.    m.colonpos = RAT(":", m.filename)
  9014.    IF m.colonpos > 0
  9015.       m.namelen  = LEN(m.filename) - m.colonpos
  9016.       m.filename = RIGHT(m.filename, m.namelen)
  9017.    ENDIF
  9018. ENDIF
  9019. RETURN m.filename
  9020.  
  9021. *
  9022. * ISOBJECT - Is otype a screen or report object?
  9023. *
  9024. *!*****************************************************************************
  9025. *!
  9026. *!       Function: ISOBJECT
  9027. *!
  9028. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  9029. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  9030. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  9031. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  9032. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  9033. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  9034. *!
  9035. *!*****************************************************************************
  9036. FUNCTION isobject
  9037. PARAMETER m.otype
  9038. RETURN INLIST(m.otype,c_otlist,c_ottxtbut,c_otbox,c_otradbut,c_otchkbox,c_otfield, ;
  9039.    c_otpopup,c_otinvbut,c_otspinner,c_otpicture,c_otline,c_otrepfld,c_otrepvar,c_ottext)
  9040.  
  9041.  
  9042. *
  9043. * ISREPTOBJECT - Is otype a report object?
  9044. *
  9045. *!*****************************************************************************
  9046. *!
  9047. *!       Function: ISREPTOBJECT
  9048. *!
  9049. *!      Called by: RPTCONVERT         (procedure in TRANSPRT.PRG)
  9050. *!
  9051. *!*****************************************************************************
  9052. FUNCTION isreptobject
  9053. PARAMETER m.otype
  9054. RETURN INLIST(m.otype,c_otrepfld,c_ottext,c_otbox,c_otline)
  9055.  
  9056. *
  9057. * ISGRAPHOBJ - Is otype an object that is present in graphics screens/reports but not
  9058. *              in character screens?
  9059. *
  9060. *!*****************************************************************************
  9061. *!
  9062. *!       Function: ISGRAPHOBJ
  9063. *!
  9064. *!*****************************************************************************
  9065. FUNCTION isgraphobj
  9066. PARAMETER m.otype
  9067. RETURN INLIST(m.otype,c_otpicture,c_otspinner)
  9068.  
  9069. *!*****************************************************************************
  9070. *!
  9071. *!       Function: ISENVIRON
  9072. *!
  9073. *!*****************************************************************************
  9074. FUNCTION isenviron
  9075. PARAMETER m.otype
  9076. RETURN INLIST(m.otype,c_otworkar,c_otindex,c_otrel)
  9077.  
  9078. *!*****************************************************************************
  9079. *!
  9080. *!       Function: IsNewerEnv
  9081. *!
  9082. *!*****************************************************************************
  9083. FUNCTION IsNewerEnv
  9084. PARAMETER mustexist    && does the "to" environment have to exist?
  9085. PRIVATE m.maxfromts, m.maxtots
  9086. * Is the "from" platform environment newer than the "to" platform environment
  9087. m.maxfromts = -1
  9088. SCAN FOR platform = m.g_fromplatform and IsEnviron(objtype)
  9089.    m.maxfromts = MAX(timestamp, m.maxfromts)
  9090. ENDSCAN
  9091. m.maxtots = -1
  9092. SCAN FOR platform = m.g_toplatform and IsEnviron(objtype)
  9093.    m.maxtots = MAX(timestamp, m.maxtots)
  9094. ENDSCAN
  9095. IF m.mustexist
  9096.    * The to platform had an environment, but it was out of date
  9097.    RETURN IIF(m.maxfromts > m.maxtots AND m.maxtots >= 0 , .T. , .F.)
  9098. ELSE
  9099.    * The to platform had no environment and the from platform does
  9100.    RETURN IIF(m.maxfromts >= 0 AND m.maxtots < 0  , .T. , .F.)
  9101. ENDIF   
  9102.  
  9103. *
  9104. * HASRECORD - Does filname contain platform records for target?
  9105. *
  9106. *!*****************************************************************************
  9107. *!
  9108. *!       Function: HASRECORDS
  9109. *!
  9110. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  9111. *!
  9112. *!*****************************************************************************
  9113. FUNCTION hasrecords
  9114. PARAMETER m.target
  9115. PRIVATE ALL
  9116. IF TYPE("PLATFORM") <> "U"
  9117.    LOCATE FOR UPPER(TRIM(platform)) == m.target
  9118.    RETURN FOUND()
  9119. ENDIF
  9120. RETURN .F.
  9121.  
  9122. *
  9123. * ASKFONT - Prompt for a font
  9124. *
  9125. *!*****************************************************************************
  9126. *!
  9127. *!       Function: ASKFONT
  9128. *!
  9129. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  9130. *!
  9131. *!*****************************************************************************
  9132. FUNCTION askfont
  9133. PRIVATE m.fontstrg, m.rptfnt
  9134.  
  9135. * Set up a default font for reports
  9136. IF m.g_filetype = c_report AND (_WINDOWS OR _MAC)
  9137.    m.rptfnt = g_rptfface + "," + ALLTRIM(STR(g_rptfsize,3))
  9138.    DEFINE WINDOW transtemp FROM SROWS()+1,SCOLS()+2 TO SROWS()+3,SCOLS()+3 ;
  9139.       FONT rptfnt
  9140.    ACTIVATE WINDOW transtemp NOSHOW
  9141. ENDIF
  9142.  
  9143. m.fontstrg = GETFONT()
  9144. IF !EMPTY(m.fontstrg)
  9145.    m.g_fontface   =  LEFT(m.fontstrg,AT(',',m.fontstrg)-1)
  9146.    m.g_fontsize   =  VAL(SUBSTR(m.fontstrg,AT(',',m.fontstrg)+1,RAT(',',m.fontstrg)-AT(',',m.fontstrg)-1))
  9147.    m.g_fontstyle  =  SUBSTR(m.fontstrg,RAT(',',m.fontstrg)+1)
  9148.    IF _MAC OR _WINDOWS
  9149.       m.g_rptlinesize      = (FONTMETRIC(1, m.g_fontface, m.g_fontsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  9150.       m.g_rptcharsize      = (FONTMETRIC(6, m.g_fontface, m.g_fontsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  9151.    ENDIF
  9152. ENDIF
  9153.  
  9154. IF m.g_filetype = c_report AND (_WINDOWS OR _MAC)
  9155.    RELEASE WINDOW transtemp
  9156. ENDIF
  9157.  
  9158. RETURN
  9159.  
  9160. *
  9161. * IS20SCX - Is the current database a 2.0 screen?
  9162. *
  9163. *!*****************************************************************************
  9164. *!
  9165. *!       Function: IS20SCX
  9166. *!
  9167. *!*****************************************************************************
  9168. FUNCTION is20scx
  9169. RETURN (FCOUNT() = c_20scxfld)
  9170. *
  9171. * IS20FRX - Is the current database a 2.0 report?
  9172. *
  9173. *!*****************************************************************************
  9174. *!
  9175. *!       Function: IS20FRX
  9176. *!
  9177. *!*****************************************************************************
  9178. FUNCTION is20frx
  9179. RETURN (FCOUNT() = c_20frxfld)
  9180. *
  9181. * IS20LBX - Is the current database a 2.0 screen?
  9182. *
  9183. *!*****************************************************************************
  9184. *!
  9185. *!       Function: IS20LBX
  9186. *!
  9187. *!*****************************************************************************
  9188. FUNCTION is20lbx
  9189. RETURN (FCOUNT() = c_20lbxfld)
  9190. IF WEXIST("lblwind")   AND WVISIBLE("lblwind")
  9191.    RELEASE WINDOW lblwind
  9192. ENDIF
  9193.  
  9194. *
  9195. * GETSNIPFLAG - See if we are just updating snippets
  9196. *
  9197. *!*****************************************************************************
  9198. *!
  9199. *!       Function: GETSNIPFLAG
  9200. *!
  9201. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  9202. *!
  9203. *!          Calls: WORDNUM()          (function  in TRANSPRT.PRG)
  9204. *!               : MATCH()            (function  in TRANSPRT.PRG)
  9205. *!
  9206. *!*****************************************************************************
  9207. FUNCTION getsnipflag
  9208. PARAMETER snippet
  9209. PRIVATE m.oldmline, m.retcode
  9210. * Format for directive is "#TRAN SNIPPET ONLY" in setup snippet
  9211. m.oldmline = _MLINE
  9212. m.retcode = .F.
  9213. IF AT('#',snippet) > 0
  9214.    _MLINE = 0
  9215.    m.sniplen = LEN(snippet)
  9216.    DO WHILE _MLINE < m.sniplen
  9217.       m.line = MLINE(snippet,1,_MLINE)
  9218.       m.upline = UPPER(LTRIM(m.line))
  9219.       IF '#TRAN' $ m.upline
  9220.          IF LEFT(wordnum(m.upline,1),5) = '#TRAN' ;
  9221.                AND match(wordnum(m.upline,2),'SNIPPETS') ;
  9222.                AND match(wordnum(m.upline,3),'ONLY')
  9223.             m.retcode = .T.
  9224.          ENDIF
  9225.       ENDIF
  9226.    ENDDO
  9227.    _MLINE = m.oldmline
  9228. ENDIF
  9229. RETURN m.retcode
  9230.  
  9231.  
  9232. *
  9233. * MATCH - Returns TRUE is candidate is a valid 4-or-more-character abbreviation of keyword
  9234. *
  9235. *!*****************************************************************************
  9236. *!
  9237. *!       Function: MATCH
  9238. *!
  9239. *!      Called by: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  9240. *!
  9241. *!*****************************************************************************
  9242. FUNCTION match
  9243. PARAMETER candidate, keyword
  9244. PRIVATE in_exact
  9245. m.in_exact = SET("EXACT")
  9246. SET EXACT OFF
  9247. DO CASE
  9248. CASE EMPTY(m.candidate)
  9249.    RETURN EMPTY(m.keyword)
  9250. CASE LEN(m.candidate) < 4
  9251.    RETURN m.candidate == m.keyword
  9252. OTHERWISE
  9253.    RETURN m.keyword = m.candidate
  9254. ENDCASE
  9255. IF m.in_exact != "OFF"
  9256.    SET EXACT ON
  9257. ENDIF
  9258.  
  9259.  
  9260. *
  9261. * WORDNUM - Returns w_num-th word from string strg
  9262. *
  9263. *!*****************************************************************************
  9264. *!
  9265. *!       Function: WORDNUM
  9266. *!
  9267. *!      Called by: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  9268. *!
  9269. *!*****************************************************************************
  9270. FUNCTION wordnum
  9271. PARAMETERS strg,w_num
  9272. PRIVATE strg,s1,w_num,ret_str
  9273.  
  9274. m.s1 = ALLTRIM(m.strg)
  9275.  
  9276. * Replace tabs with spaces
  9277. m.s1 = CHRTRAN(m.s1,CHR(9)," ")
  9278.  
  9279. * Reduce multiple spaces to a single space
  9280. DO WHILE AT('  ',m.s1) > 0
  9281.    m.s1 = STRTRAN(m.s1,'  ',' ')
  9282. ENDDO
  9283.  
  9284. ret_str = ""
  9285. DO CASE
  9286. CASE m.w_num > 1
  9287.    DO CASE
  9288.    CASE AT(" ",m.s1,m.w_num-1) = 0   && No word w_num.  Past end of string.
  9289.       m.ret_str = ""
  9290.    CASE AT(" ",m.s1,m.w_num) = 0     && Word w_num is last word in string.
  9291.       m.ret_str = SUBSTR(m.s1,AT(" ",m.s1,m.w_num-1)+1,255)
  9292.    OTHERWISE                         && Word w_num is in the middle.
  9293.       m.strt_pos = AT(" ",m.s1,m.w_num-1)
  9294.       m.ret_str  = SUBSTR(m.s1,strt_pos,AT(" ",m.s1,m.w_num)+1 - strt_pos)
  9295.    ENDCASE
  9296. CASE m.w_num = 1
  9297.    IF AT(" ",m.s1) > 0               && Get first word.
  9298.       m.ret_str = SUBSTR(m.s1,1,AT(" ",m.s1)-1)
  9299.    ELSE                              && There is only one word.  Get it.
  9300.       m.ret_str = m.s1
  9301.    ENDIF
  9302. ENDCASE
  9303. RETURN ALLTRIM(m.ret_str)
  9304.  
  9305. *
  9306. * ADDBS - Add a backslash unless there is one already there.
  9307. *
  9308. *!*****************************************************************************
  9309. *!
  9310. *!       Function: ADDBS
  9311. *!
  9312. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9313. *!
  9314. *!*****************************************************************************
  9315. FUNCTION addbs
  9316. * Add a backslash to a path name, if there isn't already one there
  9317. PARAMETER m.pathname
  9318. PRIVATE ALL
  9319. m.pathname = ALLTRIM(UPPER(m.pathname))
  9320. IF !(RIGHT(m.pathname,1) $ '\:') AND !EMPTY(m.pathname)
  9321.    m.pathname = m.pathname + '\'
  9322. ENDIF
  9323. RETURN m.pathname
  9324.  
  9325. *
  9326. * JUSTFNAME - Return just the filename (i.e., no path) from "filname"
  9327. *
  9328. *!*****************************************************************************
  9329. *!
  9330. *!       Function: JUSTFNAME
  9331. *!
  9332. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9333. *!
  9334. *!*****************************************************************************
  9335. FUNCTION justfname
  9336. PARAMETERS m.filname
  9337. PRIVATE ALL
  9338. IF RAT('\',m.filname) > 0
  9339.    m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
  9340. ENDIF
  9341. IF AT(':',m.filname) > 0
  9342.    m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255)
  9343. ENDIF
  9344. RETURN ALLTRIM(UPPER(m.filname))
  9345.  
  9346. *
  9347. * JUSTPATH - Returns just the pathname.
  9348. *
  9349. *!*****************************************************************************
  9350. *!
  9351. *!       Function: JUSTPATH
  9352. *!
  9353. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9354. *!
  9355. *!*****************************************************************************
  9356. FUNCTION justpath
  9357. * Return just the path name from "filname"
  9358. PARAMETERS m.filname
  9359. PRIVATE ALL
  9360. m.filname = ALLTRIM(UPPER(m.filname))
  9361. IF '\' $ m.filname
  9362.    m.filname = SUBSTR(m.filname,1,RAT('\',m.filname))
  9363.    IF RIGHT(m.filname,1) = '\' AND LEN(m.filname) > 1 ;
  9364.          AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> ':'
  9365.       m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
  9366.    ENDIF
  9367.    RETURN m.filname
  9368. ELSE
  9369.    RETURN ''
  9370. ENDIF
  9371.  
  9372. *
  9373. * FORCEEXT - Force filename to have a paricular extension.
  9374. *
  9375. *!*****************************************************************************
  9376. *!
  9377. *!       Function: FORCEEXT
  9378. *!
  9379. *!      Called by: cvrt102FRX()       (function  in TRANSPRT.PRG)
  9380. *!               : cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  9381. *!
  9382. *!          Calls: JUSTPATH()         (function  in TRANSPRT.PRG)
  9383. *!               : JUSTFNAME()        (function  in TRANSPRT.PRG)
  9384. *!               : ADDBS()            (function  in TRANSPRT.PRG)
  9385. *!
  9386. *!*****************************************************************************
  9387. FUNCTION forceext
  9388. * Force the extension of "filname" to be whatever ext is.
  9389. PARAMETERS m.filname,m.ext
  9390. PRIVATE ALL
  9391. IF SUBSTR(m.ext,1,1) = "."
  9392.    m.ext = SUBSTR(m.ext,2,3)
  9393. ENDIF
  9394.  
  9395. m.pname = justpath(m.filname)
  9396. m.filname = justfname(UPPER(ALLTRIM(m.filname)))
  9397. IF AT('.',m.filname) > 0
  9398.    m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) + '.' + m.ext
  9399. ELSE
  9400.    m.filname = m.filname + '.' + m.ext
  9401. ENDIF
  9402. RETURN addbs(m.pname) + m.filname
  9403.  
  9404. *!*****************************************************************************
  9405. *!
  9406. *!       Function: CVTLONG
  9407. *!
  9408. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  9409. *!
  9410. *!*****************************************************************************
  9411. FUNCTION cvtlong
  9412. PARAMETER m.itext, m.ioff
  9413. RETURN cvtshort(m.itext,m.ioff) + (65536 * cvtshort(m.itext,m.ioff+2))
  9414.  
  9415. *!*****************************************************************************
  9416. *!
  9417. *!       Function: CVTSHORT
  9418. *!
  9419. *!      Called by: GETOLDREPORTTYPE() (function  in TRANSPRT.PRG)
  9420. *!               : cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  9421. *!               : CVTLONG()          (function  in TRANSPRT.PRG)
  9422. *!
  9423. *!          Calls: CVTBYTE()          (function  in TRANSPRT.PRG)
  9424. *!
  9425. *!*****************************************************************************
  9426. FUNCTION cvtshort
  9427. PARAMETER m.itext, m.ioff
  9428. RETURN cvtbyte(m.itext,m.ioff) + (256 * cvtbyte(m.itext,m.ioff+1))
  9429.  
  9430. *!*****************************************************************************
  9431. *!
  9432. *!       Function: CVTBYTE
  9433. *!
  9434. *!      Called by: cvrtfbpRPT      (procedure in TRANSPRT.PRG)
  9435. *!               : CVTSHORT()         (function  in TRANSPRT.PRG)
  9436. *!
  9437. *!*****************************************************************************
  9438. FUNCTION cvtbyte
  9439. PARAMETER m.itext, m.ioff
  9440. RETURN ASC(SUBSTR(m.itext,m.ioff+1,1))
  9441.  
  9442. *!*****************************************************************************
  9443. *!
  9444. *!       Function: OBJ2BASEFONT
  9445. *!
  9446. *!      Called by: FILLININFO         (procedure in TRANSPRT.PRG)
  9447. *!
  9448. *!*****************************************************************************
  9449. FUNCTION obj2basefont
  9450. PARAMETER mwidth, bfontface, bfontsize, bfontstyle, ofontface, ;
  9451.    ofontsize, ofontstyle
  9452. * Map a width from one font to another one
  9453. DO CASE
  9454. CASE m.g_tographic
  9455.    RETURN m.mwidth * FONTMETRIC(6,m.ofontface,m.ofontsize,m.ofontstyle) ;
  9456.       / FONTMETRIC(6,m.bfontface,m.bfontsize,m.bfontstyle)
  9457. CASE UPPER(m.ofontface) == "MS SANS SERIF" AND ;
  9458.       UPPER(m.bfontface) == "MS SANS SERIF" AND ;
  9459.       m.ofontsize = m.bfontsize AND ;
  9460.       !("B" $ m.ofontstyle) AND ;
  9461.       "B" $ m.bfontstyle
  9462.    * We can't use FONTMETRIC on DOS, so we use heuristics instead.  Most
  9463.    * of the time we will be converting between MS Sans Serif 8 Bold and
  9464.    * MS Sans Serif Regular.  If that is the case here, use the 5/6 conversion
  9465.    * factor that is the relative widths of the chars in these two font styles.
  9466.    RETURN m.mwidth * 5/6
  9467. OTHERWISE
  9468.    RETURN m.mwidth
  9469. ENDCASE
  9470.  
  9471.  
  9472. *!*****************************************************************************
  9473. *!
  9474. *!       Function: VERSIONCAP
  9475. *!
  9476. *!      Called by: RDVALID()          (function  in TRANSPRT.PRG)
  9477. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  9478. *!
  9479. *!*****************************************************************************
  9480. FUNCTION versioncap
  9481. PARAMETER m.strg
  9482. DO CASE
  9483. CASE strg = "DOS"
  9484.    RETURN "MS-DOS"
  9485. CASE strg = "WINDOWS"
  9486.    RETURN "Windows"
  9487. CASE strg = "MAC"
  9488.    RETURN "Macintosh"
  9489. CASE strg = "UNIX"
  9490.    RETURN "UNIX"
  9491. OTHERWISE
  9492.    RETURN strg
  9493. ENDCASE
  9494.  
  9495.  
  9496. *!*****************************************************************************
  9497. *!
  9498. *!       Function: BLACKBOX
  9499. *!
  9500. *!*****************************************************************************
  9501. FUNCTION blackbox
  9502. PARAMETER otype , mred, mblue, mgreen, mpattern
  9503. * Is this a black box?
  9504. IF !m.g_tographic AND m.otype = c_otbox AND ;
  9505.       m.mred = 0 AND m.mblue = 0 AND m.mgreen = 0 ;
  9506.       AND m.mpattern = 0
  9507.    RETURN .T.
  9508. ELSE
  9509.    RETURN .F.
  9510. ENDIF
  9511.  
  9512. *!*****************************************************************************
  9513. *!
  9514. *!      Procedure: SELECTOBJ
  9515. *!
  9516. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  9517. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  9518. *!
  9519. *!          Calls: INITSEL            (procedure in TRANSPRT.PRG)
  9520. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  9521. *!               : ADDSEL             (procedure in TRANSPRT.PRG)
  9522. *!               : VERSIONCAP()       (function  in TRANSPRT.PRG)
  9523. *!               : TPSELECT           (procedure in TRANSPRT.PRG)
  9524. *!
  9525. *!           Uses: M.G_SCRNALIAS      
  9526. *!
  9527. *!        Indexes: ID                     (tag)
  9528. *!
  9529. *!*****************************************************************************
  9530. PROCEDURE selectobj
  9531. * Figure out what to transport
  9532. DO initsel
  9533.  
  9534. IF m.g_snippets
  9535.    m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  9536.    SELECT * FROM (m.g_scrnalias) ;
  9537.       WHERE !DELETED() AND platform = m.g_fromplatform ;
  9538.          AND oktransport(comment) ;
  9539.       INTO CURSOR (m.g_tempalias)
  9540.    IF _TALLY > 0
  9541.       INDEX ON uniqueid TAG id
  9542.    
  9543.       SELECT (m.g_scrnalias)
  9544.       SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  9545.       LOCATE FOR .T.
  9546.       DO CASE
  9547.       CASE m.g_filetype = c_screen
  9548.          SCAN FOR platform = m.g_toplatform ;
  9549.                AND (isobject(objtype) OR objtype = c_otheader OR objtype = c_otworkar) ;
  9550.                AND &g_tempalias..timestamp > timestamp
  9551.             DO addsel WITH "Akt"
  9552.          ENDSCAN
  9553.       CASE m.g_filetype = c_report
  9554.          SCAN FOR platform = m.g_toplatform AND ;
  9555.                INLIST(objtype,c_otheader,c_otfield,c_otpicture, ;
  9556.                  c_otrepfld,c_otband,c_otrepvar,c_ottext,c_otline,c_otbox,c_otworkar) ;
  9557.                AND &g_tempalias..timestamp > timestamp
  9558.             DO addsel WITH "Upd"
  9559.          ENDSCAN
  9560.       ENDCASE
  9561.       SELECT (m.g_tempalias)
  9562.       USE
  9563.    ENDIF
  9564.    SELECT (m.g_scrnalias)
  9565. ENDIF
  9566.  
  9567. IF m.g_newobjects
  9568.    m.junk = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  9569.    IF m.g_tographic
  9570.       SELECT * FROM (m.g_scrnalias) ;
  9571.          WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  9572.          !(objtype = c_otfontdata) AND ;
  9573.          uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  9574.          WHERE platform = m.g_toplatform) ;
  9575.             AND oktransport(comment) ;
  9576.          ORDER BY objtype ;
  9577.          INTO CURSOR (m.junk)
  9578.    ELSE
  9579.       SELECT * FROM (m.g_scrnalias) ;
  9580.          WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  9581.          !(objtype = c_otband AND INLIST(objcode,2,6)) AND ;
  9582.          !(objtype = c_otpicture) AND ;
  9583.          !(objtype = c_otfontdata) AND ;
  9584.          !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  9585.          uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  9586.          WHERE platform = m.g_toplatform) ;
  9587.             AND oktransport(comment) ;
  9588.          INTO CURSOR (m.junk)
  9589.    ENDIF
  9590.    IF _TALLY > 0
  9591.       SCAN
  9592.          DO addsel WITH "New"
  9593.       ENDSCAN
  9594.       USE  && discard the cursor
  9595.    ENDIF
  9596. ENDIF
  9597.  
  9598. IF m.g_tpselcnt > 0   && This variable is incremented in addsel()
  9599.    m.tpcancel = 1
  9600.    * Prompt user to designate at any items he does not want transported
  9601.    DO tpselect WITH tparray, m.tpcancel,versioncap(m.g_fromplatform),versioncap(m.g_toplatform)
  9602.    DO CASE
  9603.    CASE m.tpcancel = 1   && user pressed OK, so let's get to it.
  9604.    CASE m.tpcancel = 2   && user pressed "cancel" on the selection dialog.
  9605.       m.g_status = 3
  9606.       m.g_returncode = c_cancel
  9607.       RETURN TO transprt
  9608.    CASE m.tpcancel > 2
  9609.       * There aren't any objects that qualify for transporting.  User deselected all of them.
  9610.       * Pretend like we're done.
  9611.       m.g_status = 3
  9612.       m.g_returncode = c_yes
  9613.       RETURN TO transprt
  9614.    ENDCASE
  9615. ELSE
  9616.    * There aren't any objects that qualify for transporting.
  9617.    * Pretend like we're done.
  9618.    m.g_status = 3
  9619.    m.g_returncode = c_yes
  9620.    RETURN TO transprt
  9621. ENDIF
  9622.  
  9623. RETURN
  9624.  
  9625. *!*****************************************************************************
  9626. *!
  9627. *!      Procedure: INITSEL
  9628. *!
  9629. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9630. *!
  9631. *!*****************************************************************************
  9632. PROCEDURE initsel
  9633. * Initialize the tparray selection array
  9634. m.g_tpselcnt = 0
  9635. RETURN
  9636.  
  9637. *!*****************************************************************************
  9638. *!
  9639. *!      Procedure: ADDSEL
  9640. *!
  9641. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9642. *!
  9643. *!          Calls: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9644. *!
  9645. *!*****************************************************************************
  9646. PROCEDURE addsel
  9647. PARAMETER STATUS
  9648. * Don't use RECCOUNT() here since the open "database" will often be a cursor.
  9649. IF _WINDOWS OR _MAC
  9650.    m.g_tpselcnt = m.g_tpselcnt + 1
  9651.    DIMENSION tparray[m.g_tpselcnt,3]
  9652.    tparray[m.g_tpselcnt,1] = '√ '+assemble(STATUS)
  9653.    tparray[m.g_tpselcnt,2] = uniqueid
  9654.    tparray[m.g_tpselcnt,3] = objtype
  9655.    
  9656. ELSE
  9657.    m.g_tpselcnt = m.g_tpselcnt + 1
  9658.    DIMENSION tparray[m.g_tpselcnt,3]
  9659.    tparray[m.g_tpselcnt,1] = '√ '+assemble(STATUS)
  9660.    tparray[m.g_tpselcnt,2] = uniqueid
  9661.    tparray[m.g_tpselcnt,3] = objtype
  9662. ENDIF
  9663. RETURN
  9664.  
  9665. *!*****************************************************************************
  9666. *!
  9667. *!       Function: ISSELECTED
  9668. *!
  9669. *!*****************************************************************************
  9670. FUNCTION isselected
  9671. * Returns .T. if this uniqueid passed in idnum corresponds to an item
  9672. * marked on the tparray list.
  9673. PARAMETER idnum,mobjtype, mobjcode
  9674. DO CASE
  9675. CASE m.mobjtype = c_otfontdata
  9676.    RETURN .T.
  9677. OTHERWISE
  9678.    m.pos = ASCAN(tparray,m.idnum)
  9679.    IF m.pos > 0
  9680.       * Check pos-1 since this is a two dimensional array.  ASCAN returns an element number
  9681.       * but we are really interested in the column before the one that the match took place in.
  9682.       RETURN IIF(LEFT(tparray[m.pos-1],1) <> ' ',.T.,.F.)
  9683.    ELSE
  9684.       RETURN .F.
  9685.    ENDIF
  9686. ENDCASE
  9687.  
  9688. *!*****************************************************************************
  9689. *!
  9690. *!       Function: ASSEMBLE
  9691. *!
  9692. *!      Called by: ADDSEL             (procedure in TRANSPRT.PRG)
  9693. *!
  9694. *!          Calls: TYPE2NAME()        (function  in TRANSPRT.PRG)
  9695. *!               : CLEANPICT()        (function  in TRANSPRT.PRG)
  9696. *!
  9697. *!*****************************************************************************
  9698. FUNCTION assemble
  9699. * Form the string used for user selection of objects to transport
  9700. PARAMETER statstrg
  9701. PRIVATE m.strg
  9702. DO CASE
  9703. CASE INLIST(objtype,c_ottxtbut,c_otradbut,c_otchkbox)
  9704.    m.strg = PADR(statstrg,5);
  9705.       + PADR(type2name(objtype),15) ;
  9706.       + PADR(name,15) ;
  9707.       + PADR(cleanpict(PICTURE),30)
  9708. CASE objtype = c_otfield AND EMPTY(name)    && it's a SAY expression
  9709.    m.strg = PADR(statstrg,5);
  9710.       + PADR(type2name(objtype),15) ;
  9711.       + PADR(expr,45)
  9712. CASE INLIST(objtype,c_otbox,c_otline)
  9713.    IF m.g_tographic
  9714.       m.strg = PADR(statstrg,5);
  9715.          + PADR(type2name(objtype),15) ;
  9716.          + PADR("",15) ;
  9717.          + PADR("Von "+ALLTRIM(STR(vpos,3))+","+ALLTRIM(STR(hpos,3))+" bis " ;
  9718.          + ALLTRIM(STR(vpos+HEIGHT,3))+","+ALLTRIM(STR(hpos+WIDTH,3)),45)
  9719.    ELSE
  9720.       m.strg = PADR(statstrg,5);
  9721.          + PADR(type2name(objtype),15) ;
  9722.          + PADR("",15) ;
  9723.          + PADR("At: " ;
  9724.          + ALLTRIM(STR(ROUND(cvtreportvertical(vpos),0),3));
  9725.          + ",";
  9726.          + ALLTRIM(STR(ROUND(cvtreportvertical(hpos),0),3));
  9727.          + ", H÷he: ";
  9728.          + ALLTRIM(STR(ROUND(cvtreportvertical(height),0),3));
  9729.          + ", Breite: " ;
  9730.          + ALLTRIM(STR(ROUND(cvtreportvertical(width),0),3)),45)
  9731.    ENDIF
  9732. OTHERWISE
  9733.    m.strg = PADR(statstrg,5);
  9734.       + PADR(type2name(objtype),15) ;
  9735.       + PADR(name,15) ;
  9736.       + PADR(expr,30)
  9737. ENDCASE
  9738.  
  9739. IF _WINDOWS
  9740.    RETURN LEFT(m.strg,5) + ansitooem(RIGHT(m.strg,LEN(m.strg)-5))
  9741. ELSE   
  9742.    RETURN m.strg
  9743. ENDIF
  9744. *!*****************************************************************************
  9745. *!
  9746. *!       Function: TYPE2NAME
  9747. *!
  9748. *!      Called by: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9749. *!
  9750. *!*****************************************************************************
  9751. FUNCTION type2name
  9752. PARAMETER N
  9753. PRIVATE strg
  9754. DO CASE
  9755. CASE m.n = c_otheader
  9756.    m.strg = "Kopf"
  9757. CASE INLIST(m.n,c_otworkar,c_otindex,c_otrel)
  9758.    m.strg = "Umgebung"
  9759. CASE m.n = c_ottext
  9760.    m.strg = "Text"
  9761. CASE m.n = c_otline
  9762.    m.strg = "Linie"
  9763. CASE m.n = c_otbox
  9764.    m.strg = "Rahmen"
  9765. CASE m.n = c_otrepfld
  9766.    m.strg = "Berichtsfeld"
  9767. CASE m.n = c_otband
  9768.    m.strg = "Bereich"
  9769. CASE m.n = c_otgroup
  9770.    m.strg = "Gruppe"
  9771. CASE m.n = c_otlist
  9772.    m.strg = "Listenfeld"
  9773. CASE m.n = c_ottxtbut
  9774.    m.strg = "SchaltflΣche"
  9775. CASE m.n = c_otradbut
  9776.    m.strg = "Optionsfeld"
  9777. CASE m.n = c_otchkbox
  9778.    m.strg = "Kontrollk."
  9779. CASE m.n = c_otfield
  9780.    DO CASE
  9781.    CASE EMPTY(name)
  9782.       IF !EMPTY(expr)
  9783.          m.strg = "SAY-Ausdruck"
  9784.       ELSE
  9785.          m.strg = "Feld"
  9786.       ENDIF
  9787.    CASE EMPTY(expr)
  9788.       m.strg = "GET-Feld"
  9789.    OTHERWISE
  9790.       m.strg = "Feld"
  9791.    ENDCASE
  9792. CASE m.n = c_otpopup
  9793.    m.strg = "Popup"
  9794. CASE m.n = c_otpicture
  9795.    m.strg = "Bild"
  9796. CASE m.n = c_otrepvar
  9797.    m.strg = "Berichtvariable"
  9798. CASE m.n = c_otinvbut
  9799.    m.strg = "Unsichtb. Schaltfl."
  9800. CASE m.n = c_otspinner
  9801.    m.strg = "Drehfeld"
  9802. CASE m.n = c_otpdset
  9803.    m.strg = "Druckertr."
  9804. CASE m.n = c_otfontdata
  9805.    m.strg = "Schriftartdaten"
  9806. OTHERWISE
  9807.    m.strg = STR(objtype,4)
  9808. ENDCASE
  9809.  
  9810. RETURN m.strg
  9811.  
  9812.  
  9813. *!*****************************************************************************
  9814. *!
  9815. *!       Function: CLEANPICT
  9816. *!
  9817. *!      Called by: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9818. *!
  9819. *!*****************************************************************************
  9820. FUNCTION cleanpict
  9821. PARAMETER m.strg
  9822. PRIVATE m.atsign
  9823.  
  9824. * Drop quotation marks
  9825. IF AT(LEFT(m.strg,1),CHR(34)+CHR(39)) > 0
  9826.    m.strg = SUBSTR(m.strg,2)
  9827. ENDIF
  9828. IF AT(RIGHT(m.strg,1),CHR(34)+CHR(39)) > 0
  9829.    m.strg = SUBSTR(m.strg,1,LEN(m.strg)-1)
  9830. ENDIF
  9831.  
  9832. m.atsign = AT("@",m.strg)
  9833. IF m.atsign > 0
  9834.    m.strg = LTRIM(SUBSTR(m.strg,m.atsign+AT(' ',SUBSTR(m.strg,m.atsign))))
  9835. ENDIF
  9836.  
  9837. IF LEN(m.strg) > 30
  9838.    m.strg = LEFT(m.strg,27) + '...'
  9839. ENDIF
  9840. RETURN m.strg
  9841.  
  9842.  
  9843. *!*****************************************************************************
  9844. *!
  9845. *!      Procedure: TPSELECT
  9846. *!
  9847. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9848. *!
  9849. *!          Calls: TOGGLE()           (function  in TRANSPRT.PRG)
  9850. *!               : OKVALID()          (function  in TRANSPRT.PRG)
  9851. *!               : WREADDEAC()        (function  in TRANSPRT.PRG)
  9852. *!
  9853. *!*****************************************************************************
  9854. PROCEDURE tpselect
  9855. PARAMETERS tparray, tpcancel, fromplat,toplat
  9856. DO CASE
  9857. CASE m.g_snippets AND m.g_newobjects
  9858.    ptext = "Diese Objekte sind entweder neu fⁿr die Plattform "+m.toplat+" oder wurden "+;
  9859.       "spΣter unter "+m.fromplat+" geΣndert."
  9860. CASE m.g_newobjects
  9861.    ptext = "Diese Objekte sind neu fⁿr "+m.toplat+"."
  9862. CASE m.g_snippets
  9863.    ptext = "Diese Objekte wurden spΣter unter "+m.fromplat+" geΣndert."
  9864. ENDCASE
  9865.  
  9866. DO CASE
  9867. CASE _WINDOWS
  9868.    IF NOT WEXIST("tpselect")
  9869.       DEFINE WINDOW tpselect ;
  9870.          AT  0.000, 0.000  ;
  9871.          SIZE 25.538,116.000 ;
  9872.          TITLE "Portieren" ;
  9873.          FONT "MS Sans Serif", 8 ;
  9874.          FLOAT ;
  9875.          CLOSE ;
  9876.          NOMINIMIZE ;
  9877.          DOUBLE
  9878.       MOVE WINDOW tpselect CENTER
  9879.    ENDIF
  9880.    IF WVISIBLE("tpselect")
  9881.       ACTIVATE WINDOW tpselect SAME
  9882.    ELSE
  9883.       ACTIVATE WINDOW tpselect NOSHOW
  9884.    ENDIF
  9885.    @ 6.769,2.400 TO 8.154,113.000 ;
  9886.       PATTERN 1 ;
  9887.       PEN 1, 8 ;
  9888.       COLOR RGB(,,,192,192,192)
  9889.    @ 8.154,2.600 GET xsel ;
  9890.       PICTURE "@&N" ;
  9891.       FROM tparray ;
  9892.       SIZE 17.500,68.875 ;
  9893.       DEFAULT 1 ;
  9894.       FONT "FoxFont", 9 ;
  9895.       VALID toggle()
  9896.    @ 1.462,50.400 SAY "Markieren Sie alle Objekte, " + CHR(13) + ;
  9897.       "" ;
  9898.       SIZE 1.000,25.167, 0.000 ;
  9899.       FONT "MS Sans Serif", 8 ;
  9900.       STYLE "BT"
  9901.    @ 2.385,50.400 SAY "die Sie portieren m÷chten." ;
  9902.       SIZE 1.000,25.167, 0.000 ;
  9903.       FONT "MS Sans Serif", 8 ;
  9904.       STYLE "BT"
  9905.    @ 0.923,93.600 GET tpcancel ;
  9906.       PICTURE "@*VT \!\<OK;\?\<Abbrechen" ;
  9907.       SIZE 1.846,16.333,0.308 ;
  9908.       DEFAULT 1 ;
  9909.       FONT "MS Sans Serif", 8 ;
  9910.       STYLE "B" ;
  9911.       VALID okvalid()
  9912.    @ 6.923,14.000 SAY "Typ" ;
  9913.       SIZE 1.000,4.833, 0.000 ;
  9914.       FONT "MS Sans Serif", 8 ;
  9915.       STYLE "BT"
  9916.    @ 6.923,62.000 SAY "Ausdruck/Bezeichnung" ;
  9917.       SIZE 1.000,22.833, 0.000 ;
  9918.       FONT "MS Sans Serif", 8 ;
  9919.       STYLE "BT"
  9920.    @ 6.923,38.200 SAY "Variable" ;
  9921.       SIZE 1.000,7.833, 0.000 ;
  9922.       FONT "MS Sans Serif", 8 ;
  9923.       STYLE "BT"
  9924.    @ 6.923,5.800 SAY "Status" ;
  9925.       SIZE 1.000,6.000, 0.000 ;
  9926.       FONT "MS Sans Serif", 8 ;
  9927.       STYLE "BT"
  9928.    @ 1.462,3.000 SAY ptext ;
  9929.       SIZE 4.000,33.833 ;
  9930.       FONT "MS Sans Serif", 8 ;
  9931.       STYLE "B"
  9932.    
  9933.    IF NOT WVISIBLE("tpselect")
  9934.       ACTIVATE WINDOW tpselect
  9935.    ENDIF
  9936.    
  9937.    READ CYCLE;
  9938.       MODAL;
  9939.       DEACTIVATE wreaddeac()
  9940.    
  9941.    RELEASE WINDOW tpselect
  9942. CASE _DOS
  9943.    IF NOT WEXIST("tpselect")
  9944.       DEFINE WINDOW tpselect ;
  9945.          FROM INT((SROW()-23)/2),INT((SCOL()-77)/2) ;
  9946.          TO INT((SROW()-23)/2)+22,INT((SCOL()-77)/2)+76 ;
  9947.          TITLE "Portieren" ;
  9948.          FLOAT ;
  9949.          CLOSE ;
  9950.          NOMINIMIZE ;
  9951.          DOUBLE ;
  9952.          COLOR SCHEME 5
  9953.    ENDIF
  9954.    IF WVISIBLE("tpselect")
  9955.       ACTIVATE WINDOW tpselect SAME
  9956.    ELSE
  9957.       ACTIVATE WINDOW tpselect NOSHOW
  9958.    ENDIF
  9959.    @ 0,0 CLEAR
  9960.    @ 8,1 GET xsel ;
  9961.       PICTURE "@&N" ;
  9962.       FROM tparray ;
  9963.       SIZE 13,72 ;
  9964.       DEFAULT 1 ;
  9965.       VALID toggle() ;
  9966.       COLOR SCHEME 6
  9967.    @ 1,30 SAY "Markieren Sie alle Objekte," ;
  9968.       SIZE 1,27, 0
  9969.    @ 2,30 SAY "die Sie portieren m÷chten." ;
  9970.       SIZE 1,27, 0
  9971.    @ 1,60 GET tpcancel ;
  9972.       PICTURE "@*VT \!\<OK;\?\<Abbrechen" ;
  9973.       SIZE 1,13,0 ;
  9974.       DEFAULT 1 ;
  9975.       VALID okvalid()
  9976.    @ 7,10 SAY "Typ" ;
  9977.       SIZE 1,4, 0
  9978.    @ 7,40 SAY "Ausdruck/Bezeichnung" ;
  9979.       SIZE 1,20, 0
  9980.    @ 7,25 SAY "Variable" ;
  9981.       SIZE 1,8, 0
  9982.    @ 7,4 SAY "Stat." ;
  9983.       SIZE 1,5, 0
  9984.    @ 1,2 SAY ptext ;
  9985.       SIZE 5,26
  9986.    
  9987.    IF NOT WVISIBLE("tpselect")
  9988.       ACTIVATE WINDOW tpselect
  9989.    ENDIF
  9990.    
  9991.    READ CYCLE ;
  9992.       MODAL ;
  9993.       DEACTIVATE wreaddeac()
  9994.    
  9995.    RELEASE WINDOW tpselect
  9996. ENDCASE
  9997.  
  9998. *!*****************************************************************************
  9999. *!
  10000. *!       Function: TOGGLE
  10001. *!
  10002. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  10003. *!
  10004. *!*****************************************************************************
  10005. FUNCTION toggle
  10006. * Toggle mark
  10007. IF LEFT(tparray[xsel,1],1) <> ' '
  10008.    tparray[xsel,1] = STUFF(tparray[xsel,1],1,1,' ')
  10009. ELSE
  10010.    tparray[xsel,1] = STUFF(tparray[xsel,1],1,1,'√')
  10011. ENDIF
  10012. SHOW GETS
  10013. RETURN .F.
  10014.  
  10015. *!*****************************************************************************
  10016. *!
  10017. *!       Function: OKVALID
  10018. *!
  10019. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  10020. *!
  10021. *!*****************************************************************************
  10022. FUNCTION okvalid
  10023. * Simulate a cancel if no objects were selected.
  10024. IF tpcancel = 1
  10025.    PRIVATE m.i
  10026.    m.cnt = 0
  10027.    FOR m.i = 1 TO m.g_tpselcnt
  10028.       IF LEFT(tparray[m.i,1],1) <> ' '
  10029.          m.cnt = m.cnt + 1
  10030.       ENDIF
  10031.    ENDFOR
  10032.    IF m.cnt = 0
  10033.       m.tpcancel = 3   && code that means, "just open as is."
  10034.    ENDIF
  10035. ENDIF
  10036.  
  10037. *!*****************************************************************************
  10038. *!
  10039. *!       Function: WREADDEAC
  10040. *!
  10041. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  10042. *!
  10043. *!*****************************************************************************
  10044. FUNCTION wreaddeac
  10045. *
  10046. * Deactivate Code from screen: TP
  10047. *
  10048. CLEAR READ
  10049.  
  10050. *!*****************************************************************************
  10051. *!
  10052. *!       Function: EnvSelect
  10053. *!
  10054. *!*****************************************************************************
  10055. FUNCTION EnvSelect
  10056. PRIVATE m.i
  10057. * Was an environment record selected for transport?
  10058. FOR m.i = 1 TO m.g_tpselcnt
  10059.    IF IsEnviron(tparray[m.i,3]) AND LEFT(tparray[m.i,1],1) <> " "
  10060.       RETURN .T.
  10061.    ENDIF
  10062. ENDFOR
  10063. RETURN .F.
  10064.  
  10065. *!*****************************************************************************
  10066. *!
  10067. *!       Function: OutputOrd
  10068. *!
  10069. *!*****************************************************************************
  10070. FUNCTION outputord
  10071. PARAMETER m.otype, m.rno
  10072. * Function to sort screen and report files.  We want the header and environment
  10073. * records to be at the "top" of the platform, and other records to be in their
  10074. * original order.
  10075. IF objtype <= 4
  10076.    RETURN STR(m.otype,3)+STR(m.rno,3)
  10077. ELSE   
  10078.    RETURN STR(m.rno,3)+STR(m.otype,3)
  10079. ENDIF
  10080.  
  10081. *!*****************************************************************************
  10082. *!
  10083. *!       Procedure: PUTWINMSG
  10084. *!
  10085. *!*****************************************************************************
  10086. PROCEDURE putwinmsg
  10087. PARAMETER m.msg
  10088. IF _WINDOWS OR _MAC
  10089.    SET MESSAGE TO m.msg
  10090. ENDIF
  10091.  
  10092. *
  10093. * SETALL - Create program's environment.
  10094. *
  10095. * Description:
  10096. * Save the user's environment that is being modified by the GENSCRN,
  10097. * then issue various SET commands.
  10098. *
  10099. *!*****************************************************************************
  10100. *!
  10101. *!      Procedure: SETALL
  10102. *!
  10103. *!      Called by: TRANSPRT.PRG                      
  10104. *!
  10105. *!          Calls: ESCHANDLER         (procedure in TRANSPRT.PRG)
  10106. *!
  10107. *!*****************************************************************************
  10108. PROCEDURE setall
  10109.  
  10110. CLEAR PROGRAM
  10111. CLEAR GETS
  10112.  
  10113. m.escape = SET("ESCAPE")
  10114. SET ESCAPE ON
  10115.  
  10116. m.onescape = ON("ESCAPE")
  10117. ON ESCAPE DO eschandler
  10118.  
  10119. *SET ESCAPE OFF
  10120. m.trbetween = SET("TRBET")
  10121. SET TRBET OFF
  10122. m.comp = SET("COMPATIBLE")
  10123. SET COMPATIBLE FOXPLUS
  10124. m.device = SET("DEVICE")
  10125. SET DEVICE TO SCREEN
  10126.  
  10127. m.rbord = SET("READBORDER")
  10128. SET READBORDER ON
  10129.  
  10130. m.status = SET("STATUS")
  10131. *SET STATUS OFF
  10132.  
  10133. m.currarea = SELECT()
  10134.  
  10135. m.udfparms = SET('UDFPARMS')
  10136. SET UDFPARMS TO VALUE
  10137.  
  10138. m.mtopic = SET("TOPIC")
  10139. IF SET("HELP") = "ON"
  10140.    DO CASE 
  10141.    CASE ATC(".DBF",SET("HELP",1)) > 0
  10142.       SET TOPIC TO CHR(254)+" Portieren"
  10143.       ON KEY LABEL F1 HELP ■ Portieren
  10144.    CASE ATC(".HLP",SET("HELP",1)) > 0   
  10145.       SET TOPIC TO Portieren (Dialogfeld)
  10146.       ON KEY LABEL F1 HELP Portieren (Dialogfeld)
  10147.    ENDCASE
  10148. ENDIF
  10149.  
  10150. m.memowidth = SET("MEMOWIDTH")
  10151. SET MEMOWIDTH TO 256
  10152.  
  10153. m.cursor = SET("CURSOR")
  10154. SET CURSOR OFF
  10155.  
  10156. m.consol = SET("CONSOLE")
  10157. SET CONSOLE OFF
  10158.  
  10159. m.bell = SET("BELL")
  10160. SET BELL OFF
  10161.  
  10162. m.exact = SET("EXACT")
  10163. SET EXACT ON
  10164.  
  10165. m.deci = SET("DECIMALS")
  10166. SET DECIMALS TO 10
  10167.  
  10168. m.fixed = SET("FIXED")
  10169. SET FIXED ON
  10170.  
  10171. m.print = SET("PRINT")
  10172. SET PRINT OFF
  10173.  
  10174. m.unqset = SET("UNIQUE")
  10175. SET UNIQUE OFF
  10176.  
  10177. m.safety = SET("SAFETY")
  10178. SET SAFETY OFF
  10179.  
  10180. m.exclusive = SET("EXCLUSIVE")
  10181. SET EXCLUSIVE ON
  10182.  
  10183. IF versnum() > "2.5"
  10184.    m.mcollate = SET("COLLATE")
  10185.    SET COLLATE TO "machine"
  10186. ENDIF
  10187.  
  10188. *
  10189. * CLEANUP - Restore environment to pre-execution state.
  10190. *
  10191. * Description:
  10192. * Put SET command settings back the way we found them.
  10193. *
  10194. *!*****************************************************************************
  10195. *!
  10196. *!      Procedure: CLEANUP
  10197. *!
  10198. *!      Called by: TRANSPRT.PRG                      
  10199. *!               : ERRORHANDLER       (procedure in TRANSPRT.PRG)
  10200. *!               : CONVERTTYPE()      (function  in TRANSPRT.PRG)
  10201. *!               : ESCHANDLER         (procedure in TRANSPRT.PRG)
  10202. *!
  10203. *!          Calls: WRITERESULT        (procedure in TRANSPRT.PRG)
  10204. *!               : DEACTTHERM         (procedure in TRANSPRT.PRG)
  10205. *!
  10206. *!*****************************************************************************
  10207. PROCEDURE cleanup
  10208. PARAMETER m.cancafter
  10209. IF PARAMETERS() = 0
  10210.    m.cancafter = .F.
  10211. ENDIF
  10212. IF NOT EMPTY(m.g_20alias)
  10213.    IF m.g_status != 0
  10214.       IF USED(m.g_tempalias)
  10215.          SELECT (m.g_tempalias)
  10216.          USE
  10217.       ENDIF
  10218.       IF USED(m.g_fromobjonlyalias)
  10219.          SELECT (m.g_fromobjonlyalias)
  10220.          USE
  10221.       ENDIF
  10222.       IF USED(m.g_boxeditemsalias)
  10223.          SELECT (m.g_boxeditemsalias)
  10224.          USE
  10225.       ENDIF
  10226.       SELECT (m.g_20alias)
  10227.       USE
  10228.       SELECT (m.g_scrnalias)
  10229.    ELSE
  10230.       DO writeresult
  10231.    ENDIF
  10232. ENDIF
  10233.  
  10234. ON ERROR &onerror
  10235. ON ESCAPE &onescape
  10236.  
  10237. IF m.consol = "ON"
  10238.    SET CONSOLE ON
  10239. ELSE
  10240.    SET CONSOLE OFF
  10241. ENDIF
  10242.  
  10243. IF m.escape = "ON"
  10244.    SET ESCAPE ON
  10245. ELSE
  10246.    SET ESCAPE OFF
  10247. ENDIF
  10248.  
  10249. IF m.bell = "ON"
  10250.    SET BELL ON
  10251. ELSE
  10252.    SET BELL OFF
  10253. ENDIF
  10254.  
  10255. IF m.exact = "ON"
  10256.    SET EXACT ON
  10257. ELSE
  10258.    SET EXACT OFF
  10259. ENDIF
  10260.  
  10261. IF m.comp = "ON"
  10262.    SET COMPATIBLE ON
  10263. ENDIF
  10264.  
  10265. IF m.print = "ON"
  10266.    SET PRINT ON
  10267. ENDIF
  10268.  
  10269. IF m.fixed = "OFF"
  10270.    SET FIXED OFF
  10271. ENDIF
  10272.  
  10273. IF m.trbetween = "ON"
  10274.    SET TRBET ON
  10275. ENDIF
  10276.  
  10277. IF m.unqset = "ON"
  10278.    SET UNIQUE ON
  10279. ENDIF
  10280.  
  10281. IF m.rbord = "OFF"
  10282.    SET READBORDER OFF
  10283. ENDIF   
  10284.  
  10285. IF m.status = "ON"
  10286.    SET STATUS ON
  10287. ENDIF
  10288.  
  10289. SET DECIMALS TO m.deci
  10290. SET MEMOWIDTH TO m.memowidth
  10291. SET DEVICE TO &device
  10292. SET UDFPARMS TO &udfparms
  10293. SET TOPIC TO &mtopic
  10294.  
  10295. IF versnum() > "2.5"
  10296.    SET COLLATE TO "&mcollate"
  10297. ENDIF
  10298.    
  10299. ON KEY LABEL F1
  10300. POP KEY
  10301.  
  10302. USE
  10303. DELETE FILE (m.g_tempindex)
  10304. SET MESSAGE TO
  10305.  
  10306. SELECT (m.currarea)
  10307.  
  10308. DO deacttherm
  10309.  
  10310. IF m.cursor = "ON"
  10311.    SET CURSOR ON
  10312. ELSE
  10313.    SET CURSOR OFF
  10314. ENDIF
  10315.  
  10316. IF m.safety = "ON"
  10317.    SET SAFETY ON
  10318. ENDIF
  10319.  
  10320. IF m.talkset = "ON"
  10321.    SET TALK ON
  10322. ENDIF
  10323.  
  10324. IF m.exclusive = "ON"
  10325.    SET EXCLUSIVE ON
  10326. ELSE
  10327.    SET EXCLUSIVE OFF
  10328. ENDIF
  10329. IF m.talkset = "ON"
  10330.    SET TALK ON
  10331. ENDIF
  10332.  
  10333. IF m.cancafter
  10334.    CANCEL
  10335. ENDIF   
  10336.  
  10337. *
  10338. * WRITERESULT - Writes the converted cursor to the SCX/FRX/LBX/whatever.  The point of this is that we
  10339. *      need to write the records in their original order so we don't mees up any groups.  We also need
  10340. *      to keep records for a given platform contiguous.
  10341. *
  10342. *!*****************************************************************************
  10343. *!
  10344. *!      Procedure: WRITERESULT
  10345. *!
  10346. *!      Called by: CLEANUP            (procedure in TRANSPRT.PRG)
  10347. *!
  10348. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  10349. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  10350. *!
  10351. *!           Uses: M.G_SCRNALIAS      
  10352. *!
  10353. *!        Indexes: TEMP                   (tag)
  10354. *!
  10355. *!*****************************************************************************
  10356. PROCEDURE writeresult
  10357. PRIVATE m.platforms, m.loop, m.thermstep
  10358.  
  10359. IF g_filetype = c_project
  10360.    SELECT (m.g_20alias)        && Close the database so we can replace it.
  10361.    USE
  10362.    
  10363.    SELECT (m.g_scrnalias)      && Copy the temporary cursor to the database and
  10364.    COPY TO (m.g_scrndbf)       &&      get rid of the cursor
  10365.    USE
  10366. ELSE
  10367.    REPLACE ALL platform WITH UPPER(platform)
  10368.    
  10369.    * Get a list of the platforms we need to write.
  10370.    SELECT DISTINCT platform ;
  10371.       FROM (m.g_scrnalias) ;
  10372.       WHERE !DELETED() ;
  10373.       INTO ARRAY plist
  10374.    m.platforms = _TALLY
  10375.    
  10376.    * The following select creates a new cursor with the desired structure.  We write
  10377.    * into this and then dump the cursor to disk.  It's a bit cumbersome, but reduces
  10378.    * the chances of frying the original file.
  10379.    m.g_tempalias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  10380.    DO docreate WITH m.g_tempalias, m.g_filetype
  10381.    
  10382.    * We need to write DOS/UNIX label records in the order we want the objects to appear.
  10383.    * So, we create this index and set order to it when we want to write those records.
  10384.    IF m.g_filetype = c_label
  10385.       SELECT (m.g_scrnalias)
  10386.       INDEX ON platform + ;
  10387.          IIF(objtype = c_ot20label,CHR(1)+CHR(1), STR(objtype,2)) + ;
  10388.          STR(objcode,2) + ;
  10389.          STR(vpos,3) TAG temp
  10390.    ENDIF
  10391.    
  10392.    IF m.g_updenviron
  10393.       SELECT (m.g_scrnalias)
  10394.       INDEX ON outputord(objtype,recno()) TAG temp1
  10395.    ENDIF
  10396.    
  10397.    m.thermstep = (100 - m.g_mercury)/RECCOUNT()
  10398.    
  10399.    * Write the records for each platform.
  10400.    FOR m.loop = 1 TO m.platforms
  10401.       SELECT (m.g_scrnalias)
  10402.       
  10403.       DO CASE
  10404.       CASE m.g_filetype = c_label
  10405.          SET ORDER TO TAG temp
  10406.       CASE m.g_updenviron
  10407.          SET ORDER TO TAG temp1
  10408.       OTHERWISE
  10409.          SET ORDER TO
  10410.       ENDCASE
  10411.  
  10412.       SCAN FOR platform = plist[m.loop] AND !DELETED()
  10413.          SCATTER MEMVAR MEMO
  10414.          SELECT (m.g_tempalias)
  10415.          APPEND BLANK
  10416.          GATHER MEMVAR MEMO
  10417.          SELECT (m.g_scrnalias)
  10418.          
  10419.          m.g_mercury = m.g_mercury + 5
  10420.          DO updtherm WITH m.g_mercury
  10421.       ENDSCAN
  10422.    ENDFOR
  10423.    
  10424.    SELECT (m.g_20alias)        && Close the database so we can replace it.
  10425.    USE
  10426.    
  10427.    SELECT (m.g_tempalias)      && Copy the temporary cursor to the database and
  10428.    COPY TO (m.g_scrndbf)       &&      get rid of the cursor
  10429.    USE
  10430.    
  10431.    SELECT (m.g_scrnalias)      && Get rid of the master cursor
  10432.    USE
  10433. ENDIF
  10434. *!*****************************************************************************
  10435. *!
  10436. *!      Function: VERSNUM
  10437. *!
  10438. *!*****************************************************************************
  10439. FUNCTION versnum
  10440. * Return string corresponding to FoxPro version number
  10441. RETURN wordnum(vers(),2)
  10442.  
  10443. *!*****************************************************************************
  10444. *!
  10445. *!      Function: CPTRANS
  10446. *!
  10447. *!*****************************************************************************
  10448. FUNCTION cptrans
  10449. * Translate from one codepage to another, if translation is in effect.  Note that
  10450. * this function takes parameters in a different order than CPCONVERT.
  10451. PARAMETER m.tocp, m.fromcp, m.strg
  10452. IF c_cptrans AND versnum() > "2.5"
  10453.    RETURN CPCONVERT(m.fromcp, m.tocp, m.strg)
  10454. ELSE
  10455.    RETURN m.strg
  10456. ENDIF   
  10457. *!*****************************************************************************
  10458. *!
  10459. *!      Function: CPTCOND
  10460. *!
  10461. *!*****************************************************************************
  10462. FUNCTION cptcond
  10463. * Conditionally translate from one codepage to another, if translation is in effect.
  10464. * Note that this function takes parameters in a different order than CPCONVERT.  
  10465. * Only translate if the current database isn't already the tocp.
  10466. PARAMETER m.tocp, m.fromcp, m.strg
  10467. IF c_cptrans AND cpdbf() <> m.tocp AND versnum() > "2.5"
  10468.    RETURN CPCONVERT(m.fromcp, m.tocp, m.strg)
  10469. ELSE
  10470.    RETURN m.strg
  10471. ENDIF   
  10472.  
  10473. *!*****************************************************************************
  10474. *!
  10475. *!      Function: getcodepage
  10476. *!
  10477. *!*****************************************************************************
  10478. PROCEDURE getcodepage
  10479. DO CASE
  10480. CASE m.g_fromplatform = "DOS"
  10481.    m.g_fromcodepage = c_doscp
  10482. CASE m.g_fromplatform = "WINDOWS"   
  10483.    m.g_fromcodepage = c_wincp
  10484. CASE m.g_fromplatform = "MAC"   
  10485.    m.g_fromcodepage = c_maccp
  10486. CASE m.g_fromplatform = "UNIX"   
  10487.    m.g_fromcodepage = c_unixcp
  10488. OTHERWISE
  10489.    m.g_fromcodepage = c_doscp
  10490. ENDCASE   
  10491.  
  10492. *!*****************************************************************************
  10493. *!
  10494. *!      Function: oktransport
  10495. *!
  10496. *!*****************************************************************************
  10497. FUNCTION oktransport
  10498. PARAMETER strg
  10499. DIMENSION plat_arry[4]
  10500. #DEFINE dos_code  1
  10501. #DEFINE win_code  2
  10502. #DEFINE mac_code  3
  10503. #DEFINE unix_code 4
  10504. plat_arry = 0
  10505. IF ATC("#DOSOBJ",m.strg) > 0
  10506.    plat_arry[dos_code] = 1
  10507. ENDIF
  10508. IF ATC("#WINOBJ",m.strg) > 0
  10509.    plat_arry[win_code] = 1
  10510. ENDIF
  10511. IF ATC("#MACOBJ",m.strg) > 0
  10512.    plat_arry[mac_code] = 1
  10513. ENDIF
  10514. IF ATC("#UNIXOBJ",m.strg) > 0
  10515.    plat_arry[unix_code] = 1
  10516. ENDIF
  10517.  
  10518. * If no platform-specific designations found, transport anywhere
  10519. IF plat_arry[1] + plat_arry[2] + plat_arry[3] + plat_arry[4] = 0
  10520.    plat_arry = 1
  10521. ENDIF
  10522.  
  10523. DO CASE
  10524. CASE m.g_toplatform = "DOS"
  10525.    RETURN IIF(plat_arry[dos_code] = 1, .T.,.F.)
  10526. CASE m.g_toplatform = "WINDOWS"
  10527.    RETURN IIF(plat_arry[win_code] = 1, .T.,.F.)
  10528. CASE m.g_toplatform = "MAC"
  10529.    RETURN IIF(plat_arry[mac_code] = 1, .T.,.F.)
  10530. CASE m.g_toplatform = "UNIX"
  10531.    RETURN IIF(plat_arry[unix_code] = 1, .T.,.F.)
  10532. ENDCASE
  10533.  
  10534.  
  10535. *!*****************************************************************************
  10536. *!
  10537. *!      Function: boxjoin
  10538. *!
  10539. *!*****************************************************************************
  10540. FUNCTION boxjoin
  10541. PARAMETERS m.otype, m.rnum, m.pform
  10542. * Is this text object in a box group and thus boxjoin?
  10543. PRIVATE m.in_rec, m.retval, m.objpos
  10544. m.retval = .F.
  10545. IF m.otype = c_ottext
  10546.    m.in_rec = RECNO()
  10547.    
  10548.    * Get object position (position in linked list of objects) of current record
  10549.    m.objpos = GetObjPos(m.rnum, m.pform)
  10550.    IF m.objpos > 0
  10551.       * Look at all the box groups
  10552.       GOTO TOP
  10553.       SCAN FOR m.pform == platform AND objtype = c_otgroup AND objcode = 1 AND !m.retval
  10554.          * hpos has the starting object number for this group, vpos has the number of 
  10555.          * objects the group includes.
  10556.          IF m.objpos >= hpos AND m.objpos <= hpos + vpos - 1
  10557.             m.retval = .T.
  10558.          ENDIF
  10559.       ENDSCAN
  10560.    ENDIF
  10561.    GOTO m.in_rec
  10562. ENDIF
  10563. RETURN m.retval
  10564.  
  10565. *!*****************************************************************************
  10566. *!
  10567. *!      Function: GetObjPos
  10568. *!
  10569. *!*****************************************************************************
  10570. FUNCTION getobjpos
  10571. PARAMETERS m.rnum, m.pform
  10572. PRIVATE m.objcount, m.retval
  10573.  
  10574. * Get ordinal number of this object
  10575. m.objcount = 0
  10576. m.retval = 0
  10577. SCAN FOR m.pform == platform AND isobject(objtype)
  10578.    m.objcount = m.objcount + 1
  10579.    IF RECNO() = m.rnum
  10580.       m.retval = m.objcount
  10581.    ENDIF
  10582. ENDSCAN
  10583. RETURN m.retval
  10584. *: EOF: TRANSPRT.PRG
  10585.