home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d9xx / d925 / donsgenies.lha / DonsGenies / FrenchGenies.lha / Rexx / EncadreBoîtes.pprx < prev    next >
Text File  |  1993-08-07  |  4KB  |  135 lines
  1. /*@BEncadreBoites @P @I Ecrit et © par Don Cox en juillet 1992
  2. @IN'est pas du Domaine Publique. Tous Droits Réservés.
  3. Traduit et modifié par Fabien Larini le 17/07/93.
  4.  
  5. Ce Génie encadre les boîtes avec un filet et ajuste les marges
  6. en conséquence. Il utilise le motif et la couleur de trait et de
  7. remplissage courant.
  8. */
  9.  
  10. /* This Genie puts frames around boxes and sets the margins accordingly.
  11. Written by Don Cox ©1992. Not Public Domain. All rights reserved.
  12.  */
  13.  
  14. signal on error
  15. signal on syntax
  16. address command
  17. call SafeEndEdit.rexx()
  18. call ppm_AutoUpdate(0)
  19. cr="0a"x
  20.  
  21. counter=0
  22.  
  23. collist = ppm_GetColorList()
  24. collist = substr(collist, pos('0a'x, collist) +1) /* strip off initial line which is number of colours */
  25.  
  26. do forever
  27.     box=ppm_ClickOnBox("Sélectionnez les Boîtes à Encadrer")
  28.     if box=0 then break
  29.     counter=counter+1
  30.     boxes.counter=box
  31.     call ppm_SelectBox(box)
  32. end
  33.  
  34. if counter=0 then exit_msg("Pas de Boîte Selectionnée")
  35.  
  36. form = "Epaisseur en Points:5"cr"Intérieur/Extérieur (I/E):E"
  37. manylines=ppm_GetForm("Données Encadrement",4,form)
  38. if manylines="" then exit_msg("Opération Annulée")
  39.  
  40. parse var manylines weight "0a"x posn
  41. posn= upper(posn)
  42. color=ppm_SelectFromList("Choix de la Couleur",24,18,0,collist)
  43. if color = "" then exit_msg("Annulé par l'Utilisateur")
  44.  
  45. currentunits=ppm_GetUnits()
  46. call ppm_SetUnits(1)
  47.  
  48.  
  49. iw=weight/72   /* line weight in inches */
  50. iw2=iw*2
  51.  
  52. do i=1 to counter
  53.     box=boxes.i
  54.     call ppm_SetBoxFrame(box,1)
  55.     framedata = ppm_GetBoxFrameData(box)
  56.     parse var framedata lc "0a"x fillcolor "0a"x lineweight "0a"x linepattern "0a"x fillpattern  
  57.  
  58.     call ppm_SetBoxFrameData(box,color,fillcolor,weight,linepattern,fillpattern)
  59.     margins = ppm_GetBoxMargins(box)
  60.     parse var margins mleft mtop mright mbottom
  61.  
  62.     ilineweight=lineweight/72
  63.     boxtype = upper(word(ppm_GetBoxInfo(box), 1))
  64.     if boxtype = "TEXTE" then  /* extra margin for text */
  65.         do
  66.         mleft2=abs(mleft-ilineweight+iw)
  67.         if mleft2=iw then mleft2=iw2
  68.         if mleft2<iw then mleft2=iw2
  69.         
  70.         mtop2=abs(mtop-ilineweight+iw)
  71.         if mtop2=iw then mtop2=iw2
  72.         if mtop2<iw then mtop2=iw2
  73.         
  74.         mright2=abs(mright-ilineweight+iw)
  75.         if mright2=iw then mright2=iw2
  76.         if mright2<iw then mright2=iw2
  77.        
  78.         mbottom2=abs(mbottom-ilineweight+iw)
  79.         if mbottom2=iw then mbottom2=iw2
  80.         if mbottom2<iw then mbottom2=iw2
  81.         end
  82.     else
  83.         do
  84.         mleft2 = abs(mleft-ilineweight+iw)
  85.         if mleft2<iw then mleft2=iw
  86.         mtop2=abs(mtop-ilineweight+iw)
  87.         if mtop2<iw then mtop2=iw
  88.         mright2=abs(mright-ilineweight+iw)
  89.         if mright2<iw then mright2=iw
  90.         mbottom2=abs(mbottom-ilineweight+iw)
  91.         if mbottom2<iw then mbottom2=iw
  92.         end
  93.     call ppm_SetBoxMargins(box,mleft2,mtop2,mright2,mbottom2)
  94.  
  95.  
  96.    if posn="E" /* Letter E */
  97.         then do
  98.         where = ppm_GetBoxPosition(box)
  99.         xwhere=word(where,1)
  100.         ywhere=word(where,2)
  101.         call ppm_SetBoxPosition(box,xwhere-iw,ywhere-iw)
  102.         howbig = ppm_GetBoxSize(box)
  103.         boxwidth = word(howbig,1)+iw2
  104.         boxheight = word(howbig,2)+iw2
  105.         call ppm_SetBoxSize(box,boxwidth,boxheight)
  106.         
  107.         end
  108.     end
  109. call ppm_SetUnits(currentunits)
  110.  
  111. message = "Fin"
  112.     dessins=ppm_GetWireFrame()
  113.     if dessins=1 then message ="Pour voir le résultat, désactivez Dessins stylisés"
  114. call exit_msg(message)
  115.  
  116. end
  117.  
  118. error:
  119. syntax:
  120.     do                    
  121.     exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc))
  122.     end
  123.  
  124. exit_msg:
  125.     do
  126.     parse arg message
  127.     if message ~= "" then
  128.     call ppm_Inform(1,message,"Resume")
  129.     call ppm_ClearStatus()
  130.     call ppm_AutoUpdate(1)    
  131.  
  132.     exit
  133.     end
  134.  
  135.