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 >
Wrap
Text File
|
1993-08-07
|
4KB
|
135 lines
/*@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