home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0925.lha / DonsGenies / FrenchGenies.lha / Rexx / ImporteBitmapEchelle1.pprx < prev    next >
Text File  |  1993-08-03  |  5KB  |  147 lines
  1. /*@BImporteBitmapEchelle1 @P @I Ecrit et ⌐ par Don Cox en juillet 92
  2. @IN'est pas du Domaine Publique. Tous Droits RΘservΘs.
  3. Traduit et modifiΘ par Fabien Larini le 24/07/93.
  4.  
  5. Ce GΘnie importe une image bitmap α l'Θchelle 1 en prΘsumant d'une
  6. rΘsolution d'Θcran de 75 dpi. Il redimensionne la boεte devant contenir
  7. l'image afin que celle-ci soit visible entiΦrement. Il permet de 
  8. prΘvisualiser l'image avant de l'importer.
  9. */
  10.  
  11.  
  12. /*ImportBitmap1to1*/
  13. /* Import bitmap with a scale of 1:1, assuming a screen resolution of 75 dpi in hi-res.
  14. Written by Don Cox  July '92  */
  15.                                              
  16. signal on error
  17. signal on syntax
  18.  
  19. address command
  20. call ppm_AutoUpdate(0)
  21. call SafeEndEdit.rexx()
  22. oldunits = ppm_GetUnits()
  23. call ppm_SetUnits(1)                      
  24.     
  25. /* Contr⌠le fichier de configuration */
  26. fichiercfg = "rexx:ImporteBitmapEchelle1.cfg"
  27.  
  28. idem = 0
  29. viewer = ""                                            
  30. pos = 0                    
  31.  
  32. /* Demande si nouvelle config */
  33. if exists(fichiercfg) then
  34.     idem = ppm_Inform(2,"Utilisation de la configuration sauvΘe ?","Non","Oui")
  35.  
  36. /* Si fichier inexistant ou si utilisateur veut changer la config */
  37. if (~exists(fichiercfg) | idem=0) then do
  38.     /* Quel viewer ?*/
  39.     viewer = ppm_GetFileName("Choix du Visualisateur","","")
  40.     if viewer = '' then exit_msg("OpΘration AnnulΘe")           
  41.  
  42.     pos = max(lastpos(":",viewer),lastpos("/",viewer))
  43.     viewerdir = delstr(viewer,pos+1)
  44.     
  45.     /* Un fichier choisi ? */         
  46.     viewerfile = delstr(viewer,1,length(viewerdir))
  47.     if viewerfile = "" then exit_msg("Pas de Visualisateur Choisi")
  48.  
  49.     /* Y a-t-il un espace dans le nom */
  50.     if lastpos(" ",viewer) ~=0 then exit_msg("Il y a un espace dans le nom et/ou le rΘpertoire du visualisateur")
  51.  
  52.     /* Sauver dans fichier ? */
  53.     if ppm_Inform(2,"Sauvegarder dans le fichier de configuration ?","Non","Oui") = 1 then do
  54.         if open(cfg,fichiercfg,"W") then do
  55.             call writeln(cfg,viewer)
  56.             call close(cfg)
  57.         end
  58.         else
  59.             exit_msg("Impossible de sauvegarder le fichier de configuration")
  60.         end
  61.     end
  62. /* Chargement du fichier de config */
  63. else if idem = 1 then do
  64.         if open(cfg,fichiercfg,"R") then do
  65.             viewer = readln(cfg)
  66.             call close(cfg)
  67.             end
  68.         else
  69.             exit_msg("Impossible de lire le fichier de configuration")
  70.         end    
  71.     
  72. /* Y a-t-il un espace dans viewer */
  73. if lastpos(" ",viewer) ~=0 then viewer = '22'x||viewer||'22'x
  74.                                      
  75. do forever
  76.     /* Choix de l'image */
  77.     filespec = ppm_GetFileName("Choix du fichier Bitmap",getclip(pp_IBE1),"")
  78.     if filespec = '' then exit_msg("OpΘration AnnulΘe")           
  79.  
  80.     pos = max(lastpos(":",filespec),lastpos("/",filespec))
  81.     bitmapdir = delstr(filespec,pos+1)
  82.     
  83.     /* Un fichier choisi ? */         
  84.     bitmapfile = delstr(filespec,1,length(bitmapdir))
  85.     if bitmapfile = "" then exit_msg("Pas de fichier choisi")
  86.     
  87.     /* pour se rappeler du rΘpertoire mΩme aprΦs l'arrΩt du GΘnie */
  88.     call setclip(pp_IBE1, bitmapdir)
  89.                           
  90.     /* Y a-t-il un espace dans la ligne de commande */
  91.     /* PrΘvisualisation de l'image. " >nil: " ajoutΘ pour Θviter d'avoir
  92.     le rΘsultat de la commande */                     
  93.     if lastpos(" ",filespec) ~=0 then filespec = '22'x||filespec||'22'x
  94.     commande = viewer||' > nil: '||filespec
  95.     address command commande
  96.  
  97.     /* Le choix est il bon ? */
  98.     if ppm_Inform(2,"Voulez vous importer cette image ?","Non","Oui") = 1 then break
  99. end
  100.  
  101. box = ppm_ClickOnBox("Clickez dans la boεte de destination...")
  102.  
  103. if box=0 then exit_msg(1,"Pas de Boεte SΘlectionnΘe",)
  104.  
  105. gone = ppm_DeleteContents(box)
  106.    
  107. worked = ppm_ImportBM(box,filespec)
  108.  
  109. info = ppm_GetBoxInfo(box)
  110. width = word(info,2)
  111. height = word(info,3)
  112. if width>400 then do
  113.     width = width/75  /* screen images at 75dpi for high res */
  114.     xscale = 1
  115.     end
  116. else do
  117.     width = width/37.5
  118.     xscale = 2
  119.     end
  120.  
  121.  
  122. if height>360 then do
  123.     height = height/75
  124.     yscale = 1
  125.     end
  126. else do
  127.     height = height/37.5
  128.     yscale = 2
  129.     end
  130.  
  131. call ppm_SetBoxScale(box,xscale,yscale)
  132. call ppm_SetBoxSize(box,width,height)
  133. exit_msg()                                                    
  134.  
  135. exit_msg:
  136.     do
  137.     parse arg message
  138.     if message ~= "" then
  139.     call ppm_Inform(1,message,) 
  140.     call ppm_SetUnits(oldunits)
  141.     call ppm_ClearStatus()
  142.     call ppm_PPageToFront()
  143.     call ppm_AutoUpdate(1)
  144.     exit
  145.     end
  146.  
  147.