home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 82 / af082sub.adf / FINALWRITER / FINAL.lzx / FinalWriter / FinalMacros / Macros / Text2Block.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1978-01-01  |  1.7 KB  |  102 lines
  1. /* Text2Block 1.03 (19.04.95) by NDY's */
  2. OPTIONS RESULTS
  3. /* Decimal point */
  4. GetDocItemPrefs "DECIMAL"
  5. deci=RESULT
  6. DocItemPrefs "DECIMAL PERIOD"
  7. /* For cursor movement */
  8. ShiftUp
  9. AltUp
  10. CtrlUp
  11. /* Selected text or current paragraph? */
  12. Status "PARAPOS"
  13. pos=RESULT
  14. lf="0A"x
  15. IF Words(pos)=4 THEN
  16.   DO
  17.     Extract
  18.     len=Length(RESULT)
  19.     IF Right(RESULT,1)=lf THEN len=len-1
  20.     MoveToPara Word(pos,1) Word(pos,2)
  21.   END
  22. ELSE
  23.   DO
  24.     Status "PARACHARS"
  25.     len=RESULT
  26.     MoveToPara Word(pos,1) 0
  27.   END
  28. /* Get page # */
  29. Status 'PAGE "INSERT"'
  30. page=RESULT
  31. /* Process chars */
  32. old=gettexttypespecs()
  33. text=""
  34. w=0
  35. h=0
  36. nr=0
  37. x=""
  38. DO i=0 TO len
  39.   specs=gettexttypespecs()
  40.   IF specs=old & x~=lf THEN
  41.     text=text||x
  42.   ELSE
  43.     DO
  44.       CALL draw
  45.       GetObjectCoords
  46.       IF x=lf THEN
  47.         DO
  48.           w=0
  49.           h=h+Word(RESULT,5)
  50.           text=""
  51.         END
  52.       ELSE
  53.         DO
  54.           w=w+Word(RESULT,4)
  55.           text=x
  56.         END
  57.       old=specs
  58.     END
  59.   Extract
  60.   x=RESULT
  61.   Cursor "RIGHT"
  62. END
  63. IF text~="" THEN
  64.   DO
  65.     old=specs
  66.     CALL draw
  67.   END
  68. /* Group */
  69. SelectObject
  70. DO i=1 TO nr
  71.   SelectObject obj.i "MULTIPLE"
  72. END
  73. Group
  74. Redraw
  75. DocItemPrefs "DECIMAL" deci
  76. EXIT
  77.  
  78. PROC draw:
  79.   TextBlockTypePrefs old
  80.   DrawTextBlock page 1+w 2+h '"'||text||'"'
  81.   nr=nr+1
  82.   obj.nr=RESULT
  83.   Redraw
  84. RETURN
  85. PROC gettexttypespecs: PROCEDURE /*  specs=gettexttypespecs() */
  86.   Status "FONTSIZE"
  87.   p="SIZE" RESULT
  88.   Status "FONTLEADING"
  89.   p=p "LEADING" RESULT
  90.   Status "FONTWIDTH"
  91.   p=p "WIDTH" RESULT
  92.   Status "FONTOBLIQUE"
  93.   p=p "OBLIQUE" RESULT
  94.   Status "FONTCOLOR"
  95.   p=p "COLOR" RESULT
  96.   Status "FONTNAME"
  97.   f=RESULT
  98.   IF Left(f,1)~=" " THEN f=" "||f /* Incase a newer FW doesn't return the leading space (" Fontname") anymore */
  99.   p=p "FONT"||f
  100. RETURN p
  101.  
  102.