/*@BEncadreBoites @P @I Ecrit et © par Don Cox en juillet 1992
@IN'est pas du Domaine Publique. Tous Droits Réservés.
Traduit et modifié par Fabien Larini le 17/07/93.

Ce Génie encadre les boîtes avec un filet et ajuste les marges
en conséquence. Il utilise le motif et la couleur de trait et de
remplissage courant.
*/

/* This Genie puts frames around boxes and sets the margins accordingly.
Written by Don Cox ©1992. Not Public Domain. All rights reserved.
 */

signal on error
signal on syntax
address command
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
cr="0a"x

counter=0

collist = ppm_GetColorList()
collist = substr(collist, pos('0a'x, collist) +1) /* strip off initial line which is number of colours */

do forever
    box=ppm_ClickOnBox("Sélectionnez les Boîtes à Encadrer")
    if box=0 then break
    counter=counter+1
    boxes.counter=box
    call ppm_SelectBox(box)
end

if counter=0 then exit_msg("Pas de Boîte Selectionnée")

form = "Epaisseur en Points:5"cr"Intérieur/Extérieur (I/E):E"
manylines=ppm_GetForm("Données Encadrement",4,form)
if manylines="" then exit_msg("Opération Annulée")

parse var manylines weight "0a"x posn
posn= upper(posn)
color=ppm_SelectFromList("Choix de la Couleur",24,18,0,collist)
if color = "" then exit_msg("Annulé par l'Utilisateur")

currentunits=ppm_GetUnits()
call ppm_SetUnits(1)


iw=weight/72   /* line weight in inches */
iw2=iw*2

do i=1 to counter
    box=boxes.i
    call ppm_SetBoxFrame(box,1)
    framedata = ppm_GetBoxFrameData(box)
    parse var framedata lc "0a"x fillcolor "0a"x lineweight "0a"x linepattern "0a"x fillpattern  

    call ppm_SetBoxFrameData(box,color,fillcolor,weight,linepattern,fillpattern)
    margins = ppm_GetBoxMargins(box)
    parse var margins mleft mtop mright mbottom

    ilineweight=lineweight/72
    boxtype = upper(word(ppm_GetBoxInfo(box), 1))
    if boxtype = "TEXTE" then  /* extra margin for text */
        do
        mleft2=abs(mleft-ilineweight+iw)
        if mleft2=iw then mleft2=iw2
        if mleft2<iw then mleft2=iw2
        
        mtop2=abs(mtop-ilineweight+iw)
        if mtop2=iw then mtop2=iw2
        if mtop2<iw then mtop2=iw2
        
        mright2=abs(mright-ilineweight+iw)
        if mright2=iw then mright2=iw2
        if mright2<iw then mright2=iw2
       
        mbottom2=abs(mbottom-ilineweight+iw)
        if mbottom2=iw then mbottom2=iw2
        if mbottom2<iw then mbottom2=iw2
        end
    else
        do
        mleft2 = abs(mleft-ilineweight+iw)
        if mleft2<iw then mleft2=iw
        mtop2=abs(mtop-ilineweight+iw)
        if mtop2<iw then mtop2=iw
        mright2=abs(mright-ilineweight+iw)
        if mright2<iw then mright2=iw
        mbottom2=abs(mbottom-ilineweight+iw)
        if mbottom2<iw then mbottom2=iw
        end
    call ppm_SetBoxMargins(box,mleft2,mtop2,mright2,mbottom2)


   if posn="E" /* Letter E */
        then do
        where = ppm_GetBoxPosition(box)
        xwhere=word(where,1)
        ywhere=word(where,2)
        call ppm_SetBoxPosition(box,xwhere-iw,ywhere-iw)
        howbig = ppm_GetBoxSize(box)
        boxwidth = word(howbig,1)+iw2
        boxheight = word(howbig,2)+iw2
        call ppm_SetBoxSize(box,boxwidth,boxheight)
        
        end
    end
call ppm_SetUnits(currentunits)

message = "Fin"
    dessins=ppm_GetWireFrame()
    if dessins=1 then message ="Pour voir le résultat, désactivez Dessins stylisés"
call exit_msg(message)

end

error:
syntax:
    do                    
    exit_msg("Arrêt du Génie dû à l'erreur: "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