home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 911-930 / ff925 / donsgenies / frenchgenies.lha / Rexx / RedimensionneTexte.pprx < prev    next >
Text File  |  1993-08-03  |  5KB  |  155 lines
  1. /*
  2. @BRedimensionneTexte @P @I Ecrit et © Don Cox
  3. @IN'est pas du Domaine Publique. Tous Droits Réservés.
  4. Traduit par Fabien Larini le 02/08/93.
  5.  
  6. Ce Génie redimensionne taille de caractères du texte d'une boîte ou d'une
  7. chaîne de boîtes. Il applique pour cela un pourcentage à la taille des 
  8. caractères.
  9. */
  10.  
  11. /* This Genie resizes text by a percentage factor, keeping the proportions of differing sizes of text in a box. All the text in a box or linked chain will be changed.
  12. Written by Don Cox. Not Public Domain. All rights reserved.  */
  13.  
  14. trace n
  15. signal on error
  16. signal on syntax
  17. address command
  18. call SafeEndEdit.rexx()
  19. call ppm_AutoUpdate(0)
  20. cr="0a"x
  21.  
  22. cpage = ppm_CurrentPage()
  23. counter=0
  24.  
  25. do forever
  26.     box=ppm_ClickOnBox("Clickez dans les Boîtes où le Texte doit être Redimensionné")
  27.     if box=0 then break
  28.     counter=counter+1
  29.     boxes.counter=box
  30.     call ppm_SelectBox(box)
  31. end
  32.  
  33. if counter=0 then exit_msg("Pas de Boîte Sélectionnée")
  34.  
  35. percent = ppm_GetUserText(8,"Pourcentage de l'Ancienne Taille")
  36. if percent = "" then exit_msg("Abandon Utilisateur")
  37. if ~(datatype(percent,n)) then exit_msg("Saisie Invalide du Pourcentage")
  38. factor = abs(percent/100)
  39. if factor>10 then factor = 10
  40. if factor<0.1 then factor = 0.1
  41.  
  42. currentunits=ppm_GetUnits()
  43. call ppm_SetUnits(2)
  44.  
  45. call ppm_ShowStatus("Redimensionne le Texte ...")
  46. do i=1 to counter
  47.     box=boxes.i
  48.  
  49.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  50.     if boxtype~="TEXTE" then iterate
  51.     box = ppm_ArtFirstBox(box)
  52.     text = ppm_GetArticleText(box,1)
  53.     text = ResizeFonts(text,factor)
  54.     gone = ppm_DeleteContents(box)
  55.     overflow = ppm_TextIntoBox(box,text)
  56.  
  57.     end
  58.  
  59. newpage = ppm_GoToPage(cpage)
  60. call ppm_SetUnits(currentunits)
  61.  
  62. call exit_msg()
  63. end
  64.  
  65. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  66.  
  67. ResizeFonts: procedure
  68. parse arg text, factor
  69. position = 1
  70. position2 = 1
  71.  
  72. do forever  /* we have to open up style tags to get sizes */
  73.     position = pos("\dS<",text,position2)
  74.     if position = 0 then break
  75.     position2 = pos(">",text,position)
  76.     if position2 = 0 then break
  77.     styletag = substr(text,position+4, position2-position-4)
  78.     styledef = ppm_GetStyleTagData(styletag)
  79.     styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */
  80.     styledef = substr(styledef,pos("{",styledef)+1)
  81.     text = delstr(text,position, (position2-position+1)) /* delete tag name */
  82.     text = insert("\ds"styledef,text,(position-1))
  83.     end
  84.  
  85. position2 = 1
  86. do forever  /* first change font sizes */
  87.     position = pos("\fs<",text,position2)+4
  88.     if position = 4 then break  /* would be 0 but we added 4 */
  89.     position2 = pos(">",text,position)
  90.     if position2 = 0 then break
  91.     oldsize = substr(text,position, position2-position)
  92.     text = delstr(text,position, position2-position) /* delete old size */
  93.     newsize = oldsize*factor
  94.     if newsize>720 then newsize = 720
  95.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  96.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  97.     else newsize = newsize-oddsize
  98.     text = insert(newsize,text,position-1)
  99.     end
  100.  
  101.  
  102. position2 = 1
  103. do forever  /*  now fixed line spacings  */
  104.     position = pos("\lf<",text,position2)+4
  105.     if position = 4 then break  /* would be 0 but we added 4 */
  106.     position2 = pos(">",text,position)
  107.     if position2 = 0 then break
  108.     oldsize = substr(text,position, position2-position)
  109.     text = delstr(text,position, position2-position) /* delete old size */
  110.     newsize = oldsize*factor
  111.     if newsize>720 then newsize = 720
  112.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  113.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  114.     else newsize = newsize-oddsize
  115.     text = insert(newsize,text,position-1)
  116.     end
  117.  
  118. position2 = 1
  119. do forever   /* and fixed leading  */
  120.     position = pos("\ll<",text,position2)+4
  121.     if position = 4 then break  /* would be 0 but we added 4 */
  122.     position2 = pos(">",text,position)
  123.     if position2 = 0 then break
  124.     oldsize = substr(text,position, position2-position)
  125.     text = delstr(text,position, position2-position) /* delete old size */
  126.     newsize = oldsize*factor
  127.     if newsize>720 then newsize = 720
  128.     oddsize = newsize//0.125  /* round correctly to nearest 1/8 point - PPage always rounds down */
  129.     if oddsize>0.0625 then newsize = newsize-oddsize+0.125
  130.     else newsize = newsize-oddsize
  131.     text = insert(newsize,text,position-1)
  132.     end
  133.  
  134. return text
  135.  
  136.  
  137. /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
  138.  
  139. error:
  140. syntax:
  141.     do
  142.     exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc))
  143.     end
  144.  
  145. exit_msg:
  146.     do
  147.     parse arg message
  148.     if message ~= "" then
  149.     call ppm_Inform(1,message,)
  150.     call ppm_ClearStatus()
  151.     call ppm_AutoUpdate(1)
  152.     exit
  153.     end
  154.  
  155.