home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a093 / 3.ddi / TRANSPRT.PR_ / TRANSPRT.bin
Encoding:
Text File  |  1993-01-17  |  326.9 KB  |  10,364 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. *:               : CONVERT102FRX()
  17. *:               : CONVERTFBPRPT
  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. *:               : CONVERT102FRX()    (function  in TRANSPRT.PRG)
  196. *:               : CONVERTFBPRPT      (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. * Copyright (c) 1993 Microsoft Corp.
  212. * One Microsoft Way
  213. * Redmond, WA 98052
  214. *
  215. * Notes:
  216. * In this program, for clarity/readability reasons, we use variable
  217. * names that are longer than 10 characters.  Note, however, that only
  218. * the first 10 characters are significant.
  219. *
  220. *
  221. * Revision History:
  222. * First written by Matt Pohle, John Beaver and Walt Kennamer for FoxPro 2.5
  223. *
  224.  
  225. PROCEDURE transprt
  226. PARAMETER m.g_scrndbf, m.tp_filetype, m.dummy
  227. * "g_crndbf" is the name of the file to transport.  It will usually be in some sort
  228. * of database format (e.g., SCX/PJX/MNX) but might also be a FoxBASE+ or FoxPro 1.02 
  229. * report or label file, which is not a database.
  230. *
  231. * "tp_filetype" specifies what kind of file "g_scrndbf" is.  Allowable values are
  232. * found in the #DEFINE constants immediately below.  Note that the Transporter usually
  233. * does not use this value and instead figures out what kind of file it is being 
  234. * presented with by counting the fields in the database.  For FoxBASE+ and FoxPro 1.02 files,
  235. * however, the Transporter does use this parameter to convert the report or label
  236. * data into 2.0 database format before transporting to Windows.  Note that the FoxBASE+ 
  237. * types are never actually passed in m.tp_filetype.  They are inferred in GetOldReportType 
  238. * and GetOldLabelTypefrom the ID byte in the report/label files.
  239.  
  240. * The "dummy" parameter is not used.  At one point in the developement of the Transporter,
  241. * another parameter was passed.  
  242.  
  243. *
  244. * Define Global Constants
  245. *
  246. * Filetype constants for FoxPro 2.0 and FoxPro 2.5 formats
  247. #DEFINE c_20pjxtype        1
  248. #DEFINE c_25scxtype       12
  249. #DEFINE c_20scxtype        2
  250. #DEFINE c_25frxtype       13
  251. #DEFINE c_20frxtype        3
  252. #DEFINE c_25lbxtype       14
  253. #DEFINE c_20lbxtype        4
  254. * FoxPro 1.02 and FoxBASE+ formats.  Note that the FoxBASE+ types are never
  255. * actually passed in m.tp_filetype.  They are inferred in GetOldReportType and 
  256. * GetOldLabelTypefrom the ID byte in the report/label files.  The suffix tells 
  257. * us how the file was called, by REPORT FORM ... or by MODIFY REPORT ...
  258. #DEFINE c_frx102repo      23
  259. #DEFINE c_frx102modi      33
  260. #DEFINE c_fbprptrepo      43
  261. #DEFINE c_fbprptmodi      53
  262. #DEFINE c_lbx102repo      24
  263. #DEFINE c_lbx102modi      34
  264. #DEFINE c_fbplblrepo      44
  265. #DEFINE c_fbplblmodi      54
  266.  
  267. * Definitions for Objtype fields in screens/reports/labels
  268. #DEFINE c_otheader         1
  269. #DEFINE c_otworkar         2
  270. #DEFINE c_otindex          3
  271. #DEFINE c_otrel            4
  272. #DEFINE c_ottext           5
  273. #DEFINE c_otline           6
  274. #DEFINE c_otbox            7
  275. #DEFINE c_otrepfld         8
  276. #DEFINE c_otband           9
  277. #DEFINE c_otgroup         10
  278. #DEFINE c_otlist          11
  279. #DEFINE c_ottxtbut        12
  280. #DEFINE c_otradbut        13
  281. #DEFINE c_otchkbox        14
  282. #DEFINE c_otfield         15
  283. #DEFINE c_otpopup         16
  284. #DEFINE c_otpicture       17
  285. #DEFINE c_otrepvar        18
  286. #DEFINE c_ot20lbxobj      19
  287. #DEFINE c_otinvbut        20
  288. #DEFINE c_otpdset         21
  289. #DEFINE c_otspinner       22
  290. #DEFINE c_otfontdata      23
  291.  
  292. * Window types
  293. #DEFINE c_user             1
  294. #DEFINE c_system           2
  295. #DEFINE c_dialog           3
  296. #DEFINE c_alert            4
  297.  
  298. * ObjCode definitions
  299. #DEFINE c_sgsay            0
  300. #DEFINE c_sgget            1
  301. #DEFINE c_sgedit           2
  302. #DEFINE c_sgfrom           3
  303. #DEFINE c_sgbox            4
  304. #DEFINE c_sgboxd           5
  305. #DEFINE c_sgboxp           6
  306. #DEFINE c_sgboxc           7
  307.  
  308. #DEFINE c_lnvertical       0
  309. #DEFINE c_lnhorizontal     1
  310.  
  311. #DEFINE c_ocboxgrp         1
  312.  
  313. * Attempt to preserve colors of text, lines and boxes when transporting to DOS?
  314. #DEFINE c_maptextcolor     .T.
  315.  
  316. * Field counts
  317. #DEFINE c_20scxfld        57
  318. #DEFINE c_scxfld          79
  319. #DEFINE c_20frxfld        36
  320. #DEFINE c_frxfld          74
  321. #DEFINE c_ot20label       30
  322. #DEFINE c_20lbxfld        17
  323. #DEFINE c_20pjxfld        33
  324. #DEFINE c_pjxfld          31
  325.  
  326. * Metrics for various objects, report bands, etc.
  327. #DEFINE c_pophght      1.231
  328. #DEFINE c_radhght      1.308
  329. #DEFINE c_chkhght      1.308
  330. #DEFINE c_listht       1.000
  331. #DEFINE c_adjfld       0.125
  332. #DEFINE c_adjlist      0.125
  333. #DEFINE c_adjtbtn      0.769
  334. #DEFINE c_adjrbtn      0.308
  335. #DEFINE c_vchkbox      0.154
  336. #DEFINE c_vradbtn      0.154
  337. #DEFINE c_vpopup       0.906
  338. #DEFINE c_vlist        0.500
  339. #DEFINE c_hpopup       1.000
  340. #DEFINE c_adjbox       0.500
  341. #DEFINE c_chkpixel        12
  342.  
  343. #DEFINE c_pixelsize       96
  344. #DEFINE c_bandheight   ((19/96) * 10000)
  345. #DEFINE c_bandfudge    4350
  346.  
  347. #DEFINE c_charrptheight   66
  348. #DEFINE c_charrptwidth    80
  349. #DEFINE c_linesperinch    (66/11)
  350. #DEFINE c_charsperinch    13.71
  351.  
  352. * Version codes, put into Objcode fields in the header record
  353. #DEFINE c_25scx           63
  354. #DEFINE c_25frx           53
  355.  
  356. * Major file types
  357. #DEFINE c_report           0
  358. #DEFINE c_screen           1
  359. #DEFINE c_label            2
  360. #DEFINE c_project          3
  361.  
  362. * Error codes
  363. #DEFINE c_error1   "Minor"
  364. #DEFINE c_error2   "Serious"
  365. #DEFINE c_error3   "Fatal"
  366.  
  367. * Font style for Transporter dialogs
  368. #DEFINE c_dlgface   "MS Sans Serif"
  369. #DEFINE c_dlgsize   8.000
  370. #DEFINE c_dlgstyle  "BT"
  371. #DEFINE c_dlgsty1   "BO"
  372.  
  373. * Return values
  374. #DEFINE c_yes              1
  375. #DEFINE c_no               0
  376. #DEFINE c_cancel          -1
  377.  
  378. * bands[] array indexes
  379. #DEFINE c_tobandvpos       1
  380. #DEFINE c_tobandheight     2
  381. #DEFINE c_fmbandvpos       3
  382. #DEFINE c_fmbandheight     4
  383.  
  384. * Defines used in converting FoxBASE+ reports
  385. #DEFINE maxliterals    55
  386. #DEFINE litpoolsize    1452
  387. #DEFINE maxrepflds    24
  388. #DEFINE h_page    1
  389. #DEFINE h_break 3
  390. #DEFINE l_item    4
  391. #DEFINE f_break 5
  392. #DEFINE f_page    7
  393. #DEFINE f_rpt    8
  394.  
  395. PRIVATE ALL
  396.  
  397. IF SET("TALK") = "ON"
  398.    SET TALK OFF
  399.    m.talkset = "ON"
  400. ELSE
  401.    m.talkset = "OFF"
  402. ENDIF
  403. m.pcount = PARAMETERS()
  404. PUSH KEY
  405.  
  406. *
  407. * Declare Environment Variables so that they are visible throughout the program
  408. *
  409. STORE "" TO m.cursor, m.consol, m.bell, m.exact, m.escape, m.onescape, m.safety, ;
  410.    m.fixed, m.print, m.unqset, m.udfparms, m.exclusive, m.onerror, ;
  411.    m.trbetween, m.comp, m.device, m.status, m.g_fromplatform, m.choice, ;
  412.    m.g_fromobjonlyalias, m.g_boxeditemsalias, m.g_tempalias, m.mtopic, m.rbord
  413. STORE 0 TO m.deci, m.memowidth, m.currarea
  414.  
  415. DO setall
  416.  
  417. * Set default typeface for reports
  418. m.g_rptfface            = "Courier"
  419. m.g_rptfstyle           = 0
  420. m.g_rpttxtfontstyle     = ""
  421. m.g_rptfsize            = 8
  422. IF _MAC OR _WINDOWS
  423.    m.g_rptlinesize      = (FONTMETRIC(1, m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  424.    m.g_rptcharsize      = (FONTMETRIC(6, m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  425. ENDIF
  426.  
  427. * Font selections for fields/text in the SCX/FRX itself.  May be overridden by user.
  428. m.g_fontface         = "MS Sans Serif"
  429. m.g_fontsize         = 8
  430. m.g_fontstyle        = "B"
  431.  
  432. * Font selections for controls in the SCX/FRX.  Not overrideable.
  433. m.g_cfontface        = "MS Sans Serif"
  434. m.g_cfontsize        = 8
  435.  
  436. m.g_foxfont          = "Foxfont"
  437. m.g_normstyle        = 0
  438. m.g_boldstyle        = 1
  439.  
  440. m.g_filetype         = " "
  441. m.g_fromplatform     = " "
  442. m.g_toplatform       = " "
  443. m.g_windheight       = 1
  444. m.g_windwidth        = 1
  445. m.g_thermwidth       = 0
  446. m.g_mercury          = 0
  447. m.g_20alias          = ""
  448. m.g_status           = 0
  449. m.g_energize         = .F.
  450. m.g_norepeat         = .F.
  451.  
  452. m.g_allobjects       = .T.
  453. m.g_newobjects       = .T.
  454. m.g_snippets         = .T.
  455. m.g_scrnalias        = ""
  456. m.g_updenviron       = .F.  && have we transported the environment records?
  457. m.g_tpselcnt         = 0    && number of entries in the tparray selection array
  458.  
  459. m.g_boxstrg = ['─','─','│','│','┌','┐','└','┘','─','─','│','│','┌','┐','└','┘']
  460.  
  461. m.g_returncode       = c_cancel
  462.  
  463. * Dimension the array of records to be transported.  This is the picklist of new and 
  464. * updated objects.
  465. DIMENSION tparray[1,2]
  466.  
  467. DIMENSION g_lastobjectline[2]
  468. g_lastobjectline[1] = 0
  469. m.g_tempindex = "S" + SUBSTR(LOWER(SYS(3)),2,8) + ".cdx"
  470.  
  471. m.onerror = ON("ERROR")
  472. ON ERROR DO errorhandler WITH MESSAGE(), LINENO(), c_error3
  473.  
  474. IF m.pcount < 2
  475.    DO ErrorHandler WITH "Invalid number of parameters",LINENO(),c_error3
  476. ENDIF
  477.  
  478. *
  479. * Make sure we have a file name we can deal with.  Prompt if the file cannot be found.
  480. *
  481. IF TYPE("m.g_scrndbf") != "C"
  482.    m.g_scrndbf = ""
  483. ENDIF
  484. m.g_scrndbf = UPPER(ALLTRIM(m.g_scrndbf))
  485. DO CASE
  486. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "SCX"
  487.    IF !FILE(m.g_scrndbf)
  488.       m.g_scrndbf = GETFILE("SCX", "Where is "+strippath(m.g_scrndbf))
  489.    ENDIF
  490. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "FRX"
  491.    IF !FILE(m.g_scrndbf)
  492.       m.g_scrndbf = GETFILE("FRX", "Where is "+strippath(m.g_scrndbf))
  493.    ENDIF
  494. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "LBX"
  495.    IF !FILE(m.g_scrndbf)
  496.       m.g_scrndbf = GETFILE("LBX", "Where is "+strippath(m.g_scrndbf))
  497.    ENDIF
  498. CASE SUBSTR(m.g_scrndbf, RAT(".", m.g_scrndbf)+1, 3) = "PJX"
  499.    IF !FILE(m.g_scrndbf)
  500.       m.g_scrndbf = GETFILE("PJX", "Where is "+strippath(m.g_scrndbf))
  501.    ENDIF
  502. OTHERWISE
  503.    IF !FILE(m.g_scrndbf)
  504.       m.g_scrndbf = GETFILE("SCX|FRX|LBX|PJX", "Select the file to transport", "Transport")
  505.    ENDIF
  506. ENDCASE
  507.  
  508. IF !FILE(m.g_scrndbf) OR EMPTY(m.g_scrndbf)
  509.    DO cleanup
  510.    RETURN .F.
  511. ENDIF
  512.  
  513. DO putwinmsg WITH "FoxPro Transporter: " + LOWER(strippath(m.g_scrndbf))
  514.  
  515. DO setversion
  516.  
  517. * If we've been passed an old format report or label form, see if it is a FoxPro 1.02
  518. * form, a FoxBASE+ form, or an unknown form.  
  519. * Convert FoxPro 1.02 or FoxBASE+ DOS reports into 2.5 DOS reports
  520. IF INLIST(m.tp_filetype,c_frx102modi,c_frx102repo,c_lbx102modi, c_lbx102repo)
  521.    IF INLIST(m.tp_filetype,c_frx102modi,c_frx102repo)
  522.       m.tp_filetype = getoldreporttype()   && FoxPro 1.02 or FoxBASE+ report?
  523.    ELSE
  524.       m.tp_filetype = getoldlabeltype()    && FoxPro 1.02 or FoxBASE+ label?
  525.    ENDIF
  526.    
  527.    IF doupdate()           && prompt to convert to 2.5 format; sets m.g_filetype
  528.       DO CASE
  529.       CASE INLIST(m.tp_filetype,c_frx102modi,c_frx102repo)
  530.          * FoxPro 1.02 report
  531.          m.g_scrndbf = convert102frx(m.g_scrndbf, m.tp_filetype)
  532.       CASE INLIST(m.tp_filetype,c_fbprptmodi,c_fbprptrepo)
  533.          * FoxBASE+ report
  534.          m.g_scrndbf = convertfbprpt(m.g_scrndbf, m.tp_filetype)
  535.       CASE INLIST(m.tp_filetype,c_lbx102modi,c_lbx102repo)
  536.          * FoxPro 1.02 label
  537.          m.g_scrndbf = convert102lbx(m.g_scrndbf, m.tp_filetype)
  538.       CASE INLIST(m.tp_filetype,c_fbplblmodi,c_fbplblrepo)
  539.          * FoxBASE+ label
  540.          m.g_scrndbf = convertfbplbl(m.g_scrndbf, m.tp_filetype)
  541.       OTHERWISE
  542.          DO errorhandler WITH "Unknown report format",LINENO(),c_error3
  543.       ENDCASE
  544.    ELSE
  545.       DO cleanup
  546.       RETURN c_cancel
  547.    ENDIF
  548. ENDIF
  549.  
  550. * Open the database
  551. IF !opendbf(m.g_scrndbf)
  552.    m.g_returncode = c_cancel
  553. ENDIF
  554.  
  555. *
  556. * We have three basic conversion cases.  These are transporting a 2.0 file to a 
  557. * graphical 2.5 platform (structure change and conversion), converting a 2.0 file 
  558. * to a character 2.5 platform (structure change) and transporting a 2.5 platform 
  559. * to another 2.5 platform (character/graphical conversion).  This case statement
  560. * calls the appropriate dialog routines and makes sure we have done all the 
  561. * preparation (like creating the cursor we actually work with.)
  562. *
  563. * The 1.02 and FoxBASE+ reports/labels are handled in basically the same way.  
  564. * They get their own cases in this construct since we don't want to prompt the 
  565. * user twice for conversion.  Almost all of the actual conversion of these files 
  566. * has already taken place, in the "Convert102frx" procedure (and related procedures) 
  567. * called above.
  568. *
  569. * Conversion of 2.0 project files is handled in its own case also.
  570. *
  571. DO CASE
  572. CASE INLIST(m.tp_filetype,c_frx102repo,c_fbprptrepo,c_lbx102repo,c_fbplblrepo) ;
  573.        AND (_WINDOWS OR _MAC)
  574.    * FoxPro 1.02 or FoxBASE+ report/label opened via REPORT/LABEL FORM.  At this point, 
  575.    * we've already converted the old format form into FoxPro 2.5 DOS format.
  576.    * Finish conversion, but don't transport it to Windows.
  577.    m.g_fromplatform = "DOS"
  578.    m.g_returncode = c_yes
  579.    DO starttherm WITH "Converting",g_filetype
  580.    DO putwinmsg WITH "Converting " + LOWER(strippath(m.g_scrndbf))
  581.    DO converter
  582.    DO updtherm WITH 100
  583.    
  584. CASE INLIST(m.tp_filetype,c_frx102modi,c_fbprptmodi,c_lbx102modi,c_fbplblmodi) ;
  585.        AND (_WINDOWS OR _MAC)
  586.    * FoxPro 1.02 or FoxBASE+ report/label opened via MODIFY REPORT/LABEL. At this point,
  587.    *  we've already converted the old format form into FoxPro 2.5 DOS format.
  588.    * Finish conversion, and then transport it to Windows.
  589.    m.g_fromplatform = "DOS"
  590.    m.g_returncode = c_yes
  591.    DO putwinmsg WITH "Converting " + LOWER(strippath(m.g_scrndbf))
  592.    DO converter
  593.    DO putwinmsg WITH "Transporting " + LOWER(strippath(m.g_scrndbf))
  594.    DO import
  595.    DO synchtime WITH m.g_toplatform, m.g_fromplatform
  596.    DO updtherm WITH 100
  597.    
  598. CASE ((FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld OR FCOUNT() = c_20lbxfld);
  599.       AND (_DOS OR _UNIX))
  600.    * Convert it to a DOS report, but don't transport it to Windows
  601.    DO CASE
  602.    CASE !doupdate()  && displays dialog and sets g_toPlatform
  603.       m.g_returncode = c_cancel
  604.    OTHERWISE
  605.       m.g_fromplatform = "DOS"
  606.       m.g_returncode = c_yes
  607.       DO starttherm WITH "Converting",g_filetype
  608.       DO converter
  609.       DO updtherm WITH 100
  610.    ENDCASE
  611.    
  612. CASE (FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld ;
  613.       OR FCOUNT() = c_20lbxfld) AND (_WINDOWS OR _MAC)
  614.    
  615.    * Convert it to DOS and then transport it to Windows
  616.    m.choice = converttype(.T.)
  617.    
  618.    DO CASE
  619.    CASE m.choice = c_yes
  620.       m.g_returncode = c_yes
  621.       DO converter
  622.       DO import
  623.       DO synchtime WITH m.g_toplatform, m.g_fromplatform
  624.       DO updtherm WITH 100
  625.    CASE m.choice = c_no
  626.       m.g_returncode = c_no
  627.       
  628.    OTHERWISE
  629.       m.g_returncode = c_cancel
  630.    ENDCASE
  631.    
  632. CASE FCOUNT() = c_scxfld OR FCOUNT() = c_frxfld
  633.    m.choice = converttype(.F.)
  634.    DO CASE
  635.    CASE m.choice = c_yes
  636.       m.g_returncode = c_yes
  637.       DO makecursor
  638.       DO import
  639.       IF m.g_returncode <> c_cancel
  640.          * This might happen if the user picked "Cancel" on the screen that lets
  641.          * him/her uncheck specific items.
  642.          SELECT (m.g_scrnalias)
  643.          DO synchtime WITH m.g_toplatform, m.g_fromplatform
  644.          DO updtherm WITH 100
  645.       ENDIF
  646.    CASE m.choice = c_no
  647.       m.g_returncode = c_no
  648.       
  649.    OTHERWISE
  650.       m.g_returncode = c_cancel
  651.    ENDCASE
  652. CASE FCOUNT() = c_20pjxfld
  653.    * Converting a 2.0 project to 2.5 format
  654.    IF !doupdate()                 && displays dialog and sets g_toPlatform
  655.       m.g_returncode = c_cancel
  656.    ELSE
  657.       m.g_fromplatform = "DOS"
  658.       m.g_returncode = c_yes
  659.       DO putwinmsg WITH "Converting " + LOWER(strippath(m.g_scrndbf))
  660.       DO starttherm WITH "Converting",g_filetype
  661.       DO converter
  662.       DO updtherm WITH 100
  663.    ENDIF
  664. CASE FCOUNT() = c_pjxfld
  665.    * 2.5 project passed to us by mistake--shouldn't ever happen.
  666.    WAIT WINDOW "The transporter has nothing to do." NOWAIT
  667.    m.g_returncode = c_cancel
  668. OTHERWISE
  669.    DO errorhandler WITH "Unknown or invalid file format", LINENO(), c_error3
  670.    m.g_returncode = c_cancel
  671. ENDCASE
  672.  
  673. DO cleanup
  674. RETURN m.g_returncode
  675.  
  676. *!*****************************************************************************
  677. *!
  678. *!       Function: OPENDBF
  679. *!
  680. *!      Called by: TRANSPRT.PRG                      
  681. *!
  682. *!*****************************************************************************
  683. FUNCTION opendbf
  684. PARAMETER fname
  685. m.g_scrnalias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  686. SELECT 0
  687. USE (m.fname) AGAIN ALIAS (m.g_scrnalias)
  688. IF RECCOUNT() = 0
  689.    WAIT WINDOW "No records to transport" NOWAIT
  690.    RETURN .F.
  691. ENDIF
  692. RETURN .T.
  693.  
  694. *
  695. * doupdate - Ask the user if a 2.0 screen/report/label should be updated to 2.5 format.
  696. *
  697. *!*****************************************************************************
  698. *!
  699. *!       Function: DOUPDATE
  700. *!
  701. *!      Called by: TRANSPRT.PRG                      
  702. *!
  703. *!          Calls: STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  704. *!
  705. *!*****************************************************************************
  706. FUNCTION doupdate
  707. PRIVATE m.result
  708.  
  709. DO CASE
  710. CASE INLIST(m.tp_filetype,c_frx102modi, c_frx102repo)
  711.    m.g_filetype = c_report
  712.    m.result = structdialog("Convert 1.02 report file to 2.5 format?")
  713.    
  714. CASE INLIST(m.tp_filetype,c_fbprptmodi, c_fbprptrepo)
  715.    m.g_filetype = c_report
  716.    m.result = structdialog("Convert FoxBASE+ report file to FoxPro 2.5 format?")
  717.    
  718. CASE INLIST(m.tp_filetype,c_lbx102modi, c_lbx102repo)
  719.    m.g_filetype = c_label
  720.    m.result = structdialog("Convert 1.02 label file to 2.5 format?")
  721.    
  722. CASE INLIST(m.tp_filetype,c_fbplblmodi, c_fbplblrepo)
  723.    m.g_filetype = c_label
  724.    m.result = structdialog("Convert FoxBASE+ label file to FoxPro 2.5 format?")
  725.    
  726. CASE FCOUNT() = c_20scxfld
  727.    m.g_filetype = c_screen
  728.    m.result = structdialog("Convert 2.0 screen file to 2.5 format?")
  729.    
  730. CASE FCOUNT() = c_20frxfld
  731.    m.g_filetype = c_report
  732.    m.result = structdialog("Convert 2.0 report file to 2.5 format?")
  733.    
  734. CASE FCOUNT() = c_20lbxfld
  735.    RETURN .F.
  736.    
  737. CASE FCOUNT() = c_20pjxfld
  738.    m.g_filetype = c_project
  739.    m.result = structdialog("Convert 2.0 project file to 2.5 format?")
  740. ENDCASE
  741. RETURN m.result
  742.  
  743. *
  744. * converttype - Display the dialog used when converting between 2.5 platforms
  745. *
  746. *!*****************************************************************************
  747. *!
  748. *!       Function: CONVERTTYPE
  749. *!
  750. *!      Called by: TRANSPRT.PRG                      
  751. *!
  752. *!          Calls: CLEANUP            (procedure in TRANSPRT.PRG)
  753. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  754. *!
  755. *!           Uses: M.G_SCRNALIAS      
  756. *!
  757. *!*****************************************************************************
  758. FUNCTION converttype
  759. PARAMETER m.twooh
  760. PRIVATE m.i, m.pcount, m.nplatforms
  761.  
  762. IF m.twooh  && If it's a 2.0 file, there is only one platform to convert from.
  763.    DIMENSION platforms[1]
  764.    platforms[1] = "FoxPro for MS-DOS"
  765.    
  766.    DO CASE                           && Remember the type of file we are converting
  767.    CASE INLIST(m.tp_filetype,c_frx102modi,c_frx102repo,c_fbprptmodi,c_fbprptrepo)
  768.       m.g_filetype = c_report
  769.       
  770.    CASE FCOUNT() = c_20scxfld
  771.       m.g_filetype = c_screen
  772.       
  773.    CASE FCOUNT() = c_20frxfld
  774.       m.g_filetype = c_report
  775.       
  776.    CASE FCOUNT() = c_20lbxfld
  777.       m.g_filetype = c_label
  778.       
  779.    CASE FCOUNT() = c_20pjxfld
  780.       m.g_filetype = c_project
  781.    ENDCASE
  782. ELSE
  783.    IF FCOUNT() = c_scxfld                && Remember the type of file we are converting
  784.       m.g_filetype = c_screen
  785.    ELSE
  786.       IF UPPER(RIGHT(m.g_scrndbf, 4)) = ".LBX"
  787.          LOCATE FOR objtype = c_ot20label OR ;
  788.             ((platform = "WINDOWS" OR platform = "MAC") AND ;
  789.             objtype = c_otheader AND BOTTOM)
  790.          IF FOUND()
  791.             m.g_filetype = c_label
  792.          ELSE
  793.             m.g_filetype = c_report
  794.          ENDIF
  795.       ELSE
  796.          m.g_filetype = c_report
  797.       ENDIF
  798.    ENDIF
  799.    
  800.    * Get a list of the platforms in this file.
  801.    SELECT DISTINCT platform ;
  802.       FROM (m.g_scrnalias) ;
  803.       WHERE !DELETED() ;
  804.       INTO ARRAY availplatforms
  805.    m.nplatforms = _TALLY
  806.    
  807.    m.g_fromplatform = availplatforms[1]
  808.    m.pcount = 0
  809.    
  810.    FOR i = 1 TO m.nplatforms            && Get a list of available platforms excluding the current one.
  811.       DO CASE
  812.       CASE ATC('DOS',availplatforms[m.i]) > 0 AND !_DOS
  813.          m.pcount = m.pcount + 1
  814.          DIMENSION platforms[m.pcount]
  815.          platforms[m.pcount] = 'FoxPro for MS-DOS'
  816.          
  817.       CASE ATC('WINDOWS',availplatforms[m.i]) > 0 AND !_WINDOWS
  818.          m.pcount = m.pcount + 1
  819.          DIMENSION platforms[m.pcount]
  820.          platforms[m.pcount] = 'FoxPro for Windows'
  821.          
  822.       CASE ATC('UNIX',availplatforms[m.i]) > 0 AND !_UNIX
  823.          m.pcount = m.pcount + 1
  824.          DIMENSION platforms[m.pcount]
  825.          platforms[i] = 'FoxPro for Unix'
  826.          
  827.       CASE ATC('MAC',availplatforms[m.i]) > 0 AND !_MAC
  828.          m.pcount = m.pcount + 1
  829.          DIMENSION platforms[m.pcount]
  830.          platforms[i] = 'FoxPro for Macintosh'
  831.       ENDCASE
  832.    ENDFOR
  833.    RELEASE availplatforms
  834.    
  835.    IF m.nplatforms = 0 OR m.pcount = 0                        && There isn't anything to convert from.
  836.       WAIT WINDOW "The transporter has nothing to do." NOWAIT
  837.       DO cleanup
  838.       RETURN c_cancel
  839.    ENDIF
  840. ENDIF
  841.  
  842. *   Call the dialog routine appropriate to this file type.
  843. DO CASE                        && Ask the user what we should do.
  844. CASE m.g_filetype = c_screen
  845.    RETURN scxfrxdialog("SCX")
  846. CASE m.g_filetype = c_report
  847.    RETURN scxfrxdialog("FRX")
  848. CASE m.g_filetype = c_label
  849.    RETURN scxfrxdialog("LBX")
  850. ENDCASE
  851. RETURN c_cancel
  852.  
  853. *
  854. * setversion - set global variable m.g_toPlatform with the name of the platform
  855. *            we are running on.
  856. *
  857. *!*****************************************************************************
  858. *!
  859. *!      Procedure: SETVERSION
  860. *!
  861. *!      Called by: TRANSPRT.PRG                      
  862. *!
  863. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  864. *!
  865. *!*****************************************************************************
  866. PROCEDURE setversion
  867.  
  868. DO CASE
  869. CASE _WINDOWS
  870.    m.g_toplatform = "WINDOWS"
  871.    
  872. CASE _MAC
  873.    m.g_toplatform = "MAC"
  874.    
  875. CASE _UNIX
  876.    m.g_toplatform = "UNIX"
  877.    
  878. CASE _DOS
  879.    m.g_toplatform = "DOS"
  880.    
  881. OTHERWISE
  882.    DO errorhandler WITH "Unknown Version of FoxPro.", LINENO(), c_error3
  883. ENDCASE
  884.  
  885. *
  886. * import - Do the import.
  887. *
  888. *!*****************************************************************************
  889. *!
  890. *!      Procedure: IMPORT
  891. *!
  892. *!      Called by: TRANSPRT.PRG                      
  893. *!
  894. *!          Calls: EMPTYPLATFORM()    (function  in TRANSPRT.PRG)
  895. *!               : GETCHARSUPPRESS()  (function  in TRANSPRT.PRG)
  896. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  897. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  898. *!
  899. *!           Uses: M.G_SCRNALIAS      
  900. *!
  901. *!*****************************************************************************
  902. PROCEDURE import
  903. IF m.g_fromplatform = m.g_toplatform
  904.    RETURN
  905. ELSE
  906.    *   If we are converting everything, remove all records for the target
  907.    *   platform.
  908.    IF m.g_allobjects AND !emptyplatform(m.g_toplatform)
  909.       * We need to copy the records we want to a temporary file, clear our cursor
  910.       * and copy the records back since you can't pack a cursor and SELECT creates
  911.       * a read only cursor.
  912.       m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  913.       SELECT * FROM (m.g_scrnalias) ;
  914.          WHERE !DELETED() AND platform <> m.g_toplatform ;
  915.          INTO TABLE (m.g_tempalias)
  916.       SELECT (m.g_scrnalias)
  917.       ZAP
  918.       APPEND FROM (m.g_tempalias)
  919.       SELECT (m.g_tempalias)
  920.       USE
  921.       DELETE FILE (m.g_tempalias+".dbf")
  922.       DELETE FILE (m.g_tempalias+".fpt")
  923.       SELECT (m.g_scrnalias)
  924.    ENDIF
  925.    
  926.    *   Are we converting from graphics to a character
  927.    *   based screen?
  928.    m.g_tographic =  (m.g_toplatform = 'WINDOWS' OR m.g_toplatform = 'MAC') AND ;
  929.       (m.g_fromplatform = 'DOS' OR m.g_fromplatform = 'UNIX')
  930. ENDIF
  931.  
  932. IF g_filetype = c_report
  933.    m.g_norepeat = getcharsuppress()
  934. ENDIF
  935.  
  936. *  Pass control to the control routine appropriate for the direction we are converting.
  937. DO CASE
  938. CASE m.g_tographic
  939.    DO chartographic
  940. CASE !m.g_tographic
  941.    DO graphictochar
  942. ENDCASE
  943. RETURN
  944.  
  945. *
  946. * GraphicToChar - Converts everything, new objects or changed snippets from a grpahical
  947. *      platform to a character platform.
  948. *
  949. *!*****************************************************************************
  950. *!
  951. *!      Procedure: GRAPHICTOCHAR
  952. *!
  953. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  954. *!
  955. *!          Calls: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  956. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  957. *!               : STARTTHERM         (procedure in TRANSPRT.PRG)
  958. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  959. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  960. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  961. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  962. *!
  963. *!*****************************************************************************
  964. PROCEDURE graphictochar
  965. IF m.g_allobjects
  966.    *  Start the thermometer with the appropriate message.
  967.    DO starttherm WITH "Transporting",m.g_filetype
  968.    
  969.    DO allgraphictochar
  970. ELSE
  971.    * Do a partial conversion, unless we're dealing with a label
  972.    IF m.g_filetype = c_label      && We only do complete label conversion
  973.       RETURN
  974.    ENDIF
  975.    
  976.    DO selectobj   && figure out which ones to transport
  977.    
  978.    *  Start the thermometer with the appropriate message.
  979.    DO starttherm WITH "Transporting",m.g_filetype
  980.    
  981.    m.g_mercury = 5
  982.    DO updtherm WITH m.g_mercury
  983.    
  984.    DO putwinmsg WITH "Transporting " + LOWER(strippath(m.g_scrndbf))
  985.    
  986.    SELECT (m.g_scrnalias)
  987.    
  988.    IF m.g_snippets
  989.       IF m.g_filetype = c_screen
  990.          DO updatescreen
  991.       ELSE
  992.          DO updatereport
  993.       ENDIF
  994.    ENDIF
  995.    IF m.g_newobjects
  996.       DO newgraphictochar
  997.    ENDIF
  998. ENDIF
  999.  
  1000. *
  1001. * CharToGraphic - Converts everything, new objects or changed snippets from a character
  1002. *      platform to a graphical platform.
  1003. *
  1004. *!*****************************************************************************
  1005. *!
  1006. *!      Procedure: CHARTOGRAPHIC
  1007. *!
  1008. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  1009. *!
  1010. *!          Calls: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1011. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  1012. *!               : STARTTHERM         (procedure in TRANSPRT.PRG)
  1013. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1014. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  1015. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  1016. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1017. *!
  1018. *!*****************************************************************************
  1019. PROCEDURE chartographic
  1020. IF m.g_allobjects
  1021.    *  Start the thermometer with the appropriate message.
  1022.    DO starttherm WITH "Transporting",m.g_filetype
  1023.    
  1024.    DO allchartographic
  1025. ELSE
  1026.    IF m.g_filetype = c_label      && We only do complete label convertsion
  1027.       RETURN
  1028.    ENDIF
  1029.    
  1030.    DO selectobj   && figure out which ones to transport
  1031.    
  1032.    *  Start the thermometer with the appropriate message.
  1033.    DO starttherm WITH "Transporting",m.g_filetype
  1034.    
  1035.    m.g_mercury = 5
  1036.    DO updtherm WITH m.g_mercury
  1037.  
  1038.    DO putwinmsg WITH "Transporting " + LOWER(strippath(m.g_scrndbf))
  1039.    
  1040.    SELECT (m.g_scrnalias)
  1041.    
  1042.    IF m.g_snippets
  1043.       IF m.g_filetype = c_screen
  1044.          DO updatescreen
  1045.       ELSE
  1046.          DO updatereport
  1047.       ENDIF
  1048.    ENDIF
  1049.    IF m.g_newobjects
  1050.       DO newchartographic
  1051.    ENDIF
  1052. ENDIF
  1053.  
  1054. *
  1055. * UpdateScreen - Copy any non-platform specific
  1056. *
  1057. *!*****************************************************************************
  1058. *!
  1059. *!      Procedure: UPDATESCREEN
  1060. *!
  1061. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1062. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1063. *!
  1064. *!          Calls: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  1065. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1066. *!               : MAPBUTTON()        (function  in TRANSPRT.PRG)
  1067. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1068. *!
  1069. *!           Uses: M.G_SCRNALIAS      
  1070. *!
  1071. *!        Indexes: ID                     (tag)
  1072. *!
  1073. *!*****************************************************************************
  1074. PROCEDURE updatescreen
  1075. PRIVATE m.thermstep
  1076.  
  1077. COUNT TO m.thermstep FOR platform = m.g_toplatform
  1078. IF m.g_newobjects
  1079.    m.thermstep = 40/m.thermstep
  1080. ELSE
  1081.    m.thermstep = 80/m.thermstep
  1082. ENDIF
  1083.  
  1084. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1085. SELECT * FROM (m.g_scrnalias) ;
  1086.    WHERE !DELETED() AND platform = m.g_fromplatform ;
  1087.    AND isselected(uniqueid,objtype,objcode) ;
  1088.    INTO CURSOR (m.g_tempalias)
  1089. INDEX ON uniqueid TAG id
  1090.  
  1091. SELECT (m.g_scrnalias)
  1092. SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  1093. LOCATE FOR .T.
  1094.  
  1095. SELECT (m.g_scrnalias)
  1096.  
  1097. * Check for flag to transport only code snippets
  1098. sniponly = .F.
  1099. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1100. IF FOUND()
  1101.    m.sniponly = getsnipflag(setupcode)
  1102. ENDIF
  1103.  
  1104. IF !m.sniponly
  1105.    DO updenviron WITH .T.
  1106. ENDIF
  1107.  
  1108. * Update everything else
  1109. SCAN FOR platform = m.g_toplatform AND !DELETED() ;
  1110.       AND (isobject(objtype) OR objtype = c_otheader)
  1111.    IF &g_tempalias..timestamp > timestamp
  1112.       IF !m.sniponly
  1113.          REPLACE name WITH &g_tempalias..name
  1114.          REPLACE expr WITH &g_tempalias..expr
  1115.          REPLACE STYLE WITH &g_tempalias..style
  1116.          IF INLIST(objtype,c_otradbut,c_ottxtbut)
  1117.             * Don't zap the whole set of buttons if there are just some new ones
  1118.             REPLACE PICTURE WITH mapbutton(&g_tempalias..picture,PICTURE)
  1119.          ELSE
  1120.             REPLACE PICTURE WITH &g_tempalias..picture
  1121.          ENDIF
  1122.          REPLACE ORDER WITH &g_tempalias..order
  1123.          REPLACE UNIQUE WITH &g_tempalias..unique
  1124.          *REPLACE Environ WITH &g_tempalias..Environ
  1125.          REPLACE boxchar WITH &g_tempalias..boxchar
  1126.          REPLACE fillchar WITH &g_tempalias..fillchar
  1127.          REPLACE TAG WITH &g_tempalias..tag
  1128.          REPLACE tag2 WITH &g_tempalias..tag2
  1129.          REPLACE ruler WITH &g_tempalias..ruler
  1130.          REPLACE rulerlines WITH &g_tempalias..rulerlines
  1131.          REPLACE grid WITH &g_tempalias..grid
  1132.          REPLACE gridv WITH &g_tempalias..gridv
  1133.          REPLACE gridh WITH &g_tempalias..gridh
  1134.          REPLACE FLOAT WITH &g_tempalias..float
  1135.          REPLACE CLOSE WITH &g_tempalias..close
  1136.          REPLACE MINIMIZE WITH &g_tempalias..minimize
  1137.          REPLACE BORDER WITH &g_tempalias..border
  1138.          REPLACE SHADOW WITH &g_tempalias..shadow
  1139.          REPLACE CENTER WITH &g_tempalias..center
  1140.          REPLACE REFRESH WITH &g_tempalias..refresh
  1141.          REPLACE disabled WITH &g_tempalias..disabled
  1142.          REPLACE scrollbar WITH &g_tempalias..scrollbar
  1143.          REPLACE addalias WITH &g_tempalias..addalias
  1144.          REPLACE TAB WITH &g_tempalias..tab
  1145.          REPLACE initialval WITH &g_tempalias..initialval
  1146.          REPLACE initialnum WITH &g_tempalias..initialnum
  1147.          REPLACE spacing WITH &g_tempalias..spacing
  1148.       ENDIF
  1149.       REPLACE lotype WITH &g_tempalias..lotype
  1150.       REPLACE rangelo WITH &g_tempalias..rangelo
  1151.       REPLACE hitype WITH &g_tempalias..hitype
  1152.       REPLACE rangehi WITH &g_tempalias..rangehi
  1153.       REPLACE whentype WITH &g_tempalias..whentype
  1154.       REPLACE WHEN WITH &g_tempalias..when
  1155.       REPLACE validtype WITH &g_tempalias..validtype
  1156.       REPLACE VALID WITH &g_tempalias..valid
  1157.       REPLACE errortype WITH &g_tempalias..errortype
  1158.       REPLACE ERROR WITH &g_tempalias..error
  1159.       REPLACE messtype WITH &g_tempalias..messtype
  1160.       REPLACE MESSAGE WITH &g_tempalias..message
  1161.       REPLACE showtype WITH &g_tempalias..showtype
  1162.       REPLACE SHOW WITH &g_tempalias..show
  1163.       REPLACE activtype WITH &g_tempalias..activtype
  1164.       REPLACE ACTIVATE WITH &g_tempalias..activate
  1165.       REPLACE deacttype WITH &g_tempalias..deacttype
  1166.       REPLACE DEACTIVATE WITH &g_tempalias..deactivate
  1167.       REPLACE proctype WITH &g_tempalias..proctype
  1168.       REPLACE proccode WITH &g_tempalias..proccode
  1169.       REPLACE setuptype WITH &g_tempalias..setuptype
  1170.       REPLACE setupcode WITH &g_tempalias..setupcode
  1171.       
  1172.       REPLACE timestamp WITH &g_tempalias..timestamp
  1173.       REPLACE platform WITH m.g_toplatform
  1174.    ENDIF
  1175.    
  1176.    m.g_mercury = m.g_mercury + m.thermstep
  1177.    DO updtherm WITH m.g_mercury
  1178.    
  1179. ENDSCAN
  1180.  
  1181. SELECT (m.g_tempalias)
  1182. USE
  1183. SELECT (m.g_scrnalias)
  1184.  
  1185. RETURN
  1186.  
  1187. *
  1188. * UpdateReport - Copy any "non-platform specific" information from one platform to another
  1189. *
  1190. *!*****************************************************************************
  1191. *!
  1192. *!      Procedure: UPDATEREPORT
  1193. *!
  1194. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1195. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1196. *!
  1197. *!          Calls: ADJRPTSUPPRESS     (procedure in TRANSPRT.PRG)
  1198. *!               : ADJRPTFLOAT        (procedure in TRANSPRT.PRG)
  1199. *!               : ADJRPTRESET        (procedure in TRANSPRT.PRG)
  1200. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1201. *!
  1202. *!           Uses: M.G_SCRNALIAS      
  1203. *!
  1204. *!        Indexes: ID                     (tag)
  1205. *!
  1206. *!*****************************************************************************
  1207. PROCEDURE updatereport
  1208. PRIVATE m.thermstep
  1209.  
  1210. COUNT TO m.thermstep FOR platform = m.g_toplatform
  1211. IF m.g_newobjects
  1212.    m.thermstep = 40/m.thermstep
  1213. ELSE
  1214.    m.thermstep = 80/m.thermstep
  1215. ENDIF
  1216.  
  1217. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1218. SELECT * FROM (m.g_scrnalias) ;
  1219.    WHERE platform = m.g_fromplatform AND !DELETED();
  1220.    AND isselected(uniqueid,objtype,objcode) ;
  1221.    INTO CURSOR (m.g_tempalias)
  1222. INDEX ON uniqueid TAG id
  1223.  
  1224. SELECT (m.g_scrnalias)
  1225. SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  1226. LOCATE FOR .T.
  1227.  
  1228. SELECT (m.g_scrnalias)
  1229. DO updenviron WITH .T.
  1230.  
  1231. SCAN FOR platform = m.g_toplatform AND ;
  1232.       (objtype = c_otheader OR objtype = c_otfield OR objtype = c_otpicture OR ;
  1233.       objtype = c_otrepfld OR objtype = c_otband OR objtype = c_otrepvar OR ;
  1234.       objtype = c_ottext OR objtype = c_otline OR objtype = c_otbox) AND !DELETED()
  1235.    IF &g_tempalias..timestamp > timestamp
  1236.       REPLACE name WITH &g_tempalias..name
  1237.       IF objtype = c_otrepvar AND !m.g_tographic
  1238.          REPLACE name WITH UPPER(name)
  1239.       ENDIF
  1240.       REPLACE expr WITH &g_tempalias..expr
  1241.       REPLACE STYLE WITH &g_tempalias..style
  1242.       REPLACE PICTURE WITH &g_tempalias..picture
  1243.       REPLACE ORDER WITH &g_tempalias..order
  1244.       REPLACE UNIQUE WITH &g_tempalias..unique
  1245.       REPLACE ENVIRON WITH &g_tempalias..environ
  1246.       REPLACE boxchar WITH &g_tempalias..boxchar
  1247.       REPLACE fillchar WITH &g_tempalias..fillchar
  1248.       REPLACE TAG WITH &g_tempalias..tag
  1249.       REPLACE tag2 WITH &g_tempalias..tag2
  1250.       REPLACE mode WITH &g_tempalias..mode
  1251.       REPLACE ruler WITH &g_tempalias..ruler
  1252.       REPLACE rulerlines WITH &g_tempalias..rulerlines
  1253.       REPLACE grid WITH &g_tempalias..grid
  1254.       REPLACE gridv WITH &g_tempalias..gridv
  1255.       REPLACE gridh WITH &g_tempalias..gridh
  1256.       REPLACE FLOAT WITH &g_tempalias..float
  1257.       REPLACE STRETCH WITH &g_tempalias..stretch
  1258.       REPLACE stretchtop WITH &g_tempalias..stretchtop
  1259.       REPLACE TOP WITH &g_tempalias..top
  1260.       REPLACE BOTTOM WITH &g_tempalias..bottom
  1261.       REPLACE suptype WITH &g_tempalias..suptype
  1262.       REPLACE suprest WITH &g_tempalias..suprest
  1263.       REPLACE norepeat WITH &g_tempalias..norepeat
  1264.       REPLACE resetrpt WITH &g_tempalias..resetrpt
  1265.       REPLACE pagebreak WITH &g_tempalias..pagebreak
  1266.       REPLACE colbreak WITH &g_tempalias..colbreak
  1267.       REPLACE resetpage WITH &g_tempalias..resetpage
  1268.       REPLACE GENERAL WITH &g_tempalias..general
  1269.       REPLACE spacing WITH &g_tempalias..spacing
  1270.       REPLACE DOUBLE WITH &g_tempalias..double
  1271.       REPLACE swapheader WITH &g_tempalias..swapheader
  1272.       REPLACE swapfooter WITH &g_tempalias..swapfooter
  1273.       REPLACE ejectbefor WITH &g_tempalias..ejectbefor
  1274.       REPLACE ejectafter WITH &g_tempalias..ejectafter
  1275.       REPLACE PLAIN WITH &g_tempalias..plain
  1276.       REPLACE SUMMARY WITH &g_tempalias..summary
  1277.       REPLACE addalias WITH &g_tempalias..addalias
  1278.       REPLACE offset WITH &g_tempalias..offset
  1279.       REPLACE topmargin WITH &g_tempalias..topmargin
  1280.       REPLACE botmargin WITH &g_tempalias..botmargin
  1281.       REPLACE totaltype WITH &g_tempalias..totaltype
  1282.       REPLACE resettotal WITH &g_tempalias..resettotal
  1283.       REPLACE resoid WITH &g_tempalias..resoid
  1284.       REPLACE curpos WITH &g_tempalias..curpos
  1285.       REPLACE supalways WITH &g_tempalias..supalways
  1286.       REPLACE supovflow WITH &g_tempalias..supovflow
  1287.       REPLACE suprpcol WITH &g_tempalias..suprpcol
  1288.       REPLACE supgroup WITH &g_tempalias..supgroup
  1289.       REPLACE supvalchng WITH &g_tempalias..supvalchng
  1290.       REPLACE supexpr WITH &g_tempalias..supexpr
  1291.       
  1292.       REPLACE timestamp WITH &g_tempalias..timestamp
  1293.       REPLACE platform WITH m.g_toplatform
  1294.       
  1295.       DO adjrptsuppress
  1296.       DO adjrptfloat
  1297.       IF objtype = c_otrepvar OR (objtype = c_otrepfld AND totaltype > 0)
  1298.          DO adjrptreset
  1299.       ENDIF
  1300.    ENDIF
  1301.    
  1302.    m.g_mercury = m.g_mercury + m.thermstep
  1303.    DO updtherm WITH m.g_mercury
  1304. ENDSCAN
  1305.  
  1306. SELECT (m.g_tempalias)
  1307. USE
  1308. SELECT (m.g_scrnalias)
  1309.  
  1310. RETURN
  1311.  
  1312.  
  1313. *!*****************************************************************************
  1314. *!
  1315. *!      Procedure: UPDENVIRON
  1316. *!
  1317. *!*****************************************************************************
  1318. PROCEDURE updenviron
  1319. PARAMETER m.mustexist
  1320. * Update environment records if the user selected environment records for transport
  1321. * and if any of them have been updated.
  1322. IF EnvSelect() AND IsNewerEnv(m.mustexist)
  1323.    * Drop the old environment and put the new one in
  1324.    DELETE FOR IsEnviron(objtype) and platform = m.g_toplatform
  1325.    SCAN FOR platform = m.g_fromplatform AND IsEnviron(Objtype)
  1326.       SCATTER MEMVAR MEMO
  1327.       APPEND BLANK
  1328.       GATHER MEMVAR MEMO
  1329.       REPLACE platform WITH m.g_toplatform
  1330.       IF !g_tographic
  1331.          * DOS requires the alias name to be in upper case, while Windows doesn't
  1332.          REPLACE TAG WITH UPPER(TAG)
  1333.          REPLACE tag2 WITH UPPER(tag2)
  1334.       ENDIF
  1335.    ENDSCAN
  1336.    m.g_updenviron = .T.
  1337. ENDIF
  1338.  
  1339. *
  1340. * CONVERTPROJECT - Convert project file from 2.0 to 2.5 format
  1341. *
  1342. *!*****************************************************************************
  1343. *!
  1344. *!      Procedure: CONVERTPROJECT
  1345. *!
  1346. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  1347. *!
  1348. *!*****************************************************************************
  1349. PROCEDURE convertproject
  1350. PRIVATE m.i
  1351.  
  1352. SELECT (m.g_scrnalias)
  1353. ZAP
  1354.  
  1355. SELECT (m.g_20alias)
  1356. SCAN FOR !DELETED()
  1357.    SCATTER MEMVAR MEMO
  1358.    m.wasarranged = arranged
  1359.    RELEASE m.arranged         && to avoid type mismatch at GATHER time
  1360.    
  1361.    SELECT (m.g_scrnalias)
  1362.    APPEND BLANK
  1363.    GATHER MEMVAR MEMO
  1364.    DO CASE
  1365.    CASE type == "H"
  1366.       IF !EMPTY(devinfo)
  1367.          * Adjust developer info to support wider state code
  1368.          REPLACE devinfo WITH STUFF(devinfo,162,0,CHR(0)+CHR(0)+CHR(0))
  1369.          REPLACE devinfo WITH STUFF(devinfo,176,0,REPLICATE(CHR(0),46))
  1370.       ENDIF
  1371.       
  1372.    CASE type == "s"   && must be lowercase S
  1373.       * Adjust for the new method of storing cross-platform arrangement info
  1374.       * (ScrnRow = -999 for centered screens)
  1375.       REPLACE arranged WITH ;
  1376.           PADR("DOS",8);
  1377.          +IIF(m.wasarranged,"T","F");
  1378.          +IIF(m.scrnrow=-999,"T","F");
  1379.          +PADL(LTRIM(STR(m.scrnrow,4)),8) ;
  1380.          +PADL(LTRIM(STR(m.scrncol,4)),8) ;
  1381.          +PADR("WINDOWS",8);
  1382.          +IIF(m.wasarranged,"T","F");
  1383.          +IIF(m.scrnrow=-999,"T","F");
  1384.          +PADL(LTRIM(STR(m.scrnrow,4)),8) ;
  1385.          +PADL(LTRIM(STR(m.scrncol,4)),8)
  1386.    ENDCASE
  1387.    
  1388.    * Adjust the symbol table
  1389.    IF !EMPTY(symbols)
  1390.       FOR i = 1 TO INT((LEN(symbols)-4)/14)
  1391.          * Format of a 2.0 symbol table is
  1392.          *   4 bytes of header information
  1393.          *   n occurrences of this structure:
  1394.          *      TEXT symName[11]
  1395.          *      TEXT symType
  1396.          *      TEXT flags[2]
  1397.          * Format of a 2.5 symbol table is the same, except symName is now 13 bytes long
  1398.          REPLACE symbols WITH STUFF(symbols,(m.i-1)*16+15,0,CHR(0)+CHR(0))
  1399.          REPLACE ckval WITH VAL(sys(2007,symbols))
  1400.       ENDFOR
  1401.    ENDIF
  1402.    
  1403.    * Blank out the timestamp
  1404.    REPLACE timestamp WITH 0
  1405. ENDSCAN
  1406.  
  1407. *
  1408. * NewCharToGraphic - Take any new objects from the character platform and copy them
  1409. *      to the graphical platform.
  1410. *
  1411. *!*****************************************************************************
  1412. *!
  1413. *!      Procedure: NEWCHARTOGRAPHIC
  1414. *!
  1415. *!      Called by: CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1416. *!
  1417. *!          Calls: GETWINDFONT        (procedure in TRANSPRT.PRG)
  1418. *!               : NEWBANDS           (procedure in TRANSPRT.PRG)
  1419. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  1420. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1421. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  1422. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  1423. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1424. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  1425. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  1426. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1427. *!
  1428. *!           Uses: M.G_SCRNALIAS      
  1429. *!
  1430. *!*****************************************************************************
  1431. PROCEDURE newchartographic
  1432. PRIVATE m.thermstep, m.bandcount
  1433.  
  1434. SELECT (m.g_scrnalias)
  1435. SET ORDER TO
  1436.  
  1437. * Get the default font for the window in the "to" platform
  1438. IF m.g_tographic
  1439.    DO getwindfont
  1440. ENDIF
  1441.  
  1442. * Update the environment if it is new
  1443. DO updenviron WITH .F.
  1444.  
  1445. * Remember the window default font
  1446. SELECT (m.g_scrnalias)
  1447. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1448. IF FOUND()
  1449.    m.wfontface  = fontface
  1450.    m.wfontsize  = fontsize
  1451.    m.wfontstyle = fontstyle
  1452. ELSE
  1453.    m.wfontface  = m.g_fontface
  1454.    m.wfontsize  = m.g_fontsize
  1455.    m.wfontstyle = m.g_fontstyle
  1456. ENDIF
  1457.  
  1458. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1459. SELECT * FROM (m.g_scrnalias) ;
  1460.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1461.    isselected(uniqueid,objtype,objcode) AND ;
  1462.    uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  1463.    WHERE platform = m.g_toplatform) ;
  1464.    INTO CURSOR (m.g_tempalias)
  1465.  
  1466. IF m.g_snippets
  1467.    m.thermstep = 35/_TALLY
  1468. ELSE
  1469.    m.thermstep = 70/_TALLY
  1470. ENDIF
  1471.  
  1472. IF m.g_filetype = c_report
  1473.    DO newbands
  1474.    
  1475.    * We need to know where bands start and where they end in
  1476.    * both platforms.
  1477.    SELECT (m.g_scrnalias)
  1478.    COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  1479.    DIMENSION bands[m.bandCount,4]
  1480.    m.bandcount = bandinfo()
  1481.    SELECT (m.g_tempalias)
  1482. ENDIF
  1483.  
  1484. m.rightmost = 0
  1485. m.bottommost = 0
  1486.  
  1487. SCAN
  1488.    IF isobject(objtype)
  1489.       SCATTER MEMVAR MEMO
  1490.       SELECT (m.g_scrnalias)
  1491.       APPEND BLANK
  1492.       GATHER MEMVAR MEMO
  1493.  
  1494.       REPLACE platform WITH m.g_toplatform
  1495.  
  1496.       DO platformdefaults WITH 0
  1497.       DO fillininfo
  1498.  
  1499.       DO CASE
  1500.       CASE INLIST(objtype,c_otbox, c_otline)
  1501.          DO adjbox WITH c_adjbox
  1502.       ENDCASE   
  1503.  
  1504.       IF m.g_filetype = c_report
  1505.          DO rptobjconvert WITH m.bandcount
  1506.       ELSE
  1507.          REPLACE vpos WITH findlikevpos(vpos)
  1508.          REPLACE hpos WITH findlikehpos(hpos)
  1509.          
  1510.          m.rightmost = MAX(m.rightmost, hpos + width ;
  1511.           * FONTMETRIC(6,fontface,fontsize,whatstyle(fontstyle)) ;
  1512.           / FONTMETRIC(6,m.wfontface,m.wfontsize,whatstyle(m.wfontstyle)))
  1513.          m.bottommost = MAX(m.bottommost, vpos + height ;
  1514.           * FONTMETRIC(1,fontface,fontsize,whatstyle(fontstyle)) ;
  1515.           / FONTMETRIC(1,m.wfontface,m.wfontsize,whatstyle(m.wfontstyle)))
  1516.       ENDIF
  1517.    ENDIF
  1518.  
  1519.    SELECT (m.g_tempalias)
  1520.  
  1521.    m.g_mercury = m.g_mercury + m.thermstep
  1522.    DO updtherm WITH m.g_mercury
  1523. ENDSCAN
  1524.  
  1525. SELECT (m.g_tempalias)
  1526. USE
  1527. SELECT (m.g_scrnalias)
  1528. * Update screen width/height if necessary to hold the new objects
  1529. IF m.g_filetype = c_screen
  1530.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  1531.    IF FOUND()
  1532.       * If the screen/report isn't big enough to hold the widest/tallest object, 
  1533.       * resize it.
  1534.       IF width < m.rightmost
  1535.          REPLACE width WITH m.rightmost + IIF(m.g_filetype = c_screen,2,2000)
  1536.       ENDIF
  1537.       IF height < m.bottommost AND m.g_filetype = c_screen
  1538.          REPLACE height WITH m.bottommost + IIF(m.g_filetype = c_screen,1,2000)
  1539.       ENDIF
  1540.    ENDIF      
  1541. ENDIF
  1542. RETURN
  1543.    
  1544. *
  1545. * NewGraphicToChar - Take any new objects from the graphic platform and copy them
  1546. *      to the character platform.
  1547. *
  1548. *!*****************************************************************************
  1549. *!
  1550. *!      Procedure: NEWGRAPHICTOCHAR
  1551. *!
  1552. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1553. *!
  1554. *!          Calls: NEWBANDS           (procedure in TRANSPRT.PRG)
  1555. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  1556. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  1557. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  1558. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  1559. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  1560. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1561. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  1562. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  1563. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1564. *!               : MAKECHARFIT        (procedure in TRANSPRT.PRG)
  1565. *!
  1566. *!           Uses: M.G_SCRNALIAS      
  1567. *!
  1568. *!*****************************************************************************
  1569. PROCEDURE newgraphictochar
  1570. PRIVATE m.thermstep, m.bandcount
  1571.  
  1572. SELECT (m.g_scrnalias)
  1573. SET ORDER TO
  1574.  
  1575. * Update the environment if it is new
  1576. DO updenviron WITH .F.
  1577.  
  1578. m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1579. *
  1580. * Get a cursor containing the records in the "to" platform that do not have
  1581. * counterparts in the "from" platform.  Exclude Windows report column headers
  1582. * and column footers (objtype = 9, objcode = 2 or 6) since they have no DOS analogs.
  1583. * Exclude boxes that are filled black.  They are probably used for shadow effects.
  1584. *
  1585. SELECT * FROM (m.g_scrnalias) ;
  1586.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1587.    !(objtype = c_otband AND INLIST(objcode,2,6)) AND ;
  1588.    isselected(uniqueid,objtype,objcode) AND ;
  1589.    !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  1590.    uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  1591.    WHERE platform = m.g_toplatform) ;
  1592.    INTO CURSOR (m.g_tempalias)
  1593.  
  1594. IF m.g_snippets
  1595.    m.thermstep = 35/_TALLY
  1596. ELSE
  1597.    m.thermstep = 70/_TALLY
  1598. ENDIF
  1599.  
  1600. IF m.g_filetype = c_report
  1601.    DO newbands
  1602.    
  1603.    * We need to know where bands start and where they end in
  1604.    * both platforms.
  1605.    SELECT (m.g_scrnalias)
  1606.    COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  1607.    DIMENSION bands[m.bandCount,4]
  1608.    m.bandcount = bandinfo()
  1609.    SELECT (m.g_tempalias)
  1610. ENDIF
  1611.  
  1612. LOCATE FOR .T.
  1613. DO WHILE !EOF()
  1614.    IF isobject(objtype) AND objtype <> c_otpicture
  1615.       SCATTER MEMVAR MEMO
  1616.       SELECT (m.g_scrnalias)
  1617.       APPEND BLANK
  1618.       GATHER MEMVAR MEMO
  1619.       
  1620.       REPLACE platform WITH m.g_toplatform
  1621.       
  1622.       DO platformdefaults WITH 0
  1623.       DO fillininfo
  1624.       
  1625.       IF m.g_filetype = c_screen
  1626.          DO adjheightandwidth
  1627.       ELSE
  1628.         DO rptobjconvert WITH m.bandcount
  1629.       ENDIF
  1630.       
  1631.       REPLACE vpos WITH findlikevpos(vpos)
  1632.       REPLACE hpos WITH findlikehpos(hpos)
  1633.    ENDIF
  1634.    
  1635.    SELECT (m.g_tempalias)
  1636.    SKIP
  1637.    
  1638.    m.g_mercury = m.g_mercury + m.thermstep
  1639.    DO updtherm WITH m.g_mercury
  1640. ENDDO
  1641.  
  1642. SELECT (m.g_tempalias)
  1643. USE
  1644. SELECT (m.g_scrnalias)
  1645.  
  1646. DO makecharfit
  1647.  
  1648. RETURN
  1649.  
  1650. *
  1651. * NewBands - Add any new band records.
  1652. *
  1653. *!*****************************************************************************
  1654. *!
  1655. *!      Procedure: NEWBANDS
  1656. *!
  1657. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  1658. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  1659. *!
  1660. *!          Calls: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  1661. *!               : BANDPOS()          (function  in TRANSPRT.PRG)
  1662. *!
  1663. *!*****************************************************************************
  1664. PROCEDURE newbands
  1665. PRIVATE m.prevband, m.bandstart, m.bandheight
  1666. * We need to have the groups in order to do report objects, so we do them seperately.
  1667.  
  1668. SCAN FOR objtype = c_otband
  1669.    SCATTER MEMVAR MEMO
  1670.    SELECT (m.g_scrnalias)
  1671.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.uniqueid
  1672.    SKIP -1
  1673.    m.prevband = uniqueid
  1674.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.prevband
  1675.    INSERT BLANK
  1676.    GATHER MEMVAR MEMO
  1677.    REPLACE platform WITH m.g_toplatform
  1678.    
  1679.    DO rptobjconvert WITH 0
  1680.    
  1681.    m.bandheight = HEIGHT + IIF(m.g_tographic, c_bandheight+(c_bandfudge/c_pixelsize), 0)
  1682.    m.bandstart = bandpos(m.uniqueid, m.g_toplatform)
  1683.    
  1684.    * Move all the lower bands down by the size of the one we just inserted.
  1685.    REPLACE ALL vpos WITH vpos + m.bandheight ;
  1686.       FOR platform = m.g_toplatform AND ;
  1687.       (objtype = c_otline OR objtype = c_otbox OR ;
  1688.       objtype = c_ottext OR objtype = c_otrepfld) AND ;
  1689.       vpos >= m.bandstart
  1690.    SELECT (m.g_tempalias)
  1691. ENDSCAN
  1692.  
  1693. *
  1694. * AllGraphicToChar - Convert from a graphic platform to a character platform assuming
  1695. *      that no records exist for the target platform.
  1696. *
  1697. *!*****************************************************************************
  1698. *!
  1699. *!      Procedure: ALLGRAPHICTOCHAR
  1700. *!
  1701. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  1702. *!
  1703. *!          Calls: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  1704. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  1705. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  1706. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  1707. *!               : MERGELABELOBJECTS  (procedure in TRANSPRT.PRG)
  1708. *!               : LINESBETWEEN       (procedure in TRANSPRT.PRG)
  1709. *!               : MAKECHARFIT        (procedure in TRANSPRT.PRG)
  1710. *!               : SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  1711. *!
  1712. *!           Uses: M.G_SCRNALIAS      
  1713. *!
  1714. *!*****************************************************************************
  1715. PROCEDURE allgraphictochar
  1716. PRIVATE m.objindex
  1717.  
  1718. DO allenvirons
  1719.  
  1720. *
  1721. * Create a cursor with all the objects we have left to add.
  1722. *
  1723. m.g_fromobjonlyalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1724. SELECT *, RECNO() AS recnum FROM (m.g_scrnalias) ;
  1725.    WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  1726.    objtype <> c_otrel AND objtype <> c_otworkar AND objtype <> c_otindex AND ;
  1727.    objtype <> c_otheader AND objtype <> c_otgroup AND ;
  1728.    objtype <> c_otpicture AND ;
  1729.    !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  1730.    !(m.g_filetype = c_label AND objtype = c_ot20label) AND ;
  1731.    !(objtype = c_ot20lbxobj AND EMPTY(expr)) ;
  1732.    INTO CURSOR (m.g_fromobjonlyalias)
  1733. m.objindex = _TALLY
  1734.  
  1735. DO allothers WITH 80
  1736. DO allgroups WITH 10
  1737.  
  1738. DO CASE
  1739. CASE m.g_filetype = c_label
  1740.    ** Trim any records the character platforms won't deal with.
  1741.    DELETE FOR platform = m.g_toplatform AND ;
  1742.       ((objtype = c_otband AND objcode != 4) OR ;
  1743.       objtype = c_otrepvar OR objtype = c_otpicture OR ;
  1744.       objtype = c_otline OR objtype = c_otbox)
  1745.    DO rptconvert
  1746.    DO mergelabelobjects
  1747.    DO linesbetween
  1748.    
  1749. CASE m.g_filetype = c_report
  1750.    ** Trim any records the character platforms won't deal with.
  1751.    DELETE FOR platform = m.g_toplatform AND (objtype = c_otpicture)
  1752.    DO rptconvert
  1753.    DO makecharfit
  1754.    DO suppressblanklines
  1755.   
  1756. CASE m.g_filetype = c_screen
  1757.    DO makecharfit
  1758. ENDCASE
  1759.  
  1760. SELECT (m.g_fromobjonlyalias)
  1761. USE
  1762. SELECT (m.g_scrnalias)
  1763.  
  1764. RETURN
  1765.  
  1766. *
  1767. * AllCharToGraphic - Convert from a character platform to a graphic platform assuming
  1768. *      that no records exist for the target platform.
  1769. *
  1770. *!*****************************************************************************
  1771. *!
  1772. *!      Procedure: ALLCHARTOGRAPHIC
  1773. *!
  1774. *!      Called by: CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  1775. *!
  1776. *!          Calls: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  1777. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  1778. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  1779. *!               : CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  1780. *!               : ADJITEMSINBOXES    (procedure in TRANSPRT.PRG)
  1781. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  1782. *!               : JOINLINES          (procedure in TRANSPRT.PRG)
  1783. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  1784. *!               : SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  1785. *!               : ADDGRAPHICALLABELGR(procedure in TRANSPRT.PRG)
  1786. *!               : LABELBANDS         (procedure in TRANSPRT.PRG)
  1787. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  1788. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  1789. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  1790. *!               : STRETCHLINESTOBORDE(procedure in TRANSPRT.PRG)
  1791. *!
  1792. *!           Uses: M.G_SCRNALIAS      
  1793. *!
  1794. *!*****************************************************************************
  1795. PROCEDURE allchartographic
  1796. PRIVATE m.objindex
  1797.  
  1798. * Make equivalent screen/report records for the new platform.
  1799. DO allenvirons
  1800.  
  1801. m.g_fromobjonlyalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  1802. SELECT *, RECNO() AS recnum FROM (m.g_scrnalias) ;
  1803.    WHERE !DELETED() AND platform = m.g_fromplatform AND objtype <> c_otrel AND ;
  1804.    objtype <> c_otworkar AND objtype <> c_otindex AND ;
  1805.    objtype <> c_otheader AND objtype <> c_otgroup AND ;
  1806.    !(m.g_filetype = c_label AND objtype = c_ot20label) AND ;
  1807.    !(objtype = c_ot20lbxobj AND EMPTY(expr)) ;
  1808.    INTO CURSOR (m.g_fromobjonlyalias)
  1809.  
  1810. m.objindex = _TALLY
  1811. IF _TALLY = 0
  1812.    SELECT (m.g_fromobjonlyalias)
  1813.    USE
  1814.    SELECT (m.g_scrnalias)
  1815.    RETURN
  1816. ENDIF
  1817.  
  1818. DIMENSION objectpos[m.objindex, 9]
  1819.  
  1820. DO allothers WITH 25
  1821. DO allgroups WITH 5
  1822.  
  1823. * Attempt to adjust the position of objects to reflect the position
  1824. * in the previous platform.
  1825.  
  1826. DO CASE
  1827. CASE m.g_filetype = c_screen
  1828.    DO calcwindowdimensions
  1829.    DO adjitemsinboxes
  1830.    DO adjinvbtns
  1831.    SET ORDER TO
  1832.    
  1833.    IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  1834.       DO joinlines
  1835.    ENDIF
  1836.    
  1837. CASE m.g_filetype = c_report
  1838.    DO rptconvert
  1839.    DO joinlines
  1840.    DO suppressblanklines
  1841.    
  1842. CASE m.g_filetype = c_label
  1843.    IF m.g_fromplatform = "DOS" OR m.g_fromplatform = "UNIX"
  1844.       DO addgraphicallabelgroups
  1845.    ENDIF
  1846.    DO labelbands
  1847.    DO labellines
  1848. ENDCASE
  1849.  
  1850. m.g_mercury = m.g_mercury + 5
  1851. DO updtherm WITH m.g_mercury
  1852.  
  1853. IF m.g_filetype = c_screen
  1854.    IF m.g_allobjects
  1855.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader AND STYLE != 0
  1856.       IF FOUND()
  1857.          IF m.g_windheight - g_lastobjectline[1] - 3 = 0
  1858.             m.adjustment = .5
  1859.          ELSE
  1860.             m.adjustment = m.g_windheight - g_lastobjectline[1] - 3
  1861.          ENDIF
  1862.          
  1863.          IF m.adjustment < 0
  1864.             m.adjustment = m.adjustment + 1.5
  1865.          ENDIF
  1866.          
  1867.          IF m.adjustment > 0
  1868.             REPLACE HEIGHT WITH g_lastobjectline[2] + ;
  1869.                m.adjustment * (FONTMETRIC(1) / ;
  1870.                FONTMETRIC(1,fontface, fontsize, whatstyle(fontstyle)))
  1871.          ELSE
  1872.             REPLACE HEIGHT WITH g_lastobjectline[2] + 1
  1873.          ENDIF
  1874.       ENDIF
  1875.       DO stretchlinestoborders
  1876.    ENDIF
  1877. ENDIF
  1878.  
  1879. m.g_mercury = m.g_mercury + 5
  1880. DO updtherm WITH m.g_mercury
  1881.  
  1882. SELECT (m.g_fromobjonlyalias)
  1883. USE
  1884. SELECT (m.g_scrnalias)
  1885.  
  1886. *
  1887. * Convert102Frx - Converts a DOS 1.02 report to DOS 2.5 format
  1888. *
  1889. *!*****************************************************************************
  1890. *!
  1891. *!       Function: CONVERT102FRX
  1892. *!
  1893. *!      Called by: TRANSPRT.PRG                      
  1894. *!
  1895. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  1896. *!               : FORCEEXT()         (function  in TRANSPRT.PRG)
  1897. *!
  1898. *!*****************************************************************************
  1899. FUNCTION convert102frx
  1900. * Converts FoxPro 1.02 DOS report to FoxPro 2.5 DOS report
  1901. PARAMETER m.fname102, m.ftype
  1902. PRIVATE m.bakname, m.in_area
  1903.  
  1904. m.in_area = SELECT()
  1905. SELECT 0
  1906. * Create a database structure matching the tab delimited format
  1907. *  of a 1.02 report file.
  1908. CREATE CURSOR old ( ;
  1909.    objtype N(10,0), ;
  1910.    content N(10,0), ;
  1911.    fldcontent C(254), ;
  1912.    frmcontent C(254), ;
  1913.    vertpos N(10,0), ;
  1914.    horzpos N(10,0), ;
  1915.    HEIGHT N(10,0), ;
  1916.    WIDTH N(10,0), ;
  1917.    FONT N(10,0), ;
  1918.    fontsize N(10,0), ;
  1919.    STYLE N(10,0), ;
  1920.    penred N(10,0), ;
  1921.    pengreen N(10,0), ;
  1922.    penblue N(10,0), ;
  1923.    fillred N(10,0), ;
  1924.    fillgreen N(10,0), ;
  1925.    fillblue N(10,0), ;
  1926.    PICTURE C(254), ;
  1927.    rangeup N(10,0), ;
  1928.    rangelow N(10,0), ;
  1929.    VALID N(10,0), ;
  1930.    initc N(10,0), ;
  1931.    calcexp N(10,0) ;
  1932.    )
  1933.  
  1934. * Replace quote marks with \" so that APPEND won't strip them out.  They are our only
  1935. * way of distinguishing quoted text from, say, field names.
  1936. m.fpin  = fopen(m.fname102,2)   && open for read access
  1937. m.outname = forceext(m.fname102,"TMP")
  1938. m.fpout = fcreate(m.outname)
  1939.  
  1940. IF m.fpin > 0 AND m.fpout > 0
  1941.    DO WHILE !FEOF(m.fpin)
  1942.       m.buf = fgets(m.fpin)
  1943.       m.buf = STRTRAN(m.buf,'"','\+')
  1944.       =fputs(m.fpout,m.buf)
  1945.    ENDDO
  1946.    =fclose(m.fpin)
  1947.    =fclose(m.fpout)
  1948.  
  1949.    APPEND FROM (m.outname) TYPE DELIMITED WITH TAB
  1950.    
  1951.    * Drop the temporary output file
  1952.    IF FILE(m.outname)
  1953.       DELETE FILE (m.outname)
  1954.    ENDIF
  1955.    
  1956.    * Replace quote markers with quotes in the character fields
  1957.    REPLACE ALL fldcontent WITH STRTRAN(fldcontent,'\+','"'), ;
  1958.                frmcontent WITH STRTRAN(frmcontent,'\+','"'), ;
  1959.                picture    WITH STRTRAN(picture,   '\+','"')  ;
  1960.       FOR objtype = 17
  1961.    * Strip quotes from other object types, such as quoted strings.
  1962.    REPLACE ALL fldcontent WITH STRTRAN(fldcontent,'\+',''), ;
  1963.                frmcontent WITH STRTRAN(frmcontent,'\+',''), ;
  1964.                picture    WITH STRTRAN(picture,   '\+','')  ;
  1965.       FOR objtype <> 17
  1966.       
  1967. ELSE
  1968.    APPEND FROM (m.fname102) TYPE DELIMITED WITH TAB
  1969. ENDIF
  1970.  
  1971. * Create an empty 2.5 report file
  1972. DO docreate WITH "new", c_report
  1973.  
  1974. SELECT old
  1975. SCAN
  1976.    DO CASE
  1977.    CASE objtype = 1  && report record
  1978.       SELECT new
  1979.       APPEND BLANK
  1980.       SELECT old
  1981.       REPLACE new.platform WITH "DOS"
  1982.       REPLACE new.objtype WITH 1
  1983.       REPLACE new.objcode WITH c_25frx
  1984.       REPLACE new.topmargin WITH old.vertpos
  1985.       REPLACE new.botmargin WITH old.horzpos
  1986.       REPLACE new.height WITH old.height
  1987.       REPLACE new.width WITH old.width
  1988.       REPLACE new.offset WITH old.fontsize
  1989.       IF (old.initc > 0)
  1990.          REPLACE new.environ WITH .T.
  1991.       ENDIF
  1992.       IF (old.calcexp = 1 OR old.calcexp = 3)
  1993.          REPLACE new.ejectbefor WITH .T.
  1994.       ENDIF
  1995.       IF (old.calcexp = 2 OR old.calcexp = 3)
  1996.          REPLACE new.ejectafter WITH .T.
  1997.       ENDIF
  1998.       
  1999.    CASE objtype = 5  && text record
  2000.       SELECT new
  2001.       APPEND BLANK
  2002.       SELECT old
  2003.       REPLACE new.platform WITH "DOS"
  2004.       REPLACE new.objtype WITH 5
  2005.       REPLACE new.vpos WITH old.vertpos
  2006.       REPLACE new.hpos WITH old.horzpos
  2007.       REPLACE new.height WITH 1
  2008.       REPLACE new.width WITH old.width
  2009.       IF (old.rangelow > 0)
  2010.          REPLACE new.float WITH .T.
  2011.       ENDIF
  2012.       REPLACE new.expr WITH '"' + ALLTRIM(old.fldcontent) + '"'
  2013.       
  2014.    CASE objtype = 7 && box record
  2015.       SELECT new
  2016.       APPEND BLANK
  2017.       SELECT old
  2018.       REPLACE new.platform WITH "DOS"
  2019.       REPLACE new.objtype WITH 7
  2020.       REPLACE new.vpos WITH old.vertpos
  2021.       REPLACE new.hpos WITH old.horzpos
  2022.       REPLACE new.height WITH old.height
  2023.       REPLACE new.width WITH old.width
  2024.       REPLACE new.objcode WITH old.content + 4
  2025.       IF (old.rangelow > 0)
  2026.          REPLACE new.float WITH .T.
  2027.       ENDIF
  2028.       IF (old.fontsize > 0)
  2029.          REPLACE new.boxchar WITH CHR(old.fontsize / 256)
  2030.       ENDIF
  2031.       
  2032.    CASE objtype = 17 && field record
  2033.       SELECT new
  2034.       APPEND BLANK
  2035.       SELECT old
  2036.       REPLACE new.platform WITH "DOS"
  2037.       REPLACE new.objtype WITH 8
  2038.       REPLACE new.vpos WITH old.vertpos
  2039.       REPLACE new.hpos WITH old.horzpos
  2040.       REPLACE new.height WITH 1
  2041.       REPLACE new.width WITH old.width
  2042.       REPLACE new.expr WITH TRIM(old.fldcontent)
  2043.       IF !EMPTY(old.picture)
  2044.          REPLACE new.picture WITH '"' + ALLTRIM(old.picture) + '"'
  2045.       ENDIF
  2046.       REPLACE new.totaltype WITH old.valid
  2047.       REPLACE new.resettotal WITH old.initc
  2048.       IF (old.rangeup > 0)
  2049.          REPLACE new.norepeat WITH .T.
  2050.       ENDIF
  2051.       
  2052.       IF (old.rangelow > 1)
  2053.          WRAP = MAX(old.rangelow - 3, 0)
  2054.       ELSE
  2055.          WRAP = old.rangelow
  2056.       ENDIF
  2057.       
  2058.       IF (WRAP > 0)
  2059.          REPLACE new.stretch WITH .T.
  2060.       ENDIF
  2061.       
  2062.       IF (old.rangelow = 3 OR old.rangelow = 4)
  2063.          REPLACE new.float WITH .T.
  2064.       ENDIF
  2065.       
  2066.       REPLACE new.fillchar WITH ALLTRIM(old.frmcontent)
  2067.       
  2068.    CASE objtype = 18 && band record
  2069.       SELECT new
  2070.       APPEND BLANK
  2071.       SELECT old
  2072.       REPLACE new.platform WITH "DOS"
  2073.       REPLACE new.objtype WITH 9
  2074.       REPLACE new.objcode WITH old.content
  2075.       REPLACE new.expr WITH old.fldcontent
  2076.       REPLACE new.height WITH old.height
  2077.       IF (old.vertpos > 0)
  2078.          REPLACE new.pagebreak WITH .T.
  2079.       ENDIF
  2080.       IF (old.fontsize > 0)
  2081.          REPLACE new.swapheader WITH .T.
  2082.       ENDIF
  2083.       IF (old.style > 0)
  2084.          REPLACE new.swapfooter WITH .T.
  2085.       ENDIF
  2086.    ENDCASE
  2087. ENDSCAN
  2088.  
  2089. * Discard the temporary cursor
  2090. SELECT old
  2091. USE
  2092.  
  2093. IF m.ftype = c_frx102repo
  2094.    * Back up the original report and copy the new information to the original file name
  2095.    m.bakname = forceext(m.fname102,"TBK")
  2096.    RENAME (m.fname102) TO (m.bakname)
  2097. ENDIF
  2098.  
  2099. * Write the new information on top of the original 1.02 report
  2100. SELECT new
  2101. COPY TO (m.fname102)
  2102. USE
  2103. SELECT (m.in_area)
  2104. RETURN m.fname102
  2105.  
  2106. *!*****************************************************************************
  2107. *!
  2108. *!      Procedure: CONVERTFBPRPT
  2109. *!
  2110. *!      Called by: TRANSPRT.PRG                      
  2111. *!
  2112. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  2113. *!               : CVTSHORT()         (function  in TRANSPRT.PRG)
  2114. *!               : CVTBYTE()          (function  in TRANSPRT.PRG)
  2115. *!               : DOCREATE           (procedure in TRANSPRT.PRG)
  2116. *!               : EVALIMPORTEXPR     (procedure in TRANSPRT.PRG)
  2117. *!               : INITBANDS          (procedure in TRANSPRT.PRG)
  2118. *!               : BLDBREAKS          (procedure in TRANSPRT.PRG)
  2119. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2120. *!               : FORCEEXT()         (function  in TRANSPRT.PRG)
  2121. *!
  2122. *!*****************************************************************************
  2123. PROCEDURE convertfbprpt
  2124. * Convert a FoxBASE+ report to FoxPro 2.5 DOS format
  2125. PARAMETER m.fnamefbp, m.ftype
  2126. PRIVATE m.bakname, m.in_area, m.i, m.idbyte, m.objname, m.obj, m.rp_pool, ;
  2127.    m.rp_ltadr, m.rp_ltlen, m.rp_ssexno, m.rp_sbexno, m.rp_doublesp, ;
  2128.    m.rp_flds_width, m.rp_flds_exprno, m.rp_width, m.rp_flds_headno, ;
  2129.    m.rp_plain, m.band_rows, m.current_row, m.group_num, m.head_row
  2130.  
  2131. m.in_area = SELECT()
  2132. SELECT 0
  2133.  
  2134. m.objname       = ""
  2135. m.obj           = 0
  2136. m.rp_pool       = 0
  2137. m.rp_ltadr      = 0
  2138. m.rp_ltlen      = 0
  2139. m.rp_ssexno     = 0
  2140. m.rp_sbexno     = 0
  2141. m.rp_doublesp   = 0
  2142. m.rp_flds_width = 0
  2143. m.rp_flds_exprno= 0
  2144. m.rp_width      = 0
  2145. m.rp_flds_headno= 0
  2146. m.rp_plain      = 0
  2147. m.band_rows     = 0
  2148. m.current_row   = 0
  2149. m.group_num     = 0
  2150. m.head_row      = 0
  2151.  
  2152. * Create a set of parallel arrays to contain the report information we need to bring
  2153. * across to FoxPro 2.5 DOS.
  2154. DIMENSION rp_ltlen(maxliterals)
  2155. DIMENSION rp_ltadr(maxliterals)
  2156. DIMENSION rp_flds_width(maxrepflds)
  2157. DIMENSION rp_flds_type(maxrepflds)
  2158. DIMENSION rp_flds_totals(maxrepflds)
  2159. DIMENSION rp_flds_dp(maxrepflds)
  2160. DIMENSION rp_flds_exprno(maxrepflds)
  2161. DIMENSION rp_flds_headno(maxrepflds)
  2162. DIMENSION band_rows(10)
  2163. band_rows = 0
  2164.  
  2165. m.obj = FOPEN(m.g_scrndbf)
  2166. IF (m.obj < 1)
  2167.    DO errorhandler WITH "Could not open FoxBASE+ report form",LINENO(),c_error3
  2168. ENDIF
  2169.  
  2170. m.idbyte = cvtshort(FREAD(m.obj,2),0)
  2171.  
  2172. poolsize = cvtshort(FREAD(m.obj,2),0)
  2173. FOR i = 1 TO maxliterals
  2174.    rp_ltlen(i) = cvtshort(FREAD(m.obj,2),0)
  2175. ENDFOR
  2176. FOR i = 1 TO maxliterals
  2177.    rp_ltadr(i) = cvtshort(FREAD(m.obj,2),0)
  2178. ENDFOR
  2179. rp_pool = FREAD(m.obj,litpoolsize)
  2180. FOR i = 1 TO maxrepflds
  2181.    rp_flds_width(i) = cvtshort(FREAD(m.obj,2),0)
  2182.    =FREAD(m.obj,2)
  2183.    rp_flds_type(i) = FREAD(m.obj,1)
  2184.    rp_flds_totals(i) = FREAD(m.obj,1)
  2185.    rp_flds_dp(i) = cvtshort(FREAD(m.obj,2),0)
  2186.    rp_flds_exprno(i) = cvtshort(FREAD(m.obj,2),0)
  2187.    rp_flds_headno(i) = cvtshort(FREAD(m.obj,2),0)
  2188. ENDFOR
  2189. rp_pghdno = cvtshort(FREAD(m.obj,2),0)
  2190. rp_sbexno = cvtshort(FREAD(m.obj,2),0)
  2191. rp_ssexno = cvtshort(FREAD(m.obj,2),0)
  2192. rp_sbhdno = cvtshort(FREAD(m.obj,2),0)
  2193. rp_sshdno = cvtshort(FREAD(m.obj,2),0)
  2194. rp_width = cvtshort(FREAD(m.obj,2),0)
  2195. rp_length = cvtshort(FREAD(m.obj,2),0)
  2196. rp_lmarg = cvtshort(FREAD(m.obj,2),0)
  2197. rp_rmarg = cvtshort(FREAD(m.obj,2),0)
  2198. rp_fldcnt = cvtshort(FREAD(m.obj,2),0)
  2199. rp_doublesp = FREAD(m.obj,1)
  2200. rp_summary = FREAD(m.obj, 1)
  2201. rp_subeject = FREAD(m.obj,1)
  2202. rp_other = cvtbyte(FREAD(m.obj,1),0)
  2203. rp_pageno = cvtshort(FREAD(m.obj,2),0)
  2204. =FCLOSE(m.obj)
  2205. IF (rp_pageno != 2)
  2206.    =FCLOSE(m.obj)
  2207. ENDIF
  2208.  
  2209. * Create an empty 2.5 report file
  2210. DO docreate WITH "new", c_report
  2211.  
  2212. * Fill it in
  2213. DO evalimportexpr
  2214. DO initbands
  2215. DO bldbreaks
  2216. IF rp_fldcnt > 0
  2217.    DO blddetail
  2218. ENDIF
  2219.  
  2220. * Add the header data
  2221. SELECT new
  2222. GOTO TOP
  2223. REPLACE objtype WITH 1, objcode WITH c_25frx
  2224.  
  2225. IF m.ftype = c_fbprptrepo
  2226.    * Back up the original report and copy the new information to the original file name
  2227.    m.bakname = forceext(m.fnamefbp,"TBK")
  2228.    RENAME (m.fnamefbp) TO (m.bakname)
  2229. ENDIF
  2230.  
  2231. * Write the new information to a file with an FRX extension but the
  2232. * same base name as the original FoxBASE+ report
  2233. SELECT new
  2234. COPY TO (m.fnamefbp)
  2235. USE
  2236. SELECT (m.in_area)
  2237. RETURN m.fnamefbp
  2238.  
  2239.  
  2240. *!********************************************************************
  2241. *!
  2242. *!        Convert FoxPro 1.0 label to 2.0 format
  2243. *!
  2244. *!********************************************************************
  2245.  
  2246. PROCEDURE convert102lbx
  2247. PARAMETERS m.fname102, m.ftype
  2248. PRIVATE m.i, m.short, m.contlen, m.obj, m.remarks, m.height, m.lmargin, m.width, ;
  2249.    m.numacross, m.spacesbet, m.linesbet, m.bakname, m.in_area
  2250.    
  2251. m.in_area = SELECT()
  2252.  
  2253. m.lblname = m.fname102
  2254.  
  2255. m.obj = FOPEN(m.lblname)
  2256. =FREAD(m.obj,1)                && Skip revision
  2257. m.remarks = FREAD(m.obj,60)
  2258. m.height = cvtshort(FREAD(m.obj,2),0)
  2259. m.lmargin = cvtshort(FREAD(m.obj,2),0)
  2260. m.width = cvtshort(FREAD(m.obj,2),0)
  2261. m.numacross = cvtshort(FREAD(m.obj,2),0)
  2262. m.spacesbet = cvtshort(FREAD(m.obj,2),0)
  2263. m.linesbet = cvtshort(FREAD(m.obj,2),0)
  2264.  
  2265. * Read in label contents -- each line ends in a CR
  2266.  
  2267. m.contlen = cvtshort(FREAD(m.obj,2),0)
  2268. m.work = FREAD(m.obj, m.contlen)
  2269. =FCLOSE(m.obj)
  2270.  
  2271. DIMENSION lbllines[m.height]
  2272. m.start = 1
  2273. m.i = 1
  2274. FOR m.curlen = 1 TO m.contlen
  2275.    IF (SUBSTR(m.work, m.curlen, 1) = CHR(13))
  2276.       lbllines[m.i] = SUBSTR(m.work, m.start, m.curlen-m.start)
  2277.       m.start = m.curlen+1
  2278.       m.i = m.i + 1
  2279.    ENDIF
  2280. ENDFOR
  2281.  
  2282. DO WHILE (m.i <= m.height)
  2283.    lbllines[m.i] = ''
  2284.    m.i = m.i + 1
  2285. ENDDO
  2286.  
  2287. * Create an empty 2.0 label 
  2288. CREATE CURSOR new (objtype N(2), objcode N(2), ;
  2289.    name m, expr m, STYLE m, HEIGHT N(3), WIDTH N(3), lmargin N(3), ;
  2290.    numacross N(3), spacesbet N(3), linesbet N(3), ENVIRON l, ;
  2291.    ORDER m, UNIQUE l, TAG m, tag2 m, addalias l)
  2292.  
  2293. * Add the header data
  2294. SELECT new
  2295. APPEND BLANK
  2296. REPLACE new.objtype WITH 30
  2297. REPLACE new.name WITH m.remarks
  2298.  
  2299. REPLACE new.height WITH m.height
  2300. REPLACE new.width WITH m.width
  2301. REPLACE new.lmargin WITH m.lmargin
  2302. REPLACE new.numacross WITH m.numacross
  2303. REPLACE new.spacesbet WITH m.spacesbet
  2304. REPLACE new.linesbet WITH m.linesbet
  2305.  
  2306. * Add the label contents
  2307.  
  2308. FOR m.i = 1 TO m.height
  2309.    APPEND BLANK
  2310.    REPLACE new.objtype WITH 19
  2311.    REPLACE new.expr WITH lbllines[m.i]
  2312. ENDFOR
  2313.  
  2314. IF m.ftype = c_lbx102repo
  2315.    * Back up the original label and copy the new information to the original file name
  2316.    m.bakname = forceext(m.fname102,"TBK")
  2317.    RENAME (m.fname102) TO (m.bakname)
  2318. ENDIF
  2319.  
  2320. * Write the new information on top of the original 1.02 label
  2321. SELECT new
  2322. COPY TO (m.fname102)
  2323. USE
  2324. SELECT (m.in_area)
  2325. RETURN m.fname102
  2326.  
  2327.  
  2328. RETURN
  2329.  
  2330. *!********************************************************************
  2331. *!
  2332. *!        Convert FoxBase+ label to 2.0 format
  2333. *!
  2334. *!********************************************************************
  2335.  
  2336. PROCEDURE convertfbplbl
  2337. PARAMETERS m.fnamefbp, m.ftype
  2338.  
  2339. PRIVATE m.width, m.height, m.lmargin, m.spacesbet, m.linesbet, m.numacross, m.obj, ;
  2340.    m.i, m.lblname, m.in_area, m.dummy
  2341.  
  2342. m.in_area = SELECT()
  2343.    
  2344. m.lblname = m.fnamefbp
  2345.    
  2346. m.width = 0
  2347. m.height = 0
  2348. m.lmargin = 0
  2349. m.spacesbet = 0
  2350. m.linesbet = 0
  2351. m.numacross = 0
  2352.  
  2353. m.obj = FOPEN(m.lblname)
  2354. =FREAD(m.obj,1)                && Skip revision
  2355. m.remarks = FREAD(m.obj,60)
  2356. m.height = cvtshort(FREAD(m.obj,2),0)
  2357. m.width = cvtshort(FREAD(m.obj,2),0)
  2358. m.lmargin = cvtshort(FREAD(m.obj,2),0)
  2359. m.linesbet = cvtshort(FREAD(m.obj,2),0)
  2360. m.spacesbet = cvtshort(FREAD(m.obj,2),0)
  2361. m.numacross = cvtshort(FREAD(m.obj,2),0)
  2362.  
  2363. *******************************************************
  2364. * Read the label contents -- strip spaces and add a CR
  2365. *******************************************************
  2366.  
  2367. DIMENSION lbllines[m.height]
  2368. lbllines = '""'
  2369. m.lastline = 0
  2370. FOR m.i = 1 TO m.height
  2371.    m.olen = 60
  2372.    m.work = FREAD(m.obj,m.olen)
  2373.    DO WHILE ((m.olen > 0) AND (SUBSTR(m.work, m.olen, 1) = ' '))
  2374.       m.olen = m.olen - 1
  2375.    ENDDO
  2376.    =STUFF(m.work, m.olen, 1, '\n')
  2377.    lbllines[m.i] = SUBSTR(m.work, 1, m.olen+1)
  2378.    IF EMPTY(lbllines[m.i])
  2379.       lbllines[m.i] = '""'
  2380.    ELSE
  2381.       m.lastline = m.i
  2382.    ENDIF
  2383. ENDFOR
  2384.  
  2385. =FCLOSE(m.obj)
  2386.  
  2387. CREATE CURSOR new (objtype N(2), objcode N(2), ;
  2388.    name m, expr m, STYLE m, HEIGHT N(3), WIDTH N(3), lmargin N(3), ;
  2389.    numacross N(3), spacesbet N(3), linesbet N(3), ENVIRON l, ;
  2390.   ORDER m, UNIQUE l, TAG m, tag2 m, addalias l)
  2391.  
  2392. * Add the header data
  2393. SELECT new
  2394. APPEND BLANK
  2395. REPLACE new.objtype WITH 30
  2396. REPLACE new.name WITH m.remarks
  2397.  
  2398. REPLACE new.height WITH m.height
  2399. REPLACE new.width WITH m.width
  2400. REPLACE new.lmargin WITH m.lmargin
  2401. REPLACE new.numacross WITH m.numacross
  2402. REPLACE new.spacesbet WITH m.spacesbet
  2403. REPLACE new.linesbet WITH m.linesbet
  2404.  
  2405. FOR m.i = 1 TO m.lastline
  2406.    APPEND BLANK
  2407.    REPLACE new.objtype WITH 19
  2408.    REPLACE new.expr WITH lbllines[m.i]
  2409. ENDFOR
  2410.  
  2411. IF m.ftype = c_fbprptrepo
  2412.    * Back up the original report and copy the new information to the original file name
  2413.    m.bakname = forceext(m.fnamefbp,"TBK")
  2414.    RENAME (m.fnamefbp) TO (m.bakname)
  2415. ENDIF
  2416.  
  2417. * Write the new information to a file with an LBX extension but the
  2418. * same base name as the original FoxBASE+ label.
  2419. SELECT new
  2420. COPY TO (m.fnamefbp)
  2421. USE
  2422. SELECT (m.in_area)
  2423. RETURN m.fnamefbp
  2424.  
  2425. *!*****************************************************************************
  2426. *!
  2427. *!      Procedure: INITBANDS
  2428. *!
  2429. *!      Called by: CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  2430. *!
  2431. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2432. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2433. *!               : FLD_HEAD_EXIST()   (function  in TRANSPRT.PRG)
  2434. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2435. *!               : MAKEBAND           (procedure in TRANSPRT.PRG)
  2436. *!               : TOTALS_EXIST()     (function  in TRANSPRT.PRG)
  2437. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2438. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2439. *!               : GETHEADING()       (function  in TRANSPRT.PRG)
  2440. *!               : CENTER_COL()       (function  in TRANSPRT.PRG)
  2441. *!
  2442. *!*****************************************************************************
  2443. PROCEDURE initbands
  2444.  
  2445. APPEND BLANK
  2446. REPLACE new->platform WITH "DOS"
  2447. REPLACE new->WIDTH WITH m.rp_width
  2448. REPLACE new->HEIGHT WITH m.rp_length
  2449. REPLACE new->offset WITH m.rp_lmarg
  2450. REPLACE new->ejectbefor WITH .T.
  2451. m.rp_plain = 0
  2452. m.group_num = 0
  2453. IF ("Y" = m.rp_summary)
  2454.    REPLACE new->SUMMARY WITH .T.
  2455. ENDIF
  2456. IF (INLIST(m.rp_other,1,3,5,7))
  2457.    REPLACE new->ejectbefor WITH .F.
  2458. ENDIF
  2459. IF (INLIST(m.rp_other,3,6,7))
  2460.    REPLACE new->ejectafter WITH .T.
  2461. ENDIF
  2462. IF (INLIST(m.rp_other,4,5,6,7))
  2463.    REPLACE new->PLAIN WITH .T.
  2464.    m.rp_plain = 1
  2465. ENDIF
  2466. m.rp_totals = 0
  2467. m.current_row = 0
  2468.  
  2469. * header band
  2470.  
  2471. m.bandsize = 1
  2472. IF (m.rp_plain = 0)
  2473.    m.bandsize = m.bandsize + 2
  2474. ENDIF
  2475.  
  2476. m.string = ""
  2477. IF (getlitexpr(m.rp_pghdno, @m.string) <> 0)
  2478.    m.size = linesforheading(m.string)
  2479.    m.bandsize = m.bandsize + m.size
  2480. ENDIF
  2481.  
  2482. IF (fld_head_exist() = 1)
  2483.    m.size = howmanyheadings()
  2484.    m.bandsize = m.bandsize + m.size + 3
  2485. ELSE
  2486.    m.bandsize = m.bandsize + 3
  2487. ENDIF
  2488.  
  2489. DO makeband WITH h_page, m.bandsize, "", .F.
  2490.  
  2491. * group bands
  2492. m.bandstring = ""
  2493. IF (getlitexpr(m.rp_sbexno, @m.bandstring) <> 0)
  2494.    IF ("Y" = m.rp_subeject)
  2495.       m.newpage = .T.
  2496.    ELSE
  2497.       m.newpage = .F.
  2498.    ENDIF
  2499.    DO makeband WITH h_break, 2, m.bandstring, m.newpage
  2500.    m.rp_totals = m.rp_totals + 1
  2501.    IF (getlitexpr(m.rp_ssexno, @m.bandstring) <> 0)
  2502.       DO makeband WITH h_break, 2, m.bandstring, .F.
  2503.       m.rp_totals = m.rp_totals + 1
  2504.    ENDIF
  2505. ENDIF
  2506.  
  2507. group_num = rp_totals
  2508. m.numlines = 1
  2509. IF ("Y" = m.rp_doublesp)
  2510.    m.numlines = 2
  2511. ENDIF
  2512.  
  2513. * detail band
  2514. DO makeband WITH l_item, m.numlines, "", .F.
  2515.  
  2516. * break footer bands
  2517. IF (totals_exist() = 1)
  2518.    m.bandsize = 2
  2519. ELSE
  2520.    m.bandsize = 1
  2521. ENDIF
  2522.  
  2523. m.groupnum = m.rp_totals
  2524.  
  2525. FOR i = 1 TO m.rp_totals
  2526.    DO makeband WITH f_break, m.bandsize, "", .F.
  2527. ENDFOR
  2528.  
  2529. * page footer band
  2530. DO makeband WITH f_page, 1, "", .F.
  2531.  
  2532. * report footer band
  2533. DO makeband WITH f_rpt, m.bandsize, "", .F.
  2534.  
  2535. IF (rp_plain = 0)
  2536.    DO maketext WITH 9, 1, "PAGE NO. ", band_rows(h_page)+1, 0
  2537.    DO makefield WITH 5, 1, "_PAGENO", band_rows(h_page)+1, 9, "C", .F., .F., 0, 0
  2538.    DO makefield WITH 8, 1, "DATE()", band_rows(h_page)+2, 0, "D", .F., .F., 0, 0
  2539.    m.head_row = 3
  2540. ELSE
  2541.    m.head_row = 0
  2542. ENDIF
  2543.  
  2544. IF (getlitexpr(m.rp_pghdno,@m.string) <> 0)
  2545.    m.string = m.string + ";"
  2546.    m.heading = ""
  2547.    DO WHILE .T.
  2548.       IF (getheading(@m.heading, @m.string) > 0)
  2549.          DO maketext WITH LEN(m.heading), 1, m.heading, m.head_row, center_col(LEN(m.heading))
  2550.          m.head_row = m.head_row + 1
  2551.       ELSE
  2552.          EXIT
  2553.       ENDIF
  2554.    ENDDO
  2555. ENDIF
  2556.  
  2557. m.head_row = m.head_row + 1
  2558.  
  2559. RETURN
  2560.  
  2561. *!*****************************************************************************
  2562. *!
  2563. *!      Procedure: BLDBREAKEXP
  2564. *!
  2565. *!      Called by: BLDBREAKS          (procedure in TRANSPRT.PRG)
  2566. *!
  2567. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2568. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2569. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2570. *!
  2571. *!*****************************************************************************
  2572. PROCEDURE bldbreakexp
  2573. PARAMETER m.exprno, m.headno, m.row, m.stars
  2574.  
  2575. PRIVATE m.string
  2576. m.string = ""
  2577. =getlitexpr(m.headno, @m.string)
  2578. m.string = m.stars + m.string
  2579. strlen = LEN(m.string)
  2580. DO maketext WITH m.strlen, 1, m.string, m.row, 0
  2581. =getlitexpr(m.exprno, @m.string)
  2582. DO makefield WITH rp_ltlen(m.exprno+1), 1, m.string, m.row, m.strlen + 1, "C", .F., .F., 0, 0
  2583. RETURN
  2584.  
  2585. *!*****************************************************************************
  2586. *!
  2587. *!      Procedure: BLDBREAKS
  2588. *!
  2589. *!      Called by: CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  2590. *!
  2591. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2592. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2593. *!
  2594. *!*****************************************************************************
  2595. PROCEDURE bldbreaks
  2596. IF (litexist(rp_sbexno) = 1)
  2597.    DO bldbreakexp WITH rp_sbexno, rp_sbhdno, band_rows(h_break) + 1, "** "
  2598.    IF (litexist(rp_ssexno) = 1)
  2599.       DO bldbreakexp WITH rp_ssexno, rp_sshdno, band_rows(h_break) + 3, "*"
  2600.    ENDIF
  2601. ENDIF
  2602. RETURN
  2603.  
  2604. *!*****************************************************************************
  2605. *!
  2606. *!      Procedure: BLDDETAIL
  2607. *!
  2608. *!      Called by: CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  2609. *!
  2610. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2611. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2612. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2613. *!               : GETHEADING()       (function  in TRANSPRT.PRG)
  2614. *!               : MAKETEXT           (procedure in TRANSPRT.PRG)
  2615. *!
  2616. *!*****************************************************************************
  2617. PROCEDURE blddetail
  2618. PRIVATE m.i, m.pg_row, m.istotal, m.fcol, m.row, m.string, m.col, m.heading
  2619.  
  2620. m.pg_row = 0
  2621. m.istotal = 0
  2622. m.fcol = 0
  2623. m.row = band_rows(l_item)
  2624. m.string = ""
  2625. FOR m.i = 1 TO rp_fldcnt
  2626.    IF (getlitexpr(rp_flds_exprno(m.i), @m.string) <> 0)
  2627.       m.row = band_rows(l_item)
  2628.       IF (m.fcol + rp_flds_width(m.i) > m.rp_width - 1)
  2629.          rp_flds_width(m.i) = rp_flds_width(m.i) - (m.fcol + rp_flds_width(m.i) - m.rp_width)
  2630.          IF (rp_flds_width(m.i) < 0)
  2631.             EXIT
  2632.          ENDIF
  2633.       ENDIF
  2634.       DO makefield WITH rp_flds_width(m.i), 1, m.string, m.row, m.fcol, rp_flds_type(m.i), .T., .T., 0, 0
  2635.       IF ("Y" = rp_flds_totals(m.i))
  2636.          DO makefield WITH rp_flds_width(m.i), 1, m.string, band_rows(f_rpt) + 1, m.fcol, "N", .F., .F., 2, 0
  2637.          IF (m.group_num > 0)
  2638.             IF (m.group_num > 1)
  2639.                DO addtotal WITH m.istotal, band_rows(f_break), m.fcol, rp_flds_width(m.i), m.string, "* Subsubtotal *", 4
  2640.                DO addtotal WITH m.istotal, band_rows(f_break) + 2, m.fcol, rp_flds_width(m.i), m.string, "** Subtotal **", 3
  2641.             ELSE
  2642.                DO addtotal WITH m.istotal, band_rows(f_break), m.fcol, rp_flds_width(m.i), m.string, "** Subtotal **", 3
  2643.             ENDIF
  2644.          ENDIF
  2645.          m.istotal = 1
  2646.       ENDIF
  2647.    ENDIF
  2648.    
  2649.    IF (getlitexpr(rp_flds_headno(m.i), @m.string) <> 0)
  2650.       m.string = m.string + ";"
  2651.       m.heading = ""
  2652.       m.hrow = m.head_row
  2653.       DO WHILE .T.
  2654.          IF (getheading(@m.heading, @m.string) > 0)
  2655.             IF (rp_flds_type(m.i) = "N")
  2656.                m.col = (m.fcol + rp_flds_width(m.i)) - LEN(m.heading)
  2657.             ELSE
  2658.                m.col = m.fcol
  2659.             ENDIF
  2660.             DO maketext WITH LEN(m.heading), 1, m.heading, m.hrow, m.col
  2661.             m.hrow = m.hrow + 1
  2662.          ELSE
  2663.             EXIT
  2664.          ENDIF
  2665.       ENDDO
  2666.    ENDIF
  2667.    m.fcol = m.fcol + rp_flds_width(m.i) + 1
  2668. ENDFOR
  2669.  
  2670. IF (m.istotal = 1)
  2671.    DO maketext WITH 13, 1, "*** Total ***", band_rows(f_rpt), 0
  2672. ENDIF
  2673.  
  2674. RETURN
  2675.  
  2676. *!*****************************************************************************
  2677. *!
  2678. *!      Procedure: ADDTOTAL
  2679. *!
  2680. *!      Called by: BLDDETAIL          (procedure in TRANSPRT.PRG)
  2681. *!
  2682. *!          Calls: MAKETEXT           (procedure in TRANSPRT.PRG)
  2683. *!               : MAKEFIELD          (procedure in TRANSPRT.PRG)
  2684. *!
  2685. *!*****************************************************************************
  2686. PROCEDURE addtotal
  2687. PARAMETER m.isfirst, m.row, m.col, m.wt, m.workstr, m.totalstr, m.reset
  2688. IF (m.isfirst = 0)
  2689.    DO maketext WITH LEN(m.totalstr), 1, m.totalstr, m.row, 0
  2690. ENDIF
  2691. DO makefield WITH m.wt, 1, m.workstr, m.row+1, m.col, "N", .F., .F., 2, m.reset
  2692. RETURN
  2693.  
  2694.  
  2695. *!*****************************************************************************
  2696. *!
  2697. *!       Function: LITEXIST
  2698. *!
  2699. *!      Called by: BLDBREAKS          (procedure in TRANSPRT.PRG)
  2700. *!               : GETLITEXPR()       (function  in TRANSPRT.PRG)
  2701. *!               : FLD_HEAD_EXIST()   (function  in TRANSPRT.PRG)
  2702. *!
  2703. *!*****************************************************************************
  2704. FUNCTION litexist
  2705. PARAMETER m.idx
  2706. PRIVATE m.flag
  2707. m.flag = 0
  2708. IF m.idx != 65535
  2709.    IF "" <> SUBSTR(rp_pool, rp_ltadr(m.idx+1)+1, 1)
  2710.       m.flag = 1
  2711.    ENDIF
  2712. ENDIF
  2713. RETURN m.flag
  2714.  
  2715. *!*****************************************************************************
  2716. *!
  2717. *!       Function: GETLITEXPR
  2718. *!
  2719. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2720. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2721. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2722. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2723. *!               : EVALIMPORTEXPR     (procedure in TRANSPRT.PRG)
  2724. *!
  2725. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2726. *!
  2727. *!*****************************************************************************
  2728. FUNCTION getlitexpr
  2729. PARAMETER m.idx, m.string
  2730. m.flag = 0
  2731. IF (litexist(m.idx) = 1)
  2732.    m.string = SUBSTR(m.rp_pool, rp_ltadr(m.idx+1)+1, rp_ltlen(m.idx+1) - 1)
  2733.    m.flag = 1
  2734. ELSE
  2735.    m.string = ""
  2736. ENDIF
  2737. RETURN m.flag
  2738.  
  2739. *!*****************************************************************************
  2740. *!
  2741. *!      Procedure: MAKEBAND
  2742. *!
  2743. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2744. *!
  2745. *!*****************************************************************************
  2746. PROCEDURE makeband
  2747. PARAMETER m.type, m.size, m.string, m.newpage
  2748. APPEND BLANK
  2749. REPLACE new->platform WITH "DOS"
  2750. REPLACE new->objtype WITH 9
  2751. REPLACE new->objcode WITH m.type
  2752. REPLACE new->expr WITH m.string
  2753. REPLACE new->HEIGHT WITH m.size
  2754. REPLACE new->pagebreak WITH m.newpage
  2755. IF (band_rows(m.type) = 0)
  2756.    band_rows(m.type) = m.current_row
  2757. ENDIF
  2758. m.current_row = m.current_row + m.size
  2759. RETURN
  2760.  
  2761. *!*****************************************************************************
  2762. *!
  2763. *!      Procedure: MAKETEXT
  2764. *!
  2765. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2766. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2767. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2768. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2769. *!
  2770. *!*****************************************************************************
  2771. PROCEDURE maketext
  2772. PARAMETER  wt, ht, string, ROW, COL
  2773. APPEND BLANK
  2774. REPLACE new->platform WITH "DOS"
  2775. REPLACE new->expr WITH '"' + string + '"'
  2776. REPLACE new->objtype WITH 5
  2777. REPLACE new->HEIGHT WITH ht
  2778. REPLACE new->WIDTH WITH wt
  2779. REPLACE new->vpos WITH ROW
  2780. REPLACE new->hpos WITH COL
  2781. RETURN
  2782.  
  2783. *!*****************************************************************************
  2784. *!
  2785. *!      Procedure: MAKEFIELD
  2786. *!
  2787. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2788. *!               : BLDBREAKEXP        (procedure in TRANSPRT.PRG)
  2789. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2790. *!               : ADDTOTAL           (procedure in TRANSPRT.PRG)
  2791. *!
  2792. *!*****************************************************************************
  2793. PROCEDURE makefield
  2794. PARAMETER m.wt, m.ht, m.string, m.row, m.col, m.fldchar, m.strch, m.flt, m.total, m.reset
  2795.  
  2796. APPEND BLANK
  2797. REPLACE new->platform WITH "DOS"
  2798. REPLACE new->objtype WITH 8
  2799. REPLACE new->expr WITH m.string
  2800. REPLACE new->HEIGHT WITH m.ht
  2801. REPLACE new->WIDTH WITH m.wt
  2802. REPLACE new->vpos WITH m.row
  2803. REPLACE new->hpos WITH m.col
  2804. REPLACE new->fillchar WITH m.fldchar
  2805. REPLACE new->STRETCH WITH m.strch
  2806. REPLACE new->FLOAT WITH m.flt
  2807. REPLACE new->totaltype WITH m.total
  2808. REPLACE new->resettotal WITH m.reset
  2809. RETURN
  2810.  
  2811. *!*****************************************************************************
  2812. *!
  2813. *!       Function: GETHEADING
  2814. *!
  2815. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2816. *!               : BLDDETAIL          (procedure in TRANSPRT.PRG)
  2817. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2818. *!
  2819. *!*****************************************************************************
  2820. FUNCTION getheading
  2821. PARAMETER m.heading, m.string
  2822. PRIVATE m.flag, m.x, m.heading
  2823. m.flag = 0
  2824. m.x = AT(';',m.string)
  2825. m.heading = SUBSTR(m.string, 1, m.x-1)
  2826. m.string = SUBSTR(m.string, m.x+1)
  2827. IF (LEN(m.string) > 0)   && more left
  2828.    m.flag = 1
  2829. ENDIF
  2830. IF (LEN(m.heading) > 0)
  2831.    m.flag = 1
  2832. ENDIF
  2833. RETURN m.flag
  2834.  
  2835. *!*****************************************************************************
  2836. *!
  2837. *!       Function: LINESFORHEADING
  2838. *!
  2839. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2840. *!               : HOWMANYHEADINGS()  (function  in TRANSPRT.PRG)
  2841. *!
  2842. *!          Calls: GETHEADING()       (function  in TRANSPRT.PRG)
  2843. *!
  2844. *!*****************************************************************************
  2845. FUNCTION linesforheading
  2846. PARAMETER m.string
  2847. PRIVATE m.retval, m.string2, m.heading
  2848. m.string2 = m.string + ";"
  2849. m.heading = ""
  2850. m.retval = 0
  2851. DO WHILE .T.
  2852.    IF (getheading(@m.heading, @m.string2) > 0)
  2853.       m.retval = m.retval + 1
  2854.    ELSE
  2855.       EXIT
  2856.    ENDIF
  2857. ENDDO
  2858. RETURN m.retval
  2859.  
  2860. *!*****************************************************************************
  2861. *!
  2862. *!       Function: HOWMANYHEADINGS
  2863. *!
  2864. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2865. *!
  2866. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2867. *!               : LINESFORHEADING()  (function  in TRANSPRT.PRG)
  2868. *!
  2869. *!*****************************************************************************
  2870. FUNCTION howmanyheadings
  2871. PRIVATE m.retval, m.i, m.newval
  2872. m.retval = 0
  2873. FOR m.i = 1 TO m.rp_fldcnt
  2874.    IF (getlitexpr(rp_flds_headno, @m.string) <> 0)
  2875.       m.newval = linesforheading(m.string)
  2876.       m.retval = MAX(m.newval, m.retval)
  2877.    ENDIF
  2878. ENDFOR
  2879. RETURN m.retval
  2880.  
  2881. *!*****************************************************************************
  2882. *!
  2883. *!       Function: FLD_HEAD_EXIST
  2884. *!
  2885. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2886. *!
  2887. *!          Calls: LITEXIST()         (function  in TRANSPRT.PRG)
  2888. *!
  2889. *!*****************************************************************************
  2890. FUNCTION fld_head_exist
  2891. PRIVATE m.flag, m.i
  2892. m.flag = 0
  2893. FOR m.i = 1 TO m.rp_fldcnt
  2894.    IF (litexist(rp_flds_headno(m.i)) = 1)
  2895.       m.flag = 1
  2896.       EXIT
  2897.    ENDIF
  2898. ENDFOR
  2899. RETURN m.flag
  2900.  
  2901. *!*****************************************************************************
  2902. *!
  2903. *!       Function: TOTALS_EXIST
  2904. *!
  2905. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2906. *!
  2907. *!*****************************************************************************
  2908. FUNCTION totals_exist
  2909. PRIVATE m.flag, m.i
  2910. m.flag = 0
  2911. FOR m.i = 1 TO m.rp_fldcnt
  2912.    IF ("Y" = rp_flds_totals(m.i))
  2913.       m.flag = 1
  2914.       EXIT
  2915.    ENDIF
  2916. ENDFOR
  2917. RETURN m.flag
  2918.  
  2919. *!*****************************************************************************
  2920. *!
  2921. *!       Function: CENTER_COL
  2922. *!
  2923. *!      Called by: INITBANDS          (procedure in TRANSPRT.PRG)
  2924. *!
  2925. *!*****************************************************************************
  2926. FUNCTION center_col
  2927. PARAMETER m.length
  2928. RETURN (MAX(0, ((m.rp_width - m.rp_lmarg - m.rp_rmarg) - m.length)/2))
  2929.  
  2930. *!*****************************************************************************
  2931. *!
  2932. *!      Procedure: EVALIMPORTEXPR
  2933. *!
  2934. *!      Called by: CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  2935. *!
  2936. *!          Calls: GETLITEXPR()       (function  in TRANSPRT.PRG)
  2937. *!
  2938. *!*****************************************************************************
  2939. PROCEDURE evalimportexpr
  2940. PRIVATE string
  2941. m.string = ""
  2942. FOR i = 1 TO rp_fldcnt
  2943.    IF (getlitexpr(rp_flds_exprno(i), @string) <> 0)
  2944.       rp_flds_type(i) = TYPE(m.string)
  2945.       IF ("U" = rp_flds_type(i))
  2946.          rp_flds_type = "C"
  2947.       ENDIF
  2948.    ENDIF
  2949. ENDFOR
  2950. RETURN
  2951.  
  2952. *!*****************************************************************************
  2953. *!
  2954. *!       Function: GETOLDREPORTTYPE
  2955. *!
  2956. *!      Called by: TRANSPRT.PRG                      
  2957. *!
  2958. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  2959. *!
  2960. *!*****************************************************************************
  2961. FUNCTION getoldreporttype
  2962. * Open the main file and see what kind of file it is.  At this point, all we know
  2963. * is that it is either a FoxPro 1.02 report or a FoxBASE+ report.
  2964.  
  2965. PRIVATE m.fp, m.reptotals, m.retcode
  2966. m.retcode = m.tp_filetype
  2967.  
  2968. m.fp = FOPEN(m.g_scrndbf)
  2969. IF fp > 0
  2970.    m.reptotals = cvtshort(FREAD(m.fp,2),0)
  2971.    DO CASE
  2972.    CASE (m.reptotals == 2)   && FoxBASE+ report
  2973.       DO CASE
  2974.       CASE m.tp_filetype = c_frx102modi
  2975.          m.retcode= c_fbprptmodi
  2976.       CASE m.tp_filetype = c_frx102repo
  2977.          m.retcode = c_fbprptrepo
  2978.       OTHERWISE
  2979.          m.retcode = c_fbprptrepo
  2980.       ENDCASE
  2981.    OTHERWISE
  2982.       m.retcode = m.tp_filetype
  2983.    ENDCASE
  2984.    =FCLOSE(m.fp)
  2985. ENDIF
  2986. RETURN m.retcode
  2987. *!*****************************************************************************
  2988. *!
  2989. *!       Function: GETOLDLABELTYPE
  2990. *!
  2991. *!      Called by: TRANSPRT.PRG                      
  2992. *!
  2993. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  2994. *!
  2995. *!*****************************************************************************
  2996. FUNCTION getoldlabeltype
  2997. * Open the main file and see what kind of file it is.  At this point, all we know
  2998. * is that it is either a FoxPro 1.02 report or a FoxBASE+ label.
  2999.  
  3000. PRIVATE m.fp, m.reptotals, m.retcode
  3001. m.retcode = m.tp_filetype
  3002.  
  3003. m.fp = FOPEN(m.g_scrndbf)
  3004. IF fp > 0
  3005.    m.reptotals = cvtbyte(FREAD(m.fp,1),0)
  3006.    m.dummy     = FREAD(m.fp,1)   && skip this one
  3007.    DO CASE
  3008.    CASE (m.reptotals == 2)   && FoxBASE+ label
  3009.       DO CASE
  3010.       CASE m.tp_filetype = c_lbx102modi
  3011.          m.retcode= c_fbplblmodi
  3012.       CASE m.tp_filetype = c_lbx102repo
  3013.          m.retcode = c_fbplblrepo
  3014.       OTHERWISE
  3015.          m.retcode = c_fbplblrepo
  3016.       ENDCASE
  3017.    OTHERWISE
  3018.       m.retcode = m.tp_filetype
  3019.    ENDCASE
  3020.    =FCLOSE(m.fp)
  3021. ENDIF
  3022. RETURN m.retcode
  3023.  
  3024. *
  3025. * MAPBUTTON - Compare two sets of buttons
  3026. *
  3027. *!*****************************************************************************
  3028. *!
  3029. *!       Function: MAPBUTTON
  3030. *!
  3031. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  3032. *!
  3033. *!          Calls: SCATTERBUTTONS     (procedure in TRANSPRT.PRG)
  3034. *!
  3035. *!*****************************************************************************
  3036. FUNCTION mapbutton
  3037. PARAMETER frombtn, tobtn
  3038. PRIVATE m.endpos, m.outstrg, m.topos, m.i. m.pictclau
  3039. m.pictclau = LEFT(m.tobtn,AT(' ',m.tobtn)-1)
  3040. DO CASE
  3041. CASE !m.g_tographic
  3042.    * Strip out the BMP extensions, if present
  3043.    m.frombtn = STRTRAN(m.frombtn,".BMP","")
  3044.    m.frombtn = STRTRAN(m.frombtn,".bmp","")
  3045.    
  3046. CASE ".BMP" $ UPPER(m.tobtn)
  3047.    * Add back in the bitmap extensions, if the to platform already has some.  The 
  3048.    * strategy is to mark all existing bitmap extensions, then add one to each of the 
  3049.    * atoms in the picture clause.
  3050.    DO CASE
  3051.    CASE RIGHT(m.tobtn,1) = '"' OR RIGHT(m.tobtn,1) = "'"
  3052.       m.tobtn = STUFF(m.tobtn,LEN(m.tobtn),0,';')
  3053.    OTHERWISE
  3054.       m.tobtn = m.tobtn + ';'
  3055.    ENDCASE
  3056.    
  3057.    * 'brlfq' is just a marker for where a semicolon needs to go.  Mark all the existing
  3058.    * BMP extensions.
  3059.    m.tobtn = STRTRAN(m.tobtn,".BMP;",".BMPbrlfq")
  3060.    m.tobtn = STRTRAN(m.tobtn,".bmp;",".BMPbrlfq")
  3061.    
  3062.    * Add a new BMP extension where there wasn't one before.
  3063.    m.tobtn = STRTRAN(m.tobtn,";",".BMPbrlfq")
  3064.    
  3065.    * Put the semicolons back
  3066.    m.tobtn = STRTRAN(m.tobtn,"brlfq",";")
  3067.    
  3068.    * Remove trailing semicolons
  3069.    DO WHILE RIGHT(m.tobtn,2) = ';"' OR RIGHT(m.tobtn,2) = ";'"
  3070.       m.tobtn = STUFF(m.tobtn,LEN(m.tobtn)-1,1,"")
  3071.    ENDDO
  3072.    
  3073.    * Now make sure there is a 'B' in the picture clause
  3074.    IF !("B" $ m.pictclau) AND ("@" $ m.pictclau)
  3075.       m.tobtn = STUFF(m.tobtn,AT("@",m.tobtn)+2,0,"B")
  3076.       m.pictclau = m.pictclau + "B"
  3077.    ENDIF
  3078. ENDCASE
  3079.  
  3080. DO CASE
  3081. CASE m.frombtn == m.tobtn
  3082.    RETURN m.frombtn
  3083. CASE OCCURS(';',m.frombtn) = OCCURS(';',m.tobtn)
  3084.    IF m.g_tographic AND ("B" $ m.pictclau)
  3085.       * Return the newly modified "to" string in this case.
  3086.       RETURN m.tobtn
  3087.    ELSE
  3088.       RETURN m.frombtn
  3089.    ENDIF
  3090. CASE OCCURS(';',m.frombtn) > OCCURS(';',m.tobtn)
  3091.    * Are these bitmap buttons?
  3092.    IF ("B" $ m.pictclau)
  3093.       * Just add a blank one to the end
  3094.       m.endpos = RAT('"',m.tobtn)
  3095.       IF endpos > 1
  3096.          RETURN STUFF(m.tobtn,m.endpos,0,';NEW.BMP')
  3097.       ELSE
  3098.          RETURN m.tobtn + ';'
  3099.       ENDIF
  3100.    ELSE
  3101.       * Not bitmaps.
  3102.       RETURN m.frombtn
  3103.    ENDIF
  3104. OTHERWISE
  3105.    RETURN m.frombtn
  3106.    
  3107.    * An alternative strategy is to try to preserve as many as possible of the
  3108.    * destination buttons, especially since they might contain bitmaps, etc.
  3109.    
  3110.    * Populate two arrays with the button prompts.  Then scan through the
  3111.    * 'from' array seeing if we can match it up against something in the 'to'
  3112.    * array.  If so, emit the 'to' array picture.  Otherwise, emit the 'from'
  3113.    * one.
  3114.    DIMENSION fromarray[1], toarray[1]
  3115.    DO scatterbuttons WITH m.frombtn, fromarray
  3116.    DO scatterbuttons WITH m.tobtn, toarray
  3117.    outstrg = ""
  3118.    FOR m.i = 1 TO ALEN(fromarray)
  3119.       m.topos = ASCAN(toarray,fromarray[i])
  3120.       IF m.topos > 0
  3121.          m.outstrg = m.outstrg + IIF(EMPTY(m.outstrg),'',';') + toarray[m.topos]
  3122.       ELSE
  3123.          m.outstrg = m.outstrg + IIF(EMPTY(m.outstrg),'',';') + fromarray[m.i]
  3124.       ENDIF
  3125.    ENDFOR
  3126.    m.outstrg = LEFT(m.frombtn,AT(' ',m.frombtn)) + m.outstrg + '"'
  3127.    RETURN m.outstrg
  3128. ENDCASE
  3129.  
  3130. *!*****************************************************************************
  3131. *!
  3132. *!      Procedure: SCATTERBUTTONS
  3133. *!
  3134. *!      Called by: MAPBUTTON()        (function  in TRANSPRT.PRG)
  3135. *!
  3136. *!*****************************************************************************
  3137. PROCEDURE scatterbuttons
  3138. PARAMETERS btnlist, destarray
  3139. PRIVATE m.i, m.fromstrg, m.num, m.theword
  3140. m.fromstrg = SUBSTR(m.btnlist,AT(' ',m.btnlist)+1)
  3141. m.fromstrg = CHRTRAN(m.fromstrg,CHR(34)+CHR(39),"")
  3142. m.num = OCCURS(';',m.fromstrg)
  3143. DIMENSION destarray[m.num+1]
  3144. FOR m.i = 1 TO m.num + 1
  3145.    DO CASE
  3146.    CASE m.i = 1    && first button
  3147.       m.theword = LEFT(m.fromstrg,AT(';',m.fromstrg)-1)
  3148.    CASE m.i = m.num + 1   && last button
  3149.       m.theword = SUBSTR(m.fromstrg,AT(';',m.fromstrg,m.num)+1)
  3150.    OTHERWISE
  3151.       m.theword = SUBSTR(m.fromstrg,AT(';',m.fromstrg,m.i-1)+1, ;
  3152.          AT(';',m.fromstrg,m.i) - AT(';',m.fromstrg,m.i-1))
  3153.    ENDCASE
  3154.    destarray[m.i] = UPPER(ALLTRIM(m.theword))
  3155. ENDFOR
  3156.  
  3157. *
  3158. * FindLikeVpos - Tries to find an object in the from platform with a vpos that matches the vpos
  3159. *      of a new object we are adding.  If it finds one, we return that objects Vpos in the to
  3160. *      platform.  This gives us a reasonable chance of coming close to where the user will want
  3161. *      an object that is being added to a pre-converted screen.
  3162. *
  3163. *!*****************************************************************************
  3164. *!
  3165. *!      Procedure: FINDLIKEVPOS
  3166. *!
  3167. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3168. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3169. *!
  3170. *!          Calls: ISOBJECT()         (function  in TRANSPRT.PRG)
  3171. *!
  3172. *!*****************************************************************************
  3173. PROCEDURE findlikevpos
  3174. PARAMETER m.oldvpos
  3175. PRIVATE m.objid, m.saverec, m.retval
  3176. m.saverec = RECNO()
  3177. m.retval = m.oldvpos
  3178.  
  3179. LOCATE FOR platform = m.g_fromplatform AND vpos = m.oldvpos AND isobject(objtype)
  3180. IF FOUND()
  3181.    m.objid = uniqueid
  3182.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  3183.    IF FOUND()
  3184.       m.retval = vpos
  3185.    ENDIF
  3186. ENDIF
  3187.  
  3188. GOTO RECORD (m.saverec)
  3189. RETURN m.retval
  3190.  
  3191. *
  3192. * FindLikeHpos - Tries to find an object in the from platform with an hpos that matches the hpos
  3193. *      of a new object we are adding.  If it finds one, we return that objects Hpos in the to
  3194. *      platform.  This gives us a reasonable chance of coming close to where the user will want
  3195. *      an object that is being added to a pre-converted screen.
  3196. *
  3197. *!*****************************************************************************
  3198. *!
  3199. *!      Procedure: FINDLIKEHPOS
  3200. *!
  3201. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3202. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3203. *!
  3204. *!          Calls: ISOBJECT()         (function  in TRANSPRT.PRG)
  3205. *!
  3206. *!*****************************************************************************
  3207. PROCEDURE findlikehpos
  3208. PARAMETER m.oldhpos
  3209. PRIVATE m.objid, m.saverec, m.retval
  3210. m.saverec = RECNO()
  3211. m.retval = m.oldhpos
  3212.  
  3213. LOCATE FOR platform = m.g_fromplatform AND hpos = m.oldhpos AND isobject(objtype)
  3214. IF FOUND()
  3215.    m.objid = uniqueid
  3216.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  3217.    IF FOUND()
  3218.       m.retval = hpos
  3219.    ENDIF
  3220. ENDIF
  3221.  
  3222. GOTO RECORD (m.saverec)
  3223. RETURN m.retval
  3224.  
  3225. *
  3226. * MakeCharFit - Makes sure that a report or screen is large enough to hold all of its objects.
  3227. *
  3228. *!*****************************************************************************
  3229. *!
  3230. *!      Procedure: MAKECHARFIT
  3231. *!
  3232. *!      Called by: NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3233. *!               : ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3234. *!
  3235. *!          Calls: GETRIGHTMOST       (procedure in TRANSPRT.PRG)
  3236. *!               : GETLOWEST          (procedure in TRANSPRT.PRG)
  3237. *!
  3238. *!*****************************************************************************
  3239. PROCEDURE makecharfit
  3240. PRIVATE m.right, m.bottom
  3241.  
  3242. m.right = CEILING(getrightmost(m.g_toplatform))+2
  3243. m.bottom = CEILING(getlowest(m.g_toplatform))+2
  3244.  
  3245. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  3246. IF FOUND()
  3247.    IF WIDTH < m.right
  3248.       REPLACE WIDTH WITH m.right
  3249.    ENDIF
  3250.    
  3251.    IF HEIGHT < m.bottom AND m.g_filetype = c_screen
  3252.       REPLACE HEIGHT WITH m.bottom
  3253.    ENDIF
  3254. ENDIF
  3255.  
  3256. *
  3257. * allenvirons - Process all the screen and environment records first.
  3258. *
  3259. *!*****************************************************************************
  3260. *!
  3261. *!      Procedure: ALLENVIRONS
  3262. *!
  3263. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3264. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3265. *!
  3266. *!          Calls: ADJCOLOR           (procedure in TRANSPRT.PRG)
  3267. *!               : ADJOBJCODE         (procedure in TRANSPRT.PRG)
  3268. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3269. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3270. *!
  3271. *!*****************************************************************************
  3272. PROCEDURE allenvirons
  3273. PRIVATE m.recno
  3274.  
  3275. SCAN FOR platform = m.g_fromplatform AND !DELETED() AND ;
  3276.       (objtype = c_otheader OR objtype = c_otrel OR objtype = c_otworkar OR objtype = c_otindex OR ;
  3277.       (m.g_filetype = c_label AND objtype = c_ot20label))
  3278.    m.recno = RECNO()
  3279.    
  3280.    SCATTER MEMVAR MEMO
  3281.    APPEND BLANK
  3282.    GATHER MEMVAR MEMO
  3283.    
  3284.    REPLACE platform WITH m.g_toplatform
  3285.    IF IsEnviron(objtype) AND !g_tographic
  3286.       * DOS requires the alias name to be in upper case, while Windows doesn't
  3287.       REPLACE TAG WITH UPPER(TAG)
  3288.       REPLACE tag2 WITH UPPER(tag2)
  3289.    ENDIF
  3290.    
  3291.    IF objtype = c_otheader OR (m.g_filetype = c_label AND objtype = c_ot20label)
  3292.       m.g_windheight = HEIGHT
  3293.       m.g_windwidth = WIDTH
  3294.       
  3295.       DO CASE
  3296.       CASE m.g_filetype = c_screen
  3297.          DO adjcolor
  3298.          
  3299.       CASE m.g_filetype = c_report
  3300.          IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3301.             REPLACE vpos WITH 1
  3302.             REPLACE WIDTH WITH -1.0
  3303.             REPLACE ruler WITH 1
  3304.             REPLACE rulerlines WITH 1
  3305.             REPLACE gridv WITH 9
  3306.             REPLACE gridh WITH 9
  3307.             REPLACE penred   WITH 60
  3308.             REPLACE pengreen WITH 80
  3309.             REPLACE penblue    WITH 0
  3310.          ELSE
  3311.             REPLACE HEIGHT WITH c_charrptheight
  3312.             REPLACE WIDTH WITH c_charrptwidth
  3313.          ENDIF
  3314.          
  3315.       CASE m.g_filetype = c_label
  3316.          IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3317.             REPLACE objtype WITH c_otheader
  3318.             REPLACE ruler WITH 1
  3319.             REPLACE rulerlines WITH 1
  3320.             REPLACE grid WITH .T.
  3321.             REPLACE gridv WITH 12
  3322.             REPLACE gridh WITH 12
  3323.             REPLACE penred   WITH -1
  3324.             REPLACE pengreen WITH 65535
  3325.             REPLACE stretchtop WITH .F.
  3326.             REPLACE TOP WITH .F.
  3327.             REPLACE BOTTOM WITH .T.
  3328.             REPLACE curpos WITH .F.
  3329.          ELSE
  3330.             REPLACE objtype WITH c_ot20label
  3331.             *REPLACE vpos WITH (vpos * c_charsperinch)/10000
  3332.             REPLACE hpos WITH (hpos * c_charsperinch)/10000
  3333.             REPLACE HEIGHT WITH (HEIGHT * c_linesperinch)/10000
  3334.             REPLACE WIDTH WITH (WIDTH * c_charsperinch)/10000
  3335.             IF WIDTH < 0
  3336.                REPLACE WIDTH WITH c_charrptwidth
  3337.             ENDIF
  3338.          ENDIF
  3339.       ENDCASE
  3340.       
  3341.       DO adjobjcode
  3342.       DO adjfont
  3343.    ENDIF
  3344.    
  3345.    GOTO RECORD m.recno
  3346. ENDSCAN
  3347. m.g_mercury = m.g_mercury + 5
  3348. DO updtherm WITH m.g_mercury
  3349.  
  3350. *
  3351. * allothers - Process all other records.
  3352. *
  3353. *!*****************************************************************************
  3354. *!
  3355. *!      Procedure: ALLOTHERS
  3356. *!
  3357. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3358. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3359. *!
  3360. *!          Calls: CALCPOSITIONS      (procedure in TRANSPRT.PRG)
  3361. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3362. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3363. *!
  3364. *!*****************************************************************************
  3365. PROCEDURE allothers
  3366. PARAMETER m.thermpart
  3367. PRIVATE m.recno, m.numothers, m.thermstep, m.i
  3368.  
  3369. m.thermstep = m.thermpart / m.objindex
  3370.  
  3371. SELECT (m.g_fromobjonlyalias)
  3372. SET RELATION TO recnum INTO m.g_scrnalias ADDITIVE
  3373. LOCATE FOR .T.
  3374. m.i = 1
  3375.  
  3376. SCAN FOR !DELETED()
  3377.    
  3378.    m.recno = RECNO()
  3379.    
  3380.    SCATTER MEMVAR MEMO
  3381.    
  3382.    IF m.g_tographic
  3383.       DO calcpositions WITH m.i
  3384.       m.i = m.i + 1
  3385.    ENDIF
  3386.    
  3387.    SELECT (m.g_scrnalias)
  3388.    APPEND BLANK
  3389.    GATHER MEMVAR MEMO
  3390.    
  3391.    REPLACE platform WITH m.g_toplatform
  3392.    
  3393.    DO fillininfo
  3394.    
  3395.    SELECT (m.g_fromobjonlyalias)
  3396.    GOTO RECORD m.recno
  3397.    
  3398.    m.g_mercury = m.g_mercury + m.thermstep
  3399.    DO updtherm WITH m.g_mercury
  3400.       
  3401. ENDSCAN
  3402.  
  3403. *
  3404. * FillInInfo - Fill in information for the fields in SCX/FRX database.
  3405. *
  3406. *!*****************************************************************************
  3407. *!
  3408. *!      Procedure: FILLININFO
  3409. *!
  3410. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3411. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3412. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  3413. *!
  3414. *!          Calls: ADJRPTSUPPRESS     (procedure in TRANSPRT.PRG)
  3415. *!               : ADJRPTFLOAT        (procedure in TRANSPRT.PRG)
  3416. *!               : ADJRPTRESET        (procedure in TRANSPRT.PRG)
  3417. *!               : OBJ2BASEFONT()     (function  in TRANSPRT.PRG)
  3418. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  3419. *!               : ADJPEN             (procedure in TRANSPRT.PRG)
  3420. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  3421. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3422. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  3423. *!
  3424. *!*****************************************************************************
  3425. PROCEDURE fillininfo
  3426. IF m.g_filetype = c_report
  3427.    DO adjrptsuppress
  3428.    DO adjrptfloat
  3429. ENDIF
  3430.  
  3431. DO CASE
  3432. CASE m.g_tographic
  3433.    DO CASE
  3434.    CASE objtype = c_otpopup
  3435.       * Popups are a special case since the arrow control counts against the width
  3436.       * under Windows.
  3437.       REPLACE WIDTH WITH WIDTH + 2
  3438.    CASE INLIST(objtype,c_otrepvar,c_otrepfld)
  3439.       DO adjrptreset
  3440.       IF fillchar = "N"
  3441.          REPLACE offset WITH 1      && Change alignment for numerics.
  3442.       ENDIF
  3443.    ENDCASE
  3444. CASE !m.g_tographic
  3445.    DO CASE
  3446.    CASE objtype = c_otspinner
  3447.       * Map spinners to regular fields
  3448.       REPLACE objtype   WITH c_otfield, ;
  3449.          HEIGHT    WITH 1, ;
  3450.          fillchar  WITH "N"
  3451.    CASE objtype = c_otline
  3452.       * Map Windows lines to DOS boxes
  3453.       REPLACE objtype WITH c_otbox
  3454.       REPLACE HEIGHT  WITH MAX(HEIGHT,1), WIDTH WITH MAX(WIDTH,1)
  3455.       IF pensize >= 6
  3456.          REPLACE boxchar WITH "█"
  3457.       ENDIF
  3458.    CASE INLIST(objtype,c_otradbut,c_ottxtbut)
  3459.       * Remove the BMP extension from bitmap buttons
  3460.       REPLACE PICTURE WITH STRTRAN(PICTURE,".BMP","")
  3461.       REPLACE PICTURE WITH STRTRAN(PICTURE,".bmp","")
  3462.    CASE objtype = c_otfield AND ;
  3463.          (objcode = 2  OR (INLIST(objcode,0,1) AND WIDTH > 25))
  3464.       * Adjust widths of edit fields and very long GET/SAY fields to account
  3465.       * for font differences between the object and the base font.
  3466.       REPLACE WIDTH WITH obj2basefont(WIDTH,g_fontface,g_fontsize,g_fontstyle,;
  3467.          fontface,fontsize,whatstyle(fontstyle))
  3468.    CASE objtype = c_otbox AND (objcode = 4)
  3469.       IF pensize >= 6
  3470.          REPLACE boxchar WITH "█"
  3471.       ENDIF
  3472.    CASE INLIST(objtype,c_otrepvar,c_otrepfld)
  3473.       DO adjrptreset
  3474.       IF objtype = c_otrepvar
  3475.          * DOS report variable names have to be in upper case
  3476.          REPLACE name WITH UPPER(name)
  3477.       ENDIF
  3478.    ENDCASE
  3479. ENDCASE
  3480.  
  3481. IF objtype <> c_otbox AND objtype <> c_otline
  3482.    DO adjpen
  3483. ENDIF
  3484.  
  3485. DO adjcolor
  3486. DO adjfont
  3487. IF m.g_filetype = c_screen
  3488.    DO adjheightandwidth
  3489. ENDIF
  3490.  
  3491. *
  3492. * adjrptfloat - Convert float/stretch/relative postion types between
  3493. *      character and graphical positions
  3494. *
  3495. *!*****************************************************************************
  3496. *!
  3497. *!      Procedure: ADJRPTFLOAT
  3498. *!
  3499. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3500. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3501. *!
  3502. *!*****************************************************************************
  3503. PROCEDURE adjrptfloat
  3504. IF m.g_tographic
  3505.    DO CASE
  3506.    CASE FLOAT AND (objtype = c_otbox AND HEIGHT > 1)
  3507.       * Box or a vertical line--float as band stretches translates to Top--stretch w/ band.
  3508.       * Use the height > 1 test because DOS boxes haven't been translated into Windows
  3509.       * lines yet.
  3510.       REPLACE stretchtop WITH .T.
  3511.       REPLACE TOP WITH .F.
  3512.       REPLACE BOTTOM WITH .F.
  3513.    CASE FLOAT AND STRETCH
  3514.       REPLACE stretchtop WITH .T.
  3515.       REPLACE TOP WITH .F.
  3516.       REPLACE BOTTOM WITH .F.
  3517.    CASE FLOAT
  3518.       REPLACE BOTTOM WITH .T.
  3519.       REPLACE TOP WITH .F.
  3520.       REPLACE stretchtop WITH .F.
  3521.    ENDCASE
  3522. ELSE
  3523.    DO CASE
  3524.    CASE objtype = c_otrepfld AND (stretchtop OR STRETCH)
  3525.       REPLACE FLOAT WITH .T.
  3526.       REPLACE STRETCH WITH .T.
  3527.    CASE BOTTOM
  3528.       REPLACE FLOAT WITH .T.
  3529.       REPLACE STRETCH WITH .F.
  3530.    CASE TOP
  3531.       REPLACE FLOAT WITH .F.
  3532.       REPLACE STRETCH WITH .F.
  3533.    CASE stretchtop OR STRETCH
  3534.       REPLACE FLOAT WITH .T.
  3535.       REPLACE STRETCH WITH .F.
  3536.    ENDCASE
  3537. ENDIF
  3538.  
  3539. *
  3540. * adjrptSuppress - Convert Suppression types between 2.5 platforms.
  3541. *
  3542. *!*****************************************************************************
  3543. *!
  3544. *!      Procedure: ADJRPTSUPPRESS
  3545. *!
  3546. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3547. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3548. *!
  3549. *!*****************************************************************************
  3550. PROCEDURE adjrptsuppress
  3551. * Handle suppression of repeated values.
  3552. *
  3553. * In DOS 2.0, the value of the detail record "norepeat" determines whether repeated values
  3554. * are suppressed, if this is a field object, or whether group headings are repeated,
  3555. * if this is a group header.  The main screen header record "norepeat" field determines
  3556. * whether blank lines are suppressed in the detail band.
  3557. *
  3558. * In 2.5, the norepeat field is used just for suppression of blank lines.
  3559. * We are positioned on a detail record now.
  3560. *
  3561. IF m.g_tographic
  3562.    IF objtype = c_otband
  3563.       * The meaning for DOS is reversed from Windows
  3564.       REPLACE norepeat WITH !norepeat
  3565.    ELSE
  3566.       IF norepeat            && suppress repeated values
  3567.          REPLACE supvalchng WITH .T.
  3568.          REPLACE supovflow WITH .F.
  3569.          DO CASE
  3570.          CASE resetrpt = 0
  3571.             REPLACE suprpcol WITH 0
  3572.             REPLACE supgroup WITH 0
  3573.          CASE resetrpt = 1
  3574.             REPLACE suprpcol WITH 3
  3575.             REPLACE supgroup WITH 0
  3576.          OTHERWISE
  3577.             REPLACE suprpcol WITH 0
  3578.             REPLACE supgroup WITH resetrpt+3
  3579.          ENDCASE
  3580.       ELSE                   && no suppression of repeated values
  3581.          REPLACE supalways WITH .T.
  3582.          REPLACE supvalchng WITH .F.
  3583.          REPLACE supovflow WITH .F.
  3584.          REPLACE suprpcol WITH 3
  3585.          REPLACE supgroup WITH 0
  3586.       ENDIF
  3587.    ENDIF
  3588. ELSE
  3589.    IF supvalchng AND !supalways
  3590.       REPLACE norepeat WITH .T.
  3591.       IF supgroup > 0
  3592.          REPLACE resetrpt WITH supgroup - 3
  3593.       ELSE
  3594.          IF suprpcol = 3
  3595.             REPLACE resetrpt WITH 1
  3596.          ELSE
  3597.             REPLACE resetrpt WITH 0
  3598.          ENDIF
  3599.       ENDIF
  3600.    ELSE
  3601.       REPLACE norepeat WITH .F.
  3602.    ENDIF
  3603. ENDIF
  3604.  
  3605. *
  3606. * adjrptreset - Convert the reset values between 2.0 and 2.5.
  3607. *
  3608. *!*****************************************************************************
  3609. *!
  3610. *!      Procedure: ADJRPTRESET
  3611. *!
  3612. *!      Called by: UPDATEREPORT       (procedure in TRANSPRT.PRG)
  3613. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  3614. *!
  3615. *!*****************************************************************************
  3616. PROCEDURE adjrptreset
  3617. IF m.g_tographic
  3618.    DO CASE
  3619.    CASE resettotal = 0
  3620.       REPLACE resettotal WITH 1
  3621.    CASE resettotal = 1
  3622.       REPLACE resettotal WITH 2
  3623.    OTHERWISE
  3624.       REPLACE resettotal WITH resettotal+3
  3625.    ENDCASE
  3626. ELSE
  3627.    DO CASE
  3628.    CASE resettotal = 1
  3629.       REPLACE resettotal WITH 0
  3630.    CASE resettotal = 2 OR resettotal = 3
  3631.       REPLACE resettotal WITH 1
  3632.    OTHERWISE
  3633.       REPLACE resettotal WITH resettotal-3
  3634.    ENDCASE
  3635. ENDIF
  3636.  
  3637. *
  3638. * GetCharSuppress - Gets the global setting of blank line Suppression for a report. (This is
  3639. *      only valid for character mode reports).
  3640. *
  3641. *!*****************************************************************************
  3642. *!
  3643. *!       Function: GETCHARSUPPRESS
  3644. *!
  3645. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  3646. *!
  3647. *!*****************************************************************************
  3648. FUNCTION getcharsuppress
  3649. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  3650. IF FOUND()
  3651.    RETURN norepeat
  3652. ELSE
  3653.    RETURN .F.
  3654. ENDIF
  3655.  
  3656. *
  3657. * SuppressBlankLines - Looks through the from platform to see if any
  3658. *      object is marked to Suppress blank lines.  If one is, we
  3659. *      make the entire "to" report (which is assumed to be character)
  3660. *      Suppress blank lines.
  3661. *
  3662. *!*****************************************************************************
  3663. *!
  3664. *!      Procedure: SUPPRESSBLANKLINES
  3665. *!
  3666. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3667. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3668. *!
  3669. *!          Calls: GETBANDCODE()      (function  in TRANSPRT.PRG)
  3670. *!
  3671. *!*****************************************************************************
  3672. PROCEDURE suppressblanklines
  3673. PRIVATE m.supcount
  3674. DO CASE
  3675. CASE m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  3676.    COUNT TO m.supcount FOR platform = m.g_fromplatform AND objtype = c_otrepfld
  3677.    IF m.supcount > 0
  3678.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  3679.       IF FOUND()
  3680.          REPLACE norepeat WITH .T.
  3681.       ENDIF
  3682.    ENDIF
  3683. CASE m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3684.    * DOS suppression of blank lines only applies to detail lines.  Only mark graphical
  3685.    * objects in the detail band as suppressed.
  3686.    SCAN FOR platform = m.g_toplatform AND objtype <> c_otband AND objtype <> c_otheader
  3687.       myexpr = expr
  3688.       IF objtype = 8
  3689.          WAIT CLEAR
  3690.       ENDIF
  3691.       bcode  = getbandcode(vpos)
  3692.       IF bcode = 4     && detail band
  3693.          REPLACE norepeat WITH m.g_norepeat
  3694.       ELSE
  3695.          REPLACE norepeat WITH .F.
  3696.       ENDIF
  3697.    ENDSCAN
  3698. ENDCASE
  3699.  
  3700. *
  3701. * allGroups - Process all Group records.
  3702. *
  3703. *!*****************************************************************************
  3704. *!
  3705. *!      Procedure: ALLGROUPS
  3706. *!
  3707. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3708. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3709. *!
  3710. *!          Calls: UPDTHERM           (procedure in TRANSPRT.PRG)
  3711. *!
  3712. *!*****************************************************************************
  3713. PROCEDURE allgroups
  3714. PARAMETER m.thermpart
  3715. PRIVATE m.recno, m.numothers, m.thermstep
  3716.  
  3717. m.thermstep = m.thermpart / m.objindex
  3718. SELECT (m.g_scrnalias)
  3719.  
  3720. SCAN FOR platform = m.g_fromplatform AND objtype = c_otgroup
  3721.    m.recno = RECNO()
  3722.    
  3723.    SCATTER MEMVAR MEMO
  3724.    APPEND BLANK
  3725.    GATHER MEMVAR MEMO
  3726.    
  3727.    REPLACE platform WITH m.g_toplatform
  3728.    
  3729.    GOTO RECORD m.recno
  3730.    
  3731.    m.g_mercury = m.g_mercury + m.thermstep
  3732.    DO updtherm WITH m.g_mercury
  3733. ENDSCAN
  3734.  
  3735. *
  3736. * RptConvert - Converts entire reports between platforms.
  3737. *
  3738. *!*****************************************************************************
  3739. *!
  3740. *!      Procedure: RPTCONVERT
  3741. *!
  3742. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3743. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3744. *!
  3745. *!          Calls: ISREPTOBJECT()     (function  in TRANSPRT.PRG)
  3746. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  3747. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  3748. *!               : BANDINFO()         (function  in TRANSPRT.PRG)
  3749. *!               : CLONEBAND          (procedure in TRANSPRT.PRG)
  3750. *!
  3751. *!*****************************************************************************
  3752. PROCEDURE rptconvert
  3753. PRIVATE m.thermstep
  3754.  
  3755. COUNT TO m.thermstep FOR platform = m.g_toplatform AND ;
  3756.    (isreptobject(objtype) OR objtype = c_otband)
  3757.  
  3758. IF m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  3759.    m.thermstep = 25 / m.thermstep
  3760. ELSE
  3761.    m.thermstep = 50 / m.thermstep
  3762. ENDIF
  3763.  
  3764. * We need to do bands before any other object.
  3765. SCAN FOR platform = m.g_toplatform AND objtype = c_otband
  3766.    DO rptobjconvert WITH 0
  3767.    m.g_mercury = m.g_mercury + m.thermstep
  3768.    DO updtherm WITH m.g_mercury
  3769. ENDSCAN
  3770.  
  3771. * We need to know where bands start and where they end in
  3772. * both platforms.
  3773. COUNT TO m.bandcount FOR platform = m.g_toplatform AND objtype = c_otband
  3774. GOTO TOP
  3775.  
  3776. DIMENSION bands[m.bandCount,4]
  3777. m.bandcount = bandinfo()
  3778.  
  3779. * Make sure that the band headers and footers match on Windows
  3780. IF m.g_tographic
  3781.    DO cloneband
  3782. ENDIF
  3783.  
  3784. SCAN FOR platform = m.g_toplatform AND ;
  3785.       (objtype = c_otrepfld OR objtype = c_ottext OR ;
  3786.       objtype = c_otbox OR objtype = c_otline)
  3787.    
  3788.    DO rptobjconvert WITH m.bandcount
  3789.    
  3790.    m.g_mercury = m.g_mercury + m.thermstep
  3791.    DO updtherm WITH m.g_mercury
  3792. ENDSCAN
  3793.  
  3794. *
  3795. * RptObjConvert - Converts the size and postion of a given record in a report/label
  3796. *
  3797. *!*****************************************************************************
  3798. *!
  3799. *!      Procedure: RPTOBJCONVERT
  3800. *!
  3801. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3802. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3803. *!               : NEWBANDS           (procedure in TRANSPRT.PRG)
  3804. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  3805. *!
  3806. *!          Calls: EMPTYBAND()        (function  in TRANSPRT.PRG)
  3807. *!               : CVTREPORTVERTICAL()(function  in TRANSPRT.PRG)
  3808. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  3809. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  3810. *!               : ADJFONT            (procedure in TRANSPRT.PRG)
  3811. *!               : GETBANDINDEX       (procedure in TRANSPRT.PRG)
  3812. *!               : CVTREPORTHORIZONTAL(function  in TRANSPRT.PRG)
  3813. *!               : CVTRPTLINES()      (function  in TRANSPRT.PRG)
  3814. *!               : ADJTEXT            (procedure in TRANSPRT.PRG)
  3815. *!
  3816. *!*****************************************************************************
  3817. PROCEDURE rptobjconvert
  3818. PARAMETER m.bandcount
  3819. PRIVATE m.bandindex, m.endindex, m.posinband, m.saverec, m.objid, m.origvpos, m.lineheight
  3820.  
  3821. IF objtype = c_otband
  3822.    * Map height and width of band to proper values
  3823.    
  3824.    IF m.g_tographic AND emptyband(uniqueid)
  3825.       REPLACE HEIGHT WITH 0
  3826.    ELSE
  3827.       m.lineheight = cvtreportvertical(HEIGHT)
  3828.       IF !m.g_tographic AND BETWEEN(m.lineheight,1.00,1.10) AND objcode = 4
  3829.          * This is a heuristic rule to make quick reports and other reports with 
  3830.          * a single-line detail band transport to DOS correctly.  Sometimes the bands
  3831.          * will be just a little larger than one line in Windows.
  3832.          REPLACE HEIGHT WITH 1
  3833.       ELSE
  3834.          REPLACE HEIGHT WITH CEILING(m.lineheight)
  3835.       ENDIF
  3836.    ENDIF
  3837.    
  3838.    IF m.g_tographic
  3839.       * Map DOS offset field to Windows "if lines less than".  These fields control
  3840.       * when the data grouping decides to start a new page.  This data is stored in "width".
  3841.       REPLACE WIDTH WITH 10000 * offset / c_linesperinch
  3842.    ELSE
  3843.       REPLACE HEIGHT WITH MAX(1, HEIGHT)
  3844.       REPLACE offset WITH ROUND(WIDTH/10000, 0) * c_linesperinch
  3845.    ENDIF
  3846. ELSE
  3847.    * Converting a regular object such as a field or line.
  3848.    m.origvpos   = vpos
  3849.    m.origheight = HEIGHT
  3850.    
  3851.    IF (m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC") AND objtype = c_otbox
  3852.       DO adjbox WITH 0
  3853.       DO adjcolor
  3854.       DO adjfont
  3855.    ENDIF
  3856.    
  3857.    * Find which band in the "from" platform this object came from
  3858.    * Use a vpos expressed in "from" units for this function.
  3859.    m.bandindex = getbandindex(m.origvpos, m.bandcount)
  3860.    
  3861.    * Since keeping objects in the proper bands is our highest
  3862.    * priority, we calculate the new Vpos by determining how many
  3863.    * lines into its band an object lies and adding this
  3864.    * value (converted) to that band's Vpos in the from platform.
  3865.    m.posinband = MAX(cvtreportvertical((vpos - bands[m.bandIndex, c_fmbandvpos])),0)
  3866.    REPLACE vpos WITH bands[m.bandIndex, c_tobandvpos] + m.posinband
  3867.    
  3868.    * Since vertical lines and boxes can stretch across bands, we need to
  3869.    * watch their ending positions.
  3870.    IF (objtype = c_otbox AND cvtreportvertical(HEIGHT) > 1) ;
  3871.          OR (objtype = c_otline AND WIDTH < HEIGHT)
  3872.       m.endindex = getbandindex(IIF(m.g_tographic,m.origvpos+m.origheight-1,;
  3873.          m.origvpos + m.origheight), m.bandcount)
  3874.       IF m.endindex <> m.bandindex
  3875.          *m.endinband = IIF(m.g_tographic, m.origvpos+m.origheight-.25, m.origvpos+m.origheight) ;
  3876.          *   - bands[m.endIndex, c_fmbandvpos]
  3877.          m.endinband = m.origvpos+m.origheight - bands[m.endIndex, c_fmbandvpos]
  3878.          IF m.g_tographic
  3879.             * Allow for the fact that box characters in DOS appear in the middle of
  3880.             * the line, but always stick out into the "end" band a little bit.
  3881.             m.endinband = MAX(m.endinband - 0.5,0.25)
  3882.          ENDIF
  3883.          m.endinband = cvtreportvertical(m.endinband)
  3884.          REPLACE HEIGHT WITH bands[m.endIndex, c_tobandvpos] + m.endinband - vpos
  3885.       ELSE
  3886.          REPLACE HEIGHT WITH cvtreportvertical(HEIGHT)
  3887.       ENDIF
  3888.    ELSE
  3889.       REPLACE HEIGHT WITH cvtreportvertical(HEIGHT)
  3890.    ENDIF
  3891.    
  3892.    REPLACE hpos WITH cvtreporthorizontal(hpos)
  3893.    REPLACE WIDTH WITH cvtreporthorizontal(WIDTH)
  3894.    IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  3895.       IF objtype = c_otline AND WIDTH > HEIGHT
  3896.          * Handle horizontal lines separately.  They are very sensitive to line
  3897.          * height.
  3898.          REPLACE HEIGHT WITH cvtrptlines(HEIGHT)
  3899.       ENDIF
  3900.    ELSE
  3901.       IF objtype = c_otbox AND ROUND(HEIGHT,0) <> 1
  3902.          DO adjbox WITH 0
  3903.       ENDIF
  3904.       
  3905.       REPLACE vpos WITH ROUND(vpos,0)
  3906.       REPLACE hpos WITH ROUND(hpos,0)
  3907.       REPLACE HEIGHT WITH ROUND(HEIGHT,0)
  3908.       REPLACE WIDTH WITH ROUND(WIDTH,0)
  3909.       
  3910.       * Make sure that this object will not extend past the end of the last
  3911.       * band, which leads to "invalid report" errors on DOS.
  3912.       IF m.bandindex = m.bandcount AND ;
  3913.             (vpos + HEIGHT ;
  3914.             > bands[m.bandIndex,c_tobandvpos] ;
  3915.             + bands[m.bandIndex,c_tobandheight])
  3916.          * Can we move the object up so that it fits?
  3917.          IF HEIGHT <= bands[m.bandIndex, c_tobandheight]
  3918.             * It will fit if we scootch it up a little.
  3919.             REPLACE vpos WITH vpos -;
  3920.                (bands[m.bandIndex,c_tobandheight] - HEIGHT)
  3921.          ELSE
  3922.             * No room for it at all.  Crop the height.  Make as much fit as possible.
  3923.             REPLACE vpos   WITH bands[m.bandIndex,c_tobandvpos]
  3924.             REPLACE HEIGHT WITH bands[m.bandIndex,c_tobandheight]
  3925.          ENDIF
  3926.       ENDIF
  3927.       
  3928.       DO CASE
  3929.       CASE objtype = c_ottext
  3930.          REPLACE HEIGHT WITH 1
  3931.          DO adjtext WITH WIDTH
  3932.          REPLACE WIDTH WITH LEN(expr)-2
  3933.          
  3934.       CASE objtype = c_otrepfld AND HEIGHT < 1
  3935.          REPLACE HEIGHT WITH 1
  3936.          
  3937.       ENDCASE
  3938.       IF ROUND(hpos,0) = -1
  3939.          REPLACE hpos WITH 0
  3940.       ENDIF
  3941.    ENDIF
  3942.    
  3943.    * Guarantee that we are in the right band.
  3944.    IF vpos > bands[m.bandIndex,c_tobandvpos] ;
  3945.          + bands[m.bandIndex,c_tobandheight] - 1
  3946.       REPLACE vpos WITH bands[m.bandIndex,c_tobandvpos] ;
  3947.          + bands[m.bandIndex,c_tobandheight] - 1
  3948.    ENDIF
  3949.    
  3950.    IF vpos < 0
  3951.       REPLACE vpos WITH 0
  3952.    ENDIF
  3953. ENDIF
  3954.  
  3955. IF HEIGHT <= 0
  3956.    REPLACE HEIGHT WITH 1
  3957. ENDIF
  3958.  
  3959. RETURN
  3960.  
  3961. *
  3962. * GetBandIndex - Given a Vpos (from platform), this function returns the
  3963. *      index in the Band array of the band which this Vpos lies in.
  3964. *
  3965. *!*****************************************************************************
  3966. *!
  3967. *!      Procedure: GETBANDINDEX
  3968. *!
  3969. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  3970. *!
  3971. *!*****************************************************************************
  3972. PROCEDURE getbandindex
  3973. PARAMETER m.vpos, m.bandcount
  3974. PRIVATE m.loop
  3975. FOR m.loop = 1 TO m.bandcount
  3976.    IF m.vpos >= bands[m.loop,c_fmbandvpos] ;
  3977.          AND m.vpos < bands[m.loop,c_fmbandvpos]+bands[m.loop,c_fmbandheight]
  3978.       RETURN m.loop
  3979.    ENDIF
  3980. ENDFOR
  3981. RETURN m.bandcount    && drop them into the bottom band as a default
  3982.  
  3983. *
  3984. * BandInfo - Fills a predefined array named Band as follows.
  3985. *   bands[1] = Start Position in To platform.
  3986. *   bands[2] = Height in To platform.
  3987. *   bands[3] = Start Position in From platform.
  3988. *   bands[4] = Height in From platform.
  3989. *
  3990. *!*****************************************************************************
  3991. *!
  3992. *!       Function: BANDINFO
  3993. *!
  3994. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  3995. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  3996. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  3997. *!
  3998. *!          Calls: RESIZEBAND         (procedure in TRANSPRT.PRG)
  3999. *!
  4000. *!*****************************************************************************
  4001. FUNCTION bandinfo
  4002. PRIVATE m.saverec, m.bandcount, m.loop, ;
  4003.    m.pagefooter, m.pageheader, m.colheader, m.colfooter, ;
  4004.    m.toposition, m.fromposition, m.objcode, m.expr
  4005.  
  4006. m.toposition   = 0
  4007. m.fromposition = 0
  4008. m.bandcount    = 0
  4009. m.colheader    = 0
  4010. m.colfooter    = 0
  4011. m.pageheader   = 0
  4012. m.pagefooter   = 0
  4013.  
  4014. SCAN FOR platform = m.g_toplatform AND objtype = c_otband
  4015.    m.bandcount = m.bandcount + 1
  4016.    
  4017.    DO CASE
  4018.    CASE objcode = 1
  4019.       m.pageheader = m.bandcount
  4020.    CASE objcode = 2
  4021.       m.colheader  = m.bandcount
  4022.    CASE objcode = 6
  4023.       m.colfooter  = m.bandcount
  4024.    CASE objcode = 7
  4025.       m.pagefooter = m.bandcount
  4026.    ENDCASE
  4027.    
  4028.    * The To fields are already converted at this point
  4029.    bands[m.bandCount,c_tobandvpos] = m.toposition
  4030.    IF m.g_tographic
  4031.       bands[m.bandCount,c_tobandheight] ;
  4032.          = HEIGHT + c_bandheight + (c_bandfudge/c_pixelsize)
  4033.    ELSE
  4034.       bands[m.bandCount,c_tobandheight] = HEIGHT
  4035.    ENDIF
  4036.    
  4037.    
  4038.    m.objcode = objcode
  4039.    m.expr    = expr
  4040.    m.saverec = RECNO()
  4041.    
  4042.    IF !EMPTY(expr)
  4043.       LOCATE FOR platform = m.g_fromplatform AND ;
  4044.          objtype = c_otband AND objcode = m.objcode AND expr = m.expr
  4045.    ELSE
  4046.       * The expression is empty, which means this is probably a group footer.  There could
  4047.       * be many of them, all empty.  We have to find the right one.
  4048.       GOTO TOP
  4049.       * Figure out which occurrence this one is.
  4050.       COUNT TO m.seq FOR platform = m.g_toplatform AND ;
  4051.          objtype = c_otband AND objcode = m.objcode AND EMPTY(expr) ;
  4052.          AND RECNO() <= m.saverec
  4053.       GOTO TOP
  4054.       * Now find the corresponding band in the "from" platform
  4055.       LOCATE FOR platform = m.g_fromplatform AND ;
  4056.          objtype = c_otband AND objcode = m.objcode AND EMPTY(expr)
  4057.       m.i = 1
  4058.       DO WHILE FOUND() AND m.i < m.seq
  4059.          m.i = m.i + 1
  4060.          CONTINUE
  4061.       ENDDO
  4062.    ENDIF
  4063.    IF FOUND()
  4064.       bands[m.bandCount,c_fmbandvpos] = m.fromposition
  4065.       IF m.g_tographic   && so coming from DOS
  4066.          bands[m.bandCount,c_fmbandheight] = HEIGHT
  4067.       ELSE
  4068.          bands[m.bandCount,c_fmbandheight] = HEIGHT + c_bandheight
  4069.       ENDIF
  4070.       
  4071.       m.fromposition = m.fromposition + bands[m.bandCount,c_fmbandheight]
  4072.       
  4073.       IF !g_tographic
  4074.          * Resize 'to' band if necessary to account for boxes that narrowly
  4075.          * surround text on a graphic platform.  Sometimes the box can be
  4076.          * tightly against the text such that the graphical band appears to
  4077.          * be only two rows high.  We need three rows to display the box in
  4078.          * a character platform
  4079.          bands[m.bandCount,c_tobandheight] = ;
  4080.             resizeband(bands[m.bandCount,c_tobandheight], ;
  4081.             bands[m.bandCount,c_fmbandvpos  ], ;
  4082.             bands[m.bandCount,c_fmbandheight])
  4083.       ENDIF
  4084.    ELSE
  4085.       bands[m.bandCount,c_fmbandvpos] = 9999999
  4086.       bands[m.bandCount,c_fmbandheight] = 9999999
  4087.    ENDIF
  4088.    
  4089.    
  4090.    m.toposition = m.toposition + bands[m.bandCount,c_tobandheight]
  4091.    
  4092.    GOTO RECORD (m.saverec)
  4093.    
  4094.    IF !g_tographic
  4095.       * Stuff the newly recomputed height into the DOS record
  4096.       REPLACE HEIGHT WITH bands[m.bandCount,c_tobandheight]
  4097.    ENDIF
  4098.    
  4099. ENDSCAN
  4100.  
  4101. * We don't want to have any column headers/footers in the character
  4102. * products so we need to combine them with the page headers/footers.
  4103. IF m.colfooter > 0 AND m.pagefooter > 0
  4104.    bands[m.pageFooter,c_tobandvpos] = bands[m.colFooter,c_tobandvpos]
  4105.    bands[m.pageFooter,c_tobandheight];
  4106.       = bands[m.pageFooter,c_tobandheight] ;
  4107.       + bands[m.colFooter,c_tobandheight]
  4108.    bands[m.pageFooter,c_fmbandvpos] = bands[m.colFooter,c_fmbandvpos]
  4109.    bands[m.pageFooter,c_fmbandheight] ;
  4110.       = bands[m.pageFooter,c_fmbandheight] ;
  4111.       + bands[m.colFooter,c_fmbandheight]
  4112.    
  4113.    LOCATE FOR platform = m.g_toplatform ;
  4114.       AND objtype = c_otband AND objcode = 6
  4115.    IF FOUND()
  4116.       DELETE
  4117.    ENDIF
  4118.    
  4119.    LOCATE FOR platform = m.g_toplatform ;
  4120.       AND objtype = c_otband AND objcode = 7
  4121.    IF FOUND()
  4122.       REPLACE HEIGHT WITH HEIGHT + bands[m.colFooter,c_tobandheight]
  4123.    ENDIF
  4124.    
  4125.    =ADEL(bands,m.colfooter)
  4126.    m.bandcount = m.bandcount - 1
  4127. ENDIF
  4128.  
  4129. IF m.colheader > 0 AND m.pageheader > 0
  4130.    bands[m.pageHeader,c_tobandheight];
  4131.       = bands[m.pageHeader,c_tobandheight] ;
  4132.       + bands[m.colHeader,c_tobandheight]
  4133.    bands[m.pageHeader,c_fmbandheight] ;
  4134.       = bands[m.pageHeader,c_fmbandheight] ;
  4135.       + bands[m.colHeader,c_fmbandheight]
  4136.    
  4137.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 2
  4138.    IF FOUND()
  4139.       DELETE
  4140.    ENDIF
  4141.    
  4142.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 1
  4143.    IF FOUND()
  4144.       REPLACE HEIGHT WITH HEIGHT + bands[m.colHeader,c_tobandheight]
  4145.    ENDIF
  4146.    
  4147.    =ADEL(bands,m.colheader)
  4148.    m.bandcount = m.bandcount - 1
  4149. ENDIF
  4150. RETURN m.bandcount
  4151.  
  4152.  
  4153. *!*****************************************************************************
  4154. *!
  4155. *!      Procedure: CLONEBAND
  4156. *!
  4157. *!      Called by: RPTCONVERT         (procedure in TRANSPRT.PRG)
  4158. *!
  4159. *!*****************************************************************************
  4160. PROCEDURE cloneband
  4161. * Copy the band header record data into the respective footer bands.  Data in band header
  4162. * and footer records must match on Windows.  The main data that needs to match is the
  4163. * group expression and things like how many spaces to require after a heading
  4164. * before doing a page break.
  4165. PRIVATE m.in_area, m.in_rec, m.pivot, m.ouniqid, m.ovpos, m.ohpos, m.owidth, m.oheight,;
  4166.    m.oobjcode, m.headband
  4167. IF m.g_tographic
  4168.    m.in_area = SELECT()
  4169.    m.in_rec = RECNO()
  4170.    * First find the detail band.  It acts as a pivot.
  4171.    GOTO TOP
  4172.    LOCATE FOR platform = m.g_toplatform ;
  4173.       AND objtype = c_otband ;
  4174.       AND objcode = 4     && detail band has code = 4
  4175.    IF !FOUND()
  4176.       * Return and make the best of it
  4177.       RETURN
  4178.    ENDIF
  4179.    m.pivot = RECNO()
  4180.    
  4181.    * Scan for each of the header bands
  4182.    SCAN FOR platform = m.g_toplatform ;
  4183.          AND objtype = c_otband ;
  4184.          AND objcode < 4 AND objcode > 0
  4185.       SCATTER MEMVAR MEMO
  4186.       
  4187.       m.headband = RECNO()
  4188.       
  4189.       * Go to the matching footer band record
  4190.       GOTO (m.pivot + (m.pivot - RECNO()))
  4191.       
  4192.       * Store the values we don't want to copy from the header
  4193.       m.ouniqid  = uniqueid
  4194.       m.ovpos    = vpos
  4195.       m.ohpos    = hpos
  4196.       m.oheight  = HEIGHT
  4197.       m.oobjcode = objcode
  4198.       
  4199.       * Stuff header data into this footer band
  4200.       GATHER MEMVAR MEMO
  4201.       
  4202.       * Restore the data we didn't want to copy from the header
  4203.       REPLACE vpos WITH m.ovpos, hpos WITH m.ohpos, ;
  4204.          HEIGHT WITH m.oheight, objcode WITH m.oobjcode, ;
  4205.          uniqueid WITH m.ouniqid
  4206.       
  4207.       GOTO (m.headband)
  4208.       
  4209.    ENDSCAN
  4210.    SELECT (m.in_area)
  4211.    GOTO (MIN(m.in_rec,RECCOUNT()))
  4212. ENDIF
  4213.  
  4214. RETURN
  4215.  
  4216. *
  4217. * RESIZEBAND - Resize the character mode report band to accommodate
  4218. * boxes, etc.
  4219. *
  4220. *!*****************************************************************************
  4221. *!
  4222. *!      Procedure: RESIZEBAND
  4223. *!
  4224. *!      Called by: BANDINFO()         (function  in TRANSPRT.PRG)
  4225. *!
  4226. *!          Calls: CVTREPORTVERTICAL()(function  in TRANSPRT.PRG)
  4227. *!
  4228. *!*****************************************************************************
  4229. PROCEDURE resizeband
  4230. PARAMETER tobandheight, fmbandvpos, fmbandheight
  4231.  
  4232. PRIVATE in_rec, minbandheight
  4233. m.in_rec = RECNO()
  4234. m.minbandheight = m.tobandheight
  4235. IF !g_tographic
  4236.    * Search for boxes that lie entirely within this band.
  4237.    SCAN FOR platform = m.g_fromplatform ;
  4238.          AND objtype = c_otbox AND vpos >= m.fmbandvpos ;
  4239.          AND vpos + HEIGHT <= m.fmbandvpos + m.fmbandheight
  4240.       * The box needs to be expanded
  4241.       m.minbandheight = MAX(m.minbandheight,cvtreportvertical(HEIGHT)+1)
  4242.       * If there is a box in the band, always make it at least three rows
  4243.       m.minbandheight = MAX(m.minbandheight,3)
  4244.    ENDSCAN
  4245. ENDIF
  4246. GOTO RECORD (m.in_rec)
  4247. RETURN CEILING(m.minbandheight)
  4248.  
  4249. *
  4250. * BandHeight - Given a band ID and platform, this function reurns the band's
  4251. *      starting position in that platform.
  4252. *
  4253. *!*****************************************************************************
  4254. *!
  4255. *!       Function: BANDPOS
  4256. *!
  4257. *!      Called by: NEWBANDS           (procedure in TRANSPRT.PRG)
  4258. *!               : EMPTYBAND()        (function  in TRANSPRT.PRG)
  4259. *!
  4260. *!*****************************************************************************
  4261. FUNCTION bandpos
  4262. PARAMETER m.objid, m.platform
  4263. PRIVATE m.saverec, m.bandstart
  4264. m.saverec = RECNO()
  4265. m.bandstart = 0
  4266.  
  4267. SCAN FOR platform = m.platform AND objtype = c_otband
  4268.    IF uniqueid <> m.objid
  4269.       IF m.platform = "DOS" OR m.platform = "UNIX"
  4270.          m.bandstart = m.bandstart + HEIGHT
  4271.       ELSE
  4272.          m.bandstart = m.bandstart + HEIGHT + c_bandheight + (c_bandfudge/c_pixelsize)
  4273.       ENDIF
  4274.    ELSE
  4275.       LOCATE FOR .F.
  4276.    ENDIF
  4277. ENDSCAN
  4278.  
  4279. GOTO RECORD (m.saverec)
  4280. RETURN m.bandstart
  4281.  
  4282. *
  4283. * EmptyBand - Given a band ID, this funtion determines if the band is empty.
  4284. *
  4285. *!*****************************************************************************
  4286. *!
  4287. *!       Function: EMPTYBAND
  4288. *!
  4289. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4290. *!
  4291. *!          Calls: BANDPOS()          (function  in TRANSPRT.PRG)
  4292. *!
  4293. *!*****************************************************************************
  4294. FUNCTION emptyband
  4295. PARAMETER m.id
  4296. PRIVATE m.saverec, m.bandstart, m.bandheight, m.retval
  4297. IF m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  4298.    RETURN .F.
  4299. ENDIF
  4300.  
  4301. m.saverec = RECNO()
  4302. m.retval = .F.
  4303.  
  4304. LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.id
  4305. IF FOUND()
  4306.    m.bandheight = HEIGHT
  4307.    m.bandstart = bandpos(m.id, m.g_fromplatform)
  4308.    * Look for objects in this band
  4309.    LOCATE FOR platform = m.g_fromplatform AND ;
  4310.       (objtype = c_otline OR objtype = c_otbox OR ;
  4311.       objtype = c_ottext OR objtype = c_otrepfld) AND ;
  4312.       vpos >= m.bandstart AND vpos < m.bandstart + m.bandheight
  4313.    IF !FOUND() AND m.g_tographic
  4314.       * Look for a DOS box or line that ends in the band
  4315.       GOTO TOP
  4316.       LOCATE FOR platform = m.g_fromplatform AND ;
  4317.          INLIST(objtype,c_otbox, c_otline) AND ;
  4318.          vpos + HEIGHT - 1 >= m.bandstart AND vpos + HEIGHT - 1 < m.bandstart + m.bandheight
  4319.    ENDIF
  4320.    m.retval = !FOUND()
  4321. ENDIF
  4322.  
  4323. GOTO RECORD (m.saverec)
  4324. RETURN m.retval
  4325.  
  4326. *
  4327. * GETBANDCODE - returns band objcode given a vpos
  4328. *
  4329. *!*****************************************************************************
  4330. *!
  4331. *!       Function: GETBANDCODE
  4332. *!
  4333. *!      Called by: SUPPRESSBLANKLINES (procedure in TRANSPRT.PRG)
  4334. *!
  4335. *!*****************************************************************************
  4336. FUNCTION getbandcode
  4337. PARAMETER m.thisvpos
  4338. PRIVATE m.in_num, m.retcode
  4339. retcode = -1
  4340. m.in_num = RECNO()
  4341. m.startvpos = 0
  4342.  
  4343. IF INLIST(objtype,c_otheader, c_otband, c_otrel, c_otworkar, c_otindex)
  4344.    RETURN -1
  4345. ENDIF
  4346.  
  4347. SET FILTER TO platform = m.g_toplatform AND (objtype = c_otband)
  4348. GOTO TOP
  4349. DO WHILE m.startvpos <= m.thisvpos AND !EOF()
  4350.    IF m.startvpos + HEIGHT +c_bandheight > m.thisvpos
  4351.       retcode = objcode
  4352.       EXIT
  4353.    ELSE
  4354.       m.startvpos = m.startvpos + HEIGHT + c_bandheight
  4355.       SKIP
  4356.    ENDIF
  4357. ENDDO
  4358. SET FILTER TO
  4359. GOTO m.in_num
  4360. RETURN retcode
  4361.  
  4362. *
  4363. * CvtReportVertical - Convert report vertical dimensions between 10000ths of an inch and characters
  4364. *      depending on the to platform.  (This function is for vertical dimensions only).
  4365. *
  4366. *!*****************************************************************************
  4367. *!
  4368. *!       Function: CVTREPORTVERTICAL
  4369. *!
  4370. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4371. *!               : RESIZEBAND         (procedure in TRANSPRT.PRG)
  4372. *!
  4373. *!*****************************************************************************
  4374. FUNCTION cvtreportvertical
  4375. PARAMETER m.units
  4376. DO CASE
  4377. CASE !m.g_tographic
  4378.    RETURN m.units/10000 * c_linesperinch
  4379. CASE g_tographic
  4380.    RETURN (m.units * m.g_rptlinesize) + (5000/c_pixelsize)
  4381. OTHERWISE
  4382.    RETURN m.units
  4383. ENDCASE
  4384.  
  4385. *
  4386. * CvtReportWidth - Convert report horizontal dimensions between 10000ths of an inch
  4387. *      and chanracters depending on the to platform.
  4388. *
  4389. *!*****************************************************************************
  4390. *!
  4391. *!       Function: CVTREPORTHORIZONTAL
  4392. *!
  4393. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4394. *!
  4395. *!*****************************************************************************
  4396. FUNCTION cvtreporthorizontal
  4397. PARAMETER m.units
  4398. DO CASE
  4399. CASE !m.g_tographic
  4400.    RETURN m.units/10000 * c_charsperinch
  4401. CASE m.g_tographic
  4402.    RETURN m.units * m.g_rptcharsize
  4403. OTHERWISE
  4404.    RETURN m.units
  4405. ENDCASE
  4406. *!*****************************************************************************
  4407. *!
  4408. *!       Function: CVTRPTLINES
  4409. *!
  4410. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  4411. *!
  4412. *!*****************************************************************************
  4413. FUNCTION cvtrptlines
  4414. * Adjust the height of horizontal lines
  4415. PARAMETER m.height
  4416. DO CASE
  4417. CASE g_tographic
  4418.    DO CASE
  4419.    CASE BETWEEN(m.height,0,200)
  4420.       RETURN 104
  4421.    CASE BETWEEN(m.height,200,600)
  4422.       RETURN 520
  4423.    CASE BETWEEN(m.height,600,850)
  4424.       RETURN 850
  4425.    OTHERWISE
  4426.       RETURN m.height
  4427.    ENDCASE
  4428. OTHERWISE
  4429.    RETURN m.height
  4430. ENDCASE
  4431.  
  4432. *
  4433. * MergeLabelObjects - Combines report objects which lie on the same line
  4434. *      when going from a graphical platform to a character platform.
  4435. *
  4436. *!*****************************************************************************
  4437. *!
  4438. *!      Procedure: MERGELABELOBJECTS
  4439. *!
  4440. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  4441. *!
  4442. *!          Calls: LABELOBJMERGE      (procedure in TRANSPRT.PRG)
  4443. *!
  4444. *!        Indexes: TEMP                   (tag)
  4445. *!
  4446. *!*****************************************************************************
  4447. PROCEDURE mergelabelobjects
  4448. INDEX ON platform+STR(vpos,3)+STR(hpos,3) TAG temp
  4449.  
  4450. SCAN FOR platform = m.g_toplatform AND !DELETED() AND ;
  4451.       (objtype = c_otrepfld OR objtype = c_ottext OR objtype = c_otbox OR objtype = c_otline)
  4452.    DO labelobjmerge WITH RECNO()
  4453. ENDSCAN
  4454.  
  4455. DELETE TAG temp
  4456. RETURN
  4457.  
  4458. *
  4459. * LabelObjMerge - Given a record which is a report object, this function tries to find a label
  4460. *      object on the same line and combine them.  If no label object exists on the line, the
  4461. *      record is turned into one.
  4462. *
  4463. *!*****************************************************************************
  4464. *!
  4465. *!      Procedure: LABELOBJMERGE
  4466. *!
  4467. *!      Called by: MERGELABELOBJECTS  (procedure in TRANSPRT.PRG)
  4468. *!
  4469. *!*****************************************************************************
  4470. PROCEDURE labelobjmerge
  4471. PARAMETER m.recno
  4472. PRIVATE m.saverec, m.vpos, m.hpos, m.width, m.height, m.expr, m.type, m.picture
  4473.  
  4474. m.saverec = RECNO()
  4475. GOTO RECORD (m.recno)
  4476.  
  4477. m.vpos = vpos
  4478. m.width = WIDTH
  4479. m.expr = expr
  4480. m.type = fillchar
  4481. m.picture = PICTURE
  4482. DELETE
  4483.  
  4484. LOCATE FOR platform = m.g_toplatform AND !DELETED() AND ;
  4485.    objtype = c_ot20lbxobj AND vpos = m.vpos
  4486. IF FOUND()
  4487.    REPLACE expr WITH expr + "," + m.expr
  4488. ELSE
  4489.    GOTO RECORD (m.recno)
  4490.    RECALL
  4491.    REPLACE objtype WITH c_ot20lbxobj
  4492. ENDIF
  4493.  
  4494. GOTO RECORD (m.saverec)
  4495.  
  4496. *
  4497. * AddLabelBlanks - Adds sufficient blank lines to make the converted lines
  4498. *
  4499. *!*****************************************************************************
  4500. *!
  4501. *!      Procedure: ADDLABELBLANKS
  4502. *!
  4503. *!           Uses: M.G_SCRNALIAS      
  4504. *!
  4505. *!*****************************************************************************
  4506. PROCEDURE addlabelblanks
  4507. PRIVATE m.linecount, m.last, m.scanloop
  4508. SELECT vpos FROM m.g_scrnalias ;
  4509.    WHERE !DELETED() AND platform = m.g_toplatform AND objtype = c_ot20lbxobj ;
  4510.    ORDER BY vpos ;
  4511.    INTO ARRAY lines
  4512.  
  4513. m.linecount = _TALLY
  4514. m.last = 0
  4515. FOR m.scanloop = 1 TO lines[m.linecount]
  4516.    IF ASCAN(lines, m.scanloop) = 0
  4517.       APPEND BLANK
  4518.       REPLACE platform WITH m.g_toplatform
  4519.       REPLACE objtype WITH c_ot20lbxobj
  4520.       REPLACE vpos WITH m.lines
  4521.    ENDIF
  4522. ENDFOR
  4523. RETURN
  4524.  
  4525. *
  4526. * LinesBetween - Removes all the whitespace from the bottom of the detail
  4527. *      band and puts it in lines between.
  4528. *
  4529. *!*****************************************************************************
  4530. *!
  4531. *!      Procedure: LINESBETWEEN
  4532. *!
  4533. *!      Called by: ALLGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  4534. *!
  4535. *!*****************************************************************************
  4536. PROCEDURE linesbetween
  4537. PRIVATE m.linecount, m.blanklines
  4538. COUNT TO m.linecount FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4539.  
  4540. LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 4
  4541. IF FOUND() AND m.linecount < HEIGHT
  4542.    m.blanklines = HEIGHT - m.linecount
  4543.    REPLACE HEIGHT WITH m.linecount
  4544.    LOCATE FOR platform = m.g_toplatform AND objtype = c_ot20label
  4545.    IF FOUND()
  4546.       REPLACE penblue WITH m.blanklines
  4547.    ENDIF
  4548. ENDIF
  4549.  
  4550. *
  4551. * labelBands - Adds the group records needed by a graphical label
  4552. *
  4553. *!*****************************************************************************
  4554. *!
  4555. *!      Procedure: LABELBANDS
  4556. *!
  4557. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4558. *!
  4559. *!*****************************************************************************
  4560. PROCEDURE labelbands
  4561. PRIVATE m.lbxheight, m.lbxwidth, m.lbxlinesbet
  4562.  
  4563. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otband AND objcode = 4
  4564. IF FOUND()
  4565.    m.lbxheight = HEIGHT
  4566. ENDIF
  4567.  
  4568. LOCATE FOR platform = m.g_fromplatform AND objtype = c_ot20label
  4569. IF FOUND()
  4570.    DO CASE
  4571.    CASE name = '3 1/2" x 15/16" x 1' AND penblue = 1 AND ;
  4572.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4573.       m.lbxheight = (15/16) * 10000
  4574.       m.lbxwidth = -1
  4575.       m.lbxlinesbet = m.lbxheight / 5
  4576.       
  4577.    CASE name = '3 1/2" x 15/16" x 2' AND penblue = 1 AND ;
  4578.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 2 AND hpos = 0 AND HEIGHT = 2
  4579.       m.lbxheight = (15/16) * 10000
  4580.       m.lbxwidth = (3 + (1/2)) * 10000
  4581.       m.lbxlinesbet = m.lbxheight / 5
  4582.       
  4583.    CASE name = '3 1/2" x 15/16" x 3' AND penblue = 1 AND ;
  4584.          WIDTH = 35 AND m.lbxheight = 5 AND vpos = 3 AND hpos = 0 AND HEIGHT = 2
  4585.       m.lbxheight = (15/16) * 10000
  4586.       m.lbxwidth = (3 + (1/2)) * 10000
  4587.       m.lbxlinesbet = m.lbxheight / 5
  4588.       
  4589.    CASE name = '3 2/10" x 11/12" x 3 (Cheshire)' AND penblue = 1 AND ;
  4590.          WIDTH = 32 AND m.lbxheight = 5 AND vpos = 3 AND hpos = 0 AND HEIGHT = 2
  4591.       m.lbxheight = (11/12) * 10000
  4592.       m.lbxwidth = (3 + (2/10)) * 10000
  4593.       m.lbxlinesbet = m.lbxheight / 5
  4594.       
  4595.    CASE name = '3" x 5 Rolodex' AND penblue = 4 AND ;
  4596.          WIDTH = 50 AND m.lbxheight = 14 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4597.       m.lbxheight = 5 * 10000
  4598.       m.lbxwidth = -1
  4599.       m.lbxlinesbet = 4 * (m.lbxheight / 14)
  4600.       
  4601.    CASE name = '4" x 1 7/16" x 1' AND penblue = 1 AND ;
  4602.          WIDTH = 40 AND m.lbxheight = 8 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4603.       m.lbxheight = (1 + (7/16)) * 10000
  4604.       m.lbxwidth = -1
  4605.       m.lbxlinesbet = m.lbxheight / 8
  4606.       
  4607.    CASE name = '4" x 2 1/4 Rolodex' AND penblue = 1 AND ;
  4608.          WIDTH = 40 AND m.lbxheight = 10 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4609.       m.lbxheight = (2 + (1/4)) * 10000
  4610.       m.lbxwidth = -1
  4611.       m.lbxlinesbet = m.lbxheight / 10
  4612.       
  4613.    CASE name = '6 1/2" x 3 5/8 Envelope' AND penblue = 8 AND ;
  4614.          WIDTH = 65 AND m.lbxheight = 14 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4615.       m.lbxheight = (3 + (5/8)) * 10000
  4616.       m.lbxwidth = -1
  4617.       m.lbxlinesbet = 8 * (m.lbxheight / 14)
  4618.       
  4619.    CASE name = '9 7/8" x 7 1/8 Envelope' AND penblue = 8 AND ;
  4620.          WIDTH = 78 AND m.lbxheight = 17 AND vpos = 1 AND hpos = 0 AND HEIGHT = 0
  4621.       m.lbxheight = (7 + (1/8)) * 10000
  4622.       m.lbxwidth = -1
  4623.       m.lbxlinesbet = 8 * (m.lbxheight / 17)
  4624.       
  4625.    OTHERWISE
  4626.       m.lbxheight = m.lbxheight * m.g_rptlinesize
  4627.       m.lbxwidth = IIF(vpos > 1, WIDTH * m.g_rptcharsize, -1)
  4628.       m.lbxlinesbet = penblue * m.g_rptlinesize
  4629.    ENDCASE
  4630. ELSE
  4631.    RETURN
  4632. ENDIF
  4633.  
  4634. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  4635. IF FOUND()
  4636.    REPLACE vpos WITH IIF(vpos > 1, vpos * m.g_rptlinesize, 1)
  4637.    REPLACE WIDTH WITH m.lbxwidth
  4638.    REPLACE hpos WITH hpos * m.g_rptcharsize      && Left margin
  4639.    REPLACE HEIGHT WITH HEIGHT * m.g_rptcharsize   && Spaces Between Columns
  4640. ENDIF
  4641.  
  4642. LOCATE FOR platform = m.g_toplatform AND objtype = c_otband AND objcode = 4
  4643. IF FOUND()
  4644.    REPLACE HEIGHT WITH m.lbxheight + m.lbxlinesbet
  4645. ENDIF
  4646.  
  4647. *
  4648. * labelLines - Converts the character style label objects to graphical report objects
  4649. *
  4650. *!*****************************************************************************
  4651. *!
  4652. *!      Procedure: LABELLINES
  4653. *!
  4654. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4655. *!
  4656. *!          Calls: ADJFONT            (procedure in TRANSPRT.PRG)
  4657. *!               : ADJCOLOR           (procedure in TRANSPRT.PRG)
  4658. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4659. *!
  4660. *!*****************************************************************************
  4661. PROCEDURE labellines
  4662. PRIVATE m.bandstart, m.linecount, m.thermstep, m.lbxwidth, ;
  4663.    m.saverec, m.nextexpr, m.loop
  4664.  
  4665. COUNT TO m.thermstep FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4666. m.thermstep = 45 / m.thermstep
  4667. m.bandstart = 4166.667
  4668.  
  4669. LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  4670. IF WIDTH != -1
  4671.    m.lbxwidth = WIDTH
  4672. ELSE
  4673.    LOCATE FOR platform = m.g_fromplatform AND objtype = c_ot20label
  4674.    m.lbxwidth = WIDTH * m.g_rptcharsize
  4675. ENDIF
  4676.  
  4677. m.linecount = 0
  4678.  
  4679. SCAN FOR platform = m.g_toplatform AND objtype = c_ot20lbxobj AND !DELETED()
  4680.    REPLACE expr WITH ALLTRIM(expr)
  4681.    REPLACE objtype WITH c_otrepfld
  4682.    REPLACE objcode WITH 0
  4683.    REPLACE vpos WITH m.bandstart + (m.linecount * m.g_rptlinesize)
  4684.    REPLACE hpos WITH 0
  4685.    REPLACE HEIGHT WITH m.g_rptlinesize
  4686.    REPLACE WIDTH WITH m.lbxwidth
  4687.    REPLACE fillchar WITH "C"
  4688.    REPLACE FLOAT WITH .F.
  4689.    REPLACE STRETCH WITH .F.
  4690.    REPLACE spacing WITH 12
  4691.    REPLACE offset WITH 0
  4692.    REPLACE totaltype WITH 0
  4693.    REPLACE TOP WITH .T.
  4694.    REPLACE resettotal WITH 1
  4695.    REPLACE supalways WITH .T.
  4696.    REPLACE supovflow WITH .F.
  4697.    REPLACE suprpcol WITH 3
  4698.    REPLACE supgroup WITH 0
  4699.    REPLACE supvalchng WITH .F.
  4700.    
  4701.    DO adjfont
  4702.    DO adjcolor
  4703.    
  4704.    m.loop = (RIGHT(expr,1) = ";")
  4705.    DO WHILE m.loop
  4706.       m.saverec = RECNO()
  4707.       SKIP
  4708.       DO WHILE platform = m.g_toplatform AND objtype = c_ot20lbxobj AND DELETED()
  4709.          SKIP
  4710.       ENDDO
  4711.       IF platform = m.g_toplatform AND objtype = c_ot20lbxobj
  4712.          DELETE
  4713.          m.nextexpr = expr
  4714.          GOTO RECORD (m.saverec)
  4715.          REPLACE expr WITH expr + m.nextexpr
  4716.          REPLACE HEIGHT WITH HEIGHT + m.g_rptlinesize
  4717.          m.loop = (RIGHT(expr,1) = ";")
  4718.       ELSE
  4719.          GOTO RECORD (m.saverec)
  4720.          m.loop = .F.
  4721.       ENDIF
  4722.    ENDDO
  4723.    
  4724.    m.linecount = m.linecount + 1
  4725.    
  4726.    m.g_mercury = m.g_mercury + m.thermstep
  4727.    DO updtherm WITH m.g_mercury
  4728. ENDSCAN
  4729.  
  4730. *
  4731. * calcpositions - Calculate each objects position as a percentage across
  4732. *            and down the window.
  4733. *
  4734. *!*****************************************************************************
  4735. *!
  4736. *!      Procedure: CALCPOSITIONS
  4737. *!
  4738. *!      Called by: ALLOTHERS          (procedure in TRANSPRT.PRG)
  4739. *!
  4740. *!*****************************************************************************
  4741. PROCEDURE calcpositions
  4742. PARAMETER m.index
  4743. PRIVATE m.record, m.vert, m.horiz, m.width, m.numothers, m.thermstep, m.i
  4744. *
  4745. * Search for the original platform records and establish the horizontal
  4746. * and vertical positioning percentages.
  4747. *
  4748.  
  4749. objectpos[m.index, 1] = hpos / m.g_windwidth
  4750. objectpos[m.index, 2] = vpos / m.g_windheight
  4751. objectpos[m.index, 3] = uniqueid
  4752. objectpos[m.index, 4] = objtype
  4753. objectpos[m.index, 5] = .F.                && right aligned with object above or below?
  4754. objectpos[m.index, 6] = hpos
  4755. objectpos[m.index, 7] = WIDTH
  4756. objectpos[m.index, 8] = spacing
  4757. objectpos[m.index, 9] = PICTURE
  4758.  
  4759. IF objtype = c_ottext
  4760.    m.record = RECNO()
  4761.    m.vert1 = vpos
  4762.    m.horiz = hpos
  4763.    m.endpos = hpos + WIDTH
  4764.    
  4765.    LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4766.       m.vert1 - 1 = vpos AND hpos + WIDTH = m.endpos
  4767.    IF FOUND()
  4768.       objectpos[m.index,5] = .T.
  4769.       DO WHILE FOUND()
  4770.          IF objectpos[m.index, 7] < WIDTH
  4771.             objectpos[m.index, 7] = WIDTH
  4772.          ENDIF
  4773.          m.vert = vpos
  4774.          LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4775.             m.vert - 1 = vpos AND hpos + WIDTH = m.endpos
  4776.       ENDDO
  4777.    ENDIF
  4778.    LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4779.       m.vert1 + 1 = vpos AND hpos + WIDTH = m.endpos
  4780.    
  4781.    IF FOUND()
  4782.       objectpos[m.index,5] = .T.
  4783.       DO WHILE FOUND()
  4784.          IF objectpos[m.index, 7] < WIDTH
  4785.             objectpos[m.index, 7] = WIDTH
  4786.          ENDIF
  4787.          m.vert = vpos
  4788.          LOCATE FOR objtype = c_ottext AND hpos != m.horiz AND ;
  4789.             m.vert + 1 = vpos AND hpos + WIDTH = m.endpos
  4790.       ENDDO
  4791.    ENDIF
  4792.    
  4793.    GOTO RECORD m.record
  4794.    IF objectpos[m.index, 5]
  4795.       objectpos[m.index, 6] = hpos + WIDTH - 1
  4796.       objectpos[m.index, 1] = (hpos + WIDTH) / m.g_windwidth
  4797.    ENDIF
  4798.    
  4799. ENDIF
  4800.  
  4801. *
  4802. * calcwindowdimensions - Calculate the needed Height and Width for the new window
  4803. *
  4804. *!*****************************************************************************
  4805. *!
  4806. *!      Procedure: CALCWINDOWDIMENSIONS
  4807. *!
  4808. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  4809. *!
  4810. *!          Calls: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  4811. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  4812. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4813. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  4814. *!
  4815. *!        Indexes: UNIQUEID               (tag)
  4816. *!
  4817. *!*****************************************************************************
  4818. PROCEDURE calcwindowdimensions
  4819. PRIVATE m.i, m.curline, m.largestobj, m.lineheight, m.adjwindowwidth, m.thermstep
  4820.  
  4821. INDEX ON uniqueid + platform TAG uniqueid OF (m.g_tempindex) ADDITIVE
  4822.  
  4823. SELECT (m.g_fromobjonlyalias)
  4824. SET RELATION OFF INTO (m.g_scrnalias)
  4825. SET RELATION TO uniqueid+m.g_toplatform INTO (m.g_scrnalias) ADDITIVE
  4826. SELECT (m.g_scrnalias)
  4827.  
  4828. m.adjwindwidth = 0
  4829. DO findwiderobjects WITH m.adjwindwidth
  4830.  
  4831. =ASORT(objectpos,2)
  4832. STORE 0 TO m.curline, m.largestobj, m.lineheight, m.adjheight
  4833. m.thermstep = 10 / m.objindex
  4834.  
  4835. FOR m.i = 1 TO m.objindex
  4836.    
  4837.    IF objectpos[m.i,2] != m.curline
  4838.       m.adjheight = m.adjheight + m.lineheight
  4839.       STORE 0 TO m.lineheight, m.largestobj
  4840.       m.curline = objectpos[m.i,2]
  4841.    ENDIF
  4842.    
  4843.    IF m.largestobj != 3
  4844.       DO CASE
  4845.       CASE objectpos[m.i, 4] = c_ottxtbut AND m.largestobj < 3
  4846.          IF !horizbutton(objectpos[m.i, 9])
  4847.             m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4848.             m.lineheight = c_adjtbtn * m.numitems
  4849.          ELSE
  4850.             m.lineheight = c_adjtbtn
  4851.          ENDIF
  4852.          m.largestobj = 3
  4853.          
  4854.       CASE (objectpos[m.i, 4] = c_otradbut AND m.largestobj < 2) ;
  4855.             OR (objectpos[m.i, 4] = c_otchkbox AND m.largestobj < 2)
  4856.          IF objectpos[m.i, 4] = c_otradbut AND !horizbutton(objectpos[m.i, 9])
  4857.             m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4858.             m.lineheight = c_adjrbtn * m.numitems
  4859.          ELSE
  4860.             m.lineheight = c_adjrbtn
  4861.          ENDIF
  4862.          m.largestobj = 2
  4863.          
  4864.       CASE (objectpos[m.i, 4] = c_otlist AND m.largestobj < 1) ;
  4865.             OR (objectpos[m.i, 4] = c_otfield AND m.largestobj < 1)
  4866.          m.lineheight = c_adjlist
  4867.          m.largestobj = 1
  4868.          
  4869.       ENDCASE
  4870.    ENDIF
  4871.    m.g_mercury = m.g_mercury + m.thermstep
  4872.    DO updtherm WITH m.g_mercury
  4873.    
  4874. ENDFOR
  4875. m.adjheight = m.adjheight + m.lineheight
  4876. LOCATE FOR platform = m.g_toplatform AND objtype = 1
  4877. IF FOUND()
  4878.    REPLACE WIDTH WITH WIDTH + m.adjwindwidth
  4879.    DO repoobjects WITH HEIGHT + m.adjheight
  4880. ENDIF
  4881.  
  4882. RETURN
  4883.  
  4884. *
  4885. * findWiderObjects - Find objects which have changed in size
  4886. *
  4887. *!*****************************************************************************
  4888. *!
  4889. *!      Procedure: FINDWIDEROBJECTS
  4890. *!
  4891. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  4892. *!
  4893. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  4894. *!               : SGN()              (function  in TRANSPRT.PRG)
  4895. *!               : ADJHPOS            (procedure in TRANSPRT.PRG)
  4896. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  4897. *!
  4898. *!*****************************************************************************
  4899. PROCEDURE findwiderobjects
  4900. PARAMETER m.adjwindowwidth
  4901. PRIVATE m.curcol, m.adjcol, m.i, m.rightalignflag, m.numitems, ;
  4902.    m.olduniqueid, m.oldwidth, m.buttonflag, m.newwidth, m.adjust, m.thermstep
  4903.  
  4904. m.thermstep = 10 / m.objindex
  4905.  
  4906. =ASORT(objectpos,6)   && sort on hpos
  4907. STORE 0 TO m.curcol, m.adjcol
  4908. m.rightalignflag = .F.
  4909.  
  4910. FOR m.i = 1 TO m.objindex
  4911.    * Start at the leftmost object
  4912.    IF objectpos[m.i,6] != m.curcol
  4913.       m.adjcol = 0
  4914.       m.rightalignflag = .F.
  4915.       m.curcol = objectpos[m.i,6]
  4916.    ENDIF
  4917.    
  4918.    DO CASE
  4919.    CASE objectpos[m.i, 4] = c_ottxtbut OR objectpos[m.i, 4] = c_otradbut
  4920.       * Count the objects in push buttons and radio buttons
  4921.       m.numitems = OCCURS(';',objectpos[m.i, 9]) + 1
  4922.       m.olduniqueid = objectpos[m.i, 3]
  4923.       
  4924.       IF horizbutton(objectpos[m.i, 9])
  4925.          m.oldwidth = (objectpos[m.i, 7] * m.numitems) + ;
  4926.             (objectpos[m.i, 8] * (m.numitems - 1))
  4927.          m.buttonflag = .T.
  4928.       ELSE
  4929.          m.buttonflag = .F.
  4930.          m.oldwidth = objectpos[m.i, 7]
  4931.       ENDIF
  4932.       
  4933.    OTHERWISE
  4934.       m.buttonflag = .F.
  4935.       m.oldwidth = objectpos[m.i, 7]
  4936.       m.olduniqueid = objectpos[m.i, 3]
  4937.       
  4938.    ENDCASE
  4939.    
  4940.    LOCATE FOR uniqueid = m.olduniqueid AND platform = m.g_toplatform
  4941.    IF FOUND()
  4942.       IF m.buttonflag
  4943.          m.newwidth = (WIDTH * m.numitems) + ;
  4944.             (spacing * (m.numitems - 1))
  4945.       ELSE
  4946.          m.newwidth = WIDTH
  4947.       ENDIF
  4948.       IF m.oldwidth != m.newwidth AND ;
  4949.             !(objtype = c_ottext AND ASC(SUBSTR(expr,2,1))>=179 ;
  4950.             AND ASC(SUBSTR(expr,2,1))<=218)
  4951.          m.adjust = m.newwidth - m.oldwidth
  4952.          IF ABS(m.adjust) > ABS(m.adjcol) OR sgn(m.adjust) <> sgn(m.adjcol)
  4953.             IF (!objectpos[m.i,5] OR !m.rightalignflag) AND m.adjust > 0
  4954.                * Move everything over
  4955.                DO adjhpos WITH m.adjust - m.adjcol, ;
  4956.                   IIF(objectpos[m.i,5], objectpos[m.i, 6], ;
  4957.                   objectpos[m.i, 6] + objectpos[m.i, 7] - 1)
  4958.                
  4959.                * Expand the window
  4960.                m.adjwindowwidth = m.adjwindowwidth + m.adjust - m.adjcol
  4961.                
  4962.                * AdjCol contains the cumulative adjustment
  4963.                m.adjcol = m.adjust
  4964.                
  4965.                IF objectpos[m.i, 5]
  4966.                   m.rightalignflag = .T.
  4967.                   REPLACE hpos WITH hpos + m.adjust - m.adjcol
  4968.                ENDIF
  4969.             ENDIF
  4970.          ENDIF
  4971.       ENDIF
  4972.    ENDIF
  4973.    m.g_mercury = m.g_mercury + m.thermstep
  4974.    DO updtherm WITH m.g_mercury
  4975. ENDFOR
  4976.  
  4977. *
  4978. * adjHpos - Adjust the horizontal position of objects across as other objects
  4979. *       become bigger or smaller.
  4980. *
  4981. *!*****************************************************************************
  4982. *!
  4983. *!      Procedure: ADJHPOS
  4984. *!
  4985. *!      Called by: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  4986. *!
  4987. *!*****************************************************************************
  4988. PROCEDURE adjhpos
  4989. PARAMETER m.adjustment, m.position
  4990.  
  4991. SELECT (m.g_fromobjonlyalias)
  4992. SCAN FOR platform = m.g_fromplatform AND hpos >= m.position
  4993.    REPLACE &g_scrnalias..hpos WITH &g_scrnalias..hpos + m.adjustment
  4994. ENDSCAN
  4995.  
  4996. * Stretch lines that begin before the wider object and end after it starts.
  4997. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND HEIGHT = 1 AND ;
  4998.       hpos < m.position AND hpos + WIDTH - 1 >= m.position
  4999.    REPLACE &g_scrnalias..width WITH &g_scrnalias..width + m.adjustment
  5000. ENDSCAN
  5001. SELECT (m.g_scrnalias)
  5002.  
  5003. *!*****************************************************************************
  5004. *!
  5005. *!       Function: SGN
  5006. *!
  5007. *!      Called by: FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  5008. *!
  5009. *!*****************************************************************************
  5010. FUNCTION sgn
  5011. PARAMETER num
  5012. DO CASE
  5013. CASE num = 0
  5014.    RETURN 0
  5015. CASE num > 0
  5016.    RETURN 1
  5017. CASE num < 0
  5018.    RETURN -1
  5019. ENDCASE
  5020.  
  5021.  
  5022. *
  5023. * repoObjects - Reposition objects to the relative positions on the new window.
  5024. *      This procedure assumes that the array objectpos is sorted on rows ([m.i, 2]).
  5025. *
  5026. *!*****************************************************************************
  5027. *!
  5028. *!      Procedure: REPOOBJECTS
  5029. *!
  5030. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  5031. *!
  5032. *!          Calls: GETLASTOBJECTLINE()(function  in TRANSPRT.PRG)
  5033. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5034. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  5035. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  5036. *!
  5037. *!*****************************************************************************
  5038. PROCEDURE repoobjects
  5039. PARAMETER m.windheight
  5040. PRIVATE m.windwidth, m.thermstep, m.rightalign, m.saverec, ;
  5041.    m.adjust, m.buttonadjust, m.numrb
  5042.  
  5043. m.saverec = RECNO()
  5044. m.windwidth = WIDTH
  5045. m.thermstep = 10 / m.objindex
  5046. STORE 0 TO m.adjust, m.buttonadjust, m.numrb
  5047.  
  5048. FOR m.i = 1 TO m.objindex
  5049.    
  5050.    IF objectpos[m.i,2] != m.curline
  5051.       IF m.numrb > 0
  5052.          m.adjust = m.adjust + c_vradbtn
  5053.          m.numrb = m.numrb - 1
  5054.       ENDIF
  5055.       m.adjust = m.adjust + m.buttonadjust
  5056.       STORE 0 TO m.buttonadjust
  5057.       m.curline = objectpos[m.i,2]
  5058.    ENDIF
  5059.    
  5060.    LOCATE FOR platform = m.g_toplatform AND uniqueid = objectpos[m.i,3]
  5061.    IF FOUND()
  5062.       
  5063.       g_lastobjectline[1] = getlastobjectline(g_lastobjectline[1], ;
  5064.          m.windheight * objectpos[m.i, 2] + m.adjust)
  5065.       
  5066.       REPLACE vpos WITH m.windheight * objectpos[m.i, 2] + m.adjust
  5067.       
  5068.       IF objectpos[m.i,5]
  5069.          m.rightalign = (m.windwidth * objectpos[m.i,1]) - WIDTH
  5070.          REPLACE hpos WITH IIF(m.rightalign < 0, 0, m.rightalign)
  5071.       ENDIF
  5072.       
  5073.       DO CASE
  5074.       CASE objectpos[m.i,4] = c_otfield
  5075.          REPLACE hpos WITH hpos + c_adjfld
  5076.          
  5077.       CASE objectpos[m.i,4] = c_otlist
  5078.          REPLACE vpos WITH vpos + c_vlist
  5079.          REPLACE HEIGHT WITH HEIGHT - c_listht
  5080.          
  5081.       CASE objectpos[m.i,4] = c_ottxtbut
  5082.          IF horizbutton(objectpos[m.i, 9])
  5083.             m.buttonadjust = c_adjtbtn
  5084.          ENDIF
  5085.          
  5086.       CASE objectpos[m.i,4] = c_otradbut
  5087.          IF m.buttonadjust < c_adjrbtn
  5088.             m.buttonadjust = c_adjrbtn
  5089.          ENDIF
  5090.          REPLACE vpos WITH vpos - c_vradbtn
  5091.          
  5092.       CASE objectpos[m.i,4] = c_otchkbox
  5093.          REPLACE vpos WITH vpos - c_vchkbox
  5094.          
  5095.       CASE objectpos[m.i,4] = c_otpopup
  5096.          REPLACE vpos WITH MAX(vpos + c_vpopup,0)
  5097.          REPLACE hpos WITH MAX(hpos + c_hpopup,0)
  5098.          
  5099.       CASE objectpos[m.i,4] = c_otbox
  5100.          DO adjbox WITH m.adjust
  5101.       ENDCASE
  5102.       
  5103.    ENDIF
  5104.    m.g_mercury = m.g_mercury + m.thermstep
  5105.    DO updtherm WITH m.g_mercury
  5106. ENDFOR
  5107. GOTO RECORD m.saverec
  5108.  
  5109. *
  5110. * adjItemsInBoxes - Adjust the location of objects within boxes
  5111. *
  5112. *!*****************************************************************************
  5113. *!
  5114. *!      Procedure: ADJITEMSINBOXES
  5115. *!
  5116. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5117. *!
  5118. *!          Calls: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  5119. *!
  5120. *!*****************************************************************************
  5121. PROCEDURE adjitemsinboxes
  5122. PRIVATE m.subflag, m.emptybox, m.newlastline
  5123.  
  5124. DIMENSION boxdimension[4,2]
  5125. && 1 - Topmost
  5126. && 2 - Leftmost
  5127. && 3 - Bottommost
  5128. && 4 - Rightmost
  5129.  
  5130. SELECT (m.g_fromobjonlyalias)
  5131.  
  5132. SCAN FOR objtype = c_otbox AND HEIGHT != 1 AND WIDTH != 1
  5133.    STORE 999 TO boxdimension[1,1], boxdimension[2,1]
  5134.    STORE 0 TO boxdimension[3,1], boxdimension[4,1], boxdimension[4,2]
  5135.    STORE .F. TO m.subflag, m.emptybox, m.shrinkbox
  5136.    
  5137.    DO itemsinboxes WITH vpos, hpos, ;
  5138.       vpos + HEIGHT -1, hpos + WIDTH -1, m.emptybox, m.shrinkbox
  5139.    
  5140.    IF vpos + HEIGHT - 1 >= g_lastobjectline[1]
  5141.       m.newlastline = vpos + HEIGHT -1
  5142.       m.flag = .T.
  5143.       m.shrinkbox = .F.
  5144.    ELSE
  5145.       m.flag = .F.
  5146.    ENDIF
  5147.    
  5148.    boxdimension[1,1] = boxdimension[1,1] - vpos -.5
  5149.    boxdimension[2,1] = boxdimension[2,1] - hpos -.5
  5150.    boxdimension[3,1] = vpos + HEIGHT - 1 - boxdimension[3,1] - IIF(m.shrinkbox, .5 + c_vpopup, .5)
  5151.    boxdimension[4,1] = hpos + WIDTH - boxdimension[4,1] - 1.5
  5152.    
  5153.    SELECT (m.g_scrnalias)
  5154.    m.thisid = uniqueid
  5155.    LOCATE FOR uniqueid = m.thisid AND platform = m.g_toplatform
  5156.    IF FOUND() AND NOT m.emptybox
  5157.       REPLACE vpos WITH boxdimension[1,2] - boxdimension[1,1]
  5158.       REPLACE hpos WITH boxdimension[2,2] - boxdimension[2,1]
  5159.       REPLACE HEIGHT WITH boxdimension[3,2] - vpos + boxdimension[3,1]
  5160.       REPLACE WIDTH WITH boxdimension[4,2] - hpos + boxdimension[4,1]
  5161.       IF m.flag AND vpos + HEIGHT >= g_lastobjectline[2]
  5162.          g_lastobjectline[1] = m.newlastline
  5163.          g_lastobjectline[2] = vpos + HEIGHT
  5164.       ENDIF
  5165.    ENDIF
  5166.    
  5167.    SELECT (m.g_fromobjonlyalias)
  5168.    
  5169. ENDSCAN
  5170. SELECT (m.g_scrnalias)
  5171.  
  5172. *
  5173. * itemsInBoxes - Adjust objects which are within a box
  5174. *
  5175. *!*****************************************************************************
  5176. *!
  5177. *!      Procedure: ITEMSINBOXES
  5178. *!
  5179. *!      Called by: ADJITEMSINBOXES    (procedure in TRANSPRT.PRG)
  5180. *!
  5181. *!          Calls: FINDOTHERSONLINE() (function  in TRANSPRT.PRG)
  5182. *!               : WHATSTYLE()        (function  in TRANSPRT.PRG)
  5183. *!               : HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5184. *!               : GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  5185. *!
  5186. *!           Uses: M.G_FROMOBJONLYALIA
  5187. *!
  5188. *!*****************************************************************************
  5189. PROCEDURE itemsinboxes
  5190. PARAMETER m.top, m.left, m.bottom, m.right, m.emptybox, m.shrinkbox
  5191. PRIVATE m.rec, m.wasapopup, m.oldbottom, m.newbottom, m.twidth
  5192.  
  5193. m.rec = RECNO()
  5194. m.g_boxeditemsalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  5195.  
  5196. SELECT vpos, hpos, HEIGHT, WIDTH, uniqueid, spacing, objtype, PICTURE, platform ;
  5197.    FROM (m.g_fromobjonlyalias) ;
  5198.    WHERE (vpos > m.top AND vpos < m.bottom) ;
  5199.    AND (hpos > m.left AND hpos < m.right) AND ;
  5200.    objtype <> c_otbox AND !(LEN(expr)=3 AND ASC(SUBSTR(expr,2,1)) >= 179 AND ASC(SUBSTR(expr,2,1)) <= 218);
  5201.    INTO CURSOR (m.g_boxeditemsalias)
  5202.  
  5203. STORE 0 TO m.oldbottom, m.newbottom
  5204. IF _TALLY > 0
  5205.    SET RELATION TO uniqueid+m.g_toplatform INTO (m.g_scrnalias) ADDITIVE
  5206.    LOCATE FOR .T.
  5207.    m.wasapopup = .F.
  5208.    
  5209.    DO WHILE NOT EOF()
  5210.       IF vpos < boxdimension[1,1] OR (m.wasapopup AND vpos = boxdimension[1,1])
  5211.          boxdimension[1,1] = vpos
  5212.          boxdimension[1,2] = &g_scrnalias..vpos
  5213.          IF objtype = c_otpopup
  5214.             m.wasapopup = .T.
  5215.          ELSE
  5216.             m.wasapopup = .F.
  5217.          ENDIF
  5218.       ENDIF
  5219.       
  5220.       IF hpos < boxdimension[2,1]
  5221.          boxdimension[2,1]= hpos
  5222.          boxdimension[2,2] = &g_scrnalias..hpos
  5223.       ENDIF
  5224.       
  5225.       DO CASE
  5226.       CASE objtype = c_ottext OR objtype = c_otchkbox ;
  5227.             OR (objtype = c_otfield AND HEIGHT = 1)
  5228.          IF vpos > m.oldbottom
  5229.             m.shrinkbox = .F.
  5230.             IF !findothersonline(vpos, @m.newbottom, @m.oldbottom, objtype)
  5231.                m.oldbottom = vpos + HEIGHT
  5232.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5233.             ENDIF
  5234.          ENDIF
  5235.          
  5236.          * Check TXTWIDTH for text strings
  5237.          IF m.g_tographic AND objtype = c_ottext
  5238.             m.twidth = TXTWIDTH(&g_scrnalias..expr,g_fontface,g_fontsize,whatstyle(g_boldstyle))
  5239.          ELSE
  5240.             m.twidth = &g_scrnalias..width
  5241.          ENDIF
  5242.          
  5243.          IF &g_scrnalias..hpos + m.twidth > boxdimension[4,2]
  5244.             boxdimension[4,1] = hpos + WIDTH - 1
  5245.             boxdimension[4,2] = &g_scrnalias..hpos + m.twidth
  5246.          ENDIF
  5247.          
  5248.       CASE objtype = c_otradbut OR objtype = c_ottxtbut OR objtype = c_otinvbut
  5249.          m.numitems = OCCURS(';',PICTURE) + 1
  5250.          
  5251.          IF horizbutton(PICTURE)
  5252.             
  5253.             IF vpos > m.oldbottom
  5254.                m.shrinkbox = .F.
  5255.                IF findothersonline(vpos, @m.newbottom, @m.oldbottom, ;
  5256.                      objtype)
  5257.                   IF objtype = c_ottxtbut
  5258.                      REPLACE &g_scrnalias..vpos WITH &g_scrnalias..vpos - 0.312
  5259.                   ENDIF
  5260.                ENDIF
  5261.                m.oldbottom = vpos + HEIGHT - 1
  5262.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5263.             ENDIF
  5264.             
  5265.             IF (hpos -1 + (WIDTH +spacing) * m.numitems - spacing) >= ;
  5266.                   boxdimension[4,1]
  5267.                boxdimension[4,1] = hpos - 1 + ;
  5268.                   getobjwidth(objtype, ;
  5269.                   PICTURE, ;
  5270.                   WIDTH, ;
  5271.                   spacing, ;
  5272.                   m.g_toplatform)
  5273.                boxdimension[4,2] = &g_scrnalias..hpos + ;
  5274.                   getobjwidth(&g_scrnalias..objtype, ;
  5275.                   &g_scrnalias..picture, ;
  5276.                   &g_scrnalias..width, ;
  5277.                   &g_scrnalias..spacing, ;
  5278.                   m.g_toplatform)
  5279.             ENDIF
  5280.             
  5281.          ELSE
  5282.             m.shrinkbox = .F.
  5283.             IF (vpos -1 + m.numitems + (spacing * (m.numitems -1))) >= ;
  5284.                   m.oldbottom
  5285.                m.oldbottom = vpos -1 + m.numitems + ;
  5286.                   (spacing * (m.numitems -1)) - 1
  5287.                m.newbottom = &g_scrnalias..vpos  + m.numitems + ;
  5288.                   (&g_scrnalias..spacing * (m.numitems -1))
  5289.             ENDIF
  5290.             
  5291.             IF hpos -1 + WIDTH >= boxdimension[4,1]
  5292.                boxdimension[4,1] = hpos -1 + WIDTH
  5293.                boxdimension[4,2] = &g_scrnalias..hpos  + ;
  5294.                   &g_scrnalias..width
  5295.             ENDIF
  5296.          ENDIF
  5297.          
  5298.       CASE objtype = c_otpopup
  5299.          IF vpos + HEIGHT - 2 > m.oldbottom
  5300.             IF !findothersonline(vpos + 1, @m.newbottom, @m.oldbottom, objtype)
  5301.                m.oldbottom = vpos + HEIGHT - 2
  5302.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5303.             ENDIF
  5304.             m.shrinkbox = IIF(m.bottom -1 = vpos + HEIGHT -1, .T., .F.)
  5305.          ENDIF
  5306.          
  5307.          IF hpos + WIDTH - 1 > boxdimension[4,1])
  5308.             boxdimension[4,1] = hpos + WIDTH - 1
  5309.             boxdimension[4,2] = &g_scrnalias..hpos + &g_scrnalias..width
  5310.          ENDIF
  5311.          
  5312.       CASE objtype = c_otfield OR ;
  5313.             objtype = c_otlist OR objtype = c_otbox
  5314.          
  5315.          IF vpos + HEIGHT - 1 > m.oldbottom
  5316.             m.shrinkbox = .F.
  5317.             IF !findothersonline(vpos, @m.newbottom, @m.oldbottom, objtype)
  5318.                m.oldbottom = vpos + HEIGHT - 1
  5319.                m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5320.             ENDIF
  5321.          ENDIF
  5322.          
  5323.          IF hpos + WIDTH - 1 > boxdimension[4,1])
  5324.             boxdimension[4,1] = hpos + WIDTH - 1
  5325.             boxdimension[4,2] = &g_scrnalias..hpos + &g_scrnalias..width
  5326.          ENDIF
  5327.          
  5328.       ENDCASE
  5329.       SKIP
  5330.    ENDDO
  5331.    
  5332.    m.emptybox = .F.
  5333.    boxdimension[3,1] = m.oldbottom
  5334.    boxdimension[3,2] = m.newbottom
  5335. ELSE
  5336.    m.emptybox = .T.
  5337. ENDIF
  5338.  
  5339. USE
  5340. SELECT (m.g_fromobjonlyalias)
  5341. GOTO RECORD m.rec
  5342.  
  5343. *
  5344. * findOthersOnLine - Find any other objects in the box and on the line with a text button
  5345. *
  5346. *!*****************************************************************************
  5347. *!
  5348. *!       Function: FINDOTHERSONLINE
  5349. *!
  5350. *!      Called by: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  5351. *!
  5352. *!*****************************************************************************
  5353. FUNCTION findothersonline
  5354. PARAMETER m.lineno, m.newbottom, m.oldbottom, m.curtype
  5355. PRIVATE m.saverec, m.prevtype, m.flag
  5356.  
  5357. m.prevtype = 0
  5358. m.flag = .F.
  5359. m.saverec = RECNO()
  5360. LOCATE FOR (objtype != c_otpopup AND vpos = m.lineno) OR ;
  5361.    (m.curtype != c_otpopup AND objtype = c_otpopup AND m.lineno = vpos + 1)
  5362.  
  5363. IF !FOUND()
  5364.    GOTO RECORD (m.saverec)
  5365.    RETURN m.flag
  5366. ENDIF
  5367.  
  5368. DO WHILE FOUND()
  5369.    DO CASE
  5370.    CASE objtype = c_ottxtbut
  5371.       IF m.curtype != objtype
  5372.          m.flag = .T.
  5373.          m.oldbottom = vpos + HEIGHT -1
  5374.          m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5375.          GOTO RECORD (m.saverec)
  5376.          RETURN m.flag
  5377.       ENDIF
  5378.       
  5379.    CASE objtype = c_otpopup
  5380.       m.flag = .T.
  5381.       m.oldbottom = vpos + HEIGHT - 2
  5382.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5383.       m.prevtype = c_otpopup
  5384.       
  5385.    CASE (objtype = c_otfield OR objtype = c_otlist OR objtype = c_otline) AND ;
  5386.          (m.prevtype != c_otpopup)
  5387.       m.flag = .T.
  5388.       m.oldbottom = vpos + HEIGHT - 1
  5389.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5390.       m.prevtype = objtype
  5391.       
  5392.    OTHERWISE
  5393.       m.flag = .T.
  5394.       m.oldbottom = vpos
  5395.       m.newbottom = &g_scrnalias..vpos + &g_scrnalias..height
  5396.       
  5397.    ENDCASE
  5398.    
  5399.    CONTINUE
  5400. ENDDO
  5401. GOTO RECORD (m.saverec)
  5402. RETURN m.flag
  5403.  
  5404. *
  5405. * StretchLinesToBorders - This procedure makes sure that any lines which stretched to the
  5406. *      edge of the from platform window will stretch to the edge of the to platform window.
  5407. *
  5408. *!*****************************************************************************
  5409. *!
  5410. *!      Procedure: ADJINVBTNS
  5411. *!
  5412. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5413. *!
  5414. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  5415. *!               : ADJPOSTINV         (procedure in TRANSPRT.PRG)
  5416. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  5417. *!
  5418. *!*****************************************************************************
  5419. PROCEDURE adjinvbtns
  5420. PRIVATE m.saverec, m.loop, m.horizontal, m.btnid, m.objid, m.flag, m.thermstep, m.leftmost, ;
  5421.    m.label, m.btnvpos, m.btnhpos, m.btnwidth, m.btnheight, m.btnspacing, m.btncount, ;
  5422.    m.ybtn, m.vbtn, m.xbtn, m.hbtn, m.defwidth, m.defwidthindex, m.defheight, m.defheightindex, ;
  5423.    m.topmargin, m.bottommargin, m.leftmargin, m.rightmargin, m.adjustment, m.totadjust, m.newhpos
  5424.  
  5425. m.saverec = RECNO()
  5426. m.totadjust = 0
  5427. m.leftmost = 0
  5428.  
  5429. COUNT TO m.thermstep FOR platform = m.g_fromplatform AND objtype = c_otinvbut
  5430. m.thermstep = 5/m.thermstep
  5431.  
  5432. SCAN FOR platform = m.g_fromplatform AND objtype = c_otinvbut
  5433.    m.horizontal = horizbutton(PICTURE)
  5434.    m.btnvpos = vpos
  5435.    m.btnhpos = hpos
  5436.    m.btnheight = HEIGHT
  5437.    m.btnwidth = WIDTH
  5438.    m.btnspacing = spacing
  5439.    m.btncount = OCCURS(";", PICTURE) + 1
  5440.    m.btnid = uniqueid
  5441.    
  5442.    STORE 0 TO m.defwidth, m.defwidthindex, m.defheight, m.defheightindex
  5443.    
  5444.    * This array is used to keep track of the rectangle which bounds the objects which
  5445.    * lie on top of each invisible button in the set.
  5446.    *
  5447.    *   sizes[x,1] = Minimum row on the FROM platform.
  5448.    *   sizes[x,2] = Minimum colum on the FROM platform.
  5449.    *   sizes[x,3] = Maximum row on the FROM platform.
  5450.    *   sizes[x,4] = Maximum colum on the FROM platform.
  5451.    *   sizes[x,5] = Minimum row on the TO platform.
  5452.    *   sizes[x,6] = Minimum colum on the TO platform.
  5453.    *   sizes[x,7] = Maximum row on the TO platform.
  5454.    *   sizes[x,8] = Maximum colum on the TO platform.
  5455.    *   sizes[x,9] = Comma delimeted list of uniqueid's for objects positioned on
  5456.    *               the button face.
  5457.    DIMENSION sizes[m.btnCount,9]
  5458.    
  5459.    FOR m.loop = 1 TO m.btncount
  5460.       m.ybtn = IIF(m.horizontal, m.btnvpos, m.btnvpos + ((m.loop-1) * m.btnheight) + ((m.loop-1) * m.btnspacing))
  5461.       m.vbtn = m.ybtn + m.btnheight
  5462.       m.xbtn = IIF(m.horizontal, m.btnhpos + ((m.loop-1) * m.btnwidth) + ((m.loop-1) * m.btnspacing), m.btnhpos)
  5463.       m.hbtn = m.xbtn + m.btnwidth
  5464.       
  5465.       STORE 0 TO sizes[m.loop,3], sizes[m.loop,4], sizes[m.loop,7], sizes[m.loop,8]
  5466.       STORE 99999999 TO sizes[m.loop,1], sizes[m.loop,2], sizes[m.loop,5], sizes[m.loop,6]
  5467.       
  5468.       sizes[m.loop,9] = ""
  5469.       
  5470.       SCAN FOR platform = m.g_fromplatform AND (objtype = c_ottext OR objtype = c_otfield  OR ;
  5471.             objtype = c_otbox OR objtype = c_otline) AND ;
  5472.             vpos >= m.ybtn AND vpos+HEIGHT <= m.vbtn AND hpos >= m.xbtn AND hpos+WIDTH <= m.hbtn
  5473.          m.objid = uniqueid
  5474.          sizes[m.loop,1] = MIN(sizes[m.loop,1], vpos)
  5475.          sizes[m.loop,2] = MIN(sizes[m.loop,2], hpos)
  5476.          sizes[m.loop,3] = MAX(sizes[m.loop,3], vpos+HEIGHT)
  5477.          sizes[m.loop,4] = MAX(sizes[m.loop,4], hpos+WIDTH)
  5478.          sizes[m.loop,9] = sizes[m.loop,9] + ;
  5479.             IIF(LEN(sizes[m.loop,9]) = 0, uniqueid, ","+uniqueid)
  5480.          
  5481.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5482.          IF FOUND()
  5483.             sizes[m.loop,5] = MIN(sizes[m.loop,5], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5484.                vpos-c_adjbox, vpos))
  5485.             sizes[m.loop,6] = MIN(sizes[m.loop,6], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5486.                hpos-c_adjbox, hpos))
  5487.             sizes[m.loop,7] = MAX(sizes[m.loop,7], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5488.                vpos+HEIGHT+c_adjbox, vpos+HEIGHT))
  5489.             sizes[m.loop,8] = MAX(sizes[m.loop,8], IIF(objtype = c_otbox OR objtype = c_otline, ;
  5490.                hpos+WIDTH+c_adjbox, hpos+WIDTH))
  5491.          ENDIF
  5492.          
  5493.          LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.objid
  5494.       ENDSCAN
  5495.       
  5496.       * The tallest button region will define where the button set gets
  5497.       * placed so we want to remember which region that was.
  5498.       IF (sizes[m.loop,7] - sizes[m.loop,5]) > m.defheight
  5499.          m.defheight      = sizes[m.loop,7] - sizes[m.loop,5]
  5500.          m.defheightindex = m.loop
  5501.          m.topmargin      = sizes[m.loop,1] - m.ybtn
  5502.          m.bottommargin   = m.vbtn - sizes[m.loop,3]
  5503.       ENDIF
  5504.       
  5505.       * The widest button region will define where the button set gets
  5506.       * placed so we want to remember which region that was.
  5507.       IF (sizes[m.loop,8] - sizes[m.loop,6]) > m.defwidth
  5508.          m.defwidth      = sizes[m.loop,8] - sizes[m.loop,6]
  5509.          m.defwidthindex = m.loop
  5510.          m.leftmargin    = sizes[m.loop,2] - m.xbtn
  5511.          m.rightmargin   = m.hbtn - sizes[m.loop,4]
  5512.       ENDIF
  5513.    ENDFOR
  5514.    
  5515.    IF m.defheightindex != 0 AND m.defwidthindex != 0
  5516.       LOCATE FOR platform = m.g_toplatform AND uniqueid = m.btnid
  5517.       IF FOUND()
  5518.          IF m.horizontal
  5519.             REPLACE vpos WITH sizes[m.defHeightIndex,5] - m.topmargin
  5520.          ELSE
  5521.             REPLACE hpos WITH sizes[m.defWidthIndex,6] - m.leftmargin
  5522.          ENDIF
  5523.          
  5524.          REPLACE HEIGHT WITH (sizes[m.defHeightIndex,7] - sizes[m.defHeightIndex,5]) + m.topmargin + m.bottommargin
  5525.          REPLACE WIDTH WITH (sizes[m.defWidthIndex,8] - sizes[m.defWidthIndex,6]) + m.leftmargin + m.rightmargin
  5526.       ENDIF
  5527.       
  5528.       IF m.horizontal AND WIDTH > m.btnwidth
  5529.          m.adjustment = WIDTH - m.btnwidth
  5530.          IF spacing > 1
  5531.             IF m.adjustment <= spacing-1
  5532.                REPLACE spacing WITH spacing - m.adjustment
  5533.             ELSE
  5534.                m.adjustment = m.adjustment - (spacing-1)
  5535.                REPLACE spacing WITH 1
  5536.                m.leftmost = MAX(m.leftmost, hpos + (m.btncount*WIDTH) + ((m.btncount-1)*spacing))
  5537.                
  5538.                m.totadjust = MAX(m.totadjust, m.btncount * m.adjustment)
  5539.                
  5540.                DO adjpostinv WITH vpos, vpos+HEIGHT, ;
  5541.                   m.btnhpos + (m.btncount*m.btnwidth) + ((m.btncount-1)*m.btnspacing), ;
  5542.                   m.btncount * m.adjustment
  5543.                
  5544.                FOR m.loop = 2 TO m.btncount
  5545.                   DO WHILE LEN(sizes[m.loop,9]) > 0
  5546.                      IF AT(",", sizes[m.loop,9]) != 0
  5547.                         m.label = LEFT(sizes[m.loop,9], AT(",", sizes[m.loop,9])-1)
  5548.                         sizes[m.loop,9] = SUBSTR(sizes[m.loop,9], AT(",", sizes[m.loop,9])+1)
  5549.                      ELSE
  5550.                         m.label = sizes[m.loop,9]
  5551.                         sizes[m.loop,9] = ""
  5552.                      ENDIF
  5553.                      
  5554.                      LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.label
  5555.                      IF FOUND()
  5556.                         m.newhpos = hpos + (m.adjustment * (m.loop-1))
  5557.                         LOCATE FOR platform = m.g_toplatform AND uniqueid = m.label
  5558.                         IF FOUND()
  5559.                            REPLACE hpos WITH IIF(objtype = c_otbox OR objtype = c_otline, ;
  5560.                               m.newhpos+c_adjbox, m.newhpos)
  5561.                         ENDIF
  5562.                      ENDIF
  5563.                   ENDDO
  5564.                ENDFOR
  5565.             ENDIF
  5566.          ENDIF
  5567.       ENDIF
  5568.    ENDIF
  5569.    
  5570.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  5571.    IF FOUND()
  5572.       IF m.totadjust > 0
  5573.          REPLACE WIDTH WITH WIDTH + m.totadjust
  5574.       ENDIF
  5575.       
  5576.       IF WIDTH < m.leftmost
  5577.          REPLACE WIDTH WITH m.leftmost + 1
  5578.       ENDIF
  5579.    ENDIF
  5580.    
  5581.    
  5582.    m.g_mercury = m.g_mercury + m.thermstep
  5583.    DO updtherm WITH m.g_mercury
  5584.    
  5585.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.btnid
  5586. ENDSCAN
  5587.  
  5588. IF m.saverec <= RECCOUNT()
  5589.    GOTO RECORD (m.saverec)
  5590. ELSE
  5591.    LOCATE FOR .F.
  5592. ENDIF
  5593.  
  5594. *
  5595. * adjPostInv - This procedure moves objects which lie to the right of a set of horizontal
  5596. *      invisible buttons so that they won't overlap.
  5597. *
  5598. *!*****************************************************************************
  5599. *!
  5600. *!      Procedure: ADJPOSTINV
  5601. *!
  5602. *!      Called by: ADJINVBTNS         (procedure in TRANSPRT.PRG)
  5603. *!
  5604. *!          Calls: FINDALIGNEND()     (function  in TRANSPRT.PRG)
  5605. *!
  5606. *!*****************************************************************************
  5607. PROCEDURE adjpostinv
  5608. PARAMETER m.ystart, m.yend, m.xstart, m.adjustment
  5609. PRIVATE m.saverec, m.saveid
  5610.  
  5611. m.saverec = RECNO()
  5612.  
  5613. m.ystart = findalignend(m.ystart, m.xstart, -1)
  5614. m.yend = findalignend(m.yend, m.xstart, 1)
  5615.  
  5616. SCAN FOR platform = m.g_fromplatform AND hpos >= m.xstart AND vpos >= m.ystart AND vpos <= m.yend AND ;
  5617.       (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5618.       objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5619.       objtype = c_otinvbut)
  5620.    m.saveid = uniqueid
  5621.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.saveid
  5622.    IF FOUND()
  5623.       REPLACE hpos WITH hpos + m.adjustment
  5624.    ENDIF
  5625.    
  5626.    LOCATE FOR platform = m.g_fromplatform AND uniqueid = m.saveid
  5627. ENDSCAN
  5628.  
  5629. IF m.saverec <= RECCOUNT()
  5630.    GOTO RECORD m.saverec
  5631. ELSE
  5632.    LOCATE FOR .F.
  5633. ENDIF
  5634.  
  5635. *
  5636. * FindAlignEnd - Given a position to start with and a direction, this routine looks for the
  5637. *      last line where right aligned objects extend to from the starting position.
  5638. *
  5639. *!*****************************************************************************
  5640. *!
  5641. *!       Function: FINDALIGNEND
  5642. *!
  5643. *!      Called by: ADJPOSTINV         (procedure in TRANSPRT.PRG)
  5644. *!
  5645. *!*****************************************************************************
  5646. FUNCTION findalignend
  5647. PARAMETER m.ystart, m.xstart, m.increment
  5648. PRIVATE m.saverec, m.ytemp, m.xtemp, m.result
  5649.  
  5650. m.result = m.ystart
  5651.  
  5652. SCAN FOR platform = m.g_fromplatform AND hpos >= m.xstart AND vpos = m.ystart
  5653.    m.saverec = RECNO()
  5654.    
  5655.    m.ytemp = vpos + m.increment
  5656.    m.xtemp = hpos
  5657.    LOCATE FOR platform = m.g_fromplatform AND vpos = m.ytemp AND hpos = m.xtemp AND ;
  5658.       (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5659.       objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5660.       objtype = c_otinvbut)
  5661.    DO WHILE FOUND()
  5662.       m.result = IIF(m.increment < 0, MIN(m.result, m.ytemp), MAX(m.result, m.ytemp))
  5663.       m.ytemp = m.ytemp + m.increment
  5664.       LOCATE FOR platform = m.g_fromplatform AND vpos = m.ytemp AND hpos = m.xtemp AND ;
  5665.          (objtype = c_ottext   OR objtype = c_otline   OR objtype = c_otbox   OR objtype = c_list OR ;
  5666.          objtype = c_otradbut OR objtype = c_otchkbox OR objtype = c_otfield OR objtype = c_popup OR ;
  5667.          objtype = c_otinvbut)
  5668.    ENDDO
  5669.    GOTO RECORD m.saverec
  5670. ENDSCAN
  5671.  
  5672. RETURN m.result
  5673.  
  5674. *
  5675. * StretchLinesToBorders - This procedure makes sure that any lines which stretched to the
  5676. *      edge of the from platform window will stretch to the edge of the to platform window.
  5677. *
  5678. *!*****************************************************************************
  5679. *!
  5680. *!      Procedure: STRETCHLINESTOBORDERS
  5681. *!
  5682. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5683. *!
  5684. *!*****************************************************************************
  5685. PROCEDURE stretchlinestoborders
  5686. PRIVATE m.saverec, m.objid, m.objrec, m.objwidth, m.fromheight, m.fromwidth
  5687.  
  5688. IF m.g_filetype = c_report OR m.g_filetype = c_label
  5689.    RETURN
  5690. ENDIF
  5691.  
  5692. m.saverec = RECNO()
  5693.  
  5694. LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  5695. IF FOUND()
  5696.    IF BORDER = 0 OR STYLE = 0
  5697.       m.fromheight = HEIGHT
  5698.       m.fromwidth = WIDTH
  5699.    ELSE
  5700.       m.fromheight = HEIGHT - 2
  5701.       m.fromwidth = WIDTH - 2
  5702.    ENDIF
  5703.    
  5704.    SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND ;
  5705.          ((WIDTH = 1 AND vpos+HEIGHT = m.fromheight) OR (HEIGHT = 1 AND hpos+WIDTH = m.fromwidth))
  5706.       
  5707.       m.objrec = RECNO()
  5708.       m.objid = uniqueid
  5709.       m.objwidth = WIDTH
  5710.       LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  5711.       IF FOUND()
  5712.          m.toheight = HEIGHT
  5713.          m.towidth = WIDTH
  5714.          
  5715.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5716.          IF FOUND()
  5717.             IF m.objwidth = 1
  5718.                REPLACE HEIGHT WITH m.toheight-vpos
  5719.             ELSE
  5720.                REPLACE WIDTH WITH m.towidth-hpos
  5721.             ENDIF
  5722.          ENDIF
  5723.       ENDIF
  5724.       
  5725.       GOTO RECORD m.objrec
  5726.    ENDSCAN
  5727. ENDIF
  5728.  
  5729. IF m.saverec > RECCOUNT()
  5730.    LOCATE FOR .F.
  5731. ELSE
  5732.    GOTO RECORD m.saverec
  5733. ENDIF
  5734. RETURN
  5735.  
  5736. *
  5737. * JoinLines -This procedure examines each line to see where it meets other lines in the
  5738. *      from platform and constructs an array of these positons.  This array can then
  5739. *      be used to make the lines/boxes meet in the from platform.
  5740. *
  5741. *!*****************************************************************************
  5742. *!
  5743. *!      Procedure: JOINLINES
  5744. *!
  5745. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  5746. *!
  5747. *!          Calls: UPDTHERM           (procedure in TRANSPRT.PRG)
  5748. *!               : JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  5749. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  5750. *!               : MEETBOXCHAR        (procedure in TRANSPRT.PRG)
  5751. *!               : ZAPBOXCHAR         (procedure in TRANSPRT.PRG)
  5752. *!               : REJOINBOXES        (procedure in TRANSPRT.PRG)
  5753. *!
  5754. *!*****************************************************************************
  5755. PROCEDURE joinlines
  5756. PRIVATE m.saverec, m.joincount, m.linerec, m.lineid, m.i, m.thermstep, ;
  5757.    m.objvpos, m.objhpos, m.objright, m.objbottom, m.objid, m.objrec, m.objcode, ;
  5758.    m.fromvpos, m.fromhpos, m.fromheight, m.fromwidth, m.fromend, m.fromcode, ;
  5759.    m.tovpos, m.tohpos, m.toheight, m.towidth, ;
  5760.    m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5761.  
  5762. DIMENSION joins[1,5]
  5763. && Joins[X,2] - toVpos
  5764. && Joins[X,3] - toHpos
  5765. && Joins[X,4] - Vpos match level
  5766. && Joins[X,5] - Hpos match level
  5767. m.joincount = 0
  5768. m.saverec = RECNO()
  5769.  
  5770. COUNT TO m.thermstep FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH=1 OR HEIGHT=1)
  5771. IF m.thermstep <> 0
  5772.    m.thermstep = 10 / m.thermstep
  5773. ELSE
  5774.    m.g_mercury = m.g_mercury + 10
  5775.    DO updtherm WITH m.g_mercury
  5776. ENDIF
  5777.  
  5778. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH=1 OR HEIGHT=1)
  5779.    m.fromvpos = vpos
  5780.    m.fromhpos = hpos
  5781.    m.fromheight = HEIGHT
  5782.    m.fromwidth = WIDTH
  5783.    m.fromcode = objcode
  5784.    m.lineid = uniqueid
  5785.    m.linerec = RECNO()
  5786.    
  5787.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.lineid
  5788.    IF FOUND()
  5789.       m.tovpos = vpos
  5790.       m.tohpos = hpos
  5791.       m.toheight = HEIGHT
  5792.       m.towidth = WIDTH
  5793.       
  5794.       SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.lineid
  5795.          IF m.fromheight = 1 AND HEIGHT <> 1 AND (m.fromvpos >= vpos AND m.fromvpos <= vpos+HEIGHT-1)
  5796.             m.fromend = m.fromhpos + m.fromwidth - 1
  5797.             
  5798.             ** Horizontal line which starts on a vertical line/box side.
  5799.             IF m.fromhpos = hpos OR m.fromhpos = hpos+WIDTH-1
  5800.                DO joinhorizontal WITH m.fromvpos, m.fromhpos, m.fromhpos, m.tovpos, m.toheight, m.fromcode
  5801.             ENDIF
  5802.             
  5803.             ** Horizontal line which ends on a vertical line/box side.
  5804.             IF m.fromend = hpos OR m.fromend = hpos+WIDTH-1
  5805.                DO joinhorizontal WITH m.fromvpos, m.fromend, m.fromend, m.tovpos, m.toheight, m.fromcode
  5806.             ENDIF
  5807.             
  5808.             ** Horizontal line which starts one to the right of a vertical line/box side
  5809.             IF m.fromhpos-1 = hpos OR m.fromhpos = hpos+WIDTH
  5810.                DO joinhorizontal WITH m.fromvpos, m.fromhpos-1, m.fromhpos, m.tovpos, m.toheight, m.fromcode
  5811.             ENDIF
  5812.             
  5813.             ** Horizontal line which ends one left of a vertical line/box side
  5814.             IF m.fromend+1 = hpos OR  m.fromend = hpos+WIDTH-2
  5815.                DO joinhorizontal WITH m.fromvpos, m.fromend+1, m.fromend, m.tovpos, m.toheight, m.fromcode
  5816.             ENDIF
  5817.          ENDIF
  5818.          
  5819.          IF m.fromwidth = 1 AND WIDTH <> 1 AND (m.fromhpos >= hpos AND m.fromhpos <= hpos+WIDTH-1)
  5820.             m.fromend = m.fromvpos + m.fromheight - 1
  5821.             
  5822.             ** Vertical line which starts on a horizontical line/box side.
  5823.             IF m.fromvpos = vpos OR m.fromvpos = vpos+HEIGHT-1
  5824.                DO joinvertical WITH m.fromvpos, m.fromvpos, m.fromhpos, m.tohpos, m.fromcode
  5825.             ENDIF
  5826.             
  5827.             ** Vertical line which ends on a horizontical line/box side.
  5828.             IF m.fromend = vpos OR m.fromend = vpos+HEIGHT-1
  5829.                DO joinvertical WITH m.fromend, m.fromend, m.fromhpos, m.tohpos, m.fromcode
  5830.             ENDIF
  5831.             
  5832.             ** Vertical line which starts one below a horizontal line/box side
  5833.             IF m.fromvpos-1 = vpos OR m.fromvpos = vpos+HEIGHT
  5834.                DO joinvertical WITH m.fromvpos-1, m.fromvpos, m.fromhpos, m.tohpos, m.fromcode
  5835.             ENDIF
  5836.             
  5837.             ** Vertical line which ends one above a horizontal line/box side
  5838.             IF m.fromend+1 = vpos OR m.fromend = vpos+HEIGHT-2
  5839.                DO joinvertical WITH m.fromend+1, m.fromend, m.fromhpos, m.tohpos, m.fromcode
  5840.             ENDIF
  5841.          ENDIF
  5842.       ENDSCAN
  5843.    ENDIF
  5844.    
  5845.    m.g_mercury = m.g_mercury + m.thermstep
  5846.    DO updtherm WITH m.g_mercury
  5847.    
  5848.    GOTO RECORD m.linerec
  5849. ENDSCAN
  5850.  
  5851. DO meetboxchar
  5852. DO zapboxchar
  5853.  
  5854. m.thermstep = 10/m.joincount
  5855. FOR m.i = 1 TO m.joincount
  5856.    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]
  5857.    
  5858.    m.g_mercury = m.g_mercury + m.thermstep
  5859.    DO updtherm WITH m.g_mercury
  5860. ENDFOR
  5861.  
  5862. IF m.saverec > RECCOUNT()
  5863.    LOCATE FOR .F.
  5864. ELSE
  5865.    GOTO RECORD m.saverec
  5866. ENDIF
  5867. RETURN
  5868.  
  5869. *
  5870. * joinHorizontal - This procedure adds a join for a horizontal line which has been determined to
  5871. *               intersect something vertical.
  5872. *
  5873. *!*****************************************************************************
  5874. *!
  5875. *!      Procedure: JOINHORIZONTAL
  5876. *!
  5877. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  5878. *!
  5879. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  5880. *!               : ADDJOIN            (procedure in TRANSPRT.PRG)
  5881. *!
  5882. *!*****************************************************************************
  5883. PROCEDURE joinhorizontal
  5884. PARAMETER m.fromvpos, m.oldhpos1, m.oldhpos2, m.tovpos, m.tothickness, m.fromcode
  5885. PRIVATE m.objvpos, m.objhpos, m.objright, m.objbottom, m.objcode, m.objid, m.objrec
  5886.  
  5887. m.objvpos = vpos
  5888. m.objhpos = hpos
  5889. m.objright = hpos + WIDTH - 1
  5890. m.objbottom = vpos + HEIGHT - 1
  5891. m.objcode = objcode
  5892. m.objid = uniqueid
  5893. m.objrec = RECNO()
  5894.  
  5895. LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5896. IF FOUND()
  5897.    DO CASE
  5898.    CASE m.fromvpos = m.objvpos OR m.fromvpos = m.objbottom
  5899.       IF objtype = c_otline
  5900.          m.joinvpos = m.tovpos - c_adjbox + (m.tothickness/2)
  5901.          STORE 2 TO m.vlevel, m.hlevel
  5902.       ELSE
  5903.          IF m.fromvpos = m.objvpos
  5904.             m.joinvpos = vpos - c_adjbox + (getlinewidth(m.objcode, .T.)/2)
  5905.          ELSE
  5906.             m.joinvpos = vpos+HEIGHT - c_adjbox - (getlinewidth(m.objcode, .T.)/2)
  5907.          ENDIF
  5908.          STORE 4 TO m.vlevel, m.hlevel
  5909.       ENDIF
  5910.       
  5911.    OTHERWISE
  5912.       m.joinvpos = m.tovpos - c_adjbox + (getlinewidth(m.fromcode, .T.)/2)
  5913.       m.vlevel = 0
  5914.       m.hlevel = IIF(objtype = c_otline, 1, 3)
  5915.    ENDCASE
  5916.    
  5917.    IF m.oldhpos1 = m.objhpos OR objtype = c_otline
  5918.       m.joinhpos = hpos - c_adjbox + (getlinewidth(m.objcode, .F.)/2)
  5919.    ELSE
  5920.       m.joinhpos = hpos+WIDTH - c_adjbox - (getlinewidth(m.objcode, .F.)/2)
  5921.    ENDIF
  5922.    
  5923.    DO addjoin WITH m.fromvpos, m.oldhpos1, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5924.    IF m.oldhpos1 <> m.oldhpos2
  5925.       DO addjoin WITH m.fromvpos, m.oldhpos2, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5926.    ENDIF
  5927. ENDIF
  5928.  
  5929. GOTO RECORD m.objrec
  5930. RETURN
  5931.  
  5932. *
  5933. * joinVertical - This procedure adds a join for a vertical line which has been determined to
  5934. *               intersect something horizontal.
  5935. *
  5936. *!*****************************************************************************
  5937. *!
  5938. *!      Procedure: JOINVERTICAL
  5939. *!
  5940. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  5941. *!
  5942. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  5943. *!               : ADDJOIN            (procedure in TRANSPRT.PRG)
  5944. *!
  5945. *!*****************************************************************************
  5946. PROCEDURE joinvertical
  5947. PARAMETER m.oldvpos1, m.oldvpos2, m.fromhpos, m.tohpos, m.fromcode
  5948. PRIVATE m.objvpos, m.objhpos, m.objright, m.objbottom, m.objcode, m.objid, m.objrec
  5949.  
  5950. m.objvpos = vpos
  5951. m.objhpos = hpos
  5952. m.objright = hpos + WIDTH - 1
  5953. m.objbottom = vpos + HEIGHT - 1
  5954. m.objcode = objcode
  5955. m.objid = uniqueid
  5956. m.objrec = RECNO()
  5957.  
  5958. LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  5959. IF FOUND()
  5960.    DO CASE
  5961.    CASE m.fromhpos = m.objhpos OR m.fromhpos = m.objright
  5962.       IF objtype = c_otline
  5963.          m.joinhpos = IIF(m.fromhpos = m.objhpos, hpos, hpos+WIDTH-1)
  5964.          STORE 2 TO m.vlevel, m.hlevel
  5965.       ELSE
  5966.          IF m.fromhpos = m.objhpos
  5967.             m.joinhpos = hpos - c_adjbox + (getlinewidth(m.objcode, .F.)/2)
  5968.          ELSE
  5969.             m.joinhpos = hpos+WIDTH - c_adjbox - (getlinewidth(m.objcode, .F.)/2)
  5970.          ENDIF
  5971.          STORE 4 TO m.vlevel, m.hlevel
  5972.       ENDIF
  5973.       
  5974.    OTHERWISE
  5975.       m.joinhpos = m.tohpos - c_adjbox + (getlinewidth(m.fromcode, .F.)/2)
  5976.       m.vlevel = IIF(objtype = c_otline, 1, 3)
  5977.       m.hlevel = 0
  5978.    ENDCASE
  5979.    
  5980.    IF m.oldvpos1 = m.objvpos OR objtype = c_otline
  5981.       m.joinvpos = vpos - c_adjbox + (getlinewidth(m.objcode, .T.)/2)
  5982.    ELSE
  5983.       m.joinvpos = vpos+HEIGHT - c_adjbox - (getlinewidth(m.objcode, .T.)/2)
  5984.    ENDIF
  5985.    
  5986.    DO addjoin WITH m.oldvpos1, m.fromhpos, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5987.    IF m.oldvpos1 <> m.oldvpos2
  5988.       DO addjoin WITH m.oldvpos2, m.fromhpos, m.joinvpos, m.joinhpos, m.vlevel, m.hlevel
  5989.    ENDIF
  5990. ENDIF
  5991. GOTO RECORD m.objrec
  5992.  
  5993. *
  5994. * MeetBoxChar - This procedure looks at suspected box join characters and adds a join position for each
  5995. *            line which ends one short of it.
  5996. *
  5997. *!*****************************************************************************
  5998. *!
  5999. *!      Procedure: MEETBOXCHAR
  6000. *!
  6001. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6002. *!
  6003. *!          Calls: ADDJOIN            (procedure in TRANSPRT.PRG)
  6004. *!
  6005. *!*****************************************************************************
  6006. PROCEDURE meetboxchar
  6007. PRIVATE m.saverec, m.fromvpos, m.fromhpos, m.tovpos, m.tohpos, m.joinrec, m.joinid
  6008. m.saverec = RECNO()
  6009.  
  6010. SCAN FOR platform = m.g_fromplatform AND objtype = c_ottext AND LEN(expr)=3 AND ;
  6011.       ASC(SUBSTR(expr,2,1)) >= 179 AND ASC(SUBSTR(expr,2,1)) <= 218
  6012.    m.fromvpos = vpos
  6013.    m.fromhpos = hpos
  6014.    m.joinid = uniqueid
  6015.    m.joinrec = RECNO()
  6016.    
  6017.    LOCATE FOR platform = m.g_toplatform AND uniqueid = m.joinid
  6018.    IF FOUND()
  6019.       m.tovpos = vpos
  6020.       m.tohpos = hpos
  6021.       
  6022.       SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND (WIDTH = 1 OR HEIGHT = 1)
  6023.          IF WIDTH = 1 AND hpos = m.fromhpos
  6024.             DO CASE
  6025.             CASE vpos = m.fromvpos + 1
  6026.                DO addjoin WITH vpos, hpos, m.tovpos, m.tohpos, 2, 2
  6027.                
  6028.             CASE vpos+HEIGHT = m.fromvpos
  6029.                DO addjoin WITH vpos+HEIGHT-1, hpos, m.tovpos, m.tohpos, 2, 2
  6030.             ENDCASE
  6031.          ENDIF
  6032.          
  6033.          IF HEIGHT = 1 AND vpos = m.fromvpos
  6034.             DO CASE
  6035.             CASE hpos = m.fromhpos + 1
  6036.                DO addjoin WITH vpos, hpos, m.tovpos, m.tohpos, 2, 2
  6037.                
  6038.             CASE hpos+WIDTH = m.fromhpos
  6039.                DO addjoin WITH vpos, hpos+WIDTH-1, m.tovpos, m.tohpos, 2, 2
  6040.             ENDCASE
  6041.          ENDIF
  6042.       ENDSCAN
  6043.    ENDIF
  6044.    
  6045.    GOTO RECORD m.joinrec
  6046. ENDSCAN
  6047.  
  6048. IF m.saverec > RECCOUNT()
  6049.    LOCATE FOR .F.
  6050. ELSE
  6051.    GOTO RECORD m.saverec
  6052. ENDIF
  6053. RETURN
  6054.  
  6055. *
  6056. * zapBoxChar - This procedure looks for any text record which is probably a box join
  6057. *            character and replaces it with a transparent space.
  6058. *
  6059. *!*****************************************************************************
  6060. *!
  6061. *!      Procedure: ZAPBOXCHAR
  6062. *!
  6063. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6064. *!
  6065. *!*****************************************************************************
  6066. PROCEDURE zapboxchar
  6067. PRIVATE m.recno, m.fromvpos, m.fromhpos
  6068. m.recno = RECNO()
  6069.  
  6070. SCAN FOR platform = m.g_toplatform AND objtype = c_ottext AND LEN(expr)=3 AND ;
  6071.       ASC(SUBSTR(expr,2,1)) >= 179 AND ASC(SUBSTR(expr,2,1)) <= 218
  6072.    REPLACE expr WITH '" "'
  6073.    REPLACE mode WITH 1
  6074. ENDSCAN
  6075.  
  6076. IF m.recno > RECCOUNT()
  6077.    GOTO RECCOUNT()
  6078.    SKIP
  6079. ELSE
  6080.    GOTO RECORD m.recno
  6081. ENDIF
  6082.  
  6083. *
  6084. * AddJoin - This routine adds the position for a join character, or modifies a previous join
  6085. *      at the same from position if it has a lower priority.
  6086. *
  6087. *!*****************************************************************************
  6088. *!
  6089. *!      Procedure: ADDJOIN
  6090. *!
  6091. *!      Called by: JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  6092. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  6093. *!               : MEETBOXCHAR        (procedure in TRANSPRT.PRG)
  6094. *!
  6095. *!*****************************************************************************
  6096. PROCEDURE addjoin
  6097. PARAMETER m.fromvpos, m.fromhpos, m.tovpos, m.tohpos, m.vmatch, m.hmatch
  6098. PRIVATE m.row, m.key
  6099. m.key = STR(m.fromvpos, 3)+STR(m.fromhpos, 3)
  6100. m.row = ASCAN(joins, m.key)
  6101. IF m.row = 0
  6102.    m.joincount = m.joincount + 1
  6103.    DIMENSION joins[m.joinCount, 5]
  6104.    joins[m.joinCount, 1] = m.key
  6105.    joins[m.joinCount, 2] = m.tovpos
  6106.    joins[m.JoinCount, 3] = m.tohpos
  6107.    joins[m.JoinCount, 4] = m.vmatch
  6108.    joins[m.JoinCount, 5] = m.hmatch
  6109. ELSE
  6110.    m.row = ASUBSCRIPT(joins, m.row, 1)
  6111.    
  6112.    IF m.vmatch > joins[m.row, 4]
  6113.       joins[m.row, 2] = m.tovpos
  6114.       joins[m.row, 4] = m.vmatch
  6115.    ENDIF
  6116.    
  6117.    IF m.hmatch > joins[m.JoinCount, 5]
  6118.       joins[m.row, 3] = m.tohpos
  6119.       joins[m.row, 5] = m.hmatch
  6120.    ENDIF
  6121. ENDIF
  6122.  
  6123. RETURN
  6124.  
  6125. *
  6126. * RejoinBoxes - This routine stretches lines so that they meet the join characters
  6127. *      they did in the from platform.
  6128. *
  6129. *!*****************************************************************************
  6130. *!
  6131. *!      Procedure: REJOINBOXES
  6132. *!
  6133. *!      Called by: JOINLINES          (procedure in TRANSPRT.PRG)
  6134. *!
  6135. *!          Calls: JOINLINEWIDTH()    (function  in TRANSPRT.PRG)
  6136. *!               : GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  6137. *!
  6138. *!*****************************************************************************
  6139. PROCEDURE rejoinboxes
  6140. PARAMETER m.fromvpos, m.fromhpos, m.tovpos, m.tohpos
  6141. PRIVATE m.objectcode, m.objend, m.saverecno, m.objid, m.joinwidth, m.objrec
  6142.  
  6143. m.saverecno = RECNO()
  6144.  
  6145. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox
  6146.    IF WIDTH = 1 OR HEIGHT = 1
  6147.       m.objid = uniqueid
  6148.       m.objectcode = objcode
  6149.       m.objrec = RECNO()
  6150.       
  6151.       DO CASE
  6152.          ** A Vertical line which starts at a join character
  6153.       CASE m.fromvpos = vpos AND m.fromhpos = hpos AND WIDTH = 1
  6154.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6155.          IF FOUND()
  6156.             m.objend = vpos + HEIGHT
  6157.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .T., m.objid)
  6158.             REPLACE vpos WITH m.tovpos + c_adjbox - (m.joinwidth/2)
  6159.             REPLACE HEIGHT WITH m.objend - vpos
  6160.             REPLACE hpos WITH m.tohpos + c_adjbox - (getlinewidth(m.objectcode, .F.)/2)
  6161.          ENDIF
  6162.          
  6163.          ** A Horizontal line which starts at a join character
  6164.       CASE m.fromvpos = vpos AND m.fromhpos = hpos AND HEIGHT = 1
  6165.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6166.          IF FOUND()
  6167.             m.objend = hpos + WIDTH
  6168.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .F., m.objid)
  6169.             REPLACE hpos WITH m.tohpos + c_adjbox - (m.joinwidth/2)
  6170.             REPLACE WIDTH WITH m.objend - hpos
  6171.             REPLACE vpos WITH m.tovpos + c_adjbox - (getlinewidth(m.objectcode, .T.)/2)
  6172.          ENDIF
  6173.          
  6174.          ** A Vertical line which ends at a join character
  6175.       CASE m.fromvpos = (vpos+HEIGHT-1) AND m.fromhpos = hpos AND WIDTH = 1
  6176.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6177.          IF FOUND()
  6178.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .T., m.objid)
  6179.             REPLACE HEIGHT WITH (m.tovpos + c_adjbox + (m.joinwidth/2)) - vpos
  6180.             REPLACE hpos WITH m.tohpos + c_adjbox - (getlinewidth(m.objectcode, .F.)/2)
  6181.          ENDIF
  6182.          
  6183.          ** A Horizontal line which ends at a join character
  6184.       CASE m.fromhpos = (hpos+WIDTH-1) AND m.fromvpos = vpos AND HEIGHT = 1
  6185.          LOCATE FOR platform = m.g_toplatform AND uniqueid = m.objid
  6186.          IF FOUND()
  6187.             m.joinwidth = joinlinewidth(m.fromvpos, m.fromhpos, .F., m.objid)
  6188.             REPLACE WIDTH WITH (m.tohpos + c_adjbox + (m.joinwidth/2)) - hpos
  6189.             REPLACE vpos WITH m.tovpos + c_adjbox - (getlinewidth(m.objectcode, .T.)/2)
  6190.          ENDIF
  6191.       ENDCASE
  6192.       
  6193.       GOTO RECORD m.objrec
  6194.    ENDIF
  6195. ENDSCAN
  6196.  
  6197. IF m.saverecno > RECCOUNT()
  6198.    LOCATE FOR .F.
  6199. ELSE
  6200.    GOTO RECORD m.saverecno
  6201. ENDIF
  6202.  
  6203. RETURN
  6204.  
  6205. *
  6206. * JoinLineWidth - Looks for the thickest line or box which goes through a given point and
  6207. *      Returns either its horizontal or vertical Width.
  6208. *
  6209. *!*****************************************************************************
  6210. *!
  6211. *!       Function: JOINLINEWIDTH
  6212. *!
  6213. *!      Called by: REJOINBOXES        (procedure in TRANSPRT.PRG)
  6214. *!
  6215. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  6216. *!
  6217. *!*****************************************************************************
  6218. FUNCTION joinlinewidth
  6219. PARAMETERS m.joinvpos, m.joinhpos, m.horizontal, m.skipid
  6220. PRIVATE m.i, m.saverecno, m.thickness
  6221. m.saverecno = RECNO()
  6222. m.thickness = 0
  6223.  
  6224. SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.skipid
  6225.    DO CASE
  6226.    CASE m.horizontal AND WIDTH <> 1 AND ;
  6227.          (ABS(m.joinvpos - vpos) <= 1 OR ABS(m.joinvpos - (vpos+HEIGHT-1)) <= 1) AND ;
  6228.          (m.joinhpos >= hpos AND m.joinhpos <= (hpos+WIDTH-1))
  6229.       m.thickness = MAX(getlinewidth(objcode, .T.), m.thickness)
  6230.       
  6231.    CASE !m.horizontal AND HEIGHT <> 1 AND ;
  6232.          (ABS(m.joinhpos - hpos) <= 1 OR ABS(m.joinhpos - (hpos+WIDTH-1)) <= 1) AND ;
  6233.          (m.joinvpos >= vpos AND m.joinvpos <= (vpos+WIDTH-1))
  6234.       m.thickness = MAX(getlinewidth(objcode, .F.), m.thickness)
  6235.    ENDCASE
  6236. ENDSCAN
  6237.  
  6238. IF m.thickness = 0
  6239.    SCAN FOR platform = m.g_fromplatform AND objtype = c_otbox AND uniqueid <> m.skipid
  6240.       IF (HEIGHT = 1 OR WIDTH = 1) AND ;
  6241.             (ABS(m.joinvpos - vpos) <= 1 OR ABS(m.joinvpos - (vpos+HEIGHT-1)) <= 1) AND ;
  6242.             (ABS(m.joinhpos - hpos) <= 1 OR ABS(m.joinhpos - (hpos+WIDTH-1)) <= 1)
  6243.          m.thickness = MAX(getlinewidth(objcode, m.horizontal), m.thickness)
  6244.       ENDIF
  6245.    ENDSCAN
  6246. ENDIF
  6247.  
  6248. GOTO RECORD m.saverecno
  6249. RETURN m.thickness
  6250.  
  6251. *
  6252. * getLastObjectLine - Determine if this object is the lowest object.
  6253. *
  6254. *!*****************************************************************************
  6255. *!
  6256. *!       Function: GETLASTOBJECTLINE
  6257. *!
  6258. *!      Called by: REPOOBJECTS        (procedure in TRANSPRT.PRG)
  6259. *!
  6260. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  6261. *!
  6262. *!*****************************************************************************
  6263. FUNCTION getlastobjectline
  6264. PARAMETER m.currentlastline, m.newposition
  6265. PRIVATE m.numitems, m.max
  6266.  
  6267. DO CASE
  6268. CASE objtype = c_ottext OR objtype = c_otchkbox
  6269.    IF vpos > m.currentlastline
  6270.       g_lastobjectline[2] = m.newposition + HEIGHT
  6271.       RETURN vpos + HEIGHT
  6272.    ELSE
  6273.       RETURN m.currentlastline
  6274.    ENDIF
  6275.    
  6276. CASE objtype = c_otradbut OR objtype = c_ottxtbut OR objtype = c_otinvbut
  6277.    IF horizbutton(PICTURE)
  6278.       IF vpos + HEIGHT >= m.currentlastline
  6279.          g_lastobjectline[2] = m.newposition + HEIGHT
  6280.          RETURN vpos
  6281.       ELSE
  6282.          RETURN m.currentlastline
  6283.       ENDIF
  6284.    ELSE
  6285.       m.numitems = OCCURS(';',PICTURE)
  6286.       m.max = vpos + m.numitems + (m.numitems * spacing)
  6287.       IF m.max >= m.currentlastline AND (objtype = c_ottxtbut OR objtype = c_otinvbut) OR ;
  6288.             m.max > m.currentlastline AND objtype = c_otradbut
  6289.          g_lastobjectline[2] = m.newposition + (HEIGHT * (m.numitems + 1)) + ;
  6290.             (spacing * m.numitems)
  6291.          RETURN m.max + 1
  6292.       ELSE
  6293.          RETURN m.currentlastline
  6294.       ENDIF
  6295.    ENDIF
  6296.    
  6297. CASE objtype = c_otpopup
  6298.    IF vpos + 2 > m.currentlastline
  6299.       g_lastobjectline[2] = m.newposition + 2
  6300.       RETURN vpos +1
  6301.    ELSE
  6302.       RETURN m.currentlastline
  6303.    ENDIF
  6304.    
  6305. CASE objtype = c_otfield
  6306.    IF vpos + HEIGHT -1 > m.currentlastline
  6307.       g_lastobjectline[2] = m.newposition + HEIGHT
  6308.       RETURN vpos + HEIGHT -1
  6309.    ELSE
  6310.       RETURN m.currentlastline
  6311.    ENDIF
  6312.    
  6313. CASE objtype = c_otlist OR ;
  6314.       objtype = c_otbox OR objtype = c_otline
  6315.    IF vpos + HEIGHT - 1 > m.currentlastline
  6316.       g_lastobjectline[2] = m.newposition + HEIGHT
  6317.       RETURN vpos + HEIGHT - 1
  6318.    ELSE
  6319.       RETURN m.currentlastline
  6320.    ENDIF
  6321.    
  6322. OTHERWISE
  6323.    RETURN m.currentlastline
  6324.    
  6325. ENDCASE
  6326.  
  6327. *
  6328. * adjobjcode - Adjust object code field for Objtype = 1.
  6329. *
  6330. *!*****************************************************************************
  6331. *!
  6332. *!      Procedure: ADJOBJCODE
  6333. *!
  6334. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6335. *!
  6336. *!*****************************************************************************
  6337. PROCEDURE adjobjcode
  6338. * Stuff the right version code into the object code field for the header record
  6339. DO CASE
  6340. CASE objtype = c_otheader OR (m.g_filetype=c_label AND objtype = c_ot20label)
  6341.    REPLACE objcode WITH IIF(m.g_filetype=c_screen,c_25scx,c_25frx)
  6342. CASE objtype = c_otgroup
  6343.    REPLACE objcode WITH 0
  6344. ENDCASE
  6345.  
  6346. *!*****************************************************************************
  6347. *!
  6348. *!      Procedure: GETWINDFONT
  6349. *!
  6350. *!      Called by: NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  6351. *!
  6352. *!          Calls: WHATSTYLE()        (function  in TRANSPRT.PRG)
  6353. *!
  6354. *!*****************************************************************************
  6355. PROCEDURE getwindfont
  6356. * Get the default font for this window, if one has been defined
  6357. IF m.g_tographic
  6358.    * Get font information from header
  6359.    GOTO TOP
  6360.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  6361.    IF FOUND() AND !EMPTY(fontface)
  6362.       m.g_fontface  = fontface
  6363.       m.g_fontsize  = fontsize
  6364.       m.g_fontstyle = whatstyle(fontstyle)
  6365.    ENDIF
  6366. ENDIF
  6367.  
  6368. *
  6369. * adjHeightAndWidth - Adjust the Height and width of objects.
  6370. *
  6371. *!*****************************************************************************
  6372. *!
  6373. *!      Procedure: ADJHEIGHTANDWIDTH
  6374. *!
  6375. *!      Called by: NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  6376. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6377. *!
  6378. *!          Calls: WHATSTYLE()        (function  in TRANSPRT.PRG)
  6379. *!               : DOSSIZE()          (function  in TRANSPRT.PRG)
  6380. *!               : COLUMNAR()         (function  in TRANSPRT.PRG)
  6381. *!               : ADJTEXT            (procedure in TRANSPRT.PRG)
  6382. *!               : ADJBITMAPCTRL      (procedure in TRANSPRT.PRG)
  6383. *!               : MAXBTNWIDTH()      (function  in TRANSPRT.PRG)
  6384. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  6385. *!
  6386. *!*****************************************************************************
  6387. PROCEDURE adjheightandwidth
  6388. PRIVATE m.txtwidthratio, m.boldtxtratio, m.chkboxwidth, m.saverec, ;
  6389.    m.oldwidth, m.newheight, m.newwidth, ;
  6390.    m.wndface, m.wndsize, m.wndstyle, m.alignment
  6391.  
  6392. IF m.g_tographic
  6393.    m.saverec = RECNO()
  6394.    * Get font information from header
  6395.    LOCATE FOR platform = m.g_toplatform AND objtype = c_otheader
  6396.    IF FOUND()
  6397.       m.wndface  = fontface
  6398.       m.wndsize  = fontsize
  6399.       m.wndstyle = fontstyle
  6400.    ELSE
  6401.       m.wndface  = m.g_fontface
  6402.       m.wndsize  = m.g_fontsize
  6403.       m.wndstyle = m.g_fontstyle
  6404.    ENDIF
  6405.    GOTO m.saverec
  6406.    
  6407.    * This is the ratio of character size for the window font to that for the current object font
  6408.    m.txtwidthratio = FONTMETRIC(6, m.wndface, m.wndsize, whatstyle(m.wndstyle)) / ;
  6409.       FONTMETRIC(6,fontface,fontsize,whatstyle(fontstyle))
  6410.    m.boldtxtratio = FONTMETRIC(6, m.wndface, m.wndsize, whatstyle(m.wndstyle)) / ;
  6411.       FONTMETRIC(6,m.g_fontface,m.g_fontsize,whatstyle(m.g_boldstyle))
  6412.    m.chkboxwidth = c_chkpixel / FONTMETRIC(6,m.g_fontface,m.g_fontsize,whatstyle(m.g_boldstyle))
  6413.    m.chkboxwidth = m.chkboxwidth + (m.chkboxwidth / 2)
  6414. ELSE
  6415.    m.saverec = RECNO()
  6416.    LOCATE FOR platform = m.g_fromplatform AND objtype = c_otheader
  6417.    IF FOUND()
  6418.       m.wndface = fontface
  6419.       m.wndsize = fontsize
  6420.       m.wndstyle = fontstyle
  6421.    ELSE
  6422.       m.wndface  = "MS Sans Serif"
  6423.       m.wndsize  = 8
  6424.       m.wndstyle = "B"
  6425.    ENDIF
  6426.    GOTO m.saverec
  6427. ENDIF
  6428.  
  6429. DO CASE
  6430. CASE objtype = c_ottext
  6431.    IF m.g_tographic
  6432.       m.oldwidth = WIDTH
  6433.       REPLACE WIDTH WITH TXTWIDTH(SUBSTR(expr, 2,LEN(expr)-2), fontface, ;
  6434.          fontsize, whatstyle(fontstyle)) && * m.txtwidthratio
  6435.    ELSE
  6436.       m.oldwidth = ROUND(dossize(WIDTH, fontsize, m.wndsize), 0)
  6437.       m.newheight = 1
  6438.       m.newwidth = LEN(expr)-2
  6439.       
  6440.       m.alignment = columnar(vpos, hpos, WIDTH, objtype)
  6441.       DO CASE
  6442.       CASE m.alignment = 2
  6443.          REPLACE hpos WITH hpos + WIDTH - m.newwidth
  6444.          
  6445.       CASE m.alignment = 0
  6446.          REPLACE vpos WITH vpos + ((HEIGHT - m.newheight) / 2)
  6447.          REPLACE hpos WITH hpos + ((WIDTH - m.newwidth) / 2)
  6448.       ENDCASE
  6449.       
  6450.       REPLACE HEIGHT WITH m.newheight
  6451.       REPLACE WIDTH WITH m.newwidth
  6452.       
  6453.       DO adjtext WITH m.oldwidth
  6454.    ENDIF
  6455.    
  6456. CASE objtype = c_otchkbox
  6457.    IF m.g_tographic
  6458.       m.oldwidth = WIDTH
  6459.       REPLACE WIDTH WITH (TXTWIDTH(SUBSTR(PICTURE, 6,LEN(PICTURE)-6) + SPACE(1), fontface, ;
  6460.          fontsize, whatstyle(fontstyle)) * m.boldtxtratio) + m.chkboxwidth
  6461.       REPLACE HEIGHT WITH c_chkhght
  6462.    ELSE
  6463.       DO adjbitmapctrl
  6464.       
  6465.       REPLACE HEIGHT WITH 1
  6466.       REPLACE WIDTH WITH maxbtnwidth(PICTURE, "", "", "")+4
  6467.    ENDIF
  6468.    
  6469. CASE objtype = c_otradbut
  6470.    IF m.g_tographic
  6471.       m.oldwidth = WIDTH
  6472.       DO adjbitmapctrl
  6473.       REPLACE HEIGHT WITH c_radhght
  6474.    ELSE
  6475.       REPLACE HEIGHT WITH 1
  6476.       REPLACE spacing WITH ROUND(dossize(spacing, fontsize, m.wndsize), 0)
  6477.       REPLACE WIDTH WITH MAX(maxbtnwidth(PICTURE, "", "", "")+4, dossize(WIDTH, fontsize, m.wndsize))
  6478.    ENDIF
  6479.    
  6480. CASE objtype = c_otpopup
  6481.    IF m.g_tographic
  6482.       REPLACE HEIGHT WITH c_pophght
  6483.    ELSE
  6484.       m.newheight = 3
  6485.       REPLACE vpos WITH MAX(vpos + ((HEIGHT - m.newheight) / 2),0)
  6486.       REPLACE HEIGHT WITH m.newheight
  6487.       REPLACE WIDTH WITH dossize(WIDTH, fontsize, m.wndsize)
  6488.    ENDIF
  6489.    
  6490. CASE objtype = c_ottxtbut
  6491.    IF m.g_tographic
  6492.       REPLACE HEIGHT WITH HEIGHT + c_adjtbtn
  6493.    ELSE
  6494.       DO adjbitmapctrl
  6495.       
  6496.       REPLACE HEIGHT WITH 1
  6497.       REPLACE spacing WITH ROUND(dossize(spacing, fontsize, m.wndsize), 0)
  6498.       REPLACE WIDTH WITH MAX(maxbtnwidth(PICTURE, "", "", "")+2, dossize(WIDTH, fontsize, m.wndsize))
  6499.    ENDIF
  6500.    
  6501. CASE objtype = c_otfield
  6502.    IF m.g_tographic
  6503.       REPLACE HEIGHT WITH HEIGHT + c_adjfld
  6504.    ELSE
  6505.       IF INLIST(objcode,0,1)
  6506.          REPLACE height WITH 1
  6507.       ELSE
  6508.          REPLACE HEIGHT WITH dossize(HEIGHT, fontsize, m.wndsize)
  6509.       ENDIF
  6510.       REPLACE WIDTH WITH dossize(WIDTH, fontsize, m.wndsize)
  6511.    ENDIF
  6512.    
  6513. CASE objtype = c_otline OR objtype = c_otbox
  6514.    IF !m.g_tographic
  6515.       DO adjbox
  6516.    ENDIF
  6517. ENDCASE
  6518.  
  6519. IF !g_tographic
  6520.    REPLACE vpos WITH MAX(vpos,0)
  6521.    REPLACE hpos WITH MAX(hpos,0)
  6522. ENDIF
  6523.  
  6524. *
  6525. * Columnar - This function takes and object and checks to see if it
  6526. *      is right or left aligned with other objects in a column.
  6527. *      Return values are:
  6528. *         0 - Not aligned
  6529. *         1 - Left aligned
  6530. *         2 - Right aligned
  6531. *
  6532. *!*****************************************************************************
  6533. *!
  6534. *!       Function: COLUMNAR
  6535. *!
  6536. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6537. *!
  6538. *!*****************************************************************************
  6539. FUNCTION columnar
  6540. PARAMETER m.vpos, m.hpos, m.type, m.otype
  6541. PRIVATE m.saverec
  6542.  
  6543. m.saverec = RECNO()
  6544.  
  6545. LOCATE FOR platform = m.g_fromplatform AND objtype = m.type AND ;
  6546.    hpos = m.hpos AND ABS(vpos - m.vpos) < m.vpos * 2
  6547. IF FOUND()
  6548.    GOTO RECORD (m.saverec)
  6549.    RETURN 1
  6550. ENDIF
  6551.  
  6552. LOCATE FOR platform = m.g_fromplatform AND objtype = m.type AND ;
  6553.    hpos + WIDTH = m.hpos + m.width  AND ;
  6554.    ABS(vpos - m.vpos) < m.vpos * 2
  6555. IF FOUND()
  6556.    GOTO RECORD (m.saverec)
  6557.    RETURN 2
  6558. ENDIF
  6559.  
  6560. GOTO RECORD (m.saverec)
  6561. RETURN 0
  6562.  
  6563. *
  6564. * DOSSize - This function attempts to normalize a dimension of an object to the font used for the
  6565. *      window it lies in.  Unfortunately, we can't use FONTMETRIC since this needs to run on a character
  6566. *      platform.  We use the ratio of point sizes.
  6567. *
  6568. *!*****************************************************************************
  6569. *!
  6570. *!       Function: DOSSIZE
  6571. *!
  6572. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6573. *!
  6574. *!*****************************************************************************
  6575. FUNCTION dossize
  6576. PARAMETER m.size, m.objsize, m.scrnsize
  6577. RETURN m.size * (m.objsize / m.scrnsize)
  6578.  
  6579. *
  6580. * AdjBitmapCtrl - Take the Picture clause for a control, see if it is a bitmap and
  6581. *      turn it into something that a character platform can handle.
  6582. *
  6583. *!*****************************************************************************
  6584. *!
  6585. *!      Procedure: ADJBITMAPCTRL
  6586. *!
  6587. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6588. *!
  6589. *!          Calls: STRIPPATH()        (function  in TRANSPRT.PRG)
  6590. *!
  6591. *!*****************************************************************************
  6592. PROCEDURE adjbitmapctrl
  6593. PRIVATE m.function, m.oldpicture, m.newpicture, m.temp
  6594.  
  6595. m.function = ALLTRIM(SUBSTR(PICTURE, 1, AT(" ", PICTURE)))
  6596.  
  6597. IF AT("B", m.function) <> 0
  6598.    m.function = CHRTRAN(m.function, "B", "")
  6599.    m.oldpicture = ALLTRIM(SUBSTR(PICTURE, AT(" ", PICTURE)))
  6600.    m.newpicture = ""
  6601.    
  6602.    DO WHILE LEN(m.oldpicture) > 0
  6603.       IF AT(";", m.oldpicture) = 0
  6604.          m.temp = LEFT(m.oldpicture, LEN(m.oldpicture)-1)
  6605.          m.oldpicture = ""
  6606.       ELSE
  6607.          m.temp = LEFT(m.oldpicture, AT(";", m.oldpicture)-1)
  6608.          m.oldpicture = SUBSTR(m.oldpicture, AT(";", m.oldpicture)+1)
  6609.       ENDIF
  6610.       
  6611.       IF LEN(m.newpicture) = 0
  6612.          m.newpicture = ALLTRIM(strippath(m.temp))
  6613.       ELSE
  6614.          m.newpicture = m.newpicture + ";" + ALLTRIM(strippath(m.temp))
  6615.       ENDIF
  6616.    ENDDO
  6617.    
  6618.    REPLACE PICTURE WITH m.function + " " + m.newpicture + '"'
  6619. ENDIF
  6620.  
  6621. RETURN
  6622. *
  6623. * AdjColor - Adjust color fields in the database.
  6624. *
  6625. *!*****************************************************************************
  6626. *!
  6627. *!      Procedure: ADJCOLOR
  6628. *!
  6629. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6630. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6631. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  6632. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  6633. *!
  6634. *!          Calls: CONVERTCOLORPAIR   (procedure in TRANSPRT.PRG)
  6635. *!               : RGBTOX()           (function  in TRANSPRT.PRG)
  6636. *!
  6637. *!*****************************************************************************
  6638. PROCEDURE adjcolor
  6639. IF m.g_tographic
  6640.    IF m.g_filetype = c_report OR m.g_filetype = c_label OR EMPTY(colorpair)
  6641.       IF m.g_filetype = c_screen
  6642.          REPLACE colorpair WITH ""
  6643.          REPLACE penred    WITH -1
  6644.          REPLACE pengreen  WITH -1
  6645.          REPLACE penblue   WITH -1
  6646.          REPLACE fillred   WITH -1
  6647.          REPLACE fillgreen WITH -1
  6648.          REPLACE fillblue  WITH -1
  6649.       ELSE
  6650.          REPLACE penred    WITH 0
  6651.          REPLACE pengreen  WITH 0
  6652.          REPLACE penblue   WITH 0
  6653.          IF objtype = c_otline
  6654.             REPLACE fillred   WITH 0
  6655.             REPLACE fillgreen WITH 0
  6656.             REPLACE fillblue  WITH 0
  6657.          ELSE
  6658.             REPLACE fillred   WITH 255
  6659.             REPLACE fillgreen WITH 255
  6660.             REPLACE fillblue  WITH 255
  6661.          ENDIF
  6662.       ENDIF
  6663.    ELSE
  6664.       DO convertcolorpair
  6665.    ENDIF
  6666. ELSE
  6667.    IF m.g_filetype = c_screen
  6668.       DO CASE
  6669.       CASE objtype = c_otheader
  6670.          DO CASE
  6671.          CASE STYLE = c_user
  6672.             IF SCHEME + scheme2 = 0
  6673.                REPLACE SCHEME WITH 1
  6674.                REPLACE scheme2 WITH 2
  6675.             ENDIF
  6676.             
  6677.          CASE STYLE = c_system
  6678.             REPLACE SCHEME WITH 8
  6679.             REPLACE scheme2 WITH 9
  6680.             
  6681.          CASE STYLE = c_dialog
  6682.             REPLACE SCHEME WITH 5
  6683.             REPLACE scheme2 WITH 6
  6684.             
  6685.          CASE STYLE = c_alert
  6686.             REPLACE SCHEME WITH 7
  6687.             REPLACE SCHEME WITH 12
  6688.          ENDCASE
  6689.          
  6690.       CASE c_maptextcolor AND INLIST(objtype,c_otbox, c_otline,c_ottext)
  6691.          IF penred <> -1 OR fillred <> -1
  6692.             REPLACE colorpair WITH rgbtox(penred, penblue, pengreen) + "/" + ;
  6693.                rgbtox(fillred, fillblue, fillgreen)
  6694.             * Don't let it map to black on black
  6695.             IF colorpair = "N/N" OR TRIM(colorpair) == "/"
  6696.                REPLACE colorpair WITH ""
  6697.             ENDIF
  6698.          ENDIF
  6699.       OTHERWISE
  6700.           REPLACE scheme WITH 0   && default color scheme for everything else
  6701.       ENDCASE
  6702.    ENDIF
  6703. ENDIF
  6704.  
  6705. *
  6706. * RGBToX - Convert an RGB triplet to a traditional xBase color letter
  6707. *
  6708. *!*****************************************************************************
  6709. *!
  6710. *!       Function: RGBTOX
  6711. *!
  6712. *!      Called by: ADJCOLOR           (procedure in TRANSPRT.PRG)
  6713. *!
  6714. *!*****************************************************************************
  6715. FUNCTION rgbtox
  6716. PARAMETERS m.red, m.blue, m.green
  6717. PRIVATE m.color
  6718.  
  6719. *
  6720. * If it is automatic, we skip it.
  6721. *
  6722. IF m.red < 0 OR m.blue < 0 OR m.green < 0
  6723.    RETURN ""
  6724. ENDIF
  6725.  
  6726. *
  6727. * We use a special triplet for Light Gray which makes it a special case.
  6728. *
  6729. IF m.red = 192 AND m.blue = 192 AND m.green = 192
  6730.    RETURN "W"
  6731. ENDIF
  6732.  
  6733. *
  6734. * This division makes sure that we give a letter for any possible triplet
  6735. *
  6736. m.red   = ROUND(m.red / 127, 0)
  6737. m.blue = ROUND(m.blue / 127, 0)
  6738. m.green = ROUND(m.green / 127, 0)
  6739.  
  6740. *
  6741. * Save some time by getting a number we can make a single comparison against
  6742. *
  6743. m.color = (m.red * 100) + (m.blue * 10) + m.green
  6744.  
  6745. DO CASE
  6746. CASE m.color = 222      && White
  6747.    RETURN "W+"
  6748. CASE m.color = 0        && Black
  6749.    RETURN "N"
  6750. CASE m.color = 111      && Dark Gray
  6751.    RETURN "N+"
  6752. CASE m.color = 200      && Light Red
  6753.    RETURN "R+"
  6754. CASE m.color = 100      && Dark Red
  6755.    RETURN "R"
  6756. CASE m.color = 220      && Yellow
  6757.    RETURN "GR+"
  6758. CASE m.color = 110      && Brown
  6759.    RETURN "GR"
  6760. CASE m.color = 2        && Light green
  6761.    RETURN "G+"
  6762. CASE m.color = 1        && Dark Green
  6763.    RETURN "G"
  6764. CASE m.color = 22       && Light Magenta
  6765.    RETURN "BG+"
  6766. CASE m.color = 11       && Dark Magenta
  6767.    RETURN "BG"
  6768. CASE m.color = 20       && Light Blue
  6769.    RETURN "B+"
  6770. CASE m.color = 10       && Dark Blue
  6771.    RETURN "B"
  6772. CASE m.color = 202      && Light Purple
  6773.    RETURN "RB+"
  6774. CASE m.color = 101      && Dark Purple
  6775.    RETURN "RB"
  6776. ENDCASE
  6777.  
  6778. RETURN ""      && It shouldn't be possible to reach this point.
  6779.  
  6780. *
  6781. * \ - Adjust pen attributes.
  6782. *
  6783. *!*****************************************************************************
  6784. *!
  6785. *!      Procedure: ADJPEN
  6786. *!
  6787. *!      Called by: FILLININFO         (procedure in TRANSPRT.PRG)
  6788. *!
  6789. *!*****************************************************************************
  6790. PROCEDURE adjpen
  6791. IF m.g_tographic
  6792.    DO CASE
  6793.    CASE objtype = c_ottext
  6794.       REPLACE pensize WITH 1
  6795.       REPLACE penpat  WITH 0
  6796.       REPLACE fillpat WITH 0
  6797.       
  6798.    OTHERWISE
  6799.       REPLACE pensize WITH 0
  6800.       REPLACE penpat  WITH 0
  6801.       REPLACE fillpat WITH 0
  6802.    ENDCASE
  6803. ENDIF
  6804.  
  6805. *
  6806. * adjfont - Adjust font fields in the SCX or FRX database.
  6807. *
  6808. *!*****************************************************************************
  6809. *!
  6810. *!      Procedure: ADJFONT
  6811. *!
  6812. *!      Called by: ALLENVIRONS        (procedure in TRANSPRT.PRG)
  6813. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6814. *!               : RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  6815. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  6816. *!
  6817. *!*****************************************************************************
  6818. PROCEDURE adjfont
  6819. PRIVATE m.i
  6820.  
  6821. IF m.g_tographic
  6822.    DO CASE
  6823.    CASE objtype = c_ottxtbut OR ;
  6824.          objtype = c_otradbut OR ;
  6825.          objtype = c_otchkbox OR ;
  6826.          objtype = c_otheader OR ;
  6827.          objtype = c_otinvbut OR ;
  6828.          objtype = c_otspinner OR ;
  6829.          objtype = c_otbox OR ;
  6830.          objtype = c_otline
  6831.       
  6832.       REPLACE fontface  WITH m.g_cfontface
  6833.       REPLACE fontsize  WITH m.g_cfontsize
  6834.       REPLACE fontstyle WITH m.g_boldstyle
  6835.       
  6836.    CASE objtype = c_otpopup
  6837.       REPLACE fontface  WITH m.g_cfontface
  6838.       REPLACE fontsize  WITH m.g_cfontsize
  6839.       REPLACE fontstyle WITH m.g_normstyle
  6840.       
  6841.    CASE objtype = c_ottext
  6842.       REPLACE fontface  WITH m.g_fontface
  6843.       REPLACE fontsize  WITH m.g_fontsize
  6844.       REPLACE fontstyle WITH m.g_boldstyle
  6845.       
  6846.    CASE objtype = c_otfield
  6847.       REPLACE fontface  WITH m.g_fontface
  6848.       REPLACE fontsize  WITH m.g_fontsize
  6849.       REPLACE fontstyle WITH m.g_normstyle
  6850.       
  6851.    OTHERWISE
  6852.       REPLACE fontface  WITH m.g_fontface
  6853.       REPLACE fontsize  WITH m.g_fontsize
  6854.       REPLACE fontstyle WITH m.g_normstyle
  6855.    ENDCASE
  6856. ENDIF
  6857.  
  6858. *
  6859. * convertColorPair - Convert the color pair to appropriate RGB pen
  6860. *               and fill values.
  6861. *
  6862. *!*****************************************************************************
  6863. *!
  6864. *!      Procedure: CONVERTCOLORPAIR
  6865. *!
  6866. *!      Called by: ADJCOLOR           (procedure in TRANSPRT.PRG)
  6867. *!
  6868. *!          Calls: GETCOLOR()         (function  in TRANSPRT.PRG)
  6869. *!
  6870. *!*****************************************************************************
  6871. PROCEDURE convertcolorpair
  6872. PRIVATE m.oldscheme, m.rgbvalue, m.comma, m.frg, m.bkg
  6873.  
  6874. * Translate foreground colors
  6875. m.frg = UPPER(CHRTRAN(LEFT(colorpair,AT('/',colorpair)-1),'-*/, ',''))
  6876. REPLACE penred    WITH -1
  6877. REPLACE pengreen  WITH -1
  6878. REPLACE penblue   WITH -1
  6879. IF "W" $ m.frg
  6880.    REPLACE penred    WITH IIF('+' $ m.frg,255,128)
  6881.    REPLACE pengreen  WITH IIF('+' $ m.frg,255,128)
  6882.    REPLACE penblue   WITH IIF('+' $ m.frg,255,128)
  6883. ENDIF
  6884. IF "N" $ m.frg
  6885.    REPLACE penred    WITH 0
  6886.    REPLACE pengreen  WITH 0
  6887.    REPLACE penblue   WITH 0
  6888. ENDIF
  6889. IF "R" $ m.frg    && red
  6890.    REPLACE penred    WITH IIF('+' $ m.frg,255,128)
  6891. ENDIF
  6892. IF "G" $ m.frg    && green
  6893.    REPLACE pengreen  WITH IIF('+' $ m.frg,255,128)
  6894. ENDIF
  6895. IF "B" $ m.frg    && blue
  6896.    REPLACE penblue   WITH IIF('+' $ m.frg,255,128)
  6897. ENDIF
  6898. REPLACE penred   WITH IIF(penred < 0,0,penred)
  6899. REPLACE pengreen WITH IIF(pengreen < 0,0,pengreen)
  6900. REPLACE penblue  WITH IIF(penblue < 0,0,penblue)
  6901.  
  6902. m.bkg = UPPER(CHRTRAN(SUBSTR(colorpair,AT('/',colorpair)+1,3),'-*/, ',''))
  6903. REPLACE fillred    WITH -1
  6904. REPLACE fillgreen  WITH -1
  6905. REPLACE fillblue   WITH -1
  6906. DO CASE
  6907. CASE m.bkg = "W" OR m.bkg = "W+"    && white
  6908.    REPLACE fillred    WITH IIF('+' $ m.bkg,255,128)
  6909.    REPLACE fillgreen  WITH IIF('+' $ m.bkg,255,128)
  6910.    REPLACE fillblue   WITH IIF('+' $ m.bkg,255,128)
  6911. CASE m.bkg = "N" OR m.bkg = "N+"    && black
  6912.    REPLACE fillred    WITH 0
  6913.    REPLACE fillgreen  WITH 0
  6914.    REPLACE fillblue   WITH 0
  6915. CASE "R" $ m.bkg OR "G" $ m.bkg OR "B" $ m.bkg
  6916.    IF "R" $ m.bkg    && red
  6917.       REPLACE fillred    WITH IIF('+' $ m.bkg,255,128)
  6918.    ENDIF
  6919.    IF "G" $ m.bkg    && green
  6920.       REPLACE fillgreen  WITH IIF('+' $ m.bkg,255,128)
  6921.    ENDIF
  6922.    IF "B" $ m.bkg    && blue
  6923.       REPLACE fillblue   WITH IIF('+' $ m.bkg,255,128)
  6924.    ENDIF
  6925.    REPLACE fillred   WITH IIF(fillred < 0,0,fillred)
  6926.    REPLACE fillgreen WITH IIF(fillgreen < 0,0,fillgreen)
  6927.    REPLACE fillblue  WITH IIF(fillblue < 0,0,fillblue)
  6928. ENDCASE
  6929. RETURN
  6930.  
  6931. * getColor - Return the color value for a specified RGB value.
  6932. *
  6933. *!*****************************************************************************
  6934. *!
  6935. *!       Function: GETCOLOR
  6936. *!
  6937. *!      Called by: CONVERTCOLORPAIR   (procedure in TRANSPRT.PRG)
  6938. *!
  6939. *!*****************************************************************************
  6940. FUNCTION getcolor
  6941. PARAMETER m.rgbstring, m.occurence
  6942. PRIVATE m.comma, m.value
  6943. m.comma = ATC(',', m.rgbstring, m.occurence)
  6944. m.value = SUBSTR(m.rgbstring, m.comma +1, ;
  6945.    ATC(',', m.rgbstring, m.occurence + 1)-m.comma -1)
  6946. RETURN m.value
  6947.  
  6948. *
  6949. *whatStyle - Return the style string which corresponds to the style
  6950. *         stored in screen database.
  6951. *
  6952. *!*****************************************************************************
  6953. *!
  6954. *!       Function: WHATSTYLE
  6955. *!
  6956. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  6957. *!               : FILLININFO         (procedure in TRANSPRT.PRG)
  6958. *!               : ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  6959. *!               : GETWINDFONT        (procedure in TRANSPRT.PRG)
  6960. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6961. *!
  6962. *!*****************************************************************************
  6963. FUNCTION whatstyle
  6964. PARAMETER m.stylenum
  6965. IF NOT EMPTY(stylenum)
  6966.    DO CASE
  6967.    CASE m.stylenum = 1
  6968.       RETURN "B"
  6969.    CASE m.stylenum = 2
  6970.       RETURN "I"
  6971.    CASE m.stylenum = 3
  6972.       RETURN "BI"
  6973.    ENDCASE
  6974. ELSE
  6975.    RETURN ""
  6976. ENDIF
  6977.  
  6978. *
  6979. * AdjText - Takes the current record and, if it is a multi-line text object, converts it into
  6980. *      multiple single line text objects.
  6981. *
  6982. *!*****************************************************************************
  6983. *!
  6984. *!      Procedure: ADJTEXT
  6985. *!
  6986. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  6987. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  6988. *!
  6989. *!*****************************************************************************
  6990. PROCEDURE adjtext
  6991. PARAMETER m.oldwidth
  6992.  
  6993. PRIVATE m.saverec
  6994.  
  6995. IF objtype <> c_ottext OR AT(CHR(13), expr) = 0 OR ;
  6996.       m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  6997.    RETURN
  6998. ENDIF
  6999.  
  7000. m.saverec = RECNO()
  7001. SCATTER MEMVAR MEMO
  7002.  
  7003. * Update the original records
  7004. m.expr = SUBSTR(m.expr, 2, LEN(m.expr)-2)
  7005. m.pos = AT(CHR(13), m.expr)
  7006. REPLACE expr WITH '"' + LEFT(m.expr, m.pos-1) + '"'
  7007. REPLACE WIDTH WITH LEN(expr)-2
  7008. DO CASE
  7009. CASE m.picture = '"@J"'                        && Right aligned
  7010.    REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7011. CASE m.picture = '"@I"'                        && Centered
  7012.    REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7013. ENDCASE
  7014. m.expr = SUBSTR(m.expr, m.pos+1)
  7015. m.pos = AT(CHR(13), m.expr)
  7016.  
  7017. * Write all records but the last
  7018. DO WHILE m.pos > 0
  7019.    m.vpos = m.vpos + IIF(spacing = 1, m.height * 2, m.height)
  7020.    APPEND BLANK
  7021.    GATHER MEMVAR MEMO
  7022.    REPLACE platform WITH LOWER(platform)
  7023.    REPLACE uniqueid WITH SYS(2015)
  7024.    REPLACE expr WITH '"' + LEFT(m.expr, m.pos-1) + '"'
  7025.    REPLACE WIDTH WITH LEN(expr)-2
  7026.    DO CASE
  7027.    CASE m.picture = '"@J"'                     && Right aligned
  7028.       REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7029.    CASE m.picture = '"@I"'                     && Centered
  7030.       REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7031.    ENDCASE
  7032.    
  7033.    m.expr = SUBSTR(m.expr, m.pos+1)
  7034.    m.pos = AT(CHR(13), m.expr)
  7035. ENDDO
  7036.  
  7037. * Write the last record.
  7038. IF LEN(ALLTRIM(m.expr)) <> 0
  7039.    m.vpos = m.vpos + IIF(spacing = 1, m.height * 2, m.height)
  7040.    APPEND BLANK
  7041.    GATHER MEMVAR MEMO
  7042.    REPLACE platform WITH LOWER(platform)
  7043.    REPLACE uniqueid WITH SYS(2015)
  7044.    REPLACE expr WITH '"' + m.expr + '"'
  7045.    REPLACE WIDTH WITH LEN(expr)-2
  7046.    DO CASE
  7047.    CASE m.picture = '"@J"'                     && Right aligned
  7048.       REPLACE hpos WITH hpos + m.oldwidth - WIDTH
  7049.    CASE m.picture = '"@I"'                     && Centered
  7050.       REPLACE hpos WITH hpos + (m.oldwidth - WIDTH)/2
  7051.    ENDCASE
  7052. ENDIF
  7053.  
  7054. GOTO m.saverec
  7055.  
  7056. *
  7057. *
  7058. * AdjBox - Converts a box/line record from character to graphic or graphic to character
  7059. *
  7060. *!*****************************************************************************
  7061. *!
  7062. *!      Procedure: ADJBOX
  7063. *!
  7064. *!      Called by: RPTOBJCONVERT      (procedure in TRANSPRT.PRG)
  7065. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  7066. *!               : ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7067. *!
  7068. *!          Calls: GETLINEWIDTH()     (function  in TRANSPRT.PRG)
  7069. *!
  7070. *!*****************************************************************************
  7071. PROCEDURE adjbox
  7072. PARAMETER m.adjust
  7073. IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7074.    DO CASE
  7075.    CASE objcode = c_sgboxd
  7076.       REPLACE pensize WITH 4
  7077.    CASE objcode = c_sgboxp
  7078.       REPLACE pensize WITH 6
  7079.    OTHERWISE
  7080.       REPLACE pensize WITH 1
  7081.    ENDCASE
  7082.    
  7083.    DO CASE
  7084.    CASE HEIGHT = 1
  7085.       REPLACE HEIGHT WITH getlinewidth(objcode, .T.)
  7086.       REPLACE vpos WITH vpos + c_adjbox - (HEIGHT/2)
  7087.       IF m.g_filetype = c_screen
  7088.          REPLACE STYLE WITH c_lnhorizontal
  7089.       ENDIF
  7090.       
  7091.       REPLACE penpat  WITH 8
  7092.       REPLACE fillpat WITH 0
  7093.       REPLACE objtype WITH c_otline
  7094.       REPLACE objcode WITH 0
  7095.       
  7096.    CASE WIDTH = 1
  7097.       REPLACE WIDTH WITH getlinewidth(objcode, .F.)
  7098.       REPLACE hpos WITH hpos + c_adjbox - (WIDTH/2)
  7099.       IF m.g_filetype = c_screen
  7100.          REPLACE STYLE WITH c_lnvertical
  7101.       ENDIF
  7102.       
  7103.       REPLACE penpat  WITH 8
  7104.       REPLACE fillpat WITH 0
  7105.       REPLACE objtype WITH c_otline
  7106.       REPLACE objcode WITH 0
  7107.       
  7108.    OTHERWISE
  7109.       REPLACE vpos WITH vpos + c_adjbox - (getlinewidth(objcode, .T.)/2) + m.adjust
  7110.       REPLACE hpos WITH hpos + c_adjbox - (getlinewidth(objcode, .F.)/2) + m.adjust
  7111.       REPLACE HEIGHT WITH HEIGHT + getlinewidth(objcode, .T.) - 1
  7112.       REPLACE WIDTH WITH WIDTH + getlinewidth(objcode, .F.) - 1
  7113.       
  7114.       REPLACE penpat  WITH 8
  7115.       REPLACE fillpat WITH 0
  7116.       REPLACE objcode WITH 4
  7117.    ENDCASE
  7118.    
  7119.    IF m.g_filetype = c_screen
  7120.       IF BORDER > 4
  7121.          REPLACE BORDER WITH 1
  7122.       ELSE
  7123.          REPLACE BORDER WITH 0
  7124.       ENDIF
  7125.    ENDIF
  7126. ELSE
  7127.    ******************* Start Graphic to Character Conversion ******************
  7128.    IF fillpat = 0
  7129.       REPLACE fillchar WITH CHR(0)
  7130.    ELSE
  7131.       REPLACE fillchar WITH " "
  7132.    ENDIF
  7133.    
  7134.    DO CASE
  7135.    CASE pensize = 4
  7136.       REPLACE objcode WITH c_sgboxd
  7137.    CASE pensize = 6
  7138.       REPLACE objcode WITH c_sgboxp
  7139.    OTHERWISE
  7140.       REPLACE objcode WITH c_sgbox
  7141.    ENDCASE
  7142.    
  7143.    DO CASE
  7144.    CASE objtype = c_otline AND STYLE = c_lnhorizontal
  7145.       REPLACE vpos WITH vpos - c_adjbox
  7146.       REPLACE HEIGHT WITH 1
  7147.       
  7148.    CASE objtype = c_otline AND STYLE = c_lnvertical
  7149.       REPLACE hpos WITH hpos-c_adjbox
  7150.       REPLACE HEIGHT WITH 1
  7151.       
  7152.    OTHERWISE
  7153.       REPLACE vpos WITH vpos-c_adjbox
  7154.       REPLACE hpos WITH hpos-c_adjbox
  7155.       REPLACE HEIGHT WITH HEIGHT+(c_adjbox*2)
  7156.       REPLACE WIDTH WITH WIDTH+(c_adjbox*2)
  7157.    ENDCASE
  7158. ENDIF
  7159.  
  7160. *
  7161. * GetLineWidth - Given an object code for a box or line and a flag indicating
  7162. *      if we want the thickness of a horizontal or vertical size, we return
  7163. *      the thickness of the side.
  7164. *
  7165. *!*****************************************************************************
  7166. *!
  7167. *!       Function: GETLINEWIDTH
  7168. *!
  7169. *!      Called by: JOINHORIZONTAL     (procedure in TRANSPRT.PRG)
  7170. *!               : JOINVERTICAL       (procedure in TRANSPRT.PRG)
  7171. *!               : REJOINBOXES        (procedure in TRANSPRT.PRG)
  7172. *!               : JOINLINEWIDTH()    (function  in TRANSPRT.PRG)
  7173. *!               : ADJBOX             (procedure in TRANSPRT.PRG)
  7174. *!
  7175. *!*****************************************************************************
  7176. FUNCTION getlinewidth
  7177. PARAMETERS m.objcode, m.horizontal
  7178.  
  7179. IF _WINDOWS OR _MAC
  7180.    DO CASE
  7181.    CASE m.objcode = c_sgboxd
  7182.       IF m.g_filetype = c_report
  7183.          RETURN 4 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7184.       ELSE
  7185.          RETURN 4 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7186.       ENDIF
  7187.       
  7188.    CASE m.objcode = c_sgboxp
  7189.       IF m.g_filetype = c_report
  7190.          RETURN 6 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7191.       ELSE
  7192.          RETURN 6 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7193.       ENDIF
  7194.       
  7195.    OTHERWISE
  7196.       IF m.g_filetype = c_report
  7197.          RETURN 1 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_rptfface, m.g_rptfsize, m.g_rpttxtfontstyle)
  7198.       ELSE
  7199.          RETURN 1 / FONTMETRIC(IIF(m.horizontal, 1, 6), m.g_fontface, m.g_fontsize, "B")
  7200.       ENDIF
  7201.    ENDCASE
  7202. ELSE
  7203.    RETURN 1
  7204. ENDIF
  7205.  
  7206. *
  7207. * HorizButton - Will return a .T. if the ojbect passed in is a series of
  7208. *            horizontal buttons.  If they are vertical buttons, it
  7209. *            returns .F.
  7210. *
  7211. *!*****************************************************************************
  7212. *!
  7213. *!       Function: HORIZBUTTON
  7214. *!
  7215. *!      Called by: CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  7216. *!               : FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  7217. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  7218. *!               : ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  7219. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  7220. *!               : GETLASTOBJECTLINE()(function  in TRANSPRT.PRG)
  7221. *!               : GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  7222. *!               : GETOBJHEIGHT()     (function  in TRANSPRT.PRG)
  7223. *!
  7224. *!*****************************************************************************
  7225. FUNCTION horizbutton
  7226. PARAMETER m.pictclause
  7227.  
  7228. IF OCCURS(';', m.pictclause) = 0 OR ;
  7229.       AT("H", LEFT(m.pictclause, AT(" ", m.pictclause))) != 0
  7230.    RETURN .T.
  7231. ELSE
  7232.    RETURN .F.
  7233. ENDIF
  7234.  
  7235. *
  7236. * MaxBtnWidth - Given the Picture clause for a set of buttons (text or
  7237. *      radio) along with its font information and returns the Width in
  7238. *      foxels of the widest label.
  7239. *
  7240. *!*****************************************************************************
  7241. *!
  7242. *!       Function: MAXBTNWIDTH
  7243. *!
  7244. *!      Called by: ADJHEIGHTANDWIDTH  (procedure in TRANSPRT.PRG)
  7245. *!
  7246. *!*****************************************************************************
  7247. FUNCTION maxbtnwidth
  7248. PARAMETERS m.picture, m.face, m.size, m.style
  7249. PRIVATE m.max, m.label
  7250.  
  7251. m.max = 0
  7252. m.picture = SUBSTR(m.picture, AT(" ", m.picture))
  7253.  
  7254. m.picture = STRTRAN(m.picture, "\\", "")
  7255. m.picture = STRTRAN(m.picture, "\<", "")
  7256. m.picture = STRTRAN(m.picture, "\!", "")
  7257. m.picture = STRTRAN(m.picture, "\?", "")
  7258.  
  7259. DO WHILE LEN(m.picture) != 0
  7260.    IF AT(";", m.picture) != 0
  7261.       m.label = ALLTRIM(LEFT(m.picture, AT(";", m.picture)-1))
  7262.       m.picture = SUBSTR(m.picture, AT(";", m.picture)+1)
  7263.    ELSE
  7264.       m.label = ALLTRIM(LEFT(m.picture, LEN(m.picture)-1))
  7265.       m.picture = ""
  7266.    ENDIF
  7267.    
  7268.    IF m.g_tographic
  7269.       m.max = MAX(m.max, TXTWIDTH(m.label, m.face, m.size, m.style))
  7270.    ELSE
  7271.       m.max = MAX(m.max, LEN(m.label))
  7272.    ENDIF
  7273. ENDDO
  7274.  
  7275. RETURN m.max
  7276.  
  7277. *
  7278. * GetObjWidth - Given a screen object, this function returns its Width.
  7279. *
  7280. *!*****************************************************************************
  7281. *!
  7282. *!       Function: GETOBJWIDTH
  7283. *!
  7284. *!      Called by: ITEMSINBOXES       (procedure in TRANSPRT.PRG)
  7285. *!               : GETRIGHTMOST       (procedure in TRANSPRT.PRG)
  7286. *!
  7287. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  7288. *!
  7289. *!*****************************************************************************
  7290. FUNCTION getobjwidth
  7291. PARAMETERS m.objtype, m.picture, m.width, m.spacing, m.platform
  7292. PRIVATE m.numitems
  7293.  
  7294. DO CASE
  7295. CASE m.objtype = c_ottext OR m.objtype = c_otfield OR ;
  7296.       m.objtype = c_otline OR m.objtype = c_otbox OR ;
  7297.       m.objtype = c_otlist OR m.objtype = c_otchkbox OR ;
  7298.       m.objtype = c_otpopup OR m.objtype = c_otpicture OR ;
  7299.       m.objtype = c_otspinner OR m.objtype = c_otrepfld
  7300.    RETURN m.width
  7301.    
  7302. CASE m.objtype = c_ottxtbut OR m.objtype = c_otradbut OR m.objtype = c_otinvbut
  7303.    m.numitems = OCCURS(";", m.picture) + 1
  7304.    IF !horizbutton(m.picture) OR m.numitems = 1
  7305.       RETURN m.width
  7306.    ELSE
  7307.       RETURN (m.width * m.numitems) + (m.spacing * (m.numitems - 1))
  7308.    ENDIF
  7309.    
  7310. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7311.       (m.platform = "MAC" OR m.platform = "WINDOWS")
  7312.    RETURN m.width
  7313.    
  7314. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7315.       (m.platform = "DOS" OR m.platform = "UNIX")
  7316.    RETURN m.width-1
  7317.    
  7318. OTHERWISE
  7319.    RETURN m.width
  7320. ENDCASE
  7321.  
  7322. *
  7323. * GetObjHeight - Given a screen object, this function returns its Height.
  7324. *
  7325. *!*****************************************************************************
  7326. *!
  7327. *!       Function: GETOBJHEIGHT
  7328. *!
  7329. *!      Called by: GETLOWEST          (procedure in TRANSPRT.PRG)
  7330. *!
  7331. *!          Calls: HORIZBUTTON()      (function  in TRANSPRT.PRG)
  7332. *!
  7333. *!*****************************************************************************
  7334. FUNCTION getobjheight
  7335. PARAMETERS m.objtype, m.picture, m.height, m.spacing, m.platform
  7336. PRIVATE m.numitems
  7337.  
  7338. DO CASE
  7339. CASE m.objtype = c_ottext OR m.objtype = c_otfield OR ;
  7340.       m.objtype = c_otline OR m.objtype = c_otbox OR ;
  7341.       m.objtype = c_otlist OR m.objtype = c_otchkbox OR ;
  7342.       m.objtype = c_otpopup OR m.objtype = c_otpicture OR ;
  7343.       m.objtype = c_otspinner OR m.objtype = c_otrepfld
  7344.    RETURN m.height
  7345.    
  7346. CASE m.objtype = c_ottxtbut OR m.objtype = c_otradbut OR ;
  7347.       m.objtype = c_otinvbut
  7348.    m.numitems = OCCURS(";", m.picture) + 1
  7349.    
  7350.    IF horizbutton(m.picture) OR m.numitems = 1
  7351.       RETURN m.height
  7352.    ELSE
  7353.       RETURN (m.height * m.numitems) + (m.spacing * (m.numitems - 1))
  7354.    ENDIF
  7355.    
  7356. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7357.       (m.platform = "MAC" OR m.platform = "WINDOWS")
  7358.    RETURN m.height
  7359.    
  7360. CASE (m.objtype = c_otbox OR m.objtype = c_otline) AND ;
  7361.       (m.platform = "DOS" OR m.platform = "UNIX")
  7362.    RETURN m.height-1
  7363.    
  7364. OTHERWISE
  7365.    RETURN m.height
  7366. ENDCASE
  7367.  
  7368. *
  7369. * GetRightmost - Takes a platform and returns the rightmost position occupied by an object
  7370. *      in that platform
  7371. *!*****************************************************************************
  7372. *!
  7373. *!      Procedure: GETRIGHTMOST
  7374. *!
  7375. *!      Called by: MAKECHARFIT        (procedure in TRANSPRT.PRG)
  7376. *!
  7377. *!          Calls: GETOBJWIDTH()      (function  in TRANSPRT.PRG)
  7378. *!
  7379. *!*****************************************************************************
  7380. PROCEDURE getrightmost
  7381. PARAMETER m.platform
  7382. PRIVATE m.right
  7383.  
  7384. m.right = 0
  7385.  
  7386. SCAN FOR platform = m.platform AND !DELETED() AND ;
  7387.       (objtype = c_ottext OR objtype = c_otline OR ;
  7388.       objtype = c_otbox OR objtype = c_otrepfld OR ;
  7389.       objtype = c_otlist OR objtype = c_ottxtbut OR ;
  7390.       objtype = c_otradbut OR objtype = c_otchkbox OR ;
  7391.       objtype = c_otfield OR objtype = c_otpopup OR ;
  7392.       objtype = c_otpicture OR objtype = c_otinvbut OR ;
  7393.       objtype = c_otspinner)
  7394.    m.right = MAX(m.right, hpos + getobjwidth(objtype, PICTURE, WIDTH, spacing, m.g_toplatform))
  7395. ENDSCAN
  7396.  
  7397. RETURN m.right
  7398.  
  7399. *
  7400. * GetLowest - Takes a platform and returns the lowest position occupied by an object
  7401. *      in that platform
  7402. *!*****************************************************************************
  7403. *!
  7404. *!      Procedure: GETLOWEST
  7405. *!
  7406. *!      Called by: MAKECHARFIT        (procedure in TRANSPRT.PRG)
  7407. *!
  7408. *!          Calls: GETOBJHEIGHT()     (function  in TRANSPRT.PRG)
  7409. *!
  7410. *!*****************************************************************************
  7411. PROCEDURE getlowest
  7412. PARAMETER m.platform
  7413. PRIVATE m.bottom
  7414.  
  7415. m.bottom = 0
  7416.  
  7417. SCAN FOR platform = m.platform AND !DELETED() AND ;
  7418.       (objtype = c_ottext OR objtype = c_otline OR ;
  7419.       objtype = c_otbox OR objtype = c_otrepfld OR ;
  7420.       objtype = c_otlist OR objtype = c_ottxtbut OR ;
  7421.       objtype = c_otradbut OR objtype = c_otchkbox OR ;
  7422.       objtype = c_otfield OR objtype = c_otpopup OR ;
  7423.       objtype = c_otpicture OR objtype = c_otinvbut OR ;
  7424.       objtype = c_otspinner)
  7425.    m.bottom = MAX(m.bottom, vpos + getobjheight(objtype, PICTURE, HEIGHT, spacing, m.g_toplatform))
  7426. ENDSCAN
  7427.  
  7428. RETURN m.bottom
  7429.  
  7430. *
  7431. * DoCreate - Creates an empty cursor with either a report or screen structure and a given name.
  7432. *
  7433. *!*****************************************************************************
  7434. *!
  7435. *!      Procedure: DOCREATE
  7436. *!
  7437. *!      Called by: CONVERT102FRX()    (function  in TRANSPRT.PRG)
  7438. *!               : CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  7439. *!               : MAKECURSOR         (procedure in TRANSPRT.PRG)
  7440. *!               : WRITERESULT        (procedure in TRANSPRT.PRG)
  7441. *!
  7442. *!*****************************************************************************
  7443. PROCEDURE docreate
  7444. PARAMETER m.name, m.type
  7445. DO CASE
  7446. CASE m.type = c_screen
  7447.    CREATE CURSOR (m.name) (platform C(8), uniqueid C(10), timestamp N(10), objtype N(2), objcode N(3), ;
  7448.       name m, expr m, vpos N(7,3), hpos N(7,3), HEIGHT N(7,3), WIDTH N(7,3), ;
  7449.       STYLE N(2), PICTURE m, ORDER m, UNIQUE l, comment m, ENVIRON l, ;
  7450.       boxchar C(1), fillchar C(1), TAG m, tag2 m, penred N(5), pengreen N(5), ;
  7451.       penblue N(5), fillred N(5), fillgreen N(5), fillblue N(5), pensize N(5), ;
  7452.       penpat N(5), fillpat N(5), fontface m, fontstyle N(3), fontsize N(3), ;
  7453.       mode N(3), ruler N(1), rulerlines N(1), grid l, gridv N(2), gridh N(2), ;
  7454.       SCHEME N(2), scheme2 N(2), colorpair C(8), lotype N(1), rangelo m, ;
  7455.       hitype N(1), rangehi m, whentype N(1), WHEN m, validtype N(1), VALID m, ;
  7456.       errortype N(1), ERROR m, messtype N(1), MESSAGE m, showtype N(1), SHOW m, ;
  7457.       activtype N(1), ACTIVATE m, deacttype N(1), DEACTIVATE m, proctype N(1), ;
  7458.       proccode m, setuptype N(1), setupcode m, FLOAT l, CLOSE l, MINIMIZE l, ;
  7459.       BORDER N(1), SHADOW l, CENTER l, REFRESH l, disabled l, scrollbar l, ;
  7460.       addalias l, TAB l, initialval m, initialnum N(3), spacing N(6,3), curpos l)
  7461.    
  7462. CASE m.type = c_report OR m.type = c_label
  7463.    CREATE CURSOR (m.name) (platform C(8), uniqueid C(10), timestamp N(10), objtype N(2), objcode N(3), ;
  7464.       name m, expr m, vpos N(9,3), hpos N(9,3), HEIGHT N(9,3), WIDTH N(9,3), ;
  7465.       STYLE m, PICTURE m, ORDER m, UNIQUE l, comment m, ENVIRON l, ;
  7466.       boxchar C(1), fillchar C(1), TAG m, tag2 m, penred N(5), pengreen N(5), ;
  7467.       penblue N(5), fillred N(5), fillgreen N(5), fillblue N(5), pensize N(5), ;
  7468.       penpat N(5), fillpat N(5), fontface m, fontstyle N(3), fontsize N(3), ;
  7469.       mode N(3), ruler N(1), rulerlines N(1), grid l, gridv N(2), gridh N(2), ;
  7470.       FLOAT l, STRETCH l, stretchtop l, TOP l, BOTTOM l, suptype N(1), suprest N(1), ;
  7471.       norepeat l, resetrpt N(2), pagebreak l, colbreak l, resetpage l, GENERAL N(3), ;
  7472.       spacing N(3), DOUBLE l, swapheader l, swapfooter l, ejectbefor l, ejectafter l, ;
  7473.       PLAIN l, SUMMARY l, addalias l, offset N(3), topmargin N(3), botmargin N(3), ;
  7474.       totaltype N(2), resettotal N(2), resoid N(3), curpos l, supalways l, supovflow l, ;
  7475.       suprpcol N(1), supgroup N(2), supvalchng l, supexpr m)
  7476. CASE m.type = c_project
  7477.    CREATE CURSOR (m.name) ;
  7478.       (name m, ;
  7479.       TYPE C(1), ;
  7480.       timestamp N(10), ;
  7481.       outfile m, ;
  7482.       homedir m, ;
  7483.       setid N(4), ;
  7484.       exclude l, ;
  7485.       mainprog l, ;
  7486.       arranged m, ;
  7487.       savecode l, ;
  7488.       defname l, ;
  7489.       openfiles l, ;
  7490.       closefiles l, ;
  7491.       defwinds l, ;
  7492.       relwinds l, ;
  7493.       readcycle l, ;
  7494.       multreads l, ;
  7495.       NOLOCK l, ;
  7496.       MODAL l, ;
  7497.       assocwinds m, ;
  7498.       DEBUG l, ;
  7499.       ENCRYPT l, ;
  7500.       nologo l, ;
  7501.       scrnorder N(3), ;
  7502.       cmntstyle N(1), ;
  7503.       objrev N(5), ;
  7504.       commands m, ;
  7505.       devinfo m, ;
  7506.       symbols m, ;
  7507.       OBJECT m, ;
  7508.       ckval N(6) ;
  7509.       )
  7510. ENDCASE
  7511.  
  7512. *
  7513. * makecursor - Create a cursor with the structure we need for this file on the 2.5 platform.
  7514. *
  7515. *!*****************************************************************************
  7516. *!
  7517. *!      Procedure: MAKECURSOR
  7518. *!
  7519. *!      Called by: TRANSPRT.PRG                      
  7520. *!               : CONVERTER          (procedure in TRANSPRT.PRG)
  7521. *!
  7522. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  7523. *!
  7524. *!*****************************************************************************
  7525. PROCEDURE makecursor
  7526. PRIVATE m.temp20alias, m.in_del
  7527.  
  7528. m.temp20alias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  7529. DO docreate WITH m.temp20alias, m.g_filetype
  7530. m.in_del = SET("DELETED")
  7531. SET DELETED ON
  7532. APPEND FROM (m.g_scrndbf)
  7533. SET DELETED &in_del
  7534.  
  7535. m.g_20alias = m.g_scrnalias
  7536. m.g_scrnalias = m.temp20alias
  7537.  
  7538.  
  7539. *
  7540. * AddGraphicalLabelGroups - Add page and column header records for a label.
  7541. *
  7542. *!*****************************************************************************
  7543. *!
  7544. *!      Procedure: ADDGRAPHICALLABELGROUPS
  7545. *!
  7546. *!      Called by: ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  7547. *!               : UPDATELABELDATA    (procedure in TRANSPRT.PRG)
  7548. *!
  7549. *!*****************************************************************************
  7550. PROCEDURE addgraphicallabelgroups
  7551.  
  7552. IF m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7553.    * First make sure that we don't already have these headers.  Check for a page header.
  7554.    LOCATE FOR objtype = c_otband AND objcode = 1
  7555.    IF FOUND()
  7556.       * We already have a page header.  We don't want two.  Reports, like people, function
  7557.       * best with only a single head.
  7558.       RETURN
  7559.    ENDIF
  7560.    
  7561.    APPEND BLANK
  7562.    REPLACE objtype WITH c_otband
  7563.    REPLACE objcode WITH 1
  7564.    REPLACE HEIGHT WITH 0
  7565.    REPLACE pagebreak WITH .F.
  7566.    REPLACE colbreak WITH .F.
  7567.    REPLACE resetpage WITH .F.
  7568.    REPLACE platform WITH m.g_toplatform
  7569.    REPLACE uniqueid WITH SYS(2015)
  7570.    
  7571.    APPEND BLANK
  7572.    REPLACE objtype WITH c_otband
  7573.    REPLACE objcode WITH 2
  7574.    REPLACE HEIGHT WITH 0
  7575.    REPLACE pagebreak WITH .F.
  7576.    REPLACE colbreak WITH .F.
  7577.    REPLACE resetpage WITH .F.
  7578.    REPLACE platform WITH m.g_toplatform
  7579.    REPLACE uniqueid WITH SYS(2015)
  7580.    
  7581.    APPEND BLANK
  7582.    REPLACE objtype WITH c_otband
  7583.    REPLACE objcode WITH 6
  7584.    REPLACE HEIGHT WITH 0
  7585.    REPLACE pagebreak WITH .F.
  7586.    REPLACE colbreak WITH .F.
  7587.    REPLACE resetpage WITH .F.
  7588.    REPLACE platform WITH m.g_toplatform
  7589.    REPLACE uniqueid WITH SYS(2015)
  7590.    
  7591.    APPEND BLANK
  7592.    REPLACE objtype WITH c_otband
  7593.    REPLACE objcode WITH 7
  7594.    REPLACE HEIGHT WITH 0
  7595.    REPLACE pagebreak WITH .F.
  7596.    REPLACE colbreak WITH .F.
  7597.    REPLACE resetpage WITH .F.
  7598.    REPLACE platform WITH m.g_toplatform
  7599.    REPLACE uniqueid WITH SYS(2015)
  7600. ENDIF
  7601.  
  7602. *
  7603. * UpdateLabelData - Labels live in report dataases now and we need to add at least one band
  7604. *            record if we are coming from a 2.0 label.
  7605. *
  7606. *!*****************************************************************************
  7607. *!
  7608. *!      Procedure: UPDATELABELDATA
  7609. *!
  7610. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7611. *!
  7612. *!          Calls: ADDGRAPHICALLABELGR(procedure in TRANSPRT.PRG)
  7613. *!
  7614. *!*****************************************************************************
  7615. PROCEDURE updatelabeldata
  7616. PARAMETER m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight
  7617.  
  7618. DO addgraphicallabelgroups
  7619.  
  7620. * We need a detail band for any platform.
  7621. APPEND BLANK
  7622. REPLACE objtype WITH c_otband
  7623. REPLACE objcode WITH 4
  7624. REPLACE HEIGHT WITH m.lbxheight
  7625. REPLACE pagebreak WITH .F.
  7626. REPLACE colbreak WITH .F.
  7627. REPLACE resetpage WITH .F.
  7628.  
  7629. LOCATE FOR objtype = c_ot20label
  7630. IF FOUND()
  7631.    REPLACE vpos WITH m.lbxnumacross
  7632.    REPLACE hpos WITH m.lbxlmargin
  7633.    REPLACE HEIGHT WITH m.lbxspacesbet
  7634.    REPLACE penblue WITH m.lbxlinesbet
  7635. ENDIF
  7636.  
  7637. *
  7638. * PlatformDefaults - Writes information to a record that would not exist on the source platform and
  7639. *         we don't add elsewhere.
  7640. *
  7641. *!*****************************************************************************
  7642. *!
  7643. *!      Procedure: PLATFORMDEFAULTS
  7644. *!
  7645. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7646. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  7647. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  7648. *!
  7649. *!*****************************************************************************
  7650. PROCEDURE platformdefaults
  7651. PARAMETER m.timestamp
  7652.  
  7653. IF m.timestamp > 0
  7654.    REPLACE uniqueid WITH SYS(2015)
  7655.    REPLACE timestamp WITH m.timestamp
  7656.    REPLACE platform WITH m.g_fromplatform
  7657. ENDIF
  7658.  
  7659. IF m.g_toplatform = "MAC" OR m.g_toplatform = "WINDOWS"
  7660.    REPLACE ruler WITH 1             && inches
  7661.    REPLACE rulerlines WITH 1
  7662.    REPLACE grid WITH .T.
  7663.    REPLACE gridv WITH 9
  7664.    REPLACE gridh WITH 9
  7665. ENDIF
  7666.  
  7667. *
  7668. * converter - Convert a 2.0 screen or report to 2.5 format and fill in the
  7669. *            appropriate fields.
  7670. *
  7671. *!*****************************************************************************
  7672. *!
  7673. *!      Procedure: CONVERTER
  7674. *!
  7675. *!      Called by: TRANSPRT.PRG                      
  7676. *!
  7677. *!          Calls: MAKECURSOR         (procedure in TRANSPRT.PRG)
  7678. *!               : UPDATELABELDATA    (procedure in TRANSPRT.PRG)
  7679. *!               : CONVERTPROJECT     (procedure in TRANSPRT.PRG)
  7680. *!               : STAMPVAL()         (function  in TRANSPRT.PRG)
  7681. *!               : PLATFORMDEFAULTS   (procedure in TRANSPRT.PRG)
  7682. *!               : UPDATEVERSION      (procedure in TRANSPRT.PRG)
  7683. *!
  7684. *!*****************************************************************************
  7685. PROCEDURE converter
  7686. PRIVATE m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight, m.timestamp
  7687.  
  7688. DO CASE
  7689. CASE m.g_filetype = c_label
  7690.    LOCATE FOR objtype = c_ot20label
  7691.    IF FOUND()
  7692.       m.lbxnumacross   = numacross
  7693.       m.lbxlmargin     = lmargin
  7694.       m.lbxspacesbet   = spacesbet
  7695.       m.lbxlinesbet    = linesbet
  7696.       m.lbxheight      = HEIGHT
  7697.    ENDIF
  7698. ENDCASE
  7699.  
  7700. DO makecursor
  7701.  
  7702. DO CASE
  7703. CASE m.g_filetype = c_label
  7704.    DO updatelabeldata WITH m.lbxnumacross, m.lbxlmargin, m.lbxspacesbet, m.lbxlinesbet, m.lbxheight
  7705. CASE m.g_filetype = c_project
  7706.    DO convertproject
  7707.    RETURN
  7708. ENDCASE
  7709.  
  7710. m.timestamp = stampval()
  7711. SCAN
  7712.    DO platformdefaults WITH m.timestamp
  7713. ENDSCAN
  7714.  
  7715. DO updateversion
  7716.  
  7717. *
  7718. * UpdateVersion - Places the correct version number in the m.g_fromPlatfrom
  7719. *      records.
  7720. *!*****************************************************************************
  7721. *!
  7722. *!      Procedure: UPDATEVERSION
  7723. *!
  7724. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7725. *!
  7726. *!*****************************************************************************
  7727. PROCEDURE updateversion
  7728. LOCATE FOR platform = "DOS" AND objtype = c_otheader
  7729. IF FOUND()
  7730.    DO CASE
  7731.    CASE m.g_filetype = c_screen
  7732.       REPLACE objcode WITH c_25scx
  7733.    OTHERWISE
  7734.       REPLACE objcode WITH c_25frx
  7735.    ENDCASE
  7736. ENDIF
  7737.  
  7738. *
  7739. * SynchTime - Takes the names of two platforms and makes the timestamp of the header (objectype = 1)
  7740. *      record for the first platfrom match the timestamp of the header record of the second.
  7741. *
  7742. *!*****************************************************************************
  7743. *!
  7744. *!      Procedure: SYNCHTIME
  7745. *!
  7746. *!      Called by: TRANSPRT.PRG                      
  7747. *!
  7748. *!*****************************************************************************
  7749. PROCEDURE synchtime
  7750. PARAMETER m.convertedplatform, m.matchplatform
  7751. PRIVATE m.timestamp
  7752. LOCATE FOR platform = m.matchplatform AND objtype = c_otheader
  7753. IF FOUND()
  7754.    m.timestamp = timestamp
  7755.    LOCATE FOR platform = m.convertedplatform AND objtype = c_otheader
  7756.    IF FOUND()
  7757.       REPLACE timestamp WITH m.timestamp
  7758.    ENDIF
  7759. ENDIF
  7760.  
  7761. *
  7762. * Get a timestamp value based on the current date and time.
  7763. *
  7764. *!*****************************************************************************
  7765. *!
  7766. *!       Function: STAMPVAL
  7767. *!
  7768. *!      Called by: CONVERTER          (procedure in TRANSPRT.PRG)
  7769. *!
  7770. *!          Calls: SHIFTL()           (function  in TRANSPRT.PRG)
  7771. *!               : SHIFTR()           (function  in TRANSPRT.PRG)
  7772. *!
  7773. *!*****************************************************************************
  7774. FUNCTION stampval
  7775. PRIVATE m.dateval, m.timeval
  7776.  
  7777. m.dateval = DAY(DATE()) + ;
  7778.    shiftl(MONTH(DATE()), 5) + ;
  7779.    shiftl(YEAR(DATE())-1980, 9)
  7780.  
  7781. m.timeval = shiftr(VAL(RIGHT(TIME(),2)),1) + ;
  7782.    shiftl(VAL(SUBSTR(TIME(),3,2)),5) + ;
  7783.    shiftl(VAL(LEFT(TIME(),2)),11)
  7784.  
  7785. RETURN shiftl(m.dateval,16)+m.timeval
  7786.  
  7787. *
  7788. * Shift a value x times to the left.  (This isn't a true match for
  7789. * a shift since we keep extending the value without truncating it,
  7790. * but it works for us.)
  7791. *
  7792. *!*****************************************************************************
  7793. *!
  7794. *!       Function: SHIFTL
  7795. *!
  7796. *!      Called by: STAMPVAL()         (function  in TRANSPRT.PRG)
  7797. *!
  7798. *!*****************************************************************************
  7799. FUNCTION shiftl
  7800. PARAMETER m.value, m.times
  7801. PRIVATE m.loop
  7802.  
  7803. FOR m.loop = 1 TO m.times
  7804.    m.value = m.value * 2
  7805. ENDFOR
  7806. RETURN m.value
  7807.  
  7808. *
  7809. * Shift a value x times to the right.  (This isn't a true match for
  7810. * a shift since we keep extending the value without truncating it,
  7811. * but it works for us.)
  7812. *
  7813. *!*****************************************************************************
  7814. *!
  7815. *!       Function: SHIFTR
  7816. *!
  7817. *!      Called by: STAMPVAL()         (function  in TRANSPRT.PRG)
  7818. *!
  7819. *!*****************************************************************************
  7820. FUNCTION shiftr
  7821. PARAMETER m.value, m.times
  7822. PRIVATE m.loop
  7823.  
  7824. FOR m.loop = 1 TO m.times
  7825.    m.value = INT(m.value / 2)
  7826. ENDFOR
  7827. RETURN m.value
  7828.  
  7829. *
  7830. * EmptyPlatform - Takes a platform ID and returns .T. if no records for that platform
  7831. *       are in the file or .F. if some are present.
  7832. *
  7833. *!*****************************************************************************
  7834. *!
  7835. *!       Function: EMPTYPLATFORM
  7836. *!
  7837. *!      Called by: IMPORT             (procedure in TRANSPRT.PRG)
  7838. *!
  7839. *!*****************************************************************************
  7840. FUNCTION emptyplatform
  7841. PARAMETER m.platform
  7842. PRIVATE m.count
  7843. SELECT (m.g_scrnalias)
  7844.  
  7845. IF (FCOUNT() = c_20scxfld OR FCOUNT() = c_20frxfld OR FCOUNT() = c_20lbxfld)
  7846.    RETURN .T.
  7847. ENDIF
  7848.  
  7849. COUNT TO m.count FOR platform = m.platform
  7850. IF m.count > 0
  7851.    RETURN .F.
  7852. ELSE
  7853.    RETURN .T.
  7854. ENDIF
  7855.  
  7856. **
  7857. ** Code Associated With Displaying the 2.0 to 2.5 conversion dialog.
  7858. **
  7859. *!*****************************************************************************
  7860. *!
  7861. *!       Function: STRUCTDIALOG
  7862. *!
  7863. *!      Called by: DOUPDATE()         (function  in TRANSPRT.PRG)
  7864. *!
  7865. *!          Calls: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  7866. *!               : CURPOS()           (function  in TRANSPRT.PRG)
  7867. *!
  7868. *!*****************************************************************************
  7869. FUNCTION structdialog
  7870. PARAMETER m.textline
  7871. PRIVATE m.choice, m.ftype
  7872.  
  7873. DO CASE
  7874. CASE m.g_filetype = c_screen
  7875.    m.ftype = "screen "
  7876. CASE m.g_filetype = c_report
  7877.    m.ftype = "report "
  7878. CASE m.g_filetype = c_label
  7879.    m.ftype = "label "
  7880. CASE m.g_filetype = c_project
  7881.    m.ftype = "project "
  7882. OTHERWISE
  7883.    m.ftype = ""
  7884. ENDCASE
  7885.  
  7886. DO CASE
  7887. CASE m.g_toplatform = "WINDOWS" OR m.g_toplatform = "MAC"
  7888.    IF NOT WEXIST("_q3p0w5ixe")
  7889.       DEFINE WINDOW _q3p0w5ixe ;
  7890.          AT 0,0 ;
  7891.          SIZE 5.076,58.333 ;
  7892.          TITLE "Converter" ;
  7893.          FONT c_dlgface, c_dlgsize ;
  7894.          STYLE c_dlgstyle ;
  7895.          FLOAT ;
  7896.          CLOSE ;
  7897.          MINIMIZE ;
  7898.          SYSTEM
  7899.       MOVE WINDOW _q3p0w5ixe CENTER
  7900.    ENDIF
  7901.    
  7902.    IF WVISIBLE("_q3p0w5ixe")
  7903.       ACTIVATE WINDOW _q3p0w5ixe SAME
  7904.    ELSE
  7905.       ACTIVATE WINDOW _q3p0w5ixe NOSHOW
  7906.    ENDIF
  7907.    
  7908.    @ 1.000, (58.333 - TXTWIDTH(m.textline, c_dlgface, c_dlgsize, c_dlgstyle)) / 2 ;
  7909.       SAY m.textline ;
  7910.       SIZE 1.154,TXTWIDTH(m.textline, c_dlgface, c_dlgsize, c_dlgstyle) ;
  7911.       FONT c_dlgface, c_dlgsize ;
  7912.       STYLE c_dlgstyle
  7913.    
  7914.    @ 2.750,13.512 GET m.choice ;
  7915.       PICTURE "@*HT \!\<Yes;\?\<Cancel" ;
  7916.       SIZE 1.769,13.500,4.308 ;
  7917.       DEFAULT 1 ;
  7918.       FONT c_dlgface, 9 ;
  7919.       STYLE c_dlgstyle
  7920.    
  7921. CASE m.g_toplatform = "DOS" OR m.g_toplatform = "UNIX"
  7922.    IF NOT WEXIST("_q3p0w5ixe")
  7923.       DEFINE WINDOW _q3p0w5ixe ;
  7924.          FROM INT((SROW()-7)/2),INT((SCOL()-47)/2) ;
  7925.          TO INT((SROW()-7)/2)+7,INT((SCOL()-47)/2)+46 ;
  7926.          FLOAT ;
  7927.          NOCLOSE ;
  7928.          SHADOW ;
  7929.          DOUBLE ;
  7930.          COLOR SCHEME 7
  7931.    ENDIF
  7932.    
  7933.    IF WVISIBLE("_q3p0w5ixe")
  7934.       ACTIVATE WINDOW _q3p0w5ixe SAME
  7935.    ELSE
  7936.       ACTIVATE WINDOW _q3p0w5ixe NOSHOW
  7937.    ENDIF
  7938.    
  7939.    * Format the file name for display
  7940.    m.msg = "File: "+m.g_scrndbf
  7941.    IF LEN(m.msg) > 44
  7942.       m.msg = m.g_scrndbf
  7943.       IF LEN(m.msg) > 44
  7944.          m.msg = justfname(m.g_scrndbf)
  7945.       ENDIF
  7946.    ENDIF
  7947.    
  7948.    @ 1,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  7949.    @ 2,(WCOLS()-LEN(m.textline))/2 SAY m.textline
  7950.    @ 4,2 GET m.choice ;
  7951.       PICTURE "@*HT \<Yes;\!\?\<No" ;
  7952.       SIZE 1,12,18 ;
  7953.       DEFAULT 1
  7954.    
  7955. OTHERWISE
  7956.    DO errorhandler WITH "Unknown Version.", LINENO(), c_error3
  7957.    RETURN .F.
  7958. ENDCASE
  7959.  
  7960. IF NOT WVISIBLE("_q3p0w5ixe")
  7961.    ACTIVATE WINDOW _q3p0w5ixe
  7962. ENDIF
  7963.  
  7964. READ CYCLE MODAL WHEN curpos()
  7965.  
  7966. RELEASE WINDOW _q3p0w5ixe
  7967.  
  7968. IF m.choice = 1
  7969.    RETURN .T.
  7970. ELSE
  7971.    RETURN .F.
  7972. ENDIF
  7973. RETURN
  7974.  
  7975. *!*****************************************************************************
  7976. *!
  7977. *!       Function: CURPOS
  7978. *!
  7979. *!      Called by: STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  7980. *!
  7981. *!*****************************************************************************
  7982. FUNCTION curpos
  7983. IF _DOS OR _UNIX
  7984.    _CUROBJ = 2
  7985. ENDIF
  7986. RETURN .T.
  7987.  
  7988. **
  7989. ** Code Associated With Displaying the Screen Convert Dialog Box
  7990. **
  7991. *!*****************************************************************************
  7992. *!
  7993. *!       Function: SCXFRXDIALOG
  7994. *!
  7995. *!      Called by: CONVERTTYPE()      (function  in TRANSPRT.PRG)
  7996. *!
  7997. *!          Calls: HASRECORDS()       (function  in TRANSPRT.PRG)
  7998. *!               : STRIPPATH()        (function  in TRANSPRT.PRG)
  7999. *!               : SCRNCTRL()         (function  in TRANSPRT.PRG)
  8000. *!               : TRANSPRMPT()       (function  in TRANSPRT.PRG)
  8001. *!               : PVALID()           (function  in TRANSPRT.PRG)
  8002. *!               : ASKFONT()          (function  in TRANSPRT.PRG)
  8003. *!               : ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8004. *!               : RDVALID()          (function  in TRANSPRT.PRG)
  8005. *!               : DEACCLAU()         (function  in TRANSPRT.PRG)
  8006. *!               : SHOWCLAU()         (function  in TRANSPRT.PRG)
  8007. *!
  8008. *!*****************************************************************************
  8009. FUNCTION scxfrxdialog
  8010. PARAMETER ftype
  8011. PRIVATE m.choice, m.fromplatform, m.dlgnum
  8012. m.choice = 0
  8013. DO CASE
  8014. CASE (_WINDOWS OR _MAC)
  8015.    IF m.ftype <> "LBX" AND (hasrecords("WINDOWS") OR hasrecords("MAC"))
  8016.       * No partial transport of labels
  8017.       
  8018.       m.fromplatform = "FoxPro for MS-DOS"
  8019.       m.dlgnum = 1
  8020.       m.g_allobjects = .F.
  8021.       
  8022.       * already contains some records for Windows or Mac
  8023.       DEFINE WINDOW transdlg ;
  8024.          AT  0.000, 0.000  ;
  8025.          SIZE 22.385,76.167 ;
  8026.          TITLE " FoxPro Transporter" ;
  8027.          FONT c_dlgface, c_dlgsize ;
  8028.          STYLE c_dlgsty1;
  8029.          FLOAT ;
  8030.          CLOSE ;
  8031.          NOMINIMIZE ;
  8032.          DOUBLE 
  8033.       MOVE WINDOW transdlg CENTER
  8034.       
  8035.       IF WVISIBLE("transdlg")
  8036.          ACTIVATE WINDOW transdlg SAME
  8037.       ELSE
  8038.          ACTIVATE WINDOW transdlg NOSHOW
  8039.       ENDIF
  8040.       
  8041.       @ 14.077,1.667 TO 21.385,50.167 ;
  8042.          PEN 1, 8 ;
  8043.          STYLE "T"
  8044.       @ 13.615,2.667 SAY "Transport" ;
  8045.          SIZE 1.000, 9.167, 0.000 ;
  8046.          FONT c_dlgface, c_dlgsize ;
  8047.          STYLE c_dlgsty1
  8048.       @ 1.000,2.667 SAY IIF(m.ftype = "SCX","Screen File:","Report File:") ;
  8049.          SIZE 1.000,13.500, 0.000 ;
  8050.          FONT c_dlgface, c_dlgsize ;
  8051.          STYLE c_dlgstyle
  8052.       @ 1.000,16.667 SAY LOWER(strippath(m.g_scrndbf)) ;
  8053.          SIZE 1.000,21.833 ;
  8054.          FONT c_dlgface, c_dlgsize ;
  8055.          STYLE c_dlgsty1
  8056.       @ 3.077,2.667 SAY "There are objects in this file defined " + CHR(13) + ;
  8057.          "for a platform other than Windows." ;
  8058.          SIZE 2.000,35.000, 0.000 ;
  8059.          FONT c_dlgface, c_dlgsize ;
  8060.          STYLE c_dlgsty1
  8061.       @ 8.077,2.667 SAY "By transporting this file, you add, update, or " + CHR(13) + ;
  8062.          "replace Windows definitions for objects in the file." ;
  8063.          SIZE 2.000,48.167, 0.000 ;
  8064.          FONT c_dlgface, c_dlgsize ;
  8065.          STYLE c_dlgsty1
  8066.       @ 11.385,2.667 SAY "Transport Objects From: " ;
  8067.          SIZE 1.000,23.500 ;
  8068.          FONT c_dlgface, c_dlgsize ;
  8069.          STYLE c_dlgsty1
  8070.       @ 5.615,2.667 SAY "The objects are new to Windows, or more " + CHR(13) + ;
  8071.          "recently modified than their Windows equivalents." ;
  8072.          SIZE 2.000,47.833 ;
  8073.          FONT c_dlgface, c_dlgsize ;
  8074.          STYLE c_dlgsty1
  8075.       @ 17.846,7.500 SAY "Than Windows Equivalent Objects" ;
  8076.          SIZE 1.000,32.667 ;
  8077.          FONT c_dlgface, c_dlgsize ;
  8078.          STYLE c_dlgsty1
  8079.       @ 11.231,25.833 GET m.fromplatform ;
  8080.          PICTURE "@^ FoxPro for MS-DOS;\FoxPro for Macintosh;\FoxPro for UNIX" ;
  8081.          SIZE 1.538,24.333 ;
  8082.          DEFAULT 1 ;
  8083.          FONT c_dlgface, c_dlgsize ;
  8084.          STYLE c_dlgsty1
  8085.       @ 14.923,4.500 GET m.g_newobjects ;
  8086.          PICTURE "@*C Objects New to Windows" ;
  8087.          SIZE 1.308,28.167 ;
  8088.          DEFAULT .T. ;
  8089.          FONT c_dlgface, c_dlgsize ;
  8090.          STYLE c_dlgsty1 ;
  8091.          VALID scrnctrl()
  8092.       @ 16.538,4.500 GET m.g_snippets ;
  8093.          PICTURE "@*C Objects More Recently Modified" ;
  8094.          SIZE 1.308,34.667 ;
  8095.          DEFAULT .T. ;
  8096.          FONT c_dlgface, c_dlgsize ;
  8097.          STYLE c_dlgsty1 ;
  8098.          VALID scrnctrl()
  8099.       @ 19.385,4.500 GET m.g_allobjects ;
  8100.          PICTURE "@*C All Objects -- Replace Existing Definitions" ;
  8101.          SIZE 1.308,43.833 ;
  8102.          DEFAULT .F. ;
  8103.          FONT c_dlgface, c_dlgsize ;
  8104.          STYLE c_dlgsty1 ;
  8105.          VALID scrnctrl()
  8106.       @ 0.615,51.667 GET m.choice ;
  8107.          PICTURE "@*VNT "+transprmpt()+";Open As Is;\?Cancel" ;
  8108.          SIZE 1.769,23.000,0.308 ;
  8109.          DEFAULT 1 ;
  8110.          FONT c_dlgface, c_dlgsize ;
  8111.          STYLE c_dlgsty1 ;
  8112.          VALID pvalid()
  8113.       @ 14.077,51.667 GET m.g_askfont ;
  8114.          PICTURE "@*VN Font..." ;
  8115.          SIZE 1.769,23.000,0.308 ;
  8116.          DEFAULT 1 ;
  8117.          FONT c_dlgface, c_dlgsize ;
  8118.          STYLE c_dlgsty1 ;
  8119.          VALID askfont()
  8120.    ELSE    && no existing WINDOWS/MAC records
  8121.       m.fromplatform = "FoxPro for MS-DOS"
  8122.       m.dlgnum = 2
  8123.       DEFINE WINDOW transdlg ;
  8124.          AT 0.000, 0.000 ;
  8125.          SIZE 13.077,65.167 ;
  8126.          FONT c_dlgface, c_dlgsize ;
  8127.          STYLE c_dlgsty1 ;
  8128.          TITLE " FoxPro Transporter" ;
  8129.          FLOAT ;
  8130.          CLOSE ;
  8131.          NOMINIMIZE ;
  8132.          DOUBLE
  8133.       MOVE WINDOW transdlg CENTER
  8134.       
  8135.       IF WVISIBLE("transdlg")
  8136.          ACTIVATE WINDOW transdlg SAME
  8137.       ELSE
  8138.          ACTIVATE WINDOW transdlg NOSHOW
  8139.       ENDIF
  8140.       
  8141.       @ 1.000,2.667 SAY IIF(m.ftype = "SCX","Screen File:",;
  8142.          IIF(m.ftype = "FRX","Report File:","Label File:")) ;
  8143.          SIZE 1.000,11.500, 0.000 ;
  8144.          FONT c_dlgface, c_dlgsize ;
  8145.          STYLE c_dlgstyle
  8146.       @ 1.000,14.667 SAY LOWER(strippath(m.g_scrndbf)) ;
  8147.          SIZE 1.000,21.833 ;
  8148.          FONT c_dlgface, c_dlgsize ;
  8149.          STYLE c_dlgsty1
  8150.       @ 3.077,2.667 SAY "There are objects in this file defined " + CHR(13) + ;
  8151.          "for a platform other than Windows." ;
  8152.          SIZE 2.000,35.000, 0.000 ;
  8153.          FONT c_dlgface, c_dlgsize ;
  8154.          STYLE c_dlgstyle
  8155.       @ 5.923,2.667 SAY "By transporting this file, you create" + CHR(13) + ;
  8156.          "Windows definitions for these objects." ;
  8157.          SIZE 2.000,36.833, 0.000 ;
  8158.          FONT c_dlgface, c_dlgsize ;
  8159.          STYLE c_dlgstyle
  8160.       @ 8.923,2.667 SAY "Transport Objects From: " ;
  8161.          SIZE 1.000,23.500, 0.000 ;
  8162.          FONT c_dlgface, c_dlgsize ;
  8163.          STYLE c_dlgsty1
  8164.       @ 10.154,2.667 GET m.fromplatform ;
  8165.          PICTURE "@^ FoxPro for MS-DOS;\FoxPro for Macintosh;\FoxPro for UNIX" ;
  8166.          SIZE 1.538,24.333 ;
  8167.          FONT c_dlgface, c_dlgsize ;
  8168.          STYLE c_dlgsty1
  8169.       @ 7.846,40.833 GET m.g_askfont ;
  8170.          PICTURE "@*VN Font..." ;
  8171.          SIZE 1.769,23.000,0.308 ;
  8172.          DEFAULT 1 ;
  8173.          FONT c_dlgface, c_dlgsize ;
  8174.          STYLE c_dlgsty1 ;
  8175.          VALID askfont()
  8176.       @ 0.615,40.833 GET m.choice ;
  8177.          PICTURE "@*VNT "+transprmpt()+";\?Cancel" ;
  8178.          SIZE 1.769,23.000,0.308 ;
  8179.          DEFAULT 1 ;
  8180.          FONT c_dlgface, c_dlgsize ;
  8181.          STYLE c_dlgsty1 ;
  8182.          VALID pvalid()
  8183.    ENDIF
  8184. CASE _DOS OR _UNIX
  8185.    m.fromplatform = "FoxPro for Windows"
  8186.    IF m.ftype <> "LBX" AND (hasrecords("DOS") OR hasrecords("UNIX"))
  8187.       m.dlgnum = 1
  8188.       m.g_allobjects = .F.
  8189.       
  8190.       DEFINE WINDOW transdlg ;
  8191.          FROM INT((SROW()-21)/2),INT((SCOL()-67)/2) ;
  8192.          TO INT((SROW()-21)/2)+20,INT((SCOL()-67)/2)+66 ;
  8193.          FLOAT ;
  8194.          CLOSE ;
  8195.          SHADOW ;
  8196.          NOMINIMIZE ;
  8197.          DOUBLE ;
  8198.          COLOR SCHEME 5
  8199.       
  8200.       IF WVISIBLE("transdlg")
  8201.          ACTIVATE WINDOW transdlg SAME
  8202.       ELSE
  8203.          ACTIVATE WINDOW transdlg NOSHOW
  8204.       ENDIF
  8205.       
  8206.       @ 11,2 TO 16,52
  8207.       @ 1,2 SAY IIF(m.g_filetype = c_screen,"Screen File:","Report File:") ;
  8208.          SIZE 1,12, 0
  8209.       @ 1,15 SAY UPPER(strippath(m.g_scrndbf)) ;
  8210.          SIZE 1,19
  8211.       @ 3,2 SAY "There are objects in this file defined" ;
  8212.          SIZE 1,38, 0
  8213.       @ 4,2 SAY "for a platform other than MS-DOS." ;
  8214.          SIZE 1,33, 0
  8215.       @ 9,4 SAY "Transport Objects From:" ;
  8216.          SIZE 1,23, 0
  8217.       @ 8,29 GET m.fromplatform ;
  8218.          PICTURE "@^ FoxPro for Windows;\FoxPro for Macintosh;\FoxPro for UNIX" ;
  8219.          SIZE 3,24 ;
  8220.          DEFAULT "FoxPro for Windows" ;
  8221.          COLOR SCHEME 5, 6
  8222.       @ 1,45 GET m.choice ;
  8223.          PICTURE "@*VNT \!Transport & Open;Open As Is;\?Cancel" ;
  8224.          SIZE 1,20,1 ;
  8225.          DEFAULT 1 ;
  8226.          VALID pvalid()
  8227.       @ 11,4 SAY "Transport" ;
  8228.          SIZE 1,9, 0
  8229.       @ 12,4 GET m.g_newobjects ;
  8230.          PICTURE "@*C Objects New to MS-DOS" ;
  8231.          SIZE 1,25 ;
  8232.          DEFAULT .T. ;
  8233.          VALID scrnctrl()
  8234.       @ 13,4 GET m.g_snippets ;
  8235.          PICTURE "@*C Objects More Recently Modified" ;
  8236.          SIZE 1,34 ;
  8237.          DEFAULT .T. ;
  8238.          VALID scrnctrl()
  8239.       @ 14,8 SAY "Than MS-DOS Equivalent Objects" ;
  8240.          SIZE 1,30, 0
  8241.       @ 15,4 GET m.g_allobjects ;
  8242.          PICTURE "@*C All Objects -- Replace Existing Definitions" ;
  8243.          SIZE 1,47 ;
  8244.          DEFAULT .F. ;
  8245.          VALID scrnctrl()
  8246.       @ 7,2 SAY "for objects in the file." ;
  8247.          SIZE 1,24, 0
  8248.       @ 5,2 SAY "By transporting this file, you add," ;
  8249.          SIZE 1,35, 0
  8250.       @ 6,2 SAY "update, or replace MS-DOS definitions" ;
  8251.          SIZE 1,37, 0
  8252.       
  8253.       IF NOT WVISIBLE("transdlg")
  8254.          ACTIVATE WINDOW transdlg
  8255.       ENDIF
  8256.    ELSE
  8257.       m.dlgnum = 2
  8258.       
  8259.       DEFINE WINDOW transdlg ;
  8260.          FROM INT((SROW()-15)/2),INT((SCOL()-68)/2) ;
  8261.          TO INT((SROW()-15)/2)+14,INT((SCOL()-68)/2)+67 ;
  8262.          FLOAT ;
  8263.          NOCLOSE ;
  8264.          SHADOW ;
  8265.          NOMINIMIZE ;
  8266.          DOUBLE ;
  8267.          COLOR SCHEME 5
  8268.       
  8269.       IF WVISIBLE("transdlg")
  8270.          ACTIVATE WINDOW transdlg SAME
  8271.       ELSE
  8272.          ACTIVATE WINDOW transdlg NOSHOW
  8273.       ENDIF
  8274.       
  8275.       @ 1,2 SAY IIF(m.g_filetype = c_screen,"Screen File:","Report File:") ;
  8276.          SIZE 1,12, 0
  8277.       @ 1,15 SAY UPPER(strippath(m.g_scrndbf)) ;
  8278.          SIZE 1,19
  8279.       @ 3,2 SAY "There are objects in this file defined" ;
  8280.          SIZE 1,38, 0
  8281.       @ 4,2 SAY "for a platform other than MS-DOS." ;
  8282.          SIZE 1,33, 0
  8283.       @ 8,4 SAY "Transport Objects From:" ;
  8284.          SIZE 1,23, 0
  8285.       @ 9,4 GET m.fromplatform ;
  8286.          PICTURE "@^ FoxPro for Windows;\FoxPro for Macintosh;\FoxPro for UNIX" ;
  8287.          SIZE 3,24 ;
  8288.          DEFAULT "FoxPro for Windows" ;
  8289.          COLOR SCHEME 5, 6
  8290.       @ 1,45 GET m.choice ;
  8291.          PICTURE "@*VNT \!Transport & Open;\?Cancel" ;
  8292.          SIZE 1,20,1 ;
  8293.          DEFAULT 1 ;
  8294.          VALID pvalid()
  8295.       @ 5,2 SAY "By transporting this file, you create" ;
  8296.          SIZE 1,37, 0
  8297.       @ 6,2 SAY "MS-DOS definitions for these objects." ;
  8298.          SIZE 1,37, 0
  8299.       
  8300.       IF NOT WVISIBLE("transdlg")
  8301.          ACTIVATE WINDOW transdlg
  8302.       ENDIF
  8303.    ENDIF
  8304. OTHERWISE
  8305.    DO errorhandler WITH "Unknown FoxPro version.", LINENO(), c_error3
  8306.    RETURN .F.
  8307. ENDCASE
  8308.  
  8309. IF NOT WVISIBLE("transdlg")
  8310.    ACTIVATE WINDOW transdlg
  8311. ENDIF
  8312.  
  8313. READ CYCLE MODAL ;
  8314.    VALID rdvalid(m.dlgnum) ;
  8315.    DEACTIVATE deacclau() ;
  8316.    SHOW showclau()
  8317.  
  8318. RELEASE WINDOW transdlg
  8319.  
  8320. *
  8321. * We could simply return m.choice, but this way we can mess with the dialog without changing
  8322. * the defines.
  8323. *
  8324. DO CASE
  8325. CASE m.choice = 1
  8326.    RETURN c_yes
  8327. CASE m.choice = 2 AND m.dlgnum = 1
  8328.    RETURN c_no
  8329. OTHERWISE
  8330.    RETURN c_cancel
  8331. ENDCASE
  8332. RETURN
  8333.  
  8334. *
  8335. * TRANSPRMPT - Determine the prompt for the transport button
  8336. *
  8337. *!*****************************************************************************
  8338. *!
  8339. *!       Function: TRANSPRMPT
  8340. *!
  8341. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8342. *!
  8343. *!*****************************************************************************
  8344. FUNCTION transprmpt
  8345. * Debts must be paid
  8346. HOUR = LEFT(TIME(),2)
  8347. IF (DOW(DATE()) = 7 AND HOUR >= "23" AND HOUR < "24") OR ATC("ENERGIZE",GETENV("TRANSPRT")) > 0
  8348.    g_energize = .T.
  8349.    RETURN "\!Energize"       && Beam me up
  8350. ELSE
  8351.    RETURN "\!Transport and Open"
  8352. ENDIF
  8353.  
  8354. *
  8355. * RDVALID() - Prompts for overwriting all objects if g_allobjects is true
  8356. *
  8357. *!*****************************************************************************
  8358. *!
  8359. *!       Function: RDVALID
  8360. *!
  8361. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8362. *!
  8363. *!          Calls: VERSIONCAP()       (function  in TRANSPRT.PRG)
  8364. *!
  8365. *!*****************************************************************************
  8366. FUNCTION rdvalid
  8367. PARAMETER dlgnum
  8368. IF m.g_allobjects AND m.dlgnum = 1 AND m.choice = 1
  8369.    IF _WINDOWS OR _MAC
  8370.       DEFINE WINDOW msgscrn ;
  8371.          AT 0.000, 0.000 ;
  8372.          SIZE 7.308,42.667 ;
  8373.          FONT c_dlgface, c_dlgsize ;
  8374.          STYLE c_dlgsty1 ;
  8375.          NOFLOAT ;
  8376.          NOCLOSE ;
  8377.          NOMINIMIZE ;
  8378.          DOUBLE
  8379.       MOVE WINDOW msgscrn CENTER
  8380.       
  8381.       IF WVISIBLE("msgscrn")
  8382.          ACTIVATE WINDOW msgscrn SAME
  8383.       ELSE
  8384.          ACTIVATE WINDOW msgscrn NOSHOW
  8385.       ENDIF
  8386.       
  8387.       @ 0.923,2.833 SAY "Transporting All Objects will overwrite " + CHR(13) + ;
  8388.          "all existing "+versioncap(m.g_toplatform)+" object definitions" + CHR(13) + ;
  8389.          "in the file." ;
  8390.          SIZE 3.000,36.833, 0.000 ;
  8391.          PICTURE "@I" ;
  8392.          FONT c_dlgface, c_dlgsize ;
  8393.          STYLE c_dlgstyle
  8394.       @ 4.769,11.833 GET m.okcancl ;
  8395.          PICTURE "@*HNT OK;Cancel" ;
  8396.          SIZE 1.769,8.667,0.667 ;
  8397.          DEFAULT 1 ;
  8398.          FONT c_dlgface,c_dlgsize ;
  8399.          STYLE c_dlgstyle
  8400.    ELSE
  8401.       DEFINE WINDOW msgscrn ;
  8402.          FROM INT((SROWS()-8)/2),19 ;
  8403.          TO INT((SROWS()+8)/2),62 ;
  8404.          NOFLOAT ;
  8405.          NOCLOSE ;
  8406.          NOMINIMIZE ;
  8407.          DOUBLE ;
  8408.          COLOR SCHEME 7
  8409.       MOVE WINDOW msgscrn CENTER
  8410.       
  8411.       IF WVISIBLE("msgscrn")
  8412.          ACTIVATE WINDOW msgscrn SAME
  8413.       ELSE
  8414.          ACTIVATE WINDOW msgscrn NOSHOW
  8415.       ENDIF
  8416.       
  8417.       @ 1,0 SAY PADC("Transporting All Objects will overwrite",WCOLS())
  8418.       @ 2,0 SAY PADC("all existing "+versioncap(m.g_toplatform)+" object definitions",WCOLS())
  8419.       @ 3,0 SAY PADC("in the file.",WCOLS())
  8420.       
  8421.       
  8422.       @ 5,12 GET m.okcancl ;
  8423.          PICTURE "@*HNT OK;Cancel" ;
  8424.          SIZE 1,9 ;
  8425.          DEFAULT 1
  8426.    ENDIF
  8427.    
  8428.    IF NOT WVISIBLE("msgscrn")
  8429.       ACTIVATE WINDOW msgscrn
  8430.    ENDIF
  8431.    
  8432.    READ CYCLE
  8433.    
  8434.    RELEASE WINDOW msgscrn
  8435.    
  8436.    IF okcancl = 2
  8437.       RETURN .F.
  8438.    ELSE
  8439.       RETURN .T.
  8440.    ENDIF
  8441. ENDIF
  8442.  
  8443. *
  8444. * DEACCLAU - Deactivate clause code.  Clear current read if window closes.
  8445. *
  8446. *!*****************************************************************************
  8447. *!
  8448. *!       Function: DEACCLAU
  8449. *!
  8450. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8451. *!
  8452. *!*****************************************************************************
  8453. FUNCTION deacclau
  8454. CLEAR READ
  8455. RETURN .T.
  8456.  
  8457. *
  8458. * SHOWCLAU - Refresh GETS
  8459. *
  8460. *!*****************************************************************************
  8461. *!
  8462. *!       Function: SHOWCLAU
  8463. *!
  8464. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8465. *!
  8466. *!*****************************************************************************
  8467. FUNCTION showclau
  8468. IF m.dlgnum = 2
  8469.    RETURN
  8470. ENDIF
  8471.  
  8472. IF g_snippets=.T. OR g_newobjects = .T.
  8473.    SHOW GET g_allobjects DISABLE
  8474. ELSE
  8475.    SHOW GET g_allobjects ENABLE
  8476. ENDIF
  8477.  
  8478. IF g_allobjects
  8479.    SHOW GET g_snippets   DISABLE
  8480.    SHOW GET g_newobjects DISABLE
  8481.    DO CASE
  8482.    CASE (_WINDOWS OR _MAC) AND RGBSCHEME(1,10) <> "RGB(0,0,0,255,255,255)"
  8483.       @ 17.846,7.500 SAY "Than Windows Equivalent Objects" ;
  8484.          COLOR (RGBSCHEME(1,10))
  8485.    CASE (_WINDOWS OR _MAC) AND RGBSCHEME(1,10) == "RGB(0,0,0,255,255,255)"
  8486.       @ 17.846,7.500 SAY "Than Windows Equivalent Objects" ;
  8487.          COLOR RGB(192,192,192,255,255,255)
  8488.    OTHERWISE
  8489.       @ 14,8 SAY "Than MS-DOS Equivalent Objects" ;
  8490.          COLOR (SCHEME(5,10))
  8491.    ENDCASE
  8492. ELSE
  8493.    SHOW GET g_snippets   ENABLE
  8494.    SHOW GET g_newobjects ENABLE
  8495.    IF _WINDOWS OR _MAC
  8496.       @ 17.846,7.500 SAY "Than Windows Equivalent Objects"
  8497.    ELSE
  8498.       @ 14,8 SAY "Than MS-DOS Equivalent Objects"
  8499.    ENDIF
  8500. ENDIF
  8501.  
  8502. IF !g_allobjects AND g_snippets = .F. AND g_newobjects = .F.
  8503.    SHOW GET m.choice,1 DISABLE
  8504. ELSE
  8505.    SHOW GET m.choice,1 ENABLE
  8506. ENDIF
  8507.  
  8508. *
  8509. * SCRNCTRL - Called for check box validation from the first dialog
  8510. *
  8511. *!*****************************************************************************
  8512. *!
  8513. *!       Function: SCRNCTRL
  8514. *!
  8515. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8516. *!
  8517. *!*****************************************************************************
  8518. FUNCTION scrnctrl
  8519. SHOW GETS OFF
  8520. RETURN .T.
  8521.  
  8522. *
  8523. * Makes sure the proper options are enabled based on the setting of m.g_allobjects
  8524. *
  8525. *!*****************************************************************************
  8526. *!
  8527. *!       Function: ENABLEPROC
  8528. *!
  8529. *!*****************************************************************************
  8530. FUNCTION enableproc
  8531. IF m.g_allobjects
  8532.    SHOW GET m.g_newobjects DISABLE
  8533.    SHOW GET m.g_snippets DISABLE
  8534. ELSE
  8535.    SHOW GET m.g_newobjects ENABLE
  8536.    SHOW GET m.g_snippets ENABLE
  8537. ENDIF
  8538.  
  8539. *
  8540. * Fills the m.g_fromplatform global variable when the user leaves the dialog.
  8541. *
  8542. *!*****************************************************************************
  8543. *!
  8544. *!       Function: PVALID
  8545. *!
  8546. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8547. *!
  8548. *!*****************************************************************************
  8549. FUNCTION pvalid
  8550. DO CASE
  8551. CASE ATC('DOS',m.fromplatform) > 0
  8552.    m.g_fromplatform = 'DOS'
  8553. CASE ATC('WINDOWS',m.fromplatform) > 0
  8554.    m.g_fromplatform = 'WINDOWS'
  8555. CASE ATC('MAC',m.fromplatform) > 0
  8556.    m.g_fromplatform = 'MAC'
  8557. CASE ATC('UNIX',m.fromplatform) > 0
  8558.    m.g_fromplatform = 'UNIX'
  8559. ENDCASE
  8560.  
  8561. **
  8562. ** Code Associated With Displaying of the Thermometer
  8563. **
  8564.  
  8565. *!*****************************************************************************
  8566. *!
  8567. *!      Procedure: STARTTHERM
  8568. *!
  8569. *!      Called by: TRANSPRT.PRG                      
  8570. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  8571. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  8572. *!
  8573. *!          Calls: ACTTHERM           (procedure in TRANSPRT.PRG)
  8574. *!
  8575. *!*****************************************************************************
  8576. PROCEDURE starttherm
  8577. PARAMETER VERB,filetype
  8578. *  Start the thermometer with the appropriate message.
  8579. DO CASE
  8580. CASE m.filetype = c_screen
  8581.    DO acttherm WITH VERB+' screen: '
  8582. CASE m.filetype = c_report
  8583.    DO acttherm WITH VERB+' report: '
  8584. CASE m.filetype  = c_label
  8585.    DO acttherm WITH VERB+' label: '
  8586. ENDCASE
  8587.  
  8588. *
  8589. * ACTTHERM(<text>) - Activate thermometer.
  8590. *
  8591. * Activates thermometer.  Update the thermometer with UPDTHERM().
  8592. * Thermometer window is named "thermometer."  Be sure to RELEASE
  8593. * this window when done with thermometer.  Creates the global
  8594. * m.g_thermwidth.
  8595. *
  8596. *!*****************************************************************************
  8597. *!
  8598. *!      Procedure: ACTTHERM
  8599. *!
  8600. *!      Called by: STARTTHERM         (procedure in TRANSPRT.PRG)
  8601. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  8602. *!
  8603. *!*****************************************************************************
  8604. PROCEDURE acttherm
  8605. PARAMETER m.text
  8606. PRIVATE m.prompt
  8607.  
  8608. IF _WINDOWS OR _MAC
  8609.    m.prompt = LOWER(m.g_scrndbf)
  8610.    IF TXTWIDTH(m.prompt, c_dlgface, c_dlgsize, c_dlgstyle) > 43
  8611.       DO WHILE TXTWIDTH(m.prompt+"...", c_dlgface, c_dlgsize, c_dlgstyle) > 43
  8612.          m.prompt = LEFT(m.prompt, LEN(m.prompt)-1)
  8613.       ENDDO
  8614.       m.prompt = m.prompt + "..."
  8615.    ENDIF
  8616.    
  8617.    IF !WEXIST("thermomete")
  8618.       DEFINE WINDOW thermomete ;
  8619.          AT 0,0 ;
  8620.          SIZE 5.615,63.833 ;
  8621.          FONT c_dlgface, c_dlgsize ;
  8622.          STYLE c_dlgstyle ;
  8623.          NOFLOAT ;
  8624.          NOCLOSE ;
  8625.          NONE ;
  8626.          COLOR RGB(0, 0, 0, 192, 192, 192)
  8627.    ENDIF
  8628.    MOVE WINDOW thermomete CENTER
  8629.    ACTIVATE WINDOW thermomete NOSHOW
  8630.    
  8631.    @ 0.5,3 SAY m.text FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  8632.    @ 1.5,3 SAY m.prompt FONT c_dlgface, c_dlgsize STYLE c_dlgstyle
  8633.    @ 0.000,0.000 TO 0.000,63.833 ;
  8634.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8635.    @ 0.000,0.000 TO 5.615,0.000 ;
  8636.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8637.    @ 0.385,0.667 TO 5.231,0.667 ;
  8638.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8639.    @ 0.308,0.667 TO 0.308,63.167 ;
  8640.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8641.    @ 0.385,63.000 TO 5.308,63.000 ;
  8642.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8643.    @ 5.231,0.667 TO 5.231,63.167 ;
  8644.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8645.    @ 5.538,0.000 TO 5.538,63.833 ;
  8646.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8647.    @ 0.000,63.667 TO 5.615,63.667 ;
  8648.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8649.    @ 3.000,3.333 TO 4.231,3.333 ;
  8650.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8651.    @ 3.000,60.333 TO 4.308,60.333 ;
  8652.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8653.    @ 3.000,3.333 TO 3.000,60.333 ;
  8654.       COLOR RGB(128, 128, 128, 128, 128, 128)
  8655.    @ 4.231,3.333 TO 4.231,60.500 ;
  8656.       COLOR RGB(255, 255, 255, 255, 255, 255)
  8657.    m.g_thermwidth = 56.269
  8658.    
  8659.    SHOW WINDOW thermomete TOP
  8660. ELSE
  8661.    m.prompt = SUBSTR(SYS(2014,m.g_scrndbf),1,48)+;
  8662.       IIF(LEN(m.g_scrndbf)>48,"...","")
  8663.    IF !WEXIST("thermomete")
  8664.       DEFINE WINDOW thermomete;
  8665.          FROM INT((SROW()-7)/2), INT((SCOL()-57)/2) ;
  8666.          TO INT((SROW()-7)/2) + 6, INT((SCOL()-57)/2) + 57;
  8667.          DOUBLE COLOR SCHEME 5
  8668.    ENDIF
  8669.    ACTIVATE WINDOW thermomete NOSHOW
  8670.    
  8671.    m.g_thermwidth = 50
  8672.    @ 0,3 SAY m.text
  8673.    @ 1,3 SAY UPPER(m.prompt)
  8674.    @ 2,1 TO 4,m.g_thermwidth+4 &g_boxstrg
  8675.    
  8676.    SHOW WINDOW thermomete TOP
  8677. ENDIF
  8678.  
  8679. *
  8680. * UPDTHERM(<percent>) - Update thermometer.
  8681. *
  8682. *!*****************************************************************************
  8683. *!
  8684. *!      Procedure: UPDTHERM
  8685. *!
  8686. *!      Called by: TRANSPRT.PRG                      
  8687. *!               : GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  8688. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  8689. *!               : UPDATESCREEN       (procedure in TRANSPRT.PRG)
  8690. *!               : UPDATEREPORT       (procedure in TRANSPRT.PRG)
  8691. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  8692. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  8693. *!               : ALLCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  8694. *!               : ALLENVIRONS        (procedure in TRANSPRT.PRG)
  8695. *!               : ALLOTHERS          (procedure in TRANSPRT.PRG)
  8696. *!               : ALLGROUPS          (procedure in TRANSPRT.PRG)
  8697. *!               : RPTCONVERT         (procedure in TRANSPRT.PRG)
  8698. *!               : LABELLINES         (procedure in TRANSPRT.PRG)
  8699. *!               : CALCWINDOWDIMENSION(procedure in TRANSPRT.PRG)
  8700. *!               : FINDWIDEROBJECTS   (procedure in TRANSPRT.PRG)
  8701. *!               : REPOOBJECTS        (procedure in TRANSPRT.PRG)
  8702. *!               : ADJINVBTNS         (procedure in TRANSPRT.PRG)
  8703. *!               : JOINLINES          (procedure in TRANSPRT.PRG)
  8704. *!               : WRITERESULT        (procedure in TRANSPRT.PRG)
  8705. *!
  8706. *!          Calls: ACTTHERM           (procedure in TRANSPRT.PRG)
  8707. *!
  8708. *!*****************************************************************************
  8709. PROCEDURE updtherm
  8710. PARAMETER m.percent
  8711. PRIVATE m.nblocks, m.percent
  8712.  
  8713. IF m.percent > 100
  8714.    m.percent = 100
  8715. ENDIF
  8716. IF !WEXIST("thermomete")
  8717.    DO acttherm WITH ""
  8718. ENDIF
  8719. ACTIVATE WINDOW thermomete
  8720. m.nblocks = (m.percent/100) * (m.g_thermwidth)
  8721. IF _WINDOWS OR _MAC
  8722.    @ 3.000,3.333 TO 4.231,m.nblocks + 3.333 ;
  8723.       PATTERN 1 COLOR RGB(128, 128, 128, 128, 128, 128)
  8724. ELSE
  8725.    @ 3,3 SAY REPLICATE("█",m.nblocks)
  8726. ENDIF
  8727.  
  8728. *
  8729. * deactTherm - Deactivate and Release thermometer window.
  8730. *
  8731. *!*****************************************************************************
  8732. *!
  8733. *!      Procedure: DEACTTHERM
  8734. *!
  8735. *!      Called by: CLEANUP            (procedure in TRANSPRT.PRG)
  8736. *!
  8737. *!*****************************************************************************
  8738. PROCEDURE deacttherm
  8739. IF WEXIST("thermomete")
  8740.    RELEASE WINDOW thermomete
  8741. ENDIF
  8742.  
  8743. *
  8744. * ERRORHANDLER - Error Processing Center.
  8745. *
  8746. *!*****************************************************************************
  8747. *!
  8748. *!      Procedure: ERRORHANDLER
  8749. *!
  8750. *!      Called by: TRANSPRT.PRG                      
  8751. *!               : SETVERSION         (procedure in TRANSPRT.PRG)
  8752. *!               : CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  8753. *!               : STRUCTDIALOG()     (function  in TRANSPRT.PRG)
  8754. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8755. *!
  8756. *!          Calls: CLEANUP            (procedure in TRANSPRT.PRG)
  8757. *!               : ERRSHOW            (procedure in TRANSPRT.PRG)
  8758. *!               : CLEANWIND          (procedure in TRANSPRT.PRG)
  8759. *!
  8760. *!*****************************************************************************
  8761. PROCEDURE errorhandler
  8762. PARAMETERS m.msg, m.linenum, errcode
  8763. IF ERROR() = 22
  8764.    ON ERROR &onerror
  8765.    m.g_status = 1
  8766.    DO cleanup
  8767.    CANCEL
  8768. ENDIF
  8769. SET MESSAGE TO
  8770. DO CASE
  8771. CASE errcode == c_error1
  8772.    m.g_status = 1
  8773. CASE errcode == c_error2
  8774.    DO errshow WITH m.msg, m.linenum
  8775.    m.g_status = 2
  8776.    ON ERROR &onerror
  8777. CASE errcode == c_error3
  8778.    ON ERROR &onerror
  8779.    DO errshow WITH m.msg, m.linenum
  8780.    DO cleanwind
  8781.    m.g_status = 3
  8782.    m.g_returncode = c_cancel
  8783.    DO cleanup WITH .T.
  8784. ENDCASE
  8785.  
  8786. *
  8787. * CLEANWIND - Release windows that might still be open
  8788. *
  8789. *!*****************************************************************************
  8790. *!
  8791. *!      Procedure: CLEANWIND
  8792. *!
  8793. *!      Called by: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8794. *!               : ESCHANDLER         (procedure in TRANSPRT.PRG)
  8795. *!
  8796. *!*****************************************************************************
  8797. PROCEDURE cleanwind
  8798. IF WEXIST("transdlg") AND WVISIBLE("transdlg")
  8799.    RELEASE WINDOW transdlg
  8800. ENDIF
  8801. IF WEXIST("lblwind") AND WVISIBLE("lblwind")
  8802.    RELEASE WINDOW lblwind
  8803. ENDIF
  8804. IF WEXIST("msgscrn") AND WVISIBLE("msgscrn")
  8805.    RELEASE WINDOW msgscrn
  8806. ENDIF
  8807. IF WEXIST("Thermomete") AND WVISIBLE("Thermomete")
  8808.    RELEASE WINDOW thermomete
  8809. ENDIF
  8810. IF WEXIST("tpselect") AND WVISIBLE("tpselect")
  8811.    RELEASE WINDOW tpselect
  8812. ENDIF
  8813.  
  8814. *
  8815. * ESCHANDLER - Escape handler.
  8816. *
  8817. *!*****************************************************************************
  8818. *!
  8819. *!      Procedure: ESCHANDLER
  8820. *!
  8821. *!      Called by: SETALL             (procedure in TRANSPRT.PRG)
  8822. *!
  8823. *!          Calls: CLEANWIND          (procedure in TRANSPRT.PRG)
  8824. *!               : CLEANUP            (procedure in TRANSPRT.PRG)
  8825. *!
  8826. *!*****************************************************************************
  8827. PROCEDURE eschandler
  8828. ON ERROR &onerror
  8829. m.g_status = 1
  8830. DO cleanwind
  8831. DO cleanup
  8832. CANCEL
  8833.  
  8834. *
  8835. * ERRSHOW - Show error in an alert box on the screen.
  8836. *
  8837. *!*****************************************************************************
  8838. *!
  8839. *!      Procedure: ERRSHOW
  8840. *!
  8841. *!      Called by: ERRORHANDLER       (procedure in TRANSPRT.PRG)
  8842. *!
  8843. *!*****************************************************************************
  8844. PROCEDURE errshow
  8845. PARAMETER m.msg, m.lineno
  8846. PRIVATE m.curcursor
  8847.  
  8848. IF _WINDOWS OR _MAC
  8849.    DEFINE WINDOW ALERT ;
  8850.       AT 0,0 ;
  8851.       SIZE 5.615,63.833 ;
  8852.       FONT c_dlgface, c_dlgsize ;
  8853.       STYLE c_dlgstyle ;
  8854.       NOCLOSE ;
  8855.       DOUBLE ;
  8856.       TITLE "Transporter Error"
  8857.    MOVE WINDOW ALERT CENTER
  8858.    ACTIVATE WINDOW ALERT NOSHOW
  8859.    
  8860.    m.msg = SUBSTR(m.msg,1,44)+IIF(LEN(m.msg)>44,"...","")
  8861.    @ 1,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8862.    
  8863.    m.msg = "Line Number: "+LTRIM(STR(m.lineno,5))
  8864.    @ 2,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8865.    
  8866.    m.msg = "Press any key to cleanup and exit..."
  8867.    @ 3,(WCOLS()-TXTWIDTH( m.msg ))/2 SAY m.msg
  8868. ELSE
  8869.    DEFINE WINDOW ALERT;
  8870.       FROM INT((SROW()-6)/2), INT((SCOL()-50)/2) ;
  8871.       TO INT((SROW()-6)/2) + 6, INT((SCOL()-50)/2) + 50;
  8872.       FLOAT NOGROW NOCLOSE NOZOOM   SHADOW DOUBLE;
  8873.       COLOR SCHEME 7
  8874.    
  8875.    ACTIVATE WINDOW ALERT NOSHOW
  8876.    
  8877.    m.msg = SUBSTR(m.msg,1,44)+IIF(LEN(m.msg)>44,"...","")
  8878.    @ 1,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8879.    
  8880.    m.msg = "Line Number: "+STR(m.lineno, 5)
  8881.    @ 2,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8882.    
  8883.    m.msg = "Press any key to cleanup and exit..."
  8884.    @ 3,(WCOLS()-LEN(m.msg))/2 SAY m.msg
  8885. ENDIF
  8886.  
  8887. m.curcursor = SET( "CURSOR" )
  8888. SET CURSOR OFF
  8889. SHOW WINDOW ALERT
  8890.  
  8891. =INKEY(0, "M")
  8892.  
  8893. RELEASE WINDOW ALERT
  8894. SET CURSOR &curcursor
  8895.  
  8896. *
  8897. * JUSTSTEM - Returns just the stem name of the file
  8898. *
  8899. *!*****************************************************************************
  8900. *!
  8901. *!       Function: JUSTSTEM
  8902. *!
  8903. *!*****************************************************************************
  8904. FUNCTION juststem
  8905. * Return just the stem name from "filname"
  8906. PARAMETERS m.filname
  8907. PRIVATE ALL
  8908. IF RAT('\',m.filname) > 0
  8909.    m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
  8910. ENDIF
  8911. IF AT(':',m.filname) > 0
  8912.    m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255)
  8913. ENDIF
  8914. IF AT('.',m.filname) > 0
  8915.    m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1)
  8916. ENDIF
  8917. RETURN ALLTRIM(UPPER(m.filname))
  8918.  
  8919. *
  8920. * STRIPPATH - Strip the path from a file name.
  8921. *
  8922. * Description:
  8923. * Find positions of backslash in the name of the file.  If there is one
  8924. * take everything to the right of its position and make it the new file
  8925. * name.  If there is no slash look for colon.  Again if found, take
  8926. * everything to the right of it as the new name.  If neither slash
  8927. * nor colon are found then return the name unchanged.
  8928. *
  8929. * Parameters:
  8930. * filename - character string representing a file name
  8931. *
  8932. * Return value:
  8933. * The string "filename" with any path removed
  8934. *
  8935. *!*****************************************************************************
  8936. *!
  8937. *!       Function: STRIPPATH
  8938. *!
  8939. *!      Called by: TRANSPRT.PRG                      
  8940. *!               : ADJBITMAPCTRL      (procedure in TRANSPRT.PRG)
  8941. *!               : SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  8942. *!
  8943. *!*****************************************************************************
  8944. FUNCTION strippath
  8945. PARAMETER m.filename
  8946. PRIVATE m.slashpos, m.namelen, m.colonpos
  8947. m.slashpos = RAT("\", m.filename)
  8948. IF m.slashpos > 0
  8949.    m.namelen  = LEN(m.filename) - m.slashpos
  8950.    m.filename = RIGHT(m.filename, m.namelen)
  8951. ELSE
  8952.    m.colonpos = RAT(":", m.filename)
  8953.    IF m.colonpos > 0
  8954.       m.namelen  = LEN(m.filename) - m.colonpos
  8955.       m.filename = RIGHT(m.filename, m.namelen)
  8956.    ENDIF
  8957. ENDIF
  8958. RETURN m.filename
  8959.  
  8960. *
  8961. * ISOBJECT - Is otype a screen or report object?
  8962. *
  8963. *!*****************************************************************************
  8964. *!
  8965. *!       Function: ISOBJECT
  8966. *!
  8967. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  8968. *!               : NEWCHARTOGRAPHIC   (procedure in TRANSPRT.PRG)
  8969. *!               : NEWGRAPHICTOCHAR   (procedure in TRANSPRT.PRG)
  8970. *!               : FINDLIKEVPOS       (procedure in TRANSPRT.PRG)
  8971. *!               : FINDLIKEHPOS       (procedure in TRANSPRT.PRG)
  8972. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  8973. *!
  8974. *!*****************************************************************************
  8975. FUNCTION isobject
  8976. PARAMETER m.otype
  8977. RETURN INLIST(m.otype,c_otlist,c_ottxtbut,c_otbox,c_otradbut,c_otchkbox,c_otfield, ;
  8978.    c_otpopup,c_otinvbut,c_otspinner,c_otpicture,c_otline,c_otrepfld,c_otrepvar,c_ottext)
  8979.  
  8980.  
  8981. *
  8982. * ISREPTOBJECT - Is otype a report object?
  8983. *
  8984. *!*****************************************************************************
  8985. *!
  8986. *!       Function: ISREPTOBJECT
  8987. *!
  8988. *!      Called by: RPTCONVERT         (procedure in TRANSPRT.PRG)
  8989. *!
  8990. *!*****************************************************************************
  8991. FUNCTION isreptobject
  8992. PARAMETER m.otype
  8993. RETURN INLIST(m.otype,c_otrepfld,c_ottext,c_otbox,c_otline)
  8994.  
  8995. *
  8996. * ISGRAPHOBJ - Is otype an object that is present in graphics screens/reports but not
  8997. *              in character screens?
  8998. *
  8999. *!*****************************************************************************
  9000. *!
  9001. *!       Function: ISGRAPHOBJ
  9002. *!
  9003. *!*****************************************************************************
  9004. FUNCTION isgraphobj
  9005. PARAMETER m.otype
  9006. RETURN INLIST(m.otype,c_otpicture,c_otspinner)
  9007.  
  9008. *!*****************************************************************************
  9009. *!
  9010. *!       Function: ISENVIRON
  9011. *!
  9012. *!*****************************************************************************
  9013. FUNCTION isenviron
  9014. PARAMETER m.otype
  9015. RETURN INLIST(m.otype,c_otworkar,c_otindex,c_otrel)
  9016.  
  9017. *!*****************************************************************************
  9018. *!
  9019. *!       Function: IsNewerEnv
  9020. *!
  9021. *!*****************************************************************************
  9022. FUNCTION IsNewerEnv
  9023. PARAMETER mustexist    && does the "to" environment have to exist?
  9024. PRIVATE m.maxfromts, m.maxtots
  9025. * Is the "from" platform environment newer than the "to" platform environment
  9026. m.maxfromts = -1
  9027. SCAN FOR platform = m.g_fromplatform and IsEnviron(objtype)
  9028.    m.maxfromts = MAX(timestamp, m.maxfromts)
  9029. ENDSCAN
  9030. m.maxtots = -1
  9031. SCAN FOR platform = m.g_toplatform and IsEnviron(objtype)
  9032.    m.maxtots = MAX(timestamp, m.maxtots)
  9033. ENDSCAN
  9034. IF m.mustexist
  9035.    * The to platform had an environment, but it was out of date
  9036.    RETURN IIF(m.maxfromts > m.maxtots AND m.maxtots >= 0 , .T. , .F.)
  9037. ELSE
  9038.    * The to platform had no environment and the from platform does
  9039.    RETURN IIF(m.maxfromts >= 0 AND m.maxtots < 0  , .T. , .F.)
  9040. ENDIF   
  9041.  
  9042. *
  9043. * HASRECORD - Does filname contain platform records for target?
  9044. *
  9045. *!*****************************************************************************
  9046. *!
  9047. *!       Function: HASRECORDS
  9048. *!
  9049. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  9050. *!
  9051. *!*****************************************************************************
  9052. FUNCTION hasrecords
  9053. PARAMETER m.target
  9054. PRIVATE ALL
  9055. IF TYPE("PLATFORM") <> "U"
  9056.    LOCATE FOR UPPER(TRIM(platform)) == m.target
  9057.    RETURN FOUND()
  9058. ENDIF
  9059. RETURN .F.
  9060.  
  9061. *
  9062. * ASKFONT - Prompt for a font
  9063. *
  9064. *!*****************************************************************************
  9065. *!
  9066. *!       Function: ASKFONT
  9067. *!
  9068. *!      Called by: SCXFRXDIALOG()     (function  in TRANSPRT.PRG)
  9069. *!
  9070. *!*****************************************************************************
  9071. FUNCTION askfont
  9072. PRIVATE m.fontstrg, m.rptfnt
  9073.  
  9074. * Set up a default font for reports
  9075. IF m.g_filetype = c_report AND (_WINDOWS OR _MAC)
  9076.    m.rptfnt = g_rptfface + "," + ALLTRIM(STR(g_rptfsize,3))
  9077.    DEFINE WINDOW transtemp FROM SROWS()+1,SCOLS()+2 TO SROWS()+3,SCOLS()+3 ;
  9078.       FONT rptfnt
  9079.    ACTIVATE WINDOW transtemp NOSHOW
  9080. ENDIF
  9081.  
  9082. m.fontstrg = GETFONT()
  9083. IF !EMPTY(m.fontstrg)
  9084.    m.g_fontface   =  LEFT(m.fontstrg,AT(',',m.fontstrg)-1)
  9085.    m.g_fontsize   =  VAL(SUBSTR(m.fontstrg,AT(',',m.fontstrg)+1,RAT(',',m.fontstrg)-AT(',',m.fontstrg)-1))
  9086.    m.g_fontstyle  =  SUBSTR(m.fontstrg,RAT(',',m.fontstrg)+1)
  9087.    IF _MAC OR _WINDOWS
  9088.       m.g_rptlinesize      = (FONTMETRIC(1, m.g_fontface, m.g_fontsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  9089.       m.g_rptcharsize      = (FONTMETRIC(6, m.g_fontface, m.g_fontsize, m.g_rpttxtfontstyle) / c_pixelsize) * 10000
  9090.    ENDIF
  9091. ENDIF
  9092.  
  9093. IF m.g_filetype = c_report AND (_WINDOWS OR _MAC)
  9094.    RELEASE WINDOW transtemp
  9095. ENDIF
  9096.  
  9097. RETURN
  9098.  
  9099. *
  9100. * IS20SCX - Is the current database a 2.0 screen?
  9101. *
  9102. *!*****************************************************************************
  9103. *!
  9104. *!       Function: IS20SCX
  9105. *!
  9106. *!*****************************************************************************
  9107. FUNCTION is20scx
  9108. RETURN (FCOUNT() = c_20scxfld)
  9109. *
  9110. * IS20FRX - Is the current database a 2.0 report?
  9111. *
  9112. *!*****************************************************************************
  9113. *!
  9114. *!       Function: IS20FRX
  9115. *!
  9116. *!*****************************************************************************
  9117. FUNCTION is20frx
  9118. RETURN (FCOUNT() = c_20frxfld)
  9119. *
  9120. * IS20LBX - Is the current database a 2.0 screen?
  9121. *
  9122. *!*****************************************************************************
  9123. *!
  9124. *!       Function: IS20LBX
  9125. *!
  9126. *!*****************************************************************************
  9127. FUNCTION is20lbx
  9128. RETURN (FCOUNT() = c_20lbxfld)
  9129. IF WEXIST("lblwind")   AND WVISIBLE("lblwind")
  9130.    RELEASE WINDOW lblwind
  9131. ENDIF
  9132.  
  9133. *
  9134. * GETSNIPFLAG - See if we are just updating snippets
  9135. *
  9136. *!*****************************************************************************
  9137. *!
  9138. *!       Function: GETSNIPFLAG
  9139. *!
  9140. *!      Called by: UPDATESCREEN       (procedure in TRANSPRT.PRG)
  9141. *!
  9142. *!          Calls: WORDNUM()          (function  in TRANSPRT.PRG)
  9143. *!               : MATCH()            (function  in TRANSPRT.PRG)
  9144. *!
  9145. *!*****************************************************************************
  9146. FUNCTION getsnipflag
  9147. PARAMETER snippet
  9148. PRIVATE m.oldmline, m.retcode
  9149. * Format for directive is "#TRAN SNIPPET ONLY" in setup snippet
  9150. m.oldmline = _MLINE
  9151. m.retcode = .F.
  9152. IF AT('#',snippet) > 0
  9153.    _MLINE = 0
  9154.    m.sniplen = LEN(snippet)
  9155.    DO WHILE _MLINE < m.sniplen
  9156.       m.line = MLINE(snippet,1,_MLINE)
  9157.       m.upline = UPPER(LTRIM(m.line))
  9158.       IF '#TRAN' $ m.upline
  9159.          IF LEFT(wordnum(m.upline,1),5) = '#TRAN' ;
  9160.                AND match(wordnum(m.upline,2),'SNIPPETS') ;
  9161.                AND match(wordnum(m.upline,3),'ONLY')
  9162.             m.retcode = .T.
  9163.          ENDIF
  9164.       ENDIF
  9165.    ENDDO
  9166.    _MLINE = m.oldmline
  9167. ENDIF
  9168. RETURN m.retcode
  9169.  
  9170.  
  9171. *
  9172. * MATCH - Returns TRUE is candidate is a valid 4-or-more-character abbreviation of keyword
  9173. *
  9174. *!*****************************************************************************
  9175. *!
  9176. *!       Function: MATCH
  9177. *!
  9178. *!      Called by: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  9179. *!
  9180. *!*****************************************************************************
  9181. FUNCTION match
  9182. PARAMETER candidate, keyword
  9183. PRIVATE in_exact
  9184. m.in_exact = SET("EXACT")
  9185. SET EXACT OFF
  9186. DO CASE
  9187. CASE EMPTY(m.candidate)
  9188.    RETURN EMPTY(m.keyword)
  9189. CASE LEN(m.candidate) < 4
  9190.    RETURN m.candidate == m.keyword
  9191. OTHERWISE
  9192.    RETURN m.keyword = m.candidate
  9193. ENDCASE
  9194. IF m.in_exact != "OFF"
  9195.    SET EXACT ON
  9196. ENDIF
  9197.  
  9198.  
  9199. *
  9200. * WORDNUM - Returns w_num-th word from string strg
  9201. *
  9202. *!*****************************************************************************
  9203. *!
  9204. *!       Function: WORDNUM
  9205. *!
  9206. *!      Called by: GETSNIPFLAG()      (function  in TRANSPRT.PRG)
  9207. *!
  9208. *!*****************************************************************************
  9209. FUNCTION wordnum
  9210. PARAMETERS strg,w_num
  9211. PRIVATE strg,s1,w_num,ret_str
  9212.  
  9213. m.s1 = ALLTRIM(m.strg)
  9214.  
  9215. * Replace tabs with spaces
  9216. m.s1 = CHRTRAN(m.s1,CHR(9)," ")
  9217.  
  9218. * Reduce multiple spaces to a single space
  9219. DO WHILE AT('  ',m.s1) > 0
  9220.    m.s1 = STRTRAN(m.s1,'  ',' ')
  9221. ENDDO
  9222.  
  9223. ret_str = ""
  9224. DO CASE
  9225. CASE m.w_num > 1
  9226.    DO CASE
  9227.    CASE AT(" ",m.s1,m.w_num-1) = 0   && No word w_num.  Past end of string.
  9228.       m.ret_str = ""
  9229.    CASE AT(" ",m.s1,m.w_num) = 0     && Word w_num is last word in string.
  9230.       m.ret_str = SUBSTR(m.s1,AT(" ",m.s1,m.w_num-1)+1,255)
  9231.    OTHERWISE                         && Word w_num is in the middle.
  9232.       m.strt_pos = AT(" ",m.s1,m.w_num-1)
  9233.       m.ret_str  = SUBSTR(m.s1,strt_pos,AT(" ",m.s1,m.w_num)+1 - strt_pos)
  9234.    ENDCASE
  9235. CASE m.w_num = 1
  9236.    IF AT(" ",m.s1) > 0               && Get first word.
  9237.       m.ret_str = SUBSTR(m.s1,1,AT(" ",m.s1)-1)
  9238.    ELSE                              && There is only one word.  Get it.
  9239.       m.ret_str = m.s1
  9240.    ENDIF
  9241. ENDCASE
  9242. RETURN ALLTRIM(m.ret_str)
  9243.  
  9244. *
  9245. * ADDBS - Add a backslash unless there is one already there.
  9246. *
  9247. *!*****************************************************************************
  9248. *!
  9249. *!       Function: ADDBS
  9250. *!
  9251. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9252. *!
  9253. *!*****************************************************************************
  9254. FUNCTION addbs
  9255. * Add a backslash to a path name, if there isn't already one there
  9256. PARAMETER m.pathname
  9257. PRIVATE ALL
  9258. m.pathname = ALLTRIM(UPPER(m.pathname))
  9259. IF !(RIGHT(m.pathname,1) $ '\:') AND !EMPTY(m.pathname)
  9260.    m.pathname = m.pathname + '\'
  9261. ENDIF
  9262. RETURN m.pathname
  9263.  
  9264. *
  9265. * JUSTFNAME - Return just the filename (i.e., no path) from "filname"
  9266. *
  9267. *!*****************************************************************************
  9268. *!
  9269. *!       Function: JUSTFNAME
  9270. *!
  9271. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9272. *!
  9273. *!*****************************************************************************
  9274. FUNCTION justfname
  9275. PARAMETERS m.filname
  9276. PRIVATE ALL
  9277. IF RAT('\',m.filname) > 0
  9278.    m.filname = SUBSTR(m.filname,RAT('\',m.filname)+1,255)
  9279. ENDIF
  9280. IF AT(':',m.filname) > 0
  9281.    m.filname = SUBSTR(m.filname,AT(':',m.filname)+1,255)
  9282. ENDIF
  9283. RETURN ALLTRIM(UPPER(m.filname))
  9284.  
  9285. *
  9286. * JUSTPATH - Returns just the pathname.
  9287. *
  9288. *!*****************************************************************************
  9289. *!
  9290. *!       Function: JUSTPATH
  9291. *!
  9292. *!      Called by: FORCEEXT()         (function  in TRANSPRT.PRG)
  9293. *!
  9294. *!*****************************************************************************
  9295. FUNCTION justpath
  9296. * Return just the path name from "filname"
  9297. PARAMETERS m.filname
  9298. PRIVATE ALL
  9299. m.filname = ALLTRIM(UPPER(m.filname))
  9300. IF '\' $ m.filname
  9301.    m.filname = SUBSTR(m.filname,1,RAT('\',m.filname))
  9302.    IF RIGHT(m.filname,1) = '\' AND LEN(m.filname) > 1 ;
  9303.          AND SUBSTR(m.filname,LEN(m.filname)-1,1) <> ':'
  9304.       m.filname = SUBSTR(m.filname,1,LEN(m.filname)-1)
  9305.    ENDIF
  9306.    RETURN m.filname
  9307. ELSE
  9308.    RETURN ''
  9309. ENDIF
  9310.  
  9311. *
  9312. * FORCEEXT - Force filename to have a paricular extension.
  9313. *
  9314. *!*****************************************************************************
  9315. *!
  9316. *!       Function: FORCEEXT
  9317. *!
  9318. *!      Called by: CONVERT102FRX()    (function  in TRANSPRT.PRG)
  9319. *!               : CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  9320. *!
  9321. *!          Calls: JUSTPATH()         (function  in TRANSPRT.PRG)
  9322. *!               : JUSTFNAME()        (function  in TRANSPRT.PRG)
  9323. *!               : ADDBS()            (function  in TRANSPRT.PRG)
  9324. *!
  9325. *!*****************************************************************************
  9326. FUNCTION forceext
  9327. * Force the extension of "filname" to be whatever ext is.
  9328. PARAMETERS m.filname,m.ext
  9329. PRIVATE ALL
  9330. IF SUBSTR(m.ext,1,1) = "."
  9331.    m.ext = SUBSTR(m.ext,2,3)
  9332. ENDIF
  9333.  
  9334. m.pname = justpath(m.filname)
  9335. m.filname = justfname(UPPER(ALLTRIM(m.filname)))
  9336. IF AT('.',m.filname) > 0
  9337.    m.filname = SUBSTR(m.filname,1,AT('.',m.filname)-1) + '.' + m.ext
  9338. ELSE
  9339.    m.filname = m.filname + '.' + m.ext
  9340. ENDIF
  9341. RETURN addbs(m.pname) + m.filname
  9342.  
  9343. *!*****************************************************************************
  9344. *!
  9345. *!       Function: CVTLONG
  9346. *!
  9347. *!          Calls: CVTSHORT()         (function  in TRANSPRT.PRG)
  9348. *!
  9349. *!*****************************************************************************
  9350. FUNCTION cvtlong
  9351. PARAMETER m.itext, m.ioff
  9352. RETURN cvtshort(m.itext,m.ioff) + (65536 * cvtshort(m.itext,m.ioff+2))
  9353.  
  9354. *!*****************************************************************************
  9355. *!
  9356. *!       Function: CVTSHORT
  9357. *!
  9358. *!      Called by: GETOLDREPORTTYPE() (function  in TRANSPRT.PRG)
  9359. *!               : CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  9360. *!               : CVTLONG()          (function  in TRANSPRT.PRG)
  9361. *!
  9362. *!          Calls: CVTBYTE()          (function  in TRANSPRT.PRG)
  9363. *!
  9364. *!*****************************************************************************
  9365. FUNCTION cvtshort
  9366. PARAMETER m.itext, m.ioff
  9367. RETURN cvtbyte(m.itext,m.ioff) + (256 * cvtbyte(m.itext,m.ioff+1))
  9368.  
  9369. *!*****************************************************************************
  9370. *!
  9371. *!       Function: CVTBYTE
  9372. *!
  9373. *!      Called by: CONVERTFBPRPT      (procedure in TRANSPRT.PRG)
  9374. *!               : CVTSHORT()         (function  in TRANSPRT.PRG)
  9375. *!
  9376. *!*****************************************************************************
  9377. FUNCTION cvtbyte
  9378. PARAMETER m.itext, m.ioff
  9379. RETURN ASC(SUBSTR(m.itext,m.ioff+1,1))
  9380.  
  9381. *!*****************************************************************************
  9382. *!
  9383. *!       Function: OBJ2BASEFONT
  9384. *!
  9385. *!      Called by: FILLININFO         (procedure in TRANSPRT.PRG)
  9386. *!
  9387. *!*****************************************************************************
  9388. FUNCTION obj2basefont
  9389. PARAMETER mwidth, bfontface, bfontsize, bfontstyle, ofontface, ;
  9390.    ofontsize, ofontstyle
  9391. * Map a width from one font to another one
  9392. DO CASE
  9393. CASE m.g_tographic
  9394.    RETURN m.mwidth * FONTMETRIC(6,m.ofontface,m.ofontsize,m.ofontstyle) ;
  9395.       / FONTMETRIC(6,m.bfontface,m.bfontsize,m.bfontstyle)
  9396. CASE UPPER(m.ofontface) == "MS SANS SERIF" AND ;
  9397.       UPPER(m.bfontface) == "MS SANS SERIF" AND ;
  9398.       m.ofontsize = m.bfontsize AND ;
  9399.       !("B" $ m.ofontstyle) AND ;
  9400.       "B" $ m.bfontstyle
  9401.    * We can't use FONTMETRIC on DOS, so we use heuristics instead.  Most
  9402.    * of the time we will be converting between MS Sans Serif 8 Bold and
  9403.    * MS Sans Serif Regular.  If that is the case here, use the 5/6 conversion
  9404.    * factor that is the relative widths of the chars in these two font styles.
  9405.    RETURN m.mwidth * 5/6
  9406. OTHERWISE
  9407.    RETURN m.mwidth
  9408. ENDCASE
  9409.  
  9410.  
  9411. *!*****************************************************************************
  9412. *!
  9413. *!       Function: VERSIONCAP
  9414. *!
  9415. *!      Called by: RDVALID()          (function  in TRANSPRT.PRG)
  9416. *!               : SELECTOBJ          (procedure in TRANSPRT.PRG)
  9417. *!
  9418. *!*****************************************************************************
  9419. FUNCTION versioncap
  9420. PARAMETER m.strg
  9421. DO CASE
  9422. CASE strg = "DOS"
  9423.    RETURN "MS-DOS"
  9424. CASE strg = "WINDOWS"
  9425.    RETURN "Windows"
  9426. CASE strg = "MAC"
  9427.    RETURN "Macintosh"
  9428. CASE strg = "UNIX"
  9429.    RETURN "UNIX"
  9430. OTHERWISE
  9431.    RETURN strg
  9432. ENDCASE
  9433.  
  9434.  
  9435. *!*****************************************************************************
  9436. *!
  9437. *!       Function: BLACKBOX
  9438. *!
  9439. *!*****************************************************************************
  9440. FUNCTION blackbox
  9441. PARAMETER otype , mred, mblue, mgreen, mpattern
  9442. * Is this a black box?
  9443. IF !m.g_tographic AND m.otype = c_otbox AND ;
  9444.       m.mred = 0 AND m.mblue = 0 AND m.mgreen = 0 ;
  9445.       AND m.mpattern = 0
  9446.    RETURN .T.
  9447. ELSE
  9448.    RETURN .F.
  9449. ENDIF
  9450.  
  9451. *!*****************************************************************************
  9452. *!
  9453. *!      Procedure: SELECTOBJ
  9454. *!
  9455. *!      Called by: GRAPHICTOCHAR      (procedure in TRANSPRT.PRG)
  9456. *!               : CHARTOGRAPHIC      (procedure in TRANSPRT.PRG)
  9457. *!
  9458. *!          Calls: INITSEL            (procedure in TRANSPRT.PRG)
  9459. *!               : ISOBJECT()         (function  in TRANSPRT.PRG)
  9460. *!               : ADDSEL             (procedure in TRANSPRT.PRG)
  9461. *!               : VERSIONCAP()       (function  in TRANSPRT.PRG)
  9462. *!               : TPSELECT           (procedure in TRANSPRT.PRG)
  9463. *!
  9464. *!           Uses: M.G_SCRNALIAS      
  9465. *!
  9466. *!        Indexes: ID                     (tag)
  9467. *!
  9468. *!*****************************************************************************
  9469. PROCEDURE selectobj
  9470. * Figure out what to transport
  9471. DO initsel
  9472.  
  9473. IF m.g_snippets
  9474.    m.g_tempalias = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  9475.    SELECT * FROM (m.g_scrnalias) ;
  9476.       WHERE !DELETED() AND platform = m.g_fromplatform ;
  9477.       INTO CURSOR (m.g_tempalias)
  9478.    IF _TALLY > 0
  9479.       INDEX ON uniqueid TAG id
  9480.    
  9481.       SELECT (m.g_scrnalias)
  9482.       SET RELATION TO uniqueid INTO (m.g_tempalias) ADDITIVE
  9483.       LOCATE FOR .T.
  9484.       DO CASE
  9485.       CASE m.g_filetype = c_screen
  9486.          SCAN FOR platform = m.g_toplatform ;
  9487.                AND (isobject(objtype) OR objtype = c_otheader OR objtype = c_otworkar) ;
  9488.                AND &g_tempalias..timestamp > timestamp
  9489.             DO addsel WITH "Upd"
  9490.          ENDSCAN
  9491.       CASE m.g_filetype = c_report
  9492.          SCAN FOR platform = m.g_toplatform AND ;
  9493.                INLIST(objtype,c_otheader,c_otfield,c_otpicture, ;
  9494.                  c_otrepfld,c_otband,c_otrepvar,c_ottext,c_otline,c_otbox,c_otworkar) ;
  9495.                AND &g_tempalias..timestamp > timestamp
  9496.             DO addsel WITH "Upd"
  9497.          ENDSCAN
  9498.       ENDCASE
  9499.       SELECT (m.g_tempalias)
  9500.       USE
  9501.    ENDIF
  9502.    SELECT (m.g_scrnalias)
  9503. ENDIF
  9504.  
  9505. IF m.g_newobjects
  9506.    m.junk = "S" + SUBSTR(LOWER(SYS(3)),2,8)
  9507.    IF m.g_tographic
  9508.       SELECT * FROM (m.g_scrnalias) ;
  9509.          WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  9510.          !(objtype = c_otfontdata) AND ;
  9511.          uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  9512.          WHERE platform = m.g_toplatform) ;
  9513.          ORDER BY objtype ;
  9514.          INTO CURSOR (m.junk)
  9515.    ELSE
  9516.       SELECT * FROM (m.g_scrnalias) ;
  9517.          WHERE !DELETED() AND platform = m.g_fromplatform AND ;
  9518.          !(objtype = c_otband AND INLIST(objcode,2,6)) AND ;
  9519.          !(objtype = c_otpicture) AND ;
  9520.          !(objtype = c_otfontdata) AND ;
  9521.          !blackbox(objtype,fillred,fillblue,fillgreen,fillpat) AND ;
  9522.          uniqueid NOT IN (SELECT uniqueid FROM (m.g_scrnalias) ;
  9523.          WHERE platform = m.g_toplatform) ;
  9524.          INTO CURSOR (m.junk)
  9525.    ENDIF
  9526.    IF _TALLY > 0
  9527.       SCAN
  9528.          DO addsel WITH "New"
  9529.       ENDSCAN
  9530.       USE  && discard the cursor
  9531.    ENDIF
  9532. ENDIF
  9533.  
  9534. IF m.g_tpselcnt > 0   && This variable is incremented in addsel()
  9535.    m.tpcancel = 1
  9536.    * Prompt user to designate at any items he does not want transported
  9537.    DO tpselect WITH tparray, m.tpcancel,versioncap(m.g_fromplatform),versioncap(m.g_toplatform)
  9538.    DO CASE
  9539.    CASE m.tpcancel = 1   && user pressed OK, so let's get to it.
  9540.    CASE m.tpcancel = 2   && user pressed "cancel" on the selection dialog.
  9541.       m.g_status = 3
  9542.       m.g_returncode = c_cancel
  9543.       RETURN TO transprt
  9544.    CASE m.tpcancel > 2
  9545.       * There aren't any objects that qualify for transporting.  User deselected all of them.
  9546.       * Pretend like we're done.
  9547.       m.g_status = 3
  9548.       m.g_returncode = c_yes
  9549.       RETURN TO transprt
  9550.    ENDCASE
  9551. ELSE
  9552.    * There aren't any objects that qualify for transporting.
  9553.    * Pretend like we're done.
  9554.    m.g_status = 3
  9555.    m.g_returncode = c_yes
  9556.    RETURN TO transprt
  9557. ENDIF
  9558.  
  9559. RETURN
  9560.  
  9561. *!*****************************************************************************
  9562. *!
  9563. *!      Procedure: INITSEL
  9564. *!
  9565. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9566. *!
  9567. *!*****************************************************************************
  9568. PROCEDURE initsel
  9569. * Initialize the tparray selection array
  9570. m.g_tpselcnt = 0
  9571. RETURN
  9572.  
  9573. *!*****************************************************************************
  9574. *!
  9575. *!      Procedure: ADDSEL
  9576. *!
  9577. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9578. *!
  9579. *!          Calls: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9580. *!
  9581. *!*****************************************************************************
  9582. PROCEDURE addsel
  9583. PARAMETER STATUS
  9584. * Don't use RECCOUNT() here since the open "database" will often be a cursor.
  9585. IF _WINDOWS OR _MAC
  9586.    m.g_tpselcnt = m.g_tpselcnt + 1
  9587.    DIMENSION tparray[m.g_tpselcnt,3]
  9588.    tparray[m.g_tpselcnt,1] = '√ '+assemble(STATUS)
  9589.    tparray[m.g_tpselcnt,2] = uniqueid
  9590.    tparray[m.g_tpselcnt,3] = objtype
  9591.    
  9592. ELSE
  9593.    m.g_tpselcnt = m.g_tpselcnt + 1
  9594.    DIMENSION tparray[m.g_tpselcnt,3]
  9595.    tparray[m.g_tpselcnt,1] = '√ '+assemble(STATUS)
  9596.    tparray[m.g_tpselcnt,2] = uniqueid
  9597.    tparray[m.g_tpselcnt,3] = objtype
  9598. ENDIF
  9599. RETURN
  9600.  
  9601. *!*****************************************************************************
  9602. *!
  9603. *!       Function: ISSELECTED
  9604. *!
  9605. *!*****************************************************************************
  9606. FUNCTION isselected
  9607. * Returns .T. if this uniqueid passed in idnum corresponds to an item
  9608. * marked on the tparray list.
  9609. PARAMETER idnum,mobjtype, mobjcode
  9610. DO CASE
  9611. CASE m.mobjtype = c_otfontdata
  9612.    RETURN .T.
  9613. OTHERWISE
  9614.    m.pos = ASCAN(tparray,m.idnum)
  9615.    IF m.pos > 0
  9616.       * Check pos-1 since this is a two dimensional array.  ASCAN returns an element number
  9617.       * but we are really interested in the column before the one that the match took place in.
  9618.       RETURN IIF(LEFT(tparray[m.pos-1],1) <> ' ',.T.,.F.)
  9619.    ELSE
  9620.       RETURN .F.
  9621.    ENDIF
  9622. ENDCASE
  9623.  
  9624. *!*****************************************************************************
  9625. *!
  9626. *!       Function: ASSEMBLE
  9627. *!
  9628. *!      Called by: ADDSEL             (procedure in TRANSPRT.PRG)
  9629. *!
  9630. *!          Calls: TYPE2NAME()        (function  in TRANSPRT.PRG)
  9631. *!               : CLEANPICT()        (function  in TRANSPRT.PRG)
  9632. *!
  9633. *!*****************************************************************************
  9634. FUNCTION assemble
  9635. * Form the string used for user selection of objects to transport
  9636. PARAMETER statstrg
  9637. PRIVATE m.strg
  9638. DO CASE
  9639. CASE INLIST(objtype,c_ottxtbut,c_otradbut,c_otchkbox)
  9640.    m.strg = PADR(statstrg,5);
  9641.       + PADR(type2name(objtype),15) ;
  9642.       + PADR(name,15) ;
  9643.       + PADR(cleanpict(PICTURE),30)
  9644. CASE objtype = c_otfield AND EMPTY(name)    && it's a SAY expression
  9645.    m.strg = PADR(statstrg,5);
  9646.       + PADR(type2name(objtype),15) ;
  9647.       + PADR(expr,45)
  9648. CASE INLIST(objtype,c_otbox,c_otline)
  9649.    IF m.g_tographic
  9650.       m.strg = PADR(statstrg,5);
  9651.          + PADR(type2name(objtype),15) ;
  9652.          + PADR("",15) ;
  9653.          + PADR("From "+ALLTRIM(STR(vpos,3))+","+ALLTRIM(STR(hpos,3))+" to " ;
  9654.          + ALLTRIM(STR(vpos+HEIGHT,3))+","+ALLTRIM(STR(hpos+WIDTH,3)),45)
  9655.    ELSE
  9656.       m.strg = PADR(statstrg,5);
  9657.          + PADR(type2name(objtype),15) ;
  9658.          + PADR("",15) ;
  9659.          + PADR("At: " ;
  9660.          + ALLTRIM(STR(ROUND(cvtreportvertical(vpos),0),3));
  9661.          + ",";
  9662.          + ALLTRIM(STR(ROUND(cvtreportvertical(hpos),0),3));
  9663.          + ", Height: ";
  9664.          + ALLTRIM(STR(ROUND(cvtreportvertical(height),0),3));
  9665.          + ", Width: " ;
  9666.          + ALLTRIM(STR(ROUND(cvtreportvertical(width),0),3)),45)
  9667.    ENDIF
  9668. OTHERWISE
  9669.    m.strg = PADR(statstrg,5);
  9670.       + PADR(type2name(objtype),15) ;
  9671.       + PADR(name,15) ;
  9672.       + PADR(expr,30)
  9673. ENDCASE
  9674. RETURN m.strg
  9675.  
  9676. *!*****************************************************************************
  9677. *!
  9678. *!       Function: TYPE2NAME
  9679. *!
  9680. *!      Called by: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9681. *!
  9682. *!*****************************************************************************
  9683. FUNCTION type2name
  9684. PARAMETER N
  9685. PRIVATE strg
  9686. DO CASE
  9687. CASE m.n = c_otheader
  9688.    m.strg = "Header"
  9689. CASE INLIST(m.n,c_otworkar,c_otindex,c_otrel)
  9690.    m.strg = "Environment"
  9691. CASE m.n = c_ottext
  9692.    m.strg = "Text"
  9693. CASE m.n = c_otline
  9694.    m.strg = "Line"
  9695. CASE m.n = c_otbox
  9696.    m.strg = "Box"
  9697. CASE m.n = c_otrepfld
  9698.    m.strg = "Report field"
  9699. CASE m.n = c_otband
  9700.    m.strg = "Band"
  9701. CASE m.n = c_otgroup
  9702.    m.strg = "Group"
  9703. CASE m.n = c_otlist
  9704.    m.strg = "List"
  9705. CASE m.n = c_ottxtbut
  9706.    m.strg = "Push button"
  9707. CASE m.n = c_otradbut
  9708.    m.strg = "Radio button"
  9709. CASE m.n = c_otchkbox
  9710.    m.strg = "Check box"
  9711. CASE m.n = c_otfield
  9712.    DO CASE
  9713.    CASE EMPTY(name)
  9714.       IF !EMPTY(expr)
  9715.          m.strg = "SAY Expression"
  9716.       ELSE
  9717.          m.strg = "Field"
  9718.       ENDIF
  9719.    CASE EMPTY(expr)
  9720.       m.strg = "GET Field"
  9721.    OTHERWISE
  9722.       m.strg = "Field"
  9723.    ENDCASE
  9724. CASE m.n = c_otpopup
  9725.    m.strg = "Popup"
  9726. CASE m.n = c_otpicture
  9727.    m.strg = "Picture"
  9728. CASE m.n = c_otrepvar
  9729.    m.strg = "Rpt variable"
  9730. CASE m.n = c_otinvbut
  9731.    m.strg = "Inv button"
  9732. CASE m.n = c_otspinner
  9733.    m.strg = "Spinner"
  9734. CASE m.n = c_otpdset
  9735.    m.strg = "Printer driver"
  9736. CASE m.n = c_otfontdata
  9737.    m.strg = "Font data"
  9738. OTHERWISE
  9739.    m.strg = STR(objtype,4)
  9740. ENDCASE
  9741.  
  9742. RETURN m.strg
  9743.  
  9744.  
  9745. *!*****************************************************************************
  9746. *!
  9747. *!       Function: CLEANPICT
  9748. *!
  9749. *!      Called by: ASSEMBLE()         (function  in TRANSPRT.PRG)
  9750. *!
  9751. *!*****************************************************************************
  9752. FUNCTION cleanpict
  9753. PARAMETER m.strg
  9754. PRIVATE m.atsign
  9755.  
  9756. * Drop quotation marks
  9757. IF AT(LEFT(m.strg,1),CHR(34)+CHR(39)) > 0
  9758.    m.strg = SUBSTR(m.strg,2)
  9759. ENDIF
  9760. IF AT(RIGHT(m.strg,1),CHR(34)+CHR(39)) > 0
  9761.    m.strg = SUBSTR(m.strg,1,LEN(m.strg)-1)
  9762. ENDIF
  9763.  
  9764. m.atsign = AT("@",m.strg)
  9765. IF m.atsign > 0
  9766.    m.strg = LTRIM(SUBSTR(m.strg,m.atsign+AT(' ',SUBSTR(m.strg,m.atsign))))
  9767. ENDIF
  9768.  
  9769. IF LEN(m.strg) > 30
  9770.    m.strg = LEFT(m.strg,27) + '...'
  9771. ENDIF
  9772. RETURN m.strg
  9773.  
  9774.  
  9775. *!*****************************************************************************
  9776. *!
  9777. *!      Procedure: TPSELECT
  9778. *!
  9779. *!      Called by: SELECTOBJ          (procedure in TRANSPRT.PRG)
  9780. *!
  9781. *!          Calls: TOGGLE()           (function  in TRANSPRT.PRG)
  9782. *!               : OKVALID()          (function  in TRANSPRT.PRG)
  9783. *!               : WREADDEAC()        (function  in TRANSPRT.PRG)
  9784. *!
  9785. *!*****************************************************************************
  9786. PROCEDURE tpselect
  9787. PARAMETERS tparray, tpcancel, fromplat,toplat
  9788. DO CASE
  9789. CASE m.g_snippets AND m.g_newobjects
  9790.    ptext = "These objects are either new to the "+m.toplat+" platform or have "+;
  9791.       "been modified more recently on "+m.fromplat+"."
  9792. CASE m.g_newobjects
  9793.    ptext = "These objects are new to "+m.toplat+"."
  9794. CASE m.g_snippets
  9795.    ptext = "These objects have been modified more recently on "+m.fromplat+"."
  9796. ENDCASE
  9797.  
  9798. DO CASE
  9799. CASE _WINDOWS
  9800.    IF NOT WEXIST("tpselect")
  9801.       DEFINE WINDOW tpselect ;
  9802.          AT  0.000, 0.000  ;
  9803.          SIZE 25.538,116.000 ;
  9804.          TITLE "FoxPro Transporter" ;
  9805.          FONT "MS Sans Serif", 8 ;
  9806.          FLOAT ;
  9807.          CLOSE ;
  9808.          NOMINIMIZE ;
  9809.          DOUBLE
  9810.       MOVE WINDOW tpselect CENTER
  9811.    ENDIF
  9812.    IF WVISIBLE("tpselect")
  9813.       ACTIVATE WINDOW tpselect SAME
  9814.    ELSE
  9815.       ACTIVATE WINDOW tpselect NOSHOW
  9816.    ENDIF
  9817.    @ 6.769,2.400 TO 8.154,113.000 ;
  9818.       PATTERN 1 ;
  9819.       PEN 1, 8 ;
  9820.       COLOR RGB(,,,192,192,192)
  9821.    @ 8.154,2.600 GET xsel ;
  9822.       PICTURE "@&N" ;
  9823.       FROM tparray ;
  9824.       SIZE 17.500,68.875 ;
  9825.       DEFAULT 1 ;
  9826.       FONT "FoxFont", 9 ;
  9827.       VALID toggle()
  9828.    @ 1.462,50.400 SAY "Uncheck any items you do" + CHR(13) + ;
  9829.       "" ;
  9830.       SIZE 1.000,25.167, 0.000 ;
  9831.       FONT "MS Sans Serif", 8 ;
  9832.       STYLE "BT"
  9833.    @ 2.385,50.200 SAY "not" ;
  9834.       SIZE 1.000,4.167, 0.000 ;
  9835.       FONT "MS Sans Serif", 8 ;
  9836.       STYLE "BIT"
  9837.    @ 2.385,55.000 SAY "want to be transported." ;
  9838.       SIZE 1.000,22.167, 0.000 ;
  9839.       FONT "MS Sans Serif", 8 ;
  9840.       STYLE "BT"
  9841.    @ 0.923,93.600 GET tpcancel ;
  9842.       PICTURE "@*VT \!\<OK;\?\<Cancel" ;
  9843.       SIZE 1.846,16.333,0.308 ;
  9844.       DEFAULT 1 ;
  9845.       FONT "MS Sans Serif", 8 ;
  9846.       STYLE "B" ;
  9847.       VALID okvalid()
  9848.    @ 6.923,14.000 SAY "Type" ;
  9849.       SIZE 1.000,4.833, 0.000 ;
  9850.       FONT "MS Sans Serif", 8 ;
  9851.       STYLE "BT"
  9852.    @ 6.923,62.000 SAY "Expression/Prompt" ;
  9853.       SIZE 1.000,17.833, 0.000 ;
  9854.       FONT "MS Sans Serif", 8 ;
  9855.       STYLE "BT"
  9856.    @ 6.923,38.200 SAY "Variable" ;
  9857.       SIZE 1.000,7.833, 0.000 ;
  9858.       FONT "MS Sans Serif", 8 ;
  9859.       STYLE "BT"
  9860.    @ 6.923,5.800 SAY "Stat" ;
  9861.       SIZE 1.000,4.000, 0.000 ;
  9862.       FONT "MS Sans Serif", 8 ;
  9863.       STYLE "BT"
  9864.    @ 1.462,3.000 SAY ptext ;
  9865.       SIZE 4.000,33.833 ;
  9866.       FONT "MS Sans Serif", 8 ;
  9867.       STYLE "B"
  9868.    
  9869.    IF NOT WVISIBLE("tpselect")
  9870.       ACTIVATE WINDOW tpselect
  9871.    ENDIF
  9872.    
  9873.    READ CYCLE;
  9874.       MODAL;
  9875.       DEACTIVATE wreaddeac()
  9876.    
  9877.    RELEASE WINDOW tpselect
  9878. CASE _DOS
  9879.    IF NOT WEXIST("tpselect")
  9880.       DEFINE WINDOW tpselect ;
  9881.          FROM INT((SROW()-23)/2),INT((SCOL()-77)/2) ;
  9882.          TO INT((SROW()-23)/2)+22,INT((SCOL()-77)/2)+76 ;
  9883.          TITLE "FoxPro Transporter" ;
  9884.          FLOAT ;
  9885.          CLOSE ;
  9886.          NOMINIMIZE ;
  9887.          DOUBLE ;
  9888.          COLOR SCHEME 5
  9889.    ENDIF
  9890.    IF WVISIBLE("tpselect")
  9891.       ACTIVATE WINDOW tpselect SAME
  9892.    ELSE
  9893.       ACTIVATE WINDOW tpselect NOSHOW
  9894.    ENDIF
  9895.    @ 0,0 CLEAR
  9896.    @ 8,1 GET xsel ;
  9897.       PICTURE "@&N" ;
  9898.       FROM tparray ;
  9899.       SIZE 13,72 ;
  9900.       DEFAULT 1 ;
  9901.       VALID toggle() ;
  9902.       COLOR SCHEME 6
  9903.    @ 1,30 SAY "Uncheck any items you do" ;
  9904.       SIZE 1,24, 0
  9905.    @ 2,30 SAY "not" ;
  9906.       SIZE 1,3, 0
  9907.    @ 2,34 SAY "want to be transported." ;
  9908.       SIZE 1,23, 0
  9909.    @ 1,62 GET tpcancel ;
  9910.       PICTURE "@*VT \!\<OK;\?\<Cancel" ;
  9911.       SIZE 1,10,0 ;
  9912.       DEFAULT 1 ;
  9913.       VALID okvalid()
  9914.    @ 7,10 SAY "Type" ;
  9915.       SIZE 1,4, 0
  9916.    @ 7,40 SAY "Expression/Prompt" ;
  9917.       SIZE 1,17, 0
  9918.    @ 7,25 SAY "Variable" ;
  9919.       SIZE 1,8, 0
  9920.    @ 7,5 SAY "Stat" ;
  9921.       SIZE 1,4, 0
  9922.    @ 1,2 SAY ptext ;
  9923.       SIZE 5,26
  9924.    
  9925.    IF NOT WVISIBLE("tpselect")
  9926.       ACTIVATE WINDOW tpselect
  9927.    ENDIF
  9928.    
  9929.    READ CYCLE ;
  9930.       MODAL ;
  9931.       DEACTIVATE wreaddeac()
  9932.    
  9933.    RELEASE WINDOW tpselect
  9934. ENDCASE
  9935.  
  9936. *!*****************************************************************************
  9937. *!
  9938. *!       Function: TOGGLE
  9939. *!
  9940. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  9941. *!
  9942. *!*****************************************************************************
  9943. FUNCTION toggle
  9944. * Toggle mark
  9945. IF LEFT(tparray[xsel,1],1) <> ' '
  9946.    tparray[xsel,1] = STUFF(tparray[xsel,1],1,1,' ')
  9947. ELSE
  9948.    tparray[xsel,1] = STUFF(tparray[xsel,1],1,1,'√')
  9949. ENDIF
  9950. SHOW GETS
  9951. RETURN .F.
  9952.  
  9953. *!*****************************************************************************
  9954. *!
  9955. *!       Function: OKVALID
  9956. *!
  9957. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  9958. *!
  9959. *!*****************************************************************************
  9960. FUNCTION okvalid
  9961. * Simulate a cancel if no objects were selected.
  9962. IF tpcancel = 1
  9963.    PRIVATE m.i
  9964.    m.cnt = 0
  9965.    FOR m.i = 1 TO m.g_tpselcnt
  9966.       IF LEFT(tparray[m.i,1],1) <> ' '
  9967.          m.cnt = m.cnt + 1
  9968.       ENDIF
  9969.    ENDFOR
  9970.    IF m.cnt = 0
  9971.       m.tpcancel = 3   && code that means, "just open as is."
  9972.    ENDIF
  9973. ENDIF
  9974.  
  9975. *!*****************************************************************************
  9976. *!
  9977. *!       Function: WREADDEAC
  9978. *!
  9979. *!      Called by: TPSELECT           (procedure in TRANSPRT.PRG)
  9980. *!
  9981. *!*****************************************************************************
  9982. FUNCTION wreaddeac
  9983. *
  9984. * Deactivate Code from screen: TP
  9985. *
  9986. CLEAR READ
  9987.  
  9988. *!*****************************************************************************
  9989. *!
  9990. *!       Function: EnvSelect
  9991. *!
  9992. *!*****************************************************************************
  9993. FUNCTION EnvSelect
  9994. PRIVATE m.i
  9995. * Was an environment record selected for transport?
  9996. FOR m.i = 1 TO m.g_tpselcnt
  9997.    IF IsEnviron(tparray[m.i,3]) AND LEFT(tparray[m.i,1],1) <> " "
  9998.       RETURN .T.
  9999.    ENDIF
  10000. ENDFOR
  10001. RETURN .F.
  10002.  
  10003. *!*****************************************************************************
  10004. *!
  10005. *!       Function: OutputOrd
  10006. *!
  10007. *!*****************************************************************************
  10008. FUNCTION outputord
  10009. PARAMETER m.otype, m.rno
  10010. * Function to sort screen and report files.  We want the header and environment
  10011. * records to be at the "top" of the platform, and other records to be in their
  10012. * original order.
  10013. IF objtype <= 4
  10014.    RETURN STR(m.otype,3)+STR(m.rno,3)
  10015. ELSE   
  10016.    RETURN STR(m.rno,3)+STR(m.otype,3)
  10017. ENDIF
  10018.  
  10019. *!*****************************************************************************
  10020. *!
  10021. *!       Procedure: PUTWINMSG
  10022. *!
  10023. *!*****************************************************************************
  10024. PROCEDURE putwinmsg
  10025. PARAMETER m.msg
  10026. IF _WINDOWS OR _MAC
  10027.    SET MESSAGE TO m.msg
  10028. ENDIF
  10029.  
  10030. *
  10031. * SETALL - Create program's environment.
  10032. *
  10033. * Description:
  10034. * Save the user's environment that is being modified by the GENSCRN,
  10035. * then issue various SET commands.
  10036. *
  10037. *!*****************************************************************************
  10038. *!
  10039. *!      Procedure: SETALL
  10040. *!
  10041. *!      Called by: TRANSPRT.PRG                      
  10042. *!
  10043. *!          Calls: ESCHANDLER         (procedure in TRANSPRT.PRG)
  10044. *!
  10045. *!*****************************************************************************
  10046. PROCEDURE setall
  10047.  
  10048. CLEAR PROGRAM
  10049. CLEAR GETS
  10050.  
  10051. m.escape = SET("ESCAPE")
  10052. SET ESCAPE ON
  10053.  
  10054. m.onescape = ON("ESCAPE")
  10055. ON ESCAPE DO eschandler
  10056.  
  10057. *SET ESCAPE OFF
  10058. m.trbetween = SET("TRBET")
  10059. SET TRBET OFF
  10060. m.comp = SET("COMPATIBLE")
  10061. SET COMPATIBLE FOXPLUS
  10062. m.device = SET("DEVICE")
  10063. SET DEVICE TO SCREEN
  10064.  
  10065. m.rbord = SET("READBORDER")
  10066. SET READBORDER ON
  10067.  
  10068. m.status = SET("STATUS")
  10069. *SET STATUS OFF
  10070.  
  10071. m.currarea = SELECT()
  10072.  
  10073. m.udfparms = SET('UDFPARMS')
  10074. SET UDFPARMS TO VALUE
  10075.  
  10076. m.mtopic = SET("TOPIC")
  10077. IF SET("HELP") = "ON"
  10078.    DO CASE 
  10079.    CASE ATC(".DBF",SET("HELP",1)) > 0
  10080.       SET TOPIC TO CHR(254)+" Transporter"
  10081.       ON KEY LABEL F1 HELP ■ Transporter
  10082.    CASE ATC(".HLP",SET("HELP",1)) > 0   
  10083.       SET TOPIC TO Transporter Dialog
  10084.       ON KEY LABEL F1 HELP Transporter Dialog
  10085.    ENDCASE
  10086. ENDIF
  10087.  
  10088. m.memowidth = SET("MEMOWIDTH")
  10089. SET MEMOWIDTH TO 256
  10090.  
  10091. m.cursor = SET("CURSOR")
  10092. SET CURSOR OFF
  10093.  
  10094. m.consol = SET("CONSOLE")
  10095. SET CONSOLE OFF
  10096.  
  10097. m.bell = SET("BELL")
  10098. SET BELL OFF
  10099.  
  10100. m.exact = SET("EXACT")
  10101. SET EXACT ON
  10102.  
  10103. m.deci = SET("DECIMALS")
  10104. SET DECIMALS TO 10
  10105.  
  10106. m.fixed = SET("FIXED")
  10107. SET FIXED ON
  10108.  
  10109. m.print = SET("PRINT")
  10110. SET PRINT OFF
  10111.  
  10112. m.unqset = SET("UNIQUE")
  10113. SET UNIQUE OFF
  10114.  
  10115. m.safety = SET("SAFETY")
  10116. SET SAFETY OFF
  10117.  
  10118. m.exclusive = SET("EXCLUSIVE")
  10119. SET EXCLUSIVE ON
  10120.  
  10121. *
  10122. * CLEANUP - Restore environment to pre-execution state.
  10123. *
  10124. * Description:
  10125. * Put SET command settings back the way we found them.
  10126. *
  10127. *!*****************************************************************************
  10128. *!
  10129. *!      Procedure: CLEANUP
  10130. *!
  10131. *!      Called by: TRANSPRT.PRG                      
  10132. *!               : ERRORHANDLER       (procedure in TRANSPRT.PRG)
  10133. *!               : CONVERTTYPE()      (function  in TRANSPRT.PRG)
  10134. *!               : ESCHANDLER         (procedure in TRANSPRT.PRG)
  10135. *!
  10136. *!          Calls: WRITERESULT        (procedure in TRANSPRT.PRG)
  10137. *!               : DEACTTHERM         (procedure in TRANSPRT.PRG)
  10138. *!
  10139. *!*****************************************************************************
  10140. PROCEDURE cleanup
  10141. PARAMETER m.cancafter
  10142. IF PARAMETERS() = 0
  10143.    m.cancafter = .F.
  10144. ENDIF
  10145. IF NOT EMPTY(m.g_20alias)
  10146.    IF m.g_status != 0
  10147.       IF USED(m.g_tempalias)
  10148.          SELECT (m.g_tempalias)
  10149.          USE
  10150.       ENDIF
  10151.       IF USED(m.g_fromobjonlyalias)
  10152.          SELECT (m.g_fromobjonlyalias)
  10153.          USE
  10154.       ENDIF
  10155.       IF USED(m.g_boxeditemsalias)
  10156.          SELECT (m.g_boxeditemsalias)
  10157.          USE
  10158.       ENDIF
  10159.       SELECT (m.g_20alias)
  10160.       USE
  10161.       SELECT (m.g_scrnalias)
  10162.    ELSE
  10163.       DO writeresult
  10164.    ENDIF
  10165. ENDIF
  10166.  
  10167. ON ERROR &onerror
  10168. ON ESCAPE &onescape
  10169.  
  10170. IF m.consol = "ON"
  10171.    SET CONSOLE ON
  10172. ELSE
  10173.    SET CONSOLE OFF
  10174. ENDIF
  10175.  
  10176. IF m.escape = "ON"
  10177.    SET ESCAPE ON
  10178. ELSE
  10179.    SET ESCAPE OFF
  10180. ENDIF
  10181.  
  10182. IF m.bell = "ON"
  10183.    SET BELL ON
  10184. ELSE
  10185.    SET BELL OFF
  10186. ENDIF
  10187.  
  10188. IF m.exact = "ON"
  10189.    SET EXACT ON
  10190. ELSE
  10191.    SET EXACT OFF
  10192. ENDIF
  10193.  
  10194. IF m.comp = "ON"
  10195.    SET COMPATIBLE ON
  10196. ENDIF
  10197.  
  10198. IF m.print = "ON"
  10199.    SET PRINT ON
  10200. ENDIF
  10201.  
  10202. IF m.fixed = "OFF"
  10203.    SET FIXED OFF
  10204. ENDIF
  10205.  
  10206. IF m.trbetween = "ON"
  10207.    SET TRBET ON
  10208. ENDIF
  10209.  
  10210. IF m.unqset = "ON"
  10211.    SET UNIQUE ON
  10212. ENDIF
  10213.  
  10214. IF m.rbord = "OFF"
  10215.    SET READBORDER OFF
  10216. ENDIF   
  10217.  
  10218. IF m.status = "ON"
  10219.    SET STATUS ON
  10220. ENDIF
  10221.  
  10222. SET DECIMALS TO m.deci
  10223. SET MEMOWIDTH TO m.memowidth
  10224. SET DEVICE TO &device
  10225. SET UDFPARMS TO &udfparms
  10226. SET TOPIC TO &mtopic
  10227. ON KEY LABEL F1
  10228. POP KEY
  10229.  
  10230. USE
  10231. DELETE FILE (m.g_tempindex)
  10232. SET MESSAGE TO
  10233.  
  10234. SELECT (m.currarea)
  10235.  
  10236. DO deacttherm
  10237.  
  10238. IF m.cursor = "ON"
  10239.    SET CURSOR ON
  10240. ELSE
  10241.    SET CURSOR OFF
  10242. ENDIF
  10243.  
  10244. IF m.safety = "ON"
  10245.    SET SAFETY ON
  10246. ENDIF
  10247.  
  10248. IF m.talkset = "ON"
  10249.    SET TALK ON
  10250. ENDIF
  10251.  
  10252. IF m.exclusive = "ON"
  10253.    SET EXCLUSIVE ON
  10254. ELSE
  10255.    SET EXCLUSIVE OFF
  10256. ENDIF
  10257. IF m.talkset = "ON"
  10258.    SET TALK ON
  10259. ENDIF
  10260.  
  10261. IF m.cancafter
  10262.    CANCEL
  10263. ENDIF   
  10264.  
  10265. *
  10266. * WRITERESULT - Writes the converted cursor to the SCX/FRX/LBX/whatever.  The point of this is that we
  10267. *      need to write the records in their original order so we don't mees up any groups.  We also need
  10268. *      to keep records for a given platform contiguous.
  10269. *
  10270. *!*****************************************************************************
  10271. *!
  10272. *!      Procedure: WRITERESULT
  10273. *!
  10274. *!      Called by: CLEANUP            (procedure in TRANSPRT.PRG)
  10275. *!
  10276. *!          Calls: DOCREATE           (procedure in TRANSPRT.PRG)
  10277. *!               : UPDTHERM           (procedure in TRANSPRT.PRG)
  10278. *!
  10279. *!           Uses: M.G_SCRNALIAS      
  10280. *!
  10281. *!        Indexes: TEMP                   (tag)
  10282. *!
  10283. *!*****************************************************************************
  10284. PROCEDURE writeresult
  10285. PRIVATE m.platforms, m.loop, m.thermstep
  10286.  
  10287. IF g_filetype = c_project
  10288.    SELECT (m.g_20alias)        && Close the database so we can replace it.
  10289.    USE
  10290.    
  10291.    SELECT (m.g_scrnalias)      && Copy the temporary cursor to the database and
  10292.    COPY TO (m.g_scrndbf)       &&      get rid of the cursor
  10293.    USE
  10294. ELSE
  10295.    REPLACE ALL platform WITH UPPER(platform)
  10296.    
  10297.    * Get a list of the platforms we need to write.
  10298.    SELECT DISTINCT platform ;
  10299.       FROM (m.g_scrnalias) ;
  10300.       WHERE !DELETED() ;
  10301.       INTO ARRAY plist
  10302.    m.platforms = _TALLY
  10303.    
  10304.    * The following select creates a new cursor with the desired structure.  We write
  10305.    * into this and then dump the cursor to disk.  It's a bit cumbersome, but reduces
  10306.    * the chances of frying the original file.
  10307.    m.g_tempalias = "S"+SUBSTR(LOWER(SYS(3)),2,8)
  10308.    DO docreate WITH m.g_tempalias, m.g_filetype
  10309.    
  10310.    * We need to write DOS/UNIX label records in the order we want the objects to appear.
  10311.    * So, we create this index and set order to it when we want to write those records.
  10312.    IF m.g_filetype = c_label
  10313.       SELECT (m.g_scrnalias)
  10314.       INDEX ON platform + ;
  10315.          IIF(objtype = c_ot20label,CHR(1)+CHR(1), STR(objtype,2)) + ;
  10316.          STR(objcode,2) + ;
  10317.          STR(vpos,3) TAG temp
  10318.    ENDIF
  10319.    
  10320.    IF m.g_updenviron
  10321.       SELECT (m.g_scrnalias)
  10322.       INDEX ON outputord(objtype,recno()) TAG temp1
  10323.    ENDIF
  10324.    
  10325.    m.thermstep = (100 - m.g_mercury)/RECCOUNT()
  10326.    
  10327.    * Write the records for each platform.
  10328.    FOR m.loop = 1 TO m.platforms
  10329.       SELECT (m.g_scrnalias)
  10330.       
  10331.       DO CASE
  10332.       CASE m.g_filetype = c_label
  10333.          SET ORDER TO TAG temp
  10334.       CASE m.g_updenviron
  10335.          SET ORDER TO TAG temp1
  10336.       OTHERWISE
  10337.          SET ORDER TO
  10338.       ENDCASE
  10339.  
  10340.       SCAN FOR platform = plist[m.loop] AND !DELETED()
  10341.          SCATTER MEMVAR MEMO
  10342.          SELECT (m.g_tempalias)
  10343.          APPEND BLANK
  10344.          GATHER MEMVAR MEMO
  10345.          SELECT (m.g_scrnalias)
  10346.          
  10347.          m.g_mercury = m.g_mercury + 5
  10348.          DO updtherm WITH m.g_mercury
  10349.       ENDSCAN
  10350.    ENDFOR
  10351.    
  10352.    SELECT (m.g_20alias)        && Close the database so we can replace it.
  10353.    USE
  10354.    
  10355.    SELECT (m.g_tempalias)      && Copy the temporary cursor to the database and
  10356.    COPY TO (m.g_scrndbf)       &&      get rid of the cursor
  10357.    USE
  10358.    
  10359.    SELECT (m.g_scrnalias)      && Get rid of the master cursor
  10360.    USE
  10361. ENDIF
  10362.  
  10363. *: EOF: TRANSPRT.PRG
  10364.