home *** CD-ROM | disk | FTP | other *** search
/ Total C++ 2 / TOTALCTWO.iso / vfp5.0 / vfp / tools / convert / migdb4.prg < prev    next >
Text File  |  1996-08-21  |  52KB  |  1,708 lines
  1. *!*****************************************************************************
  2. *!
  3. *!     Function: MIGDB4.PRG
  4. *!     (c) Microsoft Corp. 1994, 1995
  5. *!
  6. *!     Migrates DB-IV LBL, FRM and SCR files to FoxPro equivalents
  7. *!
  8. *!     Parameter:    csrcfile    C    fully qualified file to convert
  9. *!                    oConv        O    ForeignConverter object
  10. *!
  11. *!     Returns .T. if successful
  12. *!             .F. if failed
  13. *!
  14. *!     changes:  modified version of FP 2.6 code
  15. *!
  16. *!*****************************************************************************
  17. *-FUNCTION migdb4
  18. PARAMETER m.csrcfile, m.oConv
  19.  
  20. #INCLUDE "convert.h"
  21. #INCLUDE "migdb4.h"
  22.  
  23.  
  24. PRIVATE tempstr
  25. PRIVATE cFmtConverterClass
  26. cFmtConverterClass = "FmtConverter"
  27.  
  28. PRIVATE oldexact
  29. m.oldexact = SET("EXACT")
  30. SET EXACT ON      && For ascan()
  31.  
  32. PRIVATE oldalias
  33. m.oldalias = ALIAS()
  34.  
  35. PRIVATE m.fhandle, m.fsize
  36. m.fhandle = -1
  37. IF TYPE("m.csrcfile") <> "C"
  38.     *- no parm passed
  39.     SET EXACT &oldexact
  40.     RETURN .F.
  41. ENDIF
  42.  
  43. m.fhandle = FOPEN(m.csrcfile, 2)
  44. IF m.fhandle = -1
  45.     =falldown(E_NOOPEN_LOC + JustFName(UPPER(m.csrcfile)))
  46.     SET EXACT &oldexact
  47.     RETURN .F.
  48. ENDIF
  49.  
  50. *- get file size, and return pointer to top of file
  51. m.fsize = FSEEK(m.fhandle,0,2)
  52. =FSEEK(m.fhandle,0)
  53.  
  54. PRIVATE m.rootname,m.cpathname, m.lretval
  55. m.rootname = JustStem(m.csrcfile)
  56.  
  57. *- include original path for saving migrated forms (01/27/94 jd)
  58. m.cpathname = AddBS(JustPath(m.csrcfile))        && use AddBS -- smarter about the last directory separator (jd 03.24.96)
  59.  
  60. IF LEFT(FREAD(m.fhandle,41),40) # "dBASE IV Generic Design File Version 1.0"
  61.     IF UPPER(TRIM(JustExt(m.csrcfile)))$"LBL|FRM|FRX|LBX"
  62.         PRIVATE listhere,m.nctr9, ctmpext
  63.         =FCLOSE(m.fhandle)
  64.  
  65.         *- what kind of file are we dealing with?
  66.         IF JUSTEXT(m.csrcfile) $ "LBL|LBX"
  67.             m.cfext = ".LBX"
  68.             m.cmext = ".LBT"
  69.         ELSE
  70.             m.cfext = ".FRX"
  71.             m.cmext = ".FRT"
  72.         ENDIF
  73.  
  74.         IF _DOS
  75.             *- disguise this as an .FRX file
  76.             COPY FILE (csrcfile) TO (m.cpathname + m.rootname + m.cfext)
  77.             SET EXACT &oldexact
  78.             RETURN .T.
  79.         ENDIF
  80.         FOR  m.nctr9 = 1 TO 999
  81.             IF !FILE(m.cpathname + rootname + '.' + RIGHT(STR(m.nctr9 + 1000,4),3))
  82.                 EXIT
  83.             ENDIF
  84.         NEXT
  85.         IF m.nctr9 = 1000
  86.             SET EXACT &oldexact
  87.             RETURN .F.
  88.         ENDIF
  89.         ctmpext = '.' + RIGHT(STR(m.nctr9 + 1000,4),3)
  90.         *- save their old file
  91.         RENAME (m.csrcfile) TO (m.cpathname + m.rootname + m.ctmpext)
  92.         COPY FILE (m.cpathname + m.rootname + m.ctmpext) TO (m.csrcfile)
  93.         gOTherm.SetTitle(C_THERMMSG10_LOC + LOWER(PARTIALFNAME(m.csrcfile,C_FILELEN)))
  94.         DO (gTransport) WITH m.csrcfile,IIF(m.cfext = ".FRX",23,24),.F.,gAShowMe, m.gOTherm,m.csrcfile
  95.         *- change the name to .FRX, and restore original filename
  96.         DO CASE
  97.             CASE FILE(m.cpathname + m.rootname + ".FPT")
  98.                 *- assume this means they converted
  99.                 *- assume this means they converted
  100.                 IF FILE(m.cpathname + m.rootname + m.cfext)
  101.                     ERASE (m.cpathname + m.rootname + m.cfext)
  102.                 ENDIF
  103.                 IF FILE(m.cpathname + m.rootname + m.cmext)
  104.                     ERASE (m.cpathname + m.rootname + m.cmext)
  105.                 ENDIF
  106.                 RENAME (m.cpathname + m.rootname + ".FPT") TO (m.cpathname + m.rootname + m.cmext)
  107.                 RENAME (m.csrcfile) TO (m.cpathname + m.rootname + m.cfext)
  108.                 RENAME (m.cpathname + m.rootname + m.ctmpext) TO (m.csrcfile)
  109.                 IF FILE(m.cpathname + m.rootname + ".TBK")
  110.                     ERASE (m.cpathname + m.rootname +  ".TBK")
  111.                 ENDIF
  112.                 m.lretval = .T.
  113.             CASE FILE(m.cpathname + m.rootname + m.cmext)
  114.                 *- assume this means they converted
  115.                 IF FILE(m.cpathname + m.rootname + m.ctmpext)
  116.                     ERASE (m.cpathname + m.rootname + m.ctmpext)
  117.                 ENDIF
  118.                 IF FILE(m.cpathname + m.rootname + ".TBK")
  119.                     ERASE (m.cpathname + m.rootname +  ".TBK")
  120.                 ENDIF
  121.                 m.lretval = .T.
  122.             OTHERWISE
  123.                 *- erase the copy we made
  124.                 IF FILE(m.csrcfile)
  125.                     ERASE (m.csrcfile)
  126.                 ENDIF
  127.                 RENAME (m.cpathname + m.rootname + m.ctmpext) TO (m.csrcfile)
  128.                 m.lretval = .F.
  129.         ENDCASE
  130.         SET EXACT &oldexact
  131.         RETURN m.lretval
  132.     ELSE
  133.         IF !FILE(m.cpathname + m.rootname + ".FMT")
  134.             *-=falldown(C_ERRNOFMT_LOC)
  135.             =falldown("")
  136.         ELSE
  137.             =FCLOSE(m.fhandle)
  138. ******----> Use class instead of PRG.
  139.             LOCAL oConvObject
  140.  
  141.             oConvObject = CREATE(cFmtConverterClass, @aParms)
  142.             IF TYPE("oConvObject") # 'O'
  143.                 *- object was not created
  144.                 *-THIS.lHadError = .T.
  145.                 RETURN .F.
  146.             ENDIF
  147.             
  148.             IF oConvObject.lHadError
  149.                 *- error creating SCX object: 
  150.                 *- assume error has already been presented to user
  151.                 *THIS.lHadError = .T.
  152.                 RELEASE oConvObject
  153.                 RETURN
  154.             ENDIF
  155.  
  156.             oConvObject.Converter()
  157.  
  158.             *- IF fmt2scxw(m.cpathname + m.rootname + ".FMT")
  159.             IF oConvObject.lHadError
  160.                 SET EXACT &oldexact
  161.                 oConvObject = .NULL.
  162.                 RELEASE oConvObject
  163.                 RETURN .F.
  164.             ENDIF
  165.  
  166.             RELEASE oConvObject
  167.             SET EXACT &oldexact
  168.             RETURN .T.
  169. ******---->
  170.         ENDIF
  171.     ENDIF
  172.     SET EXACT &oldexact
  173.     RETURN .F.
  174. ENDIF
  175.  
  176. PRIVATE m.filevers
  177. m.filevers = ASC(FREAD(m.fhandle,1))
  178. PRIVATE m.filetype
  179. m.filetype = ASC(FREAD(m.fhandle,1))
  180. IF m.filetype <> scr_type AND m.filetype <> lbl_type AND m.filetype <> frm_type
  181.     =falldown(C_ERRFTYPE_LOC)
  182.     SET EXACT &oldexact
  183.     RETURN .F.
  184. ENDIF
  185. =FSEEK(m.fhandle,13,1)          && Skip 13 bytes.
  186. PRIVATE num_bands
  187. num_bands = ASC(FREAD(m.fhandle,1))
  188. PRIVATE m.targetname
  189. DO CASE
  190.     CASE m.filetype = scr_type
  191.         IF FILE(m.rootname+".SCX") AND NOT ok2nuke(m.rootname+".SCX")
  192.             =FCLOSE(m.fhandle)
  193.             SET EXACT &oldexact
  194.             RETURN .F.
  195.         ENDIF
  196.         m.targetname = m.cpathname + m.rootname + ".SCX"
  197.         PRIVATE m.tempname
  198.         m.tempname = SYS(3)
  199.         SELECT SELECT(1)
  200.         CREATE DBF (m.tempname)   ;
  201.             ( platform   c(8),    ;
  202.             uniqueid   c(10),   ;
  203.             timestamp  n(10),   ;
  204.             objtype    n(2),    ;
  205.             objcode    n(3),    ;
  206.             name       m,       ;
  207.             expr       m,       ;
  208.             vpos       n(7,3),  ;
  209.             hpos       n(7,3),  ;
  210.             height     n(7,3),  ;
  211.             width      n(7,3),  ;
  212.             style      n(2),    ;
  213.             picture    m,       ;
  214.             order      m,       ;
  215.             "unique"   l,       ;
  216.             comment    m,       ;
  217.             environ    l,       ;
  218.             boxchar    c( 1),   ;
  219.             fillchar   c( 1),   ;
  220.             tag        m(10),   ;
  221.             tag2       m(10),   ;
  222.             penred     n(5),    ;
  223.             pengreen   n(5),    ;
  224.             penblue    n(5),    ;
  225.             fillred    n(5),    ;
  226.             fillgreen  n(5),    ;
  227.             fillblue   n(5),    ;
  228.             pensize    n(5),    ;
  229.             penpat     n(5),    ;
  230.             fillpat    n(5),    ;
  231.             fontface   m,       ;
  232.             fontstyle  n(3),    ;
  233.             fontsize   n(3),    ;
  234.             mode       n(3),    ;
  235.             ruler      n(1),    ;
  236.             rulerlines n(1),    ;
  237.             grid       l,       ;
  238.             gridv      n(2),    ;
  239.             gridh      n(2),    ;
  240.             scheme     n(2),    ;
  241.             scheme2    n(2),    ;
  242.             colorpair  c(8),    ;
  243.             lotype     n(1),    ;
  244.             rangelo    m,       ;
  245.             hitype     n(1),    ;
  246.             rangehi    m,       ;
  247.             whentype   n(1),    ;
  248.             when       m,       ;
  249.             validtype  n(1),    ;
  250.             valid      m,       ;
  251.             errortype  n(1),    ;
  252.             error      m,       ;
  253.             messtype   n(1),    ;
  254.             message    m,       ;
  255.             showtype   n(1),    ;
  256.             show       m,       ;
  257.             activtype  n(1),    ;
  258.             activate   m,       ;
  259.             deacttype  n(1),    ;
  260.             deactivate m,       ;
  261.             proctype   n(1),    ;
  262.             proccode   m,       ;
  263.             setuptype  n(1),    ;
  264.             setupcode  m,       ;
  265.             float      l,       ;
  266.             close      l,       ;
  267.             minimize   l,       ;
  268.             border     n(1),    ;
  269.             shadow     l,       ;
  270.             center     l,       ;
  271.             refresh    l,       ;
  272.             disabled   l,       ;
  273.             scrollbar  l,       ;
  274.             addalias   l,       ;
  275.             tab        l,       ;
  276.             initialval m,       ;
  277.             initialnum n(3),    ;
  278.             spacing    n(6,3),  ;
  279.             curpos     l        ;
  280.             )
  281.         USE (m.tempname) ALIAS newfile
  282.         APPEND BLANK
  283.         REPLACE newfile.objtype WITH 1,  ;
  284.             newfile.objcode WITH 63 &&10
  285.         *- new options added by JD for Wizards
  286.         *- window title, float, centered, single border, + support for 
  287.         *- PG UP & PG DN
  288.         *- add color scheme (02/08/94 jd)
  289.         REPLACE newfile.style WITH 2,;
  290.                 newfile.tag WITH '"' + PROPER(JustStem(m.csrcfile)) + '"',;
  291.                 newfile.gridv WITH 1,;
  292.                 newfile.gridh WITH 1,;
  293.                 newfile.whentype WITH 1,;
  294.                 newfile.validtype WITH 1,;
  295.                 newfile.showtype WITH 1,;
  296.                 newfile.activtype WITH 1,;
  297.                 newfile.deacttype WITH 1,;
  298.                 newfile.proctype WITH 1,;
  299.                 newfile.setuptype WITH 1,;
  300.                 newfile.float WITH .T.,;
  301.                 newfile.close WITH .T.,;
  302.                 newfile.border WITH 4,;
  303.                 newfile.center WITH .T.,;
  304.                 newfile.minimize WITH .T.,;
  305.                 newfile.scheme WITH 8,;
  306.                 newfile.scheme2 WITH 9,;
  307.                 newfile.deactivate WITH "CLEAR READ" + C_CRLF,;
  308.                 newfile.setupcode WITH "PUSH KEY" + C_CRLF + ;
  309.                     "ON KEY LABEL PGUP DO dopgup" + C_CRLF + ;
  310.                     "ON KEY LABEL PGDN DO dopgdn" + C_CRLF + ;
  311.                     "ON KEY LABEL CTRL+PGUP DO ctlpgup" + C_CRLF + ;
  312.                     "ON KEY LABEL CTRL+PGDN DO ctlpgdn" + C_CRLF + ;
  313.                     "IF EOF()" + C_CRLF + ;
  314.                     "  GO BOTTOM" + C_CRLF + ;
  315.                     "ENDIF" + C_CRLF
  316.             *- Append navigation code & alert screen from
  317.             *- file included in project (01/27/94 JD)
  318.             APPEND MEMO newfile.proccode FROM mignavpr.txt OVERWRITE
  319.     CASE m.filetype = frm_type
  320.         IF FILE(m.cpathname + m.rootname+".FRX") AND NOT ok2nuke(m.cpathname + m.rootname+".FRX")
  321.             =FCLOSE(m.fhandle)
  322.             SET EXACT &oldexact
  323.             RETURN .F.
  324.         ENDIF
  325.         m.targetname = m.cpathname + m.rootname + ".FRX"
  326.         SELECT SELECT(1)
  327.         CREATE DBF (m.targetname) ;
  328.             ( platform   c(8),    ;
  329.             uniqueid   c(10),   ;
  330.             timestamp  n(10),   ;
  331.             objtype    n(2),    ;
  332.             objcode    n(3),    ;
  333.             name       m,       ;
  334.             expr       m,       ;
  335.             vpos       n(9,3),  ;
  336.             hpos       n(9,3),  ;
  337.             height     n(9,3),  ;
  338.             width      n(9,3),  ;
  339.             style      m,       ;
  340.             picture    m,       ;
  341.             order      m,       ;
  342.             "unique"   l,       ;
  343.             comment    m,       ;
  344.             environ    l,       ;
  345.             boxchar    c(1),    ;
  346.             fillchar   c(1),    ;
  347.             tag        m,       ;
  348.             tag2       m,       ;
  349.             penred     n(5),    ;
  350.             pengreen   n(5),    ;
  351.             penblue    n(5),    ;
  352.             fillred    n(5),    ;
  353.             fillgreen  n(5),    ;
  354.             fillblue   n(5),    ;
  355.             pensize    n(5),    ;
  356.             penpat     n(5),    ;
  357.             fillpat    n(5),    ;
  358.             fontface   m,       ;
  359.             fontstyle  n(3),    ;
  360.             fontsize   n(3),    ;
  361.             mode       n(3),    ;
  362.             ruler      n(1),    ;
  363.             rulerlines n(1),    ;
  364.             grid       l,       ;
  365.             gridv      n(2),    ;
  366.             gridh      n(2),    ;
  367.             float      l,       ;
  368.             stretch    l,       ;
  369.             stretchtop l,       ;
  370.             top        l,       ;
  371.             bottom     l,       ;
  372.             suptype    n(1),    ;
  373.             suprest    n(1),    ;
  374.             norepeat   l,       ;
  375.             resetrpt   n( 2),   ;
  376.             pagebreak  l,       ;
  377.             colbreak   l,       ;
  378.             resetpage  l,       ;
  379.             general    n(3),    ;
  380.             spacing    n(3),    ;
  381.             double     l,       ;
  382.             swapheader l,       ;
  383.             swapfooter l,       ;
  384.             ejectbefor l,       ;
  385.             ejectafter l,       ;
  386.             plain      l,       ;
  387.             summary    l,       ;
  388.             addalias   l,       ;
  389.             offset     n(3),    ;
  390.             topmargin  n(3),    ;
  391.             botmargin  n(3),    ;
  392.             totaltype  n(2),    ;
  393.             resettotal n(2),    ;
  394.             resoid     n(3),    ;
  395.             curpos     l,       ;
  396.             supalways  l,       ;
  397.             supovflow  l,       ;
  398.             suprpcol   n(1),    ;
  399.             supgroup   n(2),    ;
  400.             supvalchng l,       ;
  401.             supexpr    m        ;
  402.             )
  403.  
  404.         USE (m.targetname) ALIAS newfile
  405.         APPEND BLANK
  406.         REPLACE newfile.objtype WITH 1,  ;
  407.             newfile.objcode WITH 53  && Header record.
  408.         REPLACE newfile.height WITH 66      && _plength in IV...
  409.         APPEND BLANK
  410.         REPLACE objtype WITH 21 && Means there is an Intro (title) band??
  411.     CASE m.filetype = lbl_type
  412.         IF FILE(m.cpathname + m.rootname+".LBX") AND NOT ok2nuke(m.cpathname + m.rootname+".LBX")
  413.             =FCLOSE(m.fhandle)
  414.             SET EXACT &oldexact
  415.             RETURN .F.
  416.         ENDIF
  417.         m.targetname = m.cpathname + m.rootname + ".LBX"
  418.         SELECT SELECT(1)
  419.         create dbf (m.targetname) ;
  420.             ( platform   c(8),    ;
  421.             uniqueid   c(10),   ;
  422.             timestamp  n(10),   ;
  423.             objtype    n(2),    ;
  424.             objcode    n(3),    ;
  425.             name       m,       ;
  426.             expr       m,       ;
  427.             vpos       n(9,3),  ;
  428.             hpos       n(9,3),  ;
  429.             height     n(9,3),  ;
  430.             width      n(9,3),  ;
  431.             style      m,       ;
  432.             picture    m,       ;
  433.             order      m,       ;
  434.             "unique"   l,       ;
  435.             comment    m,       ;
  436.             environ    l,       ;
  437.             boxchar    c(1),    ;
  438.             fillchar   c(1),    ;
  439.             tag        m,       ;
  440.             tag2       m,       ;
  441.             penred     n(5),    ;
  442.             pengreen   n(5),    ;
  443.             penblue    n(5),    ;
  444.             fillred    n(5),    ;
  445.             fillgreen  n(5),    ;
  446.             fillblue   n(5),    ;
  447.             pensize    n(5),    ;
  448.             penpat     n(5),    ;
  449.             fillpat    n(5),    ;
  450.             fontface   m,       ;
  451.             fontstyle  n(3),    ;
  452.             fontsize   n(3),    ;
  453.             mode       n(3),    ;
  454.             ruler      n(1),    ;
  455.             rulerlines n(1),    ;
  456.             grid       l,       ;
  457.             gridv      n(2),    ;
  458.             gridh      n(2),    ;
  459.             float      l,       ;
  460.             stretch    l,       ;
  461.             stretchtop l,       ;
  462.             top        l,       ;
  463.             bottom     l,       ;
  464.             suptype    n(1),    ;
  465.             suprest    n(1),    ;
  466.             norepeat   l,       ;
  467.             resetrpt   n( 2),   ;
  468.             pagebreak  l,       ;
  469.             colbreak   l,       ;
  470.             resetpage  l,       ;
  471.             general    n(3),    ;
  472.             spacing    n(3),    ;
  473.             double     l,       ;
  474.             swapheader l,       ;
  475.             swapfooter l,       ;
  476.             ejectbefor l,       ;
  477.             ejectafter l,       ;
  478.             plain      l,       ;
  479.             summary    l,       ;
  480.             addalias   l,       ;
  481.             offset     n(3),    ;
  482.             topmargin  n(3),    ;
  483.             botmargin  n(3),    ;
  484.             totaltype  n(2),    ;
  485.             resettotal n(2),    ;
  486.             resoid     n(3),    ;
  487.             curpos     l,       ;
  488.             supalways  l,       ;
  489.             supovflow  l,       ;
  490.             suprpcol   n(1),    ;
  491.             supgroup   n(2),    ;
  492.             supvalchng l,       ;
  493.             supexpr    m        ;
  494.             )
  495.         USE (m.targetname) ALIAS newfile
  496.         SELECT SELECT(1)
  497.         PRIVATE m.tempname
  498.         m.tempname = SYS(3)
  499.         CREATE DBF (m.tempname)   ;
  500.             ( expr      c(254),   ;
  501.             vpos      n(  3),   ;
  502.             hpos      n(  3),   ;
  503.             width     n(  3)    ;
  504.             )
  505.         USE (m.tempname) ALIAS tempdbf
  506.         SELECT newfile
  507.         APPEND BLANK
  508.         REPLACE newfile.objtype WITH 30
  509. ENDCASE
  510. PRIVATE isrecnofld
  511. isrecnofld = .F.
  512.  
  513. gOTherm.Update(0)
  514.  
  515. =FSEEK(m.fhandle,1,1)           && Skip 1 byte. (Page heading flag.)
  516. PRIVATE m.numfields
  517. m.numfields = word2num(FREAD(m.fhandle,2))
  518. DO CASE
  519.     CASE m.filetype = scr_type    && If screen,
  520.         =FSEEK(m.fhandle,40,1)    &&  skip 40 bytes.
  521.         REPLACE newfile.height WITH 25 && Height in file seems incorrect...
  522.     CASE m.filetype = frm_type    && If report,
  523.         =FSEEK(m.fhandle,40,1)    &&  skip 12 bytes (reserved).
  524.         ** RF tempnote: num fields, band ids, here...needed???
  525.     CASE m.filetype = lbl_type    && If label,
  526.         =FSEEK(m.fhandle,24,1)    &&  skip 24 bytes.
  527.         HEIGHT = word2num(FREAD(m.fhandle,2))
  528.         REPLACE newfile.width WITH word2num(FREAD(m.fhandle,2)),      ;
  529.             newfile.hpos WITH word2num(FREAD(m.fhandle,2)),       ;
  530.             newfile.height WITH word2num(FREAD(m.fhandle,2)),  ;
  531.             newfile.penblue WITH word2num(FREAD(m.fhandle,2)),   ;
  532.             newfile.vpos WITH word2num(FREAD(m.fhandle,2))
  533.         =FSEEK(m.fhandle,4,1)
  534.         APPEND BLANK
  535.         REPLACE newfile.objtype WITH 9,     ;
  536.             newfile.objcode WITH 4,     ;
  537.             newfile.height WITH m.height
  538.         * Pro labels have exactly one record per line for contents.
  539.         DO WHILE RECCOUNT() <= m.height + 1
  540.             APPEND BLANK
  541.             REPLACE newfile.objtype WITH 19
  542.         ENDDO
  543.  
  544.         GOTO 1
  545. ENDCASE
  546. =readstring(m.fhandle)          && Throw away print template name.
  547. IF _DOS
  548.     *?" Internal name: " + readstring(m.fhandle)
  549.     *?
  550.     =readstring(m.fhandle)
  551. ELSE
  552.     =readstring(m.fhandle)
  553. ENDIF
  554. GO TOP
  555. REPLACE comment WITH readstring(m.fhandle)
  556. PRIVATE linecount
  557. * ID bytes in band descriptor
  558. #DEFINE page_header_iv        0
  559. #DEFINE report_intro_iv       1
  560. #DEFINE group_intro_iv        2
  561. #DEFINE detail_iv             3
  562. #DEFINE group_summary_iv      4
  563. #DEFINE report_summary_iv     5
  564. #DEFINE page_footer_iv        6
  565.  
  566.  
  567. #DEFINE named_calc_variable   98
  568. * Traverse band descriptors.
  569.  
  570. PRIVATE band_type, whicheditr, group_type, num_recs, group_expr, kludgename
  571. FOR m.bandnum = 1 TO num_bands
  572.     IF m.filetype <> frm_type
  573.         =FSEEK(m.fhandle,44,1)          && Skip 44 bytes.
  574.         =readstring(m.fhandle)          && Throw away "field to group by."
  575.         =readstring(m.fhandle)          && Throw away "group by" expr.
  576.         LOOP                            && Only hits here once anyway...
  577.     ENDIF
  578.     =FSEEK(m.fhandle,12,1)          && Skip 12 bytes (reserved)
  579.     band_type = ASC(FREAD(m.fhandle,1))
  580.     GO BOTTOM
  581.     IF newfile.objtype = named_calc_variable
  582.         DO WHILE newfile.objtype = named_calc_variable
  583.             SKIP -1
  584.         ENDDO
  585.         SKIP 1
  586.         INSERT BLANK BEFORE
  587.     ELSE
  588.         APPEND BLANK
  589.     ENDIF
  590.     REPLACE newfile.objtype WITH 9
  591.     DO CASE
  592.         CASE m.band_type = page_header_iv
  593.             REPLACE newfile.objcode WITH 1
  594.         CASE m.band_type = report_intro_iv
  595.             REPLACE newfile.objcode WITH 0
  596.         CASE m.band_type = detail_iv
  597.             REPLACE newfile.objcode WITH 4
  598.         CASE m.band_type = page_footer_iv
  599.             REPLACE newfile.objcode WITH 7
  600.         CASE m.band_type = report_summary_iv
  601.             REPLACE newfile.objcode WITH 8
  602.         OTHERWISE
  603.             IF m.bandnum < CEILING(num_bands/2)
  604.                 REPLACE objcode WITH 3        && Pre-detail group band.
  605.             ELSE
  606.                 REPLACE objcode WITH 5        && Post-detail group band.
  607.             ENDIF
  608.     ENDCASE
  609.     =FSEEK(m.fhandle,1,1)           && Toss group # for now.
  610.     m.whicheditr = ASC(FREAD(m.fhandle,1))
  611.     IF m.whicheditr = 1
  612.         REPLACE newfile.comment WITH "Converted dBASE IV WordWrap band."
  613.     ENDIF
  614.     =FSEEK(m.fhandle,8,1)           && Skip 8 bytes (reserved).
  615.     PRIVATE m.isopen
  616.     m.isopen = IIF(ASC(FREAD(m.fhandle,1)) = 1, .T., .F.)
  617.     m.group_type = ASC(FREAD(m.fhandle,1))  && 0=field,3=records, otherwise
  618.     && expr datatype (N/L/C/F/D/N).
  619.     =FSEEK(m.fhandle,4,1)           && Skip 4 bytes ("spare").
  620.     m.num_recs = word2num(FREAD(m.fhandle,2))
  621.     =FSEEK(m.fhandle,4,1)          && Skip 4 bytes ("reserved").
  622.     PRIVATE eachpage, newpage
  623.     m.eachpage = ASC(FREAD(m.fhandle,1))
  624.     m.newpage  = ASC(FREAD(m.fhandle,1))
  625.     IF m.eachpage = 0
  626.         REPLACE newfile.norepeat WITH .T.
  627.     ENDIF
  628.     IF m.newpage = 1
  629.         REPLACE newfile.pagebreak WITH .T.
  630.     ENDIF
  631.     =FSEEK(m.fhandle,2,1)          && Skip 2 bytes (pitch/quality).
  632.     REPLACE newfile.objtype WITH 9
  633.     m.linecount = word2num(FREAD(m.fhandle,2))
  634.     IF m.filetype = frm_type
  635.         REPLACE newfile.height WITH IIF(m.isopen,MAX(m.linecount,1),0)
  636.     ENDIF
  637.     =FSEEK(m.fhandle,1,1)           && Skip band spacing.
  638.     =word2num(FREAD(m.fhandle,2))   && Throw away band size (get later).
  639.  
  640.     group_expr = readstring(m.fhandle)    && Field to group on.
  641.     IF m.group_type < 3
  642.         REPLACE newfile.expr WITH m.group_expr
  643.     ENDIF
  644.     group_expr = readstring(m.fhandle)    && Expr to group on.
  645.     IF m.group_type > 1
  646.         IF m.group_type = 3           && Group by record count.
  647.             kludgename = "_bandrec" + LTRIM(STR(m.bandnum))
  648.             REPLACE newfile.expr WITH kludgename,     ;
  649.                 newfile.norepeat WITH .T. &&???
  650.  
  651.             isrecnofld = .T.
  652.             APPEND BLANK
  653.             REPLACE newfile.objtype WITH named_calc_variable,     ;
  654.                 newfile.objcode WITH 0,                       ;
  655.                 newfile.name WITH UPPER(kludgename),          ;
  656.                 newfile.expr WITH                             ;
  657.                 "iif(mod(reccnt," + LTRIM(STR(m.num_recs)) + ") = 0," + ;
  658.                 "iif("+kludgename +"=1,0,1),"+kludgename+")", ;
  659.                 newfile.tag WITH "0",                         ;
  660.                 unique WITH .T.
  661.         ELSE
  662.             REPLACE newfile.expr WITH m.group_expr
  663.         ENDIF
  664.     ENDIF
  665. ENDFOR
  666.  
  667. * Next, step through "fields" (anything but text).
  668. PRIVATE fieldname, datatype, fieldtype, fieldpic, fieldpfunc,;
  669.         calias, naliaspos
  670.  
  671. #DEFINE dbftype         0
  672. #DEFINE calctype        1
  673. #DEFINE summarytype     2     && Shouldn't be needed!
  674. #DEFINE predeftype      3
  675. #DEFINE memvartype      4
  676.  
  677. DECLARE avline[256,4]               && keep track of vertical lines: for each col, 1 = start, 2 = end, 3 = colorpr, 4 = single?
  678. STORE -1 TO avline
  679.  
  680. PRIVATE workareas
  681. DECLARE workareas[25]
  682. FOR m.fieldnum = 1 TO m.numfields
  683.     IF FEOF(m.fhandle)
  684.         *- EOF has been reached prematurely, so bail out (2/23/94)
  685.         EXIT
  686.     ENDIF
  687.     gOTherm.Update(m.fieldnum/m.numfields * 100)
  688.     DO CASE
  689.         CASE m.filetype = frm_type
  690.             APPEND BLANK
  691.             REPLACE newfile.height WITH 1,   ;
  692.                 newfile.objtype WITH 8,  ;
  693.                 newfile.objcode WITH 0
  694.         CASE m.filetype = scr_type
  695.             APPEND BLANK
  696.             REPLACE newfile.height WITH 1,   ;
  697.                 newfile.refresh WITH .F.,;
  698.                 newfile.objcode WITH 1,  ;
  699.                 newfile.objtype WITH 15
  700.         CASE m.filetype = lbl_type
  701.             SELECT tempdbf
  702.             APPEND BLANK
  703.             SELECT newfile
  704.     ENDCASE
  705.     =FSEEK(m.fhandle,5,1)     && Skip 5 bytes.
  706.     fieldname = xtrim(FREAD(m.fhandle,11))
  707.     IF "QBE__" $ fieldname
  708.         *- strip off alias, since we assume it refers to a temp
  709.         *- file from a DB4 query (01/27/94 jd)
  710.         *- determine alias name
  711.         m.naliaspos = AT("QBE__",fieldname)
  712.         m.calias = SUBS(fieldname,m.naliaspos,AT(".",SUBS(fieldname,m.naliaspos)))
  713.         m.fieldname = STRTRAN(fieldname,m.calias,"")
  714.     ENDIF
  715.     fieldtype = ASC(FREAD(m.fhandle,1))
  716.     datatype  = FREAD(m.fhandle,1)
  717.     =FSEEK(m.fhandle,12,1)          && Skip reserved bytes.
  718.     WIDTH = ASC(FREAD(m.fhandle,1))
  719.     PRIVATE supprepeat, ishidden
  720.     supprepeat = IIF(ASC(FREAD(m.fhandle,1)) = 1, .T., .F.)
  721.     ishidden   = IIF(ASC(FREAD(m.fhandle,1)) = 1, .T., .F.)
  722.     DO CASE
  723.         CASE m.filetype = scr_type
  724.             REPLACE newfile.width WITH m.width,             ;
  725.                 newfile.fillchar WITH IIF(m.datatype = "F", "N", m.datatype)
  726.  
  727.         CASE m.filetype = frm_type
  728.             REPLACE newfile.width WITH m.width,             ;
  729.                 newfile.norepeat WITH m.supprepeat,     ;
  730.                 newfile.fillchar WITH IIF(m.datatype = "F", "N", m.datatype)
  731.         CASE m.filetype = lbl_type
  732.             REPLACE tempdbf.width WITH m.width
  733.     ENDCASE
  734.     IF m.fieldtype = summarytype
  735.         PRIVATE summ_field
  736.         summ_field = xtrim(FREAD(m.fhandle,11))
  737.         =FSEEK(m.fhandle,4,1)                       && Reserved.
  738.         PRIVATE summ_op
  739.         #DEFINE summ_avg_iv     0
  740.         #DEFINE summ_cnt_iv     1
  741.         #DEFINE summ_max_iv     2
  742.         #DEFINE summ_min_iv     3
  743.         #DEFINE summ_sum_iv     4
  744.         #DEFINE summ_std_iv     5
  745.         #DEFINE summ_var_iv     6
  746.  
  747.         summ_op = ASC(FREAD(m.fhandle,1))
  748.         #DEFINE reset_never     0
  749.         #DEFINE reset_page      1
  750.         #DEFINE reset_group     2
  751.         PRIVATE reset_when
  752.         reset_when = ASC(FREAD(m.fhandle,1))
  753.         =FSEEK(m.fhandle,73,1)                 && Rest of ext. info.
  754.     ELSE
  755.         PRIVATE predeftyp
  756.         predeftyp = ASC(FREAD(m.fhandle,1))
  757.         PRIVATE dbfname
  758.         dbfname = CHR(m.predeftyp) + xtrim(FREAD(m.fhandle,80))
  759.         =FSEEK(m.fhandle,9,1)                 && Last 9 of ext. info.
  760.     ENDIF
  761.     IF m.fieldtype = dbftype
  762.         dbfname = xtrim(JustFName(m.dbfname))
  763.         IF ASCAN(workareas, m.dbfname) = 0
  764.             workareas[ascan(workareas, .F.)] = m.dbfname
  765.         ENDIF
  766.         IF !("QBE__" $ m.dbfname)
  767.             *- ignore alias if from a DB4 query temp file name
  768.             fieldname = m.dbfname + "." + m.fieldname
  769.         ENDIF
  770.     ENDIF
  771.     =FSEEK(m.fhandle,4,1)                       && Reserved.
  772.     fieldpict  = readstring(m.fhandle)
  773.     fieldpfunc = readstring(m.fhandle)
  774.     IF "V"$m.fieldpfunc AND m.filetype = frm_type
  775.         fieldpfunc = STRTRAN(m.fieldpfunc,"V","")
  776.         REPLACE newfile.stretch WITH .T.
  777.     ENDIF
  778.     pict_func = ""
  779.     IF "" <> m.fieldpfunc
  780.         pict_func = "@" + m.fieldpfunc
  781.     ENDIF
  782.     IF "" <> m.fieldpict
  783.         IF "" <> m.pict_func
  784.             pict_func = m.pict_func + " "
  785.         ENDIF
  786.         pict_func = m.pict_func + m.fieldpict
  787.     ENDIF
  788.     IF "" <> m.pict_func AND TYPE("newfile.picture") <> "U"
  789.         REPLACE newfile.picture WITH '"' + m.pict_func + '"'
  790.     ENDIF
  791.     PRIVATE delimiter1, delimiter2
  792.     DO CASE
  793.         CASE m.datatype = "D"
  794.             delimiter1 = "{"
  795.             delimiter2 = "}"
  796.         CASE m.datatype = "C"
  797.             delimiter1 = '"'
  798.             delimiter2 = '"'
  799.         CASE m.datatype = "M"
  800.             REPLACE newfile.picture WITH ""
  801.             * ProWin 2.5 rel. 1 bug: no pictures on memos!
  802.         OTHERWISE
  803.             delimiter1 = ""
  804.             delimiter2 = ""
  805.     ENDCASE
  806.     DO CASE
  807.         CASE m.fieldtype = dbftype OR m.fieldtype = memvartype
  808.             DO CASE
  809.                 CASE m.filetype = scr_type
  810.                     isedit = (ASC(FREAD(m.fhandle,1)) <> 0)
  811.                     IF m.isedit
  812.                         REPLACE newfile.name WITH m.fieldname
  813.                     ELSE
  814.                         REPLACE newfile.expr WITH m.fieldname,    ;
  815.                             newfile.refresh WITH .T.,         ;
  816.                             newfile.objcode WITH 0
  817.                     ENDIF
  818.                     =FSEEK(m.fhandle,1,1)     && Skip carry flag.(??)
  819.                     REPLACE newfile.rangelo WITH readstring(m.fhandle),     ;
  820.                         newfile.rangehi WITH readstring(m.fhandle),     ;
  821.                         newfile.initialval WITH readstring(m.fhandle),  ;
  822.                         newfile.when WITH readstring(m.fhandle),        ;
  823.                         newfile.valid WITH readstring(m.fhandle),       ;
  824.                         newfile.error WITH readstring(m.fhandle),       ;
  825.                         newfile.message WITH readstring(m.fhandle)
  826.  
  827.                     * Brute force method here, Q&D but should work.
  828.                     IF "" <> newfile.rangelo AND LEFT(newfile.rangelo,1) <> m.delimiter1
  829.                         REPLACE newfile.rangelo WITH m.delimiter1 +     ;
  830.                             newfile.rangelo + m.delimiter2
  831.                     ENDIF
  832.                     IF "" <> newfile.rangehi AND LEFT(newfile.rangehi,1) <> m.delimiter1
  833.                         REPLACE newfile.rangehi WITH m.delimiter1 +     ;
  834.                             newfile.rangehi + m.delimiter2
  835.                     ENDIF
  836.                     IF "" <> newfile.message
  837.                         REPLACE newfile.message WITH '"' +              ;
  838.                             newfile.message + '"'
  839.                     ENDIF
  840.                     IF "" <> newfile.error
  841.                         REPLACE newfile.error WITH '"' + newfile.error + '"'
  842.                     ENDIF
  843.  
  844.                     choicelist = readstring(m.fhandle)
  845.                     IF LEN(m.choicelist) > 0
  846.                         REPLACE newfile.picture WITH '"@M '+choicelist+'"'
  847.                         * Overrides any previous picture and/or function.
  848.                     ENDIF
  849.                     scrolwidth=word2num(FREAD(m.fhandle,2))
  850.                     IF m.scrolwidth > 0
  851.                         IF AT('S',newfile.picture) > 0
  852.                             REPLACE newfile.picture WITH ;
  853.                                 LEFT(newfile.picture,AT('S',newfile.picture)) + ;
  854.                                 LTRIM(STR(m.scrolwidth)) +  ;
  855.                                 SUBSTR(newfile.picture,AT('S',newfile.picture)+1)
  856.                         ENDIF
  857.                     ENDIF
  858.                 CASE m.filetype = frm_type
  859.                     REPLACE newfile.expr WITH m.fieldname
  860.                 CASE m.filetype = lbl_type
  861.                     REPLACE tempdbf.expr WITH m.fieldname
  862.             ENDCASE
  863.  
  864.         CASE m.fieldtype = calctype
  865.             IF m.filetype = scr_type
  866.                 REPLACE newfile.objtype WITH 15, newfile.objcode WITH 0
  867.             ENDIF
  868.             IF TYPE("newfile.comment") <> "U"
  869.                 REPLACE newfile.comment WITH newfile.comment +  ;
  870.                     readstring(m.fhandle)
  871.             ELSE
  872.                 =readstring(m.fhandle)
  873.             ENDIF
  874.             exprvar = readstring(m.fhandle)
  875.             IF "QBE__" $ exprvar 
  876.                 *- strip off alias, since we assume it refers to a temp
  877.                 *- file from a DB4 query (01/27/94 jd)
  878.                 *- determine alias name
  879.                 m.naliaspos = AT("QBE__",exprvar )
  880.                 m.calias = SUBS(exprvar ,m.naliaspos,AT(".",SUBS(exprvar ,m.naliaspos)))
  881.                 m.exprvar = STRTRAN(exprvar ,m.calias,"")
  882.             ENDIF
  883.             DO CASE
  884.                 CASE m.filetype = lbl_type
  885.                     REPLACE tempdbf.expr WITH m.exprvar
  886.                 CASE m.filetype = scr_type
  887.                     REPLACE newfile.expr WITH m.exprvar
  888.                 CASE m.filetype = frm_type
  889.                     IF "" = m.fieldname
  890.                         REPLACE newfile.expr WITH m.exprvar
  891.                         * Just a dynamically updated expression.
  892.                     ELSE
  893.                         REPLACE newfile.expr WITH m.fieldname
  894.                         * Create report variable.
  895.                         IF m.ishidden
  896.                             REPLACE newfile.objtype WITH 18,          ;
  897.                                 newfile.name WITH m.fieldname,    ;
  898.                                 newfile.expr WITH m.exprvar, ;
  899.                                 newfile.tag WITH "0"
  900.                         ELSE
  901.                             APPEND BLANK
  902.                             REPLACE newfile.objtype WITH named_calc_variable,     ;
  903.                                 newfile.name WITH m.fieldname,   ;
  904.                                 newfile.expr WITH m.exprvar, ;
  905.                                 newfile.tag WITH "0"
  906.                             SKIP -1
  907.                         ENDIF
  908.                     ENDIF
  909.             ENDCASE
  910.  
  911.         CASE m.fieldtype = summarytype
  912.             *            replace summary with .t. &&????????? Nahhh....
  913.  
  914.             #DEFINE summ_cnt_pro    1
  915.             #DEFINE summ_sum_pro    2
  916.             #DEFINE summ_avg_pro    3
  917.             #DEFINE summ_min_pro    4
  918.             #DEFINE summ_max_pro    5
  919.             #DEFINE summ_std_pro    6
  920.             #DEFINE summ_var_pro    7
  921.             IF "" = m.fieldname
  922.                 REPLACE newfile.expr WITH m.summ_field
  923.                 * Just a dynamically updated expression.
  924.             ELSE
  925.                 REPLACE newfile.expr WITH m.fieldname
  926.                 * Create report variable.
  927.                 IF m.ishidden
  928.                     REPLACE newfile.objtype WITH 18,          ;
  929.                         newfile.name WITH m.fieldname,    ;
  930.                         newfile.expr WITH m.summ_field, ;
  931.                         newfile.tag WITH "0"
  932.                 ELSE
  933.                     APPEND BLANK
  934.                     REPLACE newfile.objtype WITH named_calc_variable,     ;
  935.                         newfile.name WITH m.fieldname,   ;
  936.                         newfile.expr WITH m.summ_field, ;
  937.                         newfile.tag WITH "0"
  938.                     *                        skip -1
  939.                 ENDIF
  940.             ENDIF
  941.             *            replace newfile.expr with m.summ_field
  942.             DO CASE
  943.                 CASE m.summ_op = summ_cnt_iv
  944.                     REPLACE newfile.totaltype WITH summ_cnt_pro
  945.                     REPLACE newfile.expr WITH "1" && (?!)
  946.                 CASE m.summ_op = summ_sum_iv
  947.                     REPLACE newfile.totaltype WITH summ_sum_pro
  948.                 CASE m.summ_op = summ_avg_iv
  949.                     REPLACE newfile.totaltype WITH summ_avg_pro
  950.                 CASE m.summ_op = summ_min_iv
  951.                     REPLACE newfile.totaltype WITH summ_min_pro
  952.                 CASE m.summ_op = summ_max_iv
  953.                     REPLACE newfile.totaltype WITH summ_max_pro
  954.                 CASE m.summ_op = summ_std_iv
  955.                     REPLACE newfile.totaltype WITH summ_std_pro
  956.                 CASE m.summ_op = summ_var_iv
  957.                     REPLACE newfile.totaltype WITH summ_var_pro
  958.             ENDCASE
  959.             IF TYPE("newfile.comment") <> "U"
  960.                 REPLACE newfile.comment WITH readstring(m.fhandle)
  961.             ELSE
  962.                 =readstring(m.fhandle)    && Toss description.
  963.             ENDIF
  964.             PRIVATE band_id
  965.             band_id = word2num(FREAD(m.fhandle,2))
  966.             IF m.reset_when < reset_group
  967.                 REPLACE newfile.resettotal WITH m.reset_when
  968.             ELSE
  969.                 REPLACE newfile.resettotal WITH m.band_id
  970.                 *** Is this always right?  Better be...
  971.             ENDIF
  972.             IF "" <> m.fieldname AND NOT m.ishidden
  973.                 SKIP -1     && Necessary?
  974.             ENDIF
  975.             =FSEEK(m.fhandle,2,1)                      && Toss hiword/bandID.
  976.         CASE m.fieldtype = predeftype
  977.             DO CASE
  978.                 CASE m.predeftyp = 0
  979.                     m.fieldname = "DATE()"
  980.                 CASE m.predeftyp = 1
  981.                     m.fieldname = "TIME()"
  982.                 CASE m.predeftyp = 2
  983.                     IF m.filetype = frm_type
  984.                         *                        fieldname = "'converted RECNO field'"
  985.                     ELSE
  986.                         fieldname = "RECNO()"
  987.                     ENDIF
  988.                 CASE m.predeftyp = 3
  989.                     fieldname = "_pageno"
  990.             ENDCASE
  991.             DO CASE
  992.                 CASE m.filetype = scr_type
  993.                     REPLACE newfile.objtype WITH 15, newfile.objcode WITH 0
  994.                     REPLACE newfile.expr WITH m.fieldname
  995.                 CASE m.filetype = frm_type
  996.                     REPLACE newfile.objtype WITH 8, newfile.objcode WITH 0
  997.                     IF m.predeftyp = 2
  998.                         REPLACE newfile.expr WITH "'converted RECNO field'"
  999.                         REPLACE totaltype WITH 1 && Count
  1000.                     ELSE
  1001.                         REPLACE newfile.expr WITH m.fieldname
  1002.                     ENDIF
  1003.                 CASE m.filetype = lbl_type
  1004.                     REPLACE tempdbf.expr WITH m.fieldname
  1005.             ENDCASE
  1006.     ENDCASE
  1007.     * Handle concatenation of label fields on one line
  1008.     *  by making everything alpha.
  1009.     *IF m.filetype = lbl_type AND m.datatype <> "C" ;
  1010.     *        AND "" <> ALLTRIM(tempdbf.expr)
  1011.     *- removed test for datatype, since we want to migrate all picture clauses? (jd 6/23/94)
  1012.     IF m.filetype = lbl_type AND "" <> ALLTRIM(tempdbf.expr)
  1013.         REPLACE tempdbf.expr WITH "TRANSFORM(" + TRIM(tempdbf.expr) ;
  1014.             + ',"' + pict_func + '")'
  1015.     ENDIF
  1016. ENDFOR
  1017.  
  1018. *- under certain condtions, EOF will have been
  1019. *- reached prematurely, so skip rest of file processing in that case (2/22/94)
  1020. IF !FEOF(m.fhandle)
  1021.     PRIVATE gl_ruler, bookmark
  1022.     gl_ruler = FREAD(m.fhandle,68)
  1023.     IF m.filetype = frm_type
  1024.         bookmark = RECNO()
  1025.         GOTO TOP
  1026.         REPLACE newfile.width WITH word2num(SUBSTR(m.gl_ruler,5,2)) + 1
  1027.         GOTO m.bookmark
  1028.     ENDIF
  1029.  
  1030.     PRIVATE bandmessg
  1031.     FOR m.bandnum = 1 TO num_bands
  1032.         bandmessg = dump_band(m.bandnum)
  1033.         IF m.bandmessg <> "OK"
  1034.             =falldown(bandmessg)
  1035.             SET EXACT &oldexact
  1036.             RETURN .F.
  1037.         ENDIF
  1038.     ENDFOR
  1039. ENDIF && !FEOF(m.fhandle)
  1040.  
  1041. *- resolve any lingering vertical lines
  1042. =FixVert(@avline)
  1043. gOTherm.Update(.98)
  1044. IF m.isrecnofld   && Reports only.
  1045.     APPEND BLANK
  1046.     *** CHECK IT OUT!  .NAME below MUST be upper case!
  1047.     REPLACE newfile.objtype WITH named_calc_variable,    ;
  1048.         newfile.objcode WITH 0,     ;
  1049.         newfile.name WITH "RECCNT", ;
  1050.         newfile.expr WITH "reccnt", ;
  1051.         newfile.tag WITH "0"        ;
  1052.         newfile.unique WITH .T.,    ;
  1053.         newfile.totaltype WITH 1  && (count)
  1054. ENDIF
  1055. =FCLOSE(m.fhandle)
  1056. PRIVATE warea
  1057. FOR warea = 1 TO 25
  1058.     IF TYPE("workareas[m.warea]") = "L"
  1059.         EXIT
  1060.     ENDIF
  1061.     IF LEFT(workareas[m.warea],5) = "QBE__"
  1062.         *- assume a temp file from a DB4 query, so ignore (01/27/94 jd)
  1063.         LOOP
  1064.     ENDIF
  1065.     APPEND BLANK
  1066.     REPLACE newfile.objtype WITH 2,                       ;
  1067.         newfile.objcode WITH m.warea,                 ;
  1068.         newfile.name WITH workareas[m.warea]+".DBF",  ;
  1069.         newfile.tag WITH workareas[m.warea]
  1070. ENDFOR
  1071. IF m.warea > 1
  1072.     GOTO TOP
  1073.     REPLACE newfile.environ WITH .T.
  1074. ENDIF
  1075. REPLACE ALL newfile.platform WITH "DOS", newfile.uniqueid WITH SYS(2015)
  1076. DO CASE
  1077.     CASE m.filetype = scr_type
  1078.         PRIVATE scrheight,m.nmaxwidth, m.nmaxheight
  1079.         GO TOP
  1080.         scrheight = newfile.height
  1081.         SCAN
  1082.             scrheight = MAX(m.scrheight, newfile.vpos + newfile.height)
  1083.         ENDSCAN
  1084.         GO TOP
  1085.         REPLACE newfile.height WITH m.scrheight
  1086.         SORT ON vpos, hpos TO (m.targetname)
  1087.         USE (m.targetname)
  1088.         CALCULATE MAX(hpos + width),MAX(vpos + height) FOR RECNO() > 1 ;
  1089.             TO m.nmaxwidth, m.nmaxheight
  1090.         GO TOP
  1091.         REPLACE width WITH MAX(width,m.nmaxwidth + 2),;
  1092.             height WITH MAX(height,m.nmaxheight + 2) 
  1093.         USE
  1094.         DELETE FILE &tempname..dbf
  1095.         DELETE FILE &tempname..fpt    &&added by bobfor
  1096.         =CPTAG(m.targetname,CPCURRENT(2))
  1097.     CASE m.filetype = lbl_type
  1098.         SELECT tempdbf
  1099.         USE
  1100.         DELETE FILE &tempname..dbf
  1101.         SELECT newfile
  1102.         GOTO 3
  1103.         SCAN WHILE .NOT. EOF()
  1104.             REPLACE newfile.width WITH 0
  1105.         ENDSCAN
  1106.         USE
  1107.         =CPTAG(m.targetname,CPCURRENT(2))
  1108.     CASE m.filetype = frm_type
  1109.         SELECT newfile
  1110.         REPLACE ALL objtype WITH 18 FOR newfile.objtype = named_calc_variable
  1111.  
  1112.         * Now get tricky and find empty open bands, make sure they print.
  1113.         PRIVATE bandheight, hasobjects
  1114.         GO TOP
  1115.         LOCATE FOR objtype = 9  && Find first band.
  1116.         bandstart = 0
  1117.         SCAN WHILE newfile.objtype = 9
  1118.             IF newfile.height = 0
  1119.                 bandstart = m.bandstart + 1
  1120.                 LOOP
  1121.             ENDIF
  1122.             bookmark = RECNO()
  1123.             hasobjects = .F.
  1124.             bandheight = newfile.height
  1125.             SCAN REST
  1126.                 IF newfile.vpos >= m.bandstart AND newfile.vpos < (m.bandstart + m.bandheight)
  1127.                     hasobjects = .T.
  1128.                     EXIT
  1129.                 ENDIF
  1130.             ENDSCAN
  1131.             IF !m.hasobjects
  1132.                 APPEND BLANK
  1133.                 REPLACE newfile.objtype WITH 5,           ;
  1134.                     newfile.objcode WITH 0,           ;
  1135.                     newfile.height WITH 1,            ;
  1136.                     newfile.width WITH 1,             ;
  1137.                     newfile.expr WITH '" "'           ;
  1138.                     newfile.vpos WITH m.bandstart,    ;
  1139.                     newfile.hpos WITH 0,              ;
  1140.                     newfile.uniqueid WITH SYS(2015),  ;
  1141.                     newfile.platform WITH "DOS"
  1142.             ENDIF
  1143.             GOTO m.bookmark
  1144.             bandstart = m.bandstart + newfile.height
  1145.         ENDSCAN
  1146.         * Now replace all "closed" band sizes with 1 so they show on surface.
  1147.         REPLACE ALL newfile.height WITH 1 FOR newfile.height = 0
  1148.  
  1149.         * Hokay, now make sure that all of the object in the report
  1150.         * fit in the margins.
  1151.         PRIVATE repwidth
  1152.         GOTO TOP
  1153.         repwidth = newfile.width
  1154.         LOCATE FOR newfile.objtype = 9
  1155.         SCAN WHILE newfile.objtype = 9
  1156.         ENDSCAN
  1157.         SCAN WHILE .NOT. EOF()
  1158.             repwidth = MAX(m.repwidth, newfile.hpos + newfile.width)
  1159.         ENDSCAN
  1160.         GO TOP
  1161.         REPLACE newfile.width WITH m.repwidth
  1162.         USE
  1163.         =CPTAG(m.targetname,CPCURRENT(2))
  1164. ENDCASE
  1165.  
  1166. gOTherm.Complete
  1167.  
  1168. USE
  1169. SET EXACT &oldexact.
  1170. IF "" <> oldalias
  1171.     SELECT (oldalias)
  1172. ENDIF
  1173. RETURN .T.
  1174.  
  1175. ******************
  1176. FUNCTION dump_band      && Call funcs to dump wordwrap or layout band.
  1177. PARAMETER bandnum
  1178. PRIVATE bandstart && Starting row of band on display, used in both band dumps.
  1179. bandstart = 0
  1180. IF m.filetype <> scr_type
  1181.     GOTO 3
  1182.     SCAN WHILE newfile.objtype = 9 AND RECNO() < m.bandnum + 2
  1183.         bandstart = m.bandstart + MAX(newfile.height,1)
  1184.     ENDSCAN
  1185. ENDIF
  1186. IF m.filetype = frm_type
  1187.     GOTO m.bandnum + 2
  1188.     IF "WORDWRAP" $ UPPER(newfile.comment)
  1189.         RETURN dmprapband(m.bandnum)
  1190.     ENDIF
  1191. ENDIF
  1192. RETURN dumplayout(m.bandnum)
  1193.  
  1194. *******************
  1195. FUNCTION dmprapband     && No not Vanilla Ice...
  1196. PARAMETER bandnum
  1197.  
  1198. PRIVATE bandsize
  1199. bandsize = word2num(FREAD(m.fhandle,2))
  1200. PRIVATE wholeband
  1201. m.wholeband = FREAD(m.fhandle, m.bandsize)
  1202. PRIVATE marker
  1203. m.marker = 1
  1204. PRIVATE paragraph, linetext, LINENO, linemark, fieldmark, COLUMN, fieldwidth
  1205. PRIVATE lmargin, lindent
  1206. LINENO = -1
  1207. DO WHILE m.marker < m.bandsize
  1208.     LINENO = m.lineno + 1
  1209.     m.paragraph = SUBSTR(m.wholeband, m.marker)
  1210.     m.paragraph = LEFT(m.paragraph, AT(CHR(0), m.paragraph) - 1)
  1211.     m.marker = m.marker + LEN(m.paragraph) + 104
  1212.     m.lmargin = VAL(SUBSTR(m.wholeband,m.marker - 102,3))
  1213.     m.lindent = VAL(SUBSTR(m.wholeband,m.marker - 96,3))
  1214.     IF m.lindent = 0 AND SUBSTR(m.wholeband,m.marker - 95,2) <> " 0"
  1215.         IF SUBSTR(m.wholeband, m.marker - 95,1) <> " "
  1216.             lindent = (48-ASC(SUBSTR(m.wholeband,m.marker - 95,1))) * 10
  1217.         ENDIF
  1218.         m.lindent = m.lindent + 48 - ASC(SUBSTR(m.wholeband,m.marker - 94,1))
  1219.         m.lindent = 0 - m.lindent
  1220.     ENDIF
  1221.     COLUMN = m.lmargin + m.lindent
  1222.  
  1223.     DO WHILE LEN(m.paragraph) > 0
  1224.         m.linemark = AT(CHR(141)+CHR(10), m.paragraph)
  1225.         m.fieldmark = AT(CHR(1), m.paragraph)
  1226.         DO CASE
  1227.             CASE m.linemark > 0 AND (m.linemark < m.fieldmark OR m.fieldmark = 0)
  1228.                 linetext = LEFT(m.paragraph, m.linemark - 1)
  1229.                 paragraph = SUBSTR(m.paragraph, LEN(m.linetext) + 3)
  1230.             CASE m.fieldmark > 0 AND (m.fieldmark < m.linemark OR m.linemark = 0)
  1231.                 linetext = LEFT(m.paragraph, m.fieldmark - 1)
  1232.                 =gotofrmfld(VAL(SUBSTR(m.paragraph, LEN(m.linetext) + 3, 2)))
  1233.                 REPLACE newfile.hpos WITH m.column + LEN(m.linetext),       ;
  1234.                     newfile.vpos WITH m.lineno + m.bandstart,           ;
  1235.                     newfile.float WITH .T.
  1236.  
  1237.                 m.fieldwidth = newfile.width
  1238.                 m.paragraph = SUBSTR(m.paragraph, LEN(m.linetext) + 12)
  1239.             OTHERWISE
  1240.                 m.linetext = m.paragraph
  1241.                 m.paragraph = ""
  1242.         ENDCASE
  1243.         APPEND BLANK
  1244.         REPLACE newfile.objtype WITH 5,                       ;
  1245.             newfile.objcode WITH 0,                       ;
  1246.             newfile.expr WITH '"' + m.linetext + '"'      ;
  1247.             newfile.height WITH 1,                        ;
  1248.             newfile.width WITH LEN(m.linetext),           ;
  1249.             newfile.vpos WITH m.lineno + m.bandstart,     ;
  1250.             newfile.hpos WITH m.column,                   ;
  1251.             newfile.float WITH .T.
  1252.         IF m.linemark > 0 AND (m.linemark < m.fieldmark OR m.fieldmark = 0)
  1253.             m.lineno = m.lineno + 1
  1254.         ENDIF
  1255.         IF m.fieldmark > 0 AND (m.fieldmark < m.linemark OR m.linemark = 0)
  1256.             m.column = m.column + LEN(m.linetext) + m.fieldwidth
  1257.         ELSE
  1258.             m.column = m.lmargin
  1259.         ENDIF
  1260.     ENDDO
  1261. ENDDO
  1262. RETURN "OK"
  1263.  
  1264. *******************
  1265. FUNCTION gotofrmfld     && Recno() + 2 + bands = field info but compensate
  1266. && for Report Variable records (temptype=NAMED_CALC_VARIABLE).
  1267. PARAMETER pseekrec
  1268. PRIVATE seekrec
  1269. seekrec = m.pseekrec
  1270. GOTO 2 + m.num_bands
  1271.  
  1272. SET FILTER TO newfile.objtype <> named_calc_variable
  1273. * "Artificial" hidden fields.
  1274.  
  1275. SKIP m.pseekrec
  1276. SET FILTER TO
  1277. RETURN m.pseekrec
  1278.  
  1279. *******************
  1280. FUNCTION dumplayout     && Dump layout bands to FRX/LBX/SCX.
  1281. PARAMETER bandnum
  1282.  
  1283. PRIVATE bandsize
  1284. bandsize = word2num(FREAD(m.fhandle,2))
  1285. PRIVATE bandend
  1286. bandend = FSEEK(m.fhandle,0,1) + bandsize
  1287. bandversn = ASC(FREAD(m.fhandle,1))
  1288. * Update header record.
  1289. GOTO TOP
  1290. IF m.filetype = frm_type
  1291.     =FSEEK(m.fhandle,2,1)
  1292. ELSE
  1293.     REPLACE newfile.width WITH MAX(newfile.width,word2num(FREAD(m.fhandle,2)))
  1294. ENDIF
  1295. =FSEEK(m.fhandle,6,1)     && Screens: skip max height (not there?)
  1296. && and #rows (not max), numtextrows (not correct?)
  1297.  
  1298. PRIVATE mrow && For labels, new row for field expr.
  1299. PRIVATE mexp && For labels, transfer expr from "order".
  1300. DO WHILE FREAD(m.fhandle,1) = ","     && Constant spacer--starts each field.
  1301.     && (Should be "." if end of list.)
  1302.     gOTherm.Update(FSEEK(m.fhandle,0,1)/m.fsize * 100)            && progress therm
  1303.     DO CASE
  1304.         CASE m.filetype = lbl_type
  1305.             GOTO word2num(FREAD(m.fhandle, 2)) IN tempdbf
  1306.         CASE m.filetype = frm_type
  1307.             =gotofrmfld(word2num(FREAD(m.fhandle,2)))
  1308.         CASE m.filetype = scr_type
  1309.             GOTO word2num(FREAD(m.fhandle, 2)) + 1
  1310.     ENDCASE
  1311.     IF m.bandversn = 4
  1312.         =FSEEK(m.fhandle,12,1)
  1313.     ENDIF
  1314.     IF m.filetype = scr_type OR m.filetype = frm_type
  1315.         IF EOF()    && ...Pro skips next three reads, eerie.
  1316.             =FSEEK(m.fhandle,6,1)
  1317.         ELSE
  1318.             REPLACE newfile.vpos WITH word2num(FREAD(m.fhandle,2)),   ;
  1319.                 newfile.hpos WITH word2num(FREAD(m.fhandle,2)),   ;
  1320.                 newfile.width WITH word2num(FREAD(m.fhandle,2))
  1321.             IF m.filetype = frm_type
  1322.                 REPLACE newfile.vpos WITH newfile.vpos + m.bandstart
  1323.             ENDIF
  1324.         ENDIF
  1325.     ELSE
  1326.         REPLACE tempdbf.vpos WITH word2num(FREAD(m.fhandle,2)),   ;
  1327.             tempdbf.hpos WITH word2num(FREAD(m.fhandle,2)),   ;
  1328.             tempdbf.width WITH word2num(FREAD(m.fhandle,2))
  1329.     ENDIF
  1330.     IF m.bandversn = 4
  1331.         =FSEEK(m.fhandle,4,1)
  1332.     ENDIF
  1333.     IF ASC(FREAD(m.fhandle,1)) <> 0       && Window flag.
  1334.         IF m.bandversn = 4
  1335.             =FSEEK(m.fhandle,8,1)
  1336.         ENDIF
  1337.         =FSEEK(m.fhandle,8,1) && Skip window frame.
  1338.         winfo = FREAD(m.fhandle,9)
  1339.         IF SUBSTR(m.winfo,9,1) <> CHR(0)          && Open window memo.
  1340.             REPLACE newfile.objcode WITH 2      && "Edit" window.
  1341.             REPLACE newfile.hpos WITH word2num(SUBSTR(m.winfo,1,2)),    ;
  1342.                 newfile.vpos WITH word2num(SUBSTR(m.winfo,3,2)),      ;
  1343.                 newfile.width WITH word2num(SUBSTR(m.winfo,5,2)),     ;
  1344.                 newfile.scrollbar WITH .T.,                           ;
  1345.                 newfile.height WITH word2num(SUBSTR(m.winfo,7,2))
  1346.         ENDIF
  1347.         =FSEEK(m.fhandle,2,1)     && Toss attribute for now...
  1348.         IF m.bandversn = 4
  1349.             =FSEEK(m.fhandle,3,1)
  1350.         ENDIF
  1351.     ENDIF
  1352. ENDDO
  1353.  
  1354. * Read the box(/line) descriptors.  Method: read 19 bytes at
  1355. * a time.  When the first byte of the 19 is seen to be the list
  1356. * terminator, rewind 18 that belong to the next section.
  1357.  
  1358. PRIVATE m.boxdlength
  1359. IF m.bandversn = 5
  1360.     m.boxdlength = 19
  1361. ELSE
  1362.     m.boxdlength = 28
  1363. ENDIF
  1364. PRIVATE m.boxdescrpt
  1365. m.boxdescrpt = FREAD(m.fhandle,m.boxdlength)
  1366. DO WHILE LEFT(m.boxdescrpt, 1) = ","
  1367.     gOTherm.Update(FSEEK(m.fhandle,0,1)/m.fsize * 100)            && progress therm
  1368.     IF m.filetype = lbl_type
  1369.         m.boxdescrpt = FREAD(m.fhandle,m.boxdlength)
  1370.         * Boxes/lines not supported in labels.
  1371.         LOOP
  1372.     ENDIF
  1373.     APPEND BLANK
  1374.     REPLACE newfile.objtype WITH 7
  1375.     IF m.bandversn = 4
  1376.         m.boxdescrpt = SUBSTR(m.boxdescrpt,9)
  1377.     ENDIF
  1378.     DO CASE
  1379.         CASE SUBSTR(m.boxdescrpt,2,1) = "═"
  1380.             REPLACE newfile.objcode WITH 5      && Double-line box
  1381.         CASE SUBSTR(m.boxdescrpt,2,1) = "─"
  1382.             REPLACE newfile.objcode WITH 4      && Single-line box
  1383.         OTHERWISE
  1384.             REPLACE newfile.objcode WITH 7      && Special-char box
  1385.             REPLACE newfile.boxchar WITH SUBSTR(m.boxdescrpt,2,1)
  1386.     ENDCASE
  1387.     REPLACE newfile.fillchar WITH CHR(0)      && Make transparent.
  1388.     REPLACE newfile.hpos WITH word2num(SUBSTR(m.boxdescrpt,10,2)),      ;
  1389.         newfile.vpos WITH word2num(SUBSTR(m.boxdescrpt,12,2)),      ;
  1390.         newfile.width WITH word2num(SUBSTR(m.boxdescrpt,14,2)),     ;
  1391.         newfile.height WITH word2num(SUBSTR(m.boxdescrpt,16,2))
  1392.     IF m.filetype = scr_type
  1393.         IF bandversn = 4
  1394.             REPLACE newfile.colorpair WITH ;
  1395.                 bits2color(word2num(SUBSTR(m.boxdescrpt,19,2)))
  1396.         ELSE
  1397.             REPLACE newfile.colorpair WITH ;
  1398.                 bits2color(word2num(SUBSTR(m.boxdescrpt,18,2)))
  1399.         ENDIF
  1400.     ENDIF
  1401.     IF m.filetype = frm_type
  1402.         REPLACE newfile.vpos WITH newfile.vpos + m.bandstart
  1403.     ENDIF
  1404.     m.boxdescrpt = FREAD(m.fhandle,m.boxdlength)
  1405. ENDDO
  1406.  
  1407. =FSEEK(m.fhandle,1-m.boxdlength,1)   && Rewind, we read an extra box descriptor above.
  1408.  
  1409. * Now get the text items, stepping through the layout band contents.
  1410. * This involves some concatenation of label stuff since Fox only
  1411. * allows one expression per line on labels.
  1412.  
  1413. PRIVATE size_row, this_row, this_col, scanned, packed_row, ;
  1414.     value_type, textlength, VALUE, attr_change, bytesread
  1415.  
  1416. this_row    = 0
  1417. bytesread   = 0
  1418. DO WHILE FSEEK(m.fhandle,0,1)  < bandend  && AND !FEOF(m.fhandle) && While bytes left in this band...
  1419.     gOTherm.Update(FSEEK(m.fhandle,0,1)/m.fsize * 100)            && progress therm
  1420.     scanned = 0
  1421.     this_col = 0
  1422.     this_row = m.this_row + word2num(FREAD(m.fhandle, 2))
  1423.     size_row = word2num(FREAD(m.fhandle,2))
  1424.     IF size_row < 1
  1425.         LOOP
  1426.     ENDIF
  1427.     bytesread = m.bytesread + m.size_row
  1428.     packed_row = FREAD(m.fhandle, m.size_row)
  1429.     PRIVATE newcolor
  1430.     newcolor = ""
  1431.  
  1432.     * Flag values for tokens in a "text row."
  1433.     #DEFINE eorow           0
  1434.     #DEFINE skipcolumns     1
  1435.     #DEFINE k_field         2
  1436.     #DEFINE k_text          3
  1437.     #DEFINE styleattrib     4
  1438.     #DEFINE displattrib     5
  1439.     #DEFINE pagebreak       8
  1440.     PRIVATE newstyle
  1441.     newstyle = ""
  1442.     DO WHILE m.scanned < m.size_row - 1
  1443.         gOTherm.Update(FSEEK(m.fhandle,0,1)/m.fsize * 100)            && progress therm
  1444.         scanned = m.scanned + 1
  1445.         value_type = ASC(SUBSTR(m.packed_row, m.scanned,1))
  1446.  
  1447.         m.value = SUBSTR(m.packed_row, m.scanned + 1)
  1448.         * May not be used, depends on value_type.
  1449.  
  1450.         DO CASE
  1451.             CASE m.value_type = eorow
  1452.                 m.this_col = 0
  1453.                 m.newstyle = ""
  1454.             CASE m.value_type = skipcolumns
  1455.                 m.scanned = m.scanned + 1
  1456.                 m.this_col = m.this_col + ASC(m.value)
  1457.             CASE m.value_type = k_field
  1458.                 DO CASE
  1459.                     CASE m.filetype = frm_type
  1460.                         SCAN FOR newfile.objtype = 8 && fields
  1461.                             IF newfile.vpos = m.this_row + m.bandstart AND ;
  1462.                                     newfile.hpos = m.this_col
  1463.                                 m.this_col = m.this_col + newfile.width
  1464.                                 EXIT
  1465.                             ENDIF
  1466.                         ENDSCAN
  1467.                     CASE m.filetype = scr_type
  1468.                         SCAN FOR newfile.objtype = 15 && fields
  1469.                             IF newfile.vpos = m.this_row AND ;
  1470.                                     newfile.hpos = m.this_col
  1471.                                 m.this_col = m.this_col + newfile.width
  1472.                                 EXIT
  1473.                             ENDIF
  1474.                         ENDSCAN
  1475.                     CASE m.filetype = lbl_type
  1476.                         SELECT tempdbf
  1477.                         SCAN
  1478.                             IF tempdbf.vpos = m.this_row AND ;
  1479.                                     tempdbf.hpos = m.this_col
  1480.                                 SELECT newfile
  1481.                                 GOTO m.this_row + 3
  1482.                                 IF "" <> ALLTRIM(newfile.expr)
  1483.                                     REPLACE newfile.expr WITH ;
  1484.                                         ALLTRIM(newfile.expr) +  '+'
  1485.                                 ENDIF
  1486.                                 IF newfile.width < m.this_col
  1487.                                     REPLACE newfile.expr WITH     ;
  1488.                                         ALLTRIM(newfile.expr) +  '"' + ;
  1489.                                         SPACE(m.this_col - newfile.width) +;
  1490.                                         '"+'
  1491.                                 ENDIF
  1492.                                 REPLACE newfile.expr WITH newfile.expr + ALLTRIM(tempdbf.expr)
  1493.                                 m.this_col = m.this_col + tempdbf.width
  1494.                                 REPLACE newfile.width WITH m.this_col
  1495.                                 EXIT
  1496.                             ENDIF
  1497.                         ENDSCAN
  1498.                         SELECT newfile
  1499.                 ENDCASE
  1500.  
  1501.                 *      newcolor = ""
  1502.                 IF m.filetype = frm_type
  1503.                     REPLACE newfile.style WITH m.newstyle
  1504.                 ENDIF
  1505.                 m.scanned = m.scanned + 4
  1506.             CASE m.value_type = k_text
  1507.                 textlength = AT(CHR(0), m.value)
  1508.                 IF m.filetype = scr_type OR m.filetype = frm_type
  1509.                     APPEND BLANK
  1510.                     REPLACE newfile.objtype WITH 5,           ;
  1511.                         newfile.objcode WITH 0,           ;
  1512.                         newfile.vpos WITH m.this_row,     ;
  1513.                         newfile.hpos WITH m.this_col      ;
  1514.                         newfile.height WITH 1,            ;
  1515.                         newfile.width WITH textlength - 1
  1516.                     IF m.filetype = scr_type
  1517.                         REPLACE newfile.colorpair WITH m.newcolor
  1518.                     ELSE
  1519.                         REPLACE newfile.vpos WITH newfile.vpos + m.bandstart
  1520.                     ENDIF
  1521.                     *                        newcolor = ""
  1522.                     REPLACE newfile.expr WITH newfile.expr + '"' +     ;
  1523.                         LEFT(m.value,m.textlength-1) + '"'
  1524.                 ELSE     && labels
  1525.                     GOTO m.this_row + 3
  1526.                     VALUE = LEFT(m.value,textlength-1)
  1527.                     IF "" <> ALLTRIM(newfile.expr)
  1528.                         REPLACE newfile.expr WITH newfile.expr +  ;
  1529.                             '+'
  1530.                     ENDIF
  1531.                     IF newfile.width < m.this_col - 1
  1532.                         VALUE = SPACE(m.this_col - newfile.width) ;
  1533.                             + m.value
  1534.                         *                              textlength = m.textlength + m.this_col - newfile.width
  1535.                     ENDIF
  1536.                     REPLACE newfile.expr WITH newfile.expr + '"' +     ;
  1537.                         m.value + '"'
  1538.                     REPLACE newfile.width WITH m.this_col + LEN(m.value) &&textlength + 1
  1539.                 ENDIF
  1540.                 scanned = m.scanned + m.textlength
  1541.                 this_col = m.this_col + m.textlength - 1
  1542.                 IF m.filetype = frm_type
  1543.                     REPLACE style WITH newstyle
  1544.                 ENDIF
  1545.                 *- Added by JD 12/29/93 -- check to see if text describes a line
  1546.                 *- if so, convert to line type object!
  1547.                 =cvtLine(@avline)
  1548.             CASE m.value_type = styleattrib
  1549.                 newstyle = cvtstyle(word2num(LEFT(m.value, 2)))
  1550.                 scanned = m.scanned + 2
  1551.             CASE m.value_type = displattrib
  1552.                 scanned = m.scanned + 2
  1553.                 newcolor = bits2color(word2num(LEFT(m.value, 2)))
  1554.             CASE m.value_type = pagebreak && N/A??
  1555.                 *                  newstyle = ""
  1556.             OTHERWISE
  1557.                 RETURN '"Text row" value type incorrect!'
  1558.         ENDCASE
  1559.     ENDDO
  1560. ENDDO
  1561. RETURN "OK"
  1562.  
  1563.  
  1564. *****************
  1565. FUNCTION falldown       && Show error message and cancel.
  1566. *****************
  1567.     PARAMETER m.pmessage
  1568.     IF !EMPTY(m.pmessage)
  1569.         =MESSAGEBOX(m.pmessage, 0 + 48, C_THERMTITLE_LOC)
  1570.     ENDIF
  1571.     =FCLOSE(m.fhandle)
  1572.     SET EXACT &oldexact.
  1573.     IF "" <> oldalias
  1574.         SELECT (oldalias)
  1575.     ENDIF
  1576.     IF TYPE("field(1,'newfile')") <> "U"
  1577.         SELECT newfile
  1578.         USE
  1579.     ENDIF
  1580.     IF TYPE("field(1,'tempdbf')") <> "U"
  1581.         SELECT tempdbf
  1582.         USE
  1583.         DELETE FILE &tempname..dbf
  1584.         DELETE FILE &tempname..fpt  &&changed from .dbt by bobfor
  1585.     ENDIF
  1586.     IF TYPE("m.targetname") = "C" AND FILE(m.targetname)
  1587.         DELETE FILE &m.targetname.
  1588.         PRIVATE m.memoname
  1589.         DO CASE
  1590.             CASE m.filetype = frm_type
  1591.                 m.memoname = STRTRAN(m.targetname,"FRX","FRT")
  1592.             CASE m.filetype = scr_type
  1593.                 m.memoname = STRTRAN(m.targetname,"SCX","SCT")
  1594.             CASE m.filetype = lbl_type
  1595.                 m.memoname = STRTRAN(m.targetname,"LBX","LBT")
  1596.         ENDCASE
  1597.         IF FILE(m.memoname)
  1598.             DELETE FILE &m.memoname.
  1599.         ENDIF
  1600.     ENDIF
  1601.     RETURN
  1602. ENDFUNC
  1603.  
  1604. *****************
  1605. FUNCTION word2num       && Convert 2-byte word to Pro-type number.
  1606. PARAMETER bytes
  1607. RETURN ASC(m.bytes) + ASC(SUBSTR(m.bytes,2,1)) * 256
  1608.  
  1609. *******************
  1610. FUNCTION readstring     && Read a string formatted as 2-byte length + C-string.
  1611. PARAMETER phandle
  1612. PRIVATE m.strlength
  1613. m.strlength = word2num(FREAD(m.phandle,2))
  1614. IF m.strlength = 0
  1615.     RETURN ""
  1616. ENDIF
  1617. RETURN xtrim(FREAD(m.phandle, m.strlength))
  1618.  
  1619. **************
  1620. FUNCTION xtrim          && Trim spaces and nulls.
  1621. PARAMETER pstring
  1622. PRIVATE pos
  1623. m.pos = AT(CHR(0), m.pstring)
  1624. IF m.pos > 0
  1625.     m.pstring = LEFT(pstring, m.pos-1)
  1626. ELSE
  1627.     m.pos = LEN(m.pstring)
  1628.     DO WHILE m.pos > 1 AND ASC(RIGHT(m.pstring, 1)) = 0
  1629.         m.pstring = LEFT(m.pstring, LEN(m.pstring) - 1)
  1630.         m.pos = m.pos - 1
  1631.     ENDDO
  1632. ENDIF
  1633. IF m.pos = 1 AND ASC(m.pstring) = 0
  1634.     RETURN ""
  1635. ENDIF
  1636. RETURN ALLTRIM(m.pstring)
  1637.  
  1638. *******************
  1639. FUNCTION cvtstyle     && Change 2-word IV style code to Pro style string.
  1640. PARAMETER styleword
  1641. PRIVATE m.retstring, stylesstring
  1642. m.retstring = ""
  1643. stylesstring = "        BIURL"
  1644. bitval = 2^8
  1645. FOR bit = 9 TO  13
  1646.     IF isbitset(m.styleword, m.bitval)
  1647.         m.retstring = m.retstring + SUBSTR(m.stylesstring, m.bit, 1)
  1648.     ENDIF
  1649.     bitval = m.bitval * 2
  1650. ENDFOR
  1651. RETURN ALLTRIM(m.retstring)
  1652.  
  1653. *******************
  1654. FUNCTION bits2color     && Change 2-word IV color code to Pro color text.
  1655. *******************
  1656.     PARAMETER attrword
  1657.     #DEFINE defaultattr 32768     && If bit 15 set, use default attribute.
  1658.     PRIVATE m.retstring, colorstring
  1659.     m.retstring = ""
  1660.     colorstring = "BGR+BGR + U*"
  1661.     IF defaultattr = m.attrword
  1662.         RETURN ""
  1663.     ENDIF
  1664.     bitval = 1
  1665.     FOR bit = 1 TO  4
  1666.         IF isbitset(m.attrword, m.bitval)
  1667.             m.retstring = m.retstring + SUBSTR(m.colorstring, m.bit, 1)
  1668.         ENDIF
  1669.         bitval = m.bitval * 2
  1670.     ENDFOR
  1671.     IF "" = m.retstring
  1672.         m.retstring = "N"
  1673.     ENDIF
  1674.     m.retstring = m.retstring + "/"
  1675.     FOR bit = 5 TO 12
  1676.         IF isbitset(m.attrword, m.bitval)
  1677.             m.retstring = m.retstring + SUBSTR(m.colorstring, m.bit, 1)
  1678.         ENDIF
  1679.         bitval = m.bitval * 2
  1680.     ENDFOR
  1681.     RETURN STRTRAN(m.retstring,"BGR","W")
  1682. ENDFUNC
  1683.  
  1684. *****************
  1685. FUNCTION isbitset
  1686. *****************
  1687.     PARAMETERS bitfield, bitval
  1688.     IF MOD(m.bitfield, m.bitval*2) / m.bitval >= 1
  1689.         RETURN .T.
  1690.     ENDIF
  1691.     RETURN .F.
  1692. ENDFUNC
  1693.  
  1694. ****************
  1695. FUNCTION ok2nuke
  1696. ****************
  1697. *- Emulate SAFETY ON
  1698.  
  1699.     PARAMETER filename
  1700.  
  1701.     PRIVATE m.nresult
  1702.  
  1703.     m.nresult = MESSAGEBOX(JustFName(UPPER(m.filename)) + C_OVERWRITE_LOC,4 + 32 + 256,C_THERMTITLE_LOC)
  1704.     *- fix return values (jd 6/24/94)
  1705.     RETURN (m.nresult = IDYES)
  1706. ENDFUNC
  1707.  
  1708. *- eof MIGDB4.PRG