home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d9xx / d925 / donsgenies.lha / DonsGenies / FrenchGenies.lha / Rexx / BoîtesNoiresTexteBlanc.pprx < prev    next >
Text File  |  1993-08-03  |  2KB  |  91 lines

  1. /*
  2. @BBoitesNoiresTexteBlanc @P @I Ecrit et © par Don Cox Avril 1993
  3. @IN'est pas du Domaine Publique. Tous Droit Réservés
  4. Traduit par Fabien Larini le 29/07/93.
  5.  
  6. Ce Génie colore la boîte en noir, le texte en blanc et permet
  7. d'indiquer un valeur identique pour les marges.
  8. */                                               
  9.  
  10.  
  11. /* BoxesWOB*/
  12. /* This Genie sets the box to black and text to white and puts an equal margin all round the box. 
  13. Written by Don Cox  April '93  Not Public Domain. All rights reserved. */
  14.  
  15.  
  16. signal on error
  17. signal on syntax
  18. address command
  19. call SafeEndEdit.rexx()
  20. cr="0a"x
  21.  
  22. call ppm_AutoUpdate(0)
  23. CurrentUnits = ppm_GetUnits()
  24. oldcolor = ppm_GetTextColor()
  25.  
  26. select
  27.     when CurrentUnits = 1 then units="inches"
  28.     when CurrentUnits = 2 then units="millimètres"
  29.     otherwise units ="points"
  30.     end
  31.  
  32. counter=0
  33.  
  34. do forever
  35.     box=ppm_ClickOnBox("Clickez dans les Boîtes à Modifier")
  36.     if box=0 then break
  37.     counter=counter+1
  38.     boxes.counter=box
  39.     call ppm_SelectBox(box)
  40. end
  41.  
  42. if counter=0 then exit_msg()
  43.  
  44. color   =  "Noir"
  45. tcolor  =  "Blanc"
  46.  
  47. size = ppm_GetUserText(6,"Marges en "units)
  48. if size = "" then exit_msg("Abandon Utilisateur")
  49. if CurrentUnits = 2 then size = size/10  /* mm to cm */
  50. else if CurrentUnits = 3 then size = size/12  /* points to picas */
  51.  
  52. do i=1 to counter
  53.     box=boxes.i
  54.     call ppm_SetBoxMargins(box,size,size,size,size)
  55.     
  56.     call ppm_SetBoxFrameData(box,color, color, ppm_GetLineWeight(), ppm_GetLinePattern(), 1)
  57.     call ppm_SetBoxFrame(box, 1)
  58.     call ppm_SetBoxTransparent(box, 0)
  59.  
  60.     if upper(word(ppm_GetBoxInfo(box), 1)) ~= TEXTE then iterate i
  61.  
  62.     call SafeSetEdit.rexx(box)
  63.     call ppm_SelectBoxText()
  64.     call ppm_SetTextColor(tcolor)
  65.     call SafeEndEdit.rexx()
  66.  
  67.     end
  68.  
  69. call exit_msg()
  70.  
  71. end
  72.  
  73. error:
  74. syntax:
  75.     do
  76.     exit_msg("Arrêt du Génie dû à l'erreur: "errortext(rc)) 
  77.     end
  78.  
  79. exit_msg:
  80.     do
  81.     parse arg message
  82.     if message ~= "" then
  83.     call ppm_Inform(1,message,)
  84.     call ppm_SetTextColor(oldcolor)
  85.     call ppm_SetWireFrame(0)
  86.     call ppm_ClearStatus()
  87.     call ppm_AutoUpdate(1)
  88.     exit
  89.     end
  90.                               
  91.