home *** CD-ROM | disk | FTP | other *** search
Wrap
/* 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. Written by Don Cox */ trace n signal on error signal on syntax address command call SafeEndEdit.rexx() call ppm_AutoUpdate(0) cr="0a"x cpage = ppm_CurrentPage() counter=0 do forever box=ppm_ClickOnBox("Click on boxes to be resized") if box=0 then break counter=counter+1 boxes.counter=box call ppm_SelectBox(box) end if counter=0 then exit_msg("No boxes selected") percent = ppm_GetUserText(8,"Percentage of old size") if percent = "" then exit_msg("Aborted by User") if ~(datatype(percent,n)) then exit_msg("Invalid entry") factor = abs(percent/100) if factor>10 then factor = 10 if factor<0.1 then factor = 0.1 currentunits=ppm_GetUnits() call ppm_SetUnits(2) call ppm_ShowStatus(" Resizing text...") do i=1 to counter box=boxes.i boxtype = upper(word(ppm_GetBoxInfo(box), 1)) if boxtype~="TEXT" then iterate box = ppm_ArtFirstBox(box) text = ppm_GetArticleText(box,1) text = ResizeFonts(text,factor) gone = ppm_DeleteContents(box) overflow = ppm_TextIntoBox(box,text) end newpage = ppm_GoToPage(cpage) call ppm_SetUnits(currentunits) call exit_msg() end /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ ResizeFonts: procedure parse arg text, factor position = 1 position2 = 1 do forever /* we have to open up style tags to get sizes */ position = pos("\dS<",text,position2) if position = 0 then break position2 = pos(">",text,position) if position2 = 0 then break styletag = substr(text,position+4, position2-position-4) styledef = ppm_GetStyleTagData(styletag) styledef = left(styledef,pos("}",styledef)-1) /* remove name of tag */ styledef = substr(styledef,pos("{",styledef)+1) text = delstr(text,position, (position2-position+1)) /* delete tag name */ text = insert("\ds"styledef,text,(position-1)) end position2 = 1 do forever /* first change font sizes */ position = pos("\fs<",text,position2)+4 if position = 4 then break /* would be 0 but we added 4 */ position2 = pos(">",text,position) if position2 = 0 then break oldsize = substr(text,position, position2-position) text = delstr(text,position, position2-position) /* delete old size */ newsize = oldsize*factor if newsize>720 then newsize = 720 oddsize = newsize//0.125 /* round correctly to nearest 1/8 point - PPage always rounds down */ if oddsize>0.0625 then newsize = newsize-oddsize+0.125 else newsize = newsize-oddsize text = insert(newsize,text,position-1) end position2 = 1 do forever /* now fixed line spacings */ position = pos("\lf<",text,position2)+4 if position = 4 then break /* would be 0 but we added 4 */ position2 = pos(">",text,position) if position2 = 0 then break oldsize = substr(text,position, position2-position) text = delstr(text,position, position2-position) /* delete old size */ newsize = oldsize*factor if newsize>720 then newsize = 720 oddsize = newsize//0.125 /* round correctly to nearest 1/8 point - PPage always rounds down */ if oddsize>0.0625 then newsize = newsize-oddsize+0.125 else newsize = newsize-oddsize text = insert(newsize,text,position-1) end position2 = 1 do forever /* and fixed leading */ position = pos("\ll<",text,position2)+4 if position = 4 then break /* would be 0 but we added 4 */ position2 = pos(">",text,position) if position2 = 0 then break oldsize = substr(text,position, position2-position) text = delstr(text,position, position2-position) /* delete old size */ newsize = oldsize*factor if newsize>720 then newsize = 720 oddsize = newsize//0.125 /* round correctly to nearest 1/8 point - PPage always rounds down */ if oddsize>0.0625 then newsize = newsize-oddsize+0.125 else newsize = newsize-oddsize text = insert(newsize,text,position-1) end return text /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */ error: syntax: do exit_msg("Genie failed due to error: "errortext(rc)) end exit_msg: do parse arg message if message ~= "" then call ppm_Inform(1,message,"Resume") call ppm_ClearStatus() call ppm_AutoUpdate(1) exit end