Bitmap pour DCL

[Patrick_35]

Bonjour

 

Je viens de tomber sur ce sujet et là chapeau, des images dans du DCL.

Je dis Monsieur LeeMac :D

 

Ps : Si ce sujet intéresse et se développe, cela pourrait faire l'objet d'un forum pour ceux qui veulent déposer des images.

 

@+

[vincentp010]

Ça m’intéresse mais les inscriptions au forum sont désactivées, donc impossible de voir le post.

[Patrick_35]

Ah ok

 

Voici les exemples déposés sur le site Theswamp

http://www.theswamp.org/lilly_pond/leemac/32x32test.png

 

http://www.theswamp.org/lilly_pond/leemac/48x48test.png

 

http://www.theswamp.org/lilly_pond/leemac/textedit.png

 

http://www.theswamp.org/lilly_pond/leemac/arrows.png

 

http://www.theswamp.org/lilly_pond/leemac/textwrap.png

 

http://www.theswamp.org/lilly_pond/leemac/yesno.png

 

Ainsi que le lisp et ses exemples

 

ps : L'auteur est Lee Mac

 

@+

[Patrick_35]

Bonjour

 

Et un lisp qui permet de convertir les images bmp au format 24 bits dans une liste compatible avec ceux de Lee Mac

 

(defun bmp(/ act col fic lst nb pal pos str readbinary hexdec inv)

 ; Lecture d'un fichier binaire
 ; Merci à highflyingbird
 ; Trouvé sur TheSwamp.org
 ; http://www.theswamp.org/index.php?topic=36656.msg417089#msg417089
 ; Modifié par Patrick_35 pour positionner le début de la lecture et la longueur à lire
 ; ReadBinary (fichier position longueur)

 (defun readbinary (fichier position longueur / str wsObj)
   (setq wsObj (vlax-create-object "ScriptControl"))
   (or position
     (setq position 0)
   )
   (if (or (not longueur) (zerop longueur))
     (setq longueur (- (vl-file-size fichier) position))
   )
   (vlax-put wsObj "language" "VBS")
   (setq str
     (strcat
      "Function ReadBinary(fichier)
Const adTypeBinary = 1
Dim stream, xmldom, node
Set xmldom = CreateObject(\"Microsoft.XMLDOM\")
Set node = xmldom.CreateElement(\"binary\")
node.DataType = \"bin.hex\"
Set stream = CreateObject(\"ADODB.Stream\")
stream.Type = adTypeBinary
stream.Open
stream.LoadFromFile fichier
stream.Position = " (itoa position) "
node.NodeTypedValue = stream.Read(" (itoa longueur) ")
stream.Close
Set stream = Nothing
ReadBinary = node.Text
Set node = Nothing
Set xmldom = Nothing
End Function"
     )
   )
   (vlax-invoke wsObj 'ExecuteStatement str)
   (setq str (vlax-invoke wsObj 'run "ReadBinary" fichier))
   (vlax-release-object wsObj)
   str
 )

 (defun hexdec (nb / r i s) 
   (if (= (type nb) 'INT)
     (setq nb (itoa nb))
   )
   (setq r 0 i 0)
   (while (and (= (type nb) 'STR) (< i (strlen nb)))
     (setq i (1+ i)
    s (strcase (substr nb i 1 ))
    r (+ (lsh r 4) (- (ascii s)
		      (if (<= s "9")
			48
			55
		      )
		    )
      )
     )
   )
 )

 (defun inv(str / nb txt)
   (setq nb 1 txt "")
   (while (< nb (strlen str))
     (setq txt (strcat (substr str nb 2) txt)
    nb (+ nb 2)
     )
   )
   txt
 )

 (and (setq fic (getfiled "Veuillez sélectionner un fichier BMP" "" "bmp" 16))
   (progn
     (setq col (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2)))
    pos (hexdec (inv (readbinary fic 10 4)))
    bit (hexdec (inv (readbinary fic 28 4)))
    str (readbinary fic pos nil)
    nb 1
     )
     (cond
((eq bit 24)
  (while (< nb (strlen str))
    (vla-setrgb col (hexdec (substr str (+ nb 4) 2))
		    (hexdec (substr str (+ nb 2) 2))
		    (hexdec (substr str nb 2))
    )
    (setq act (vla-get-colorindex col)
	  nb (+ nb 6)
    )
    (if (eq act 7)
      (setq lst (cons -15 lst))
      (setq lst (cons act lst))
    )
  )
)
(T
  (princ "\nLe lisp ne fonctionne qu'avec des images 24 bits\n")
)
     )
     (vlax-release-object col)
   )
 )
 lst
)

 

Exemple

(setq Ma_variable (bmp))

 

ps : si j'ai un peu de temps, je regarderai pour des images 256, 16 couleurs et monochrome

 

@+

[VDH-Bruno]

Patrick_35, merci beaucoup pour ce partage et le lien, sujet intéressant même si je suis un peu dans l’obligation de mettre cela de côté pour un peu plus tard..

 

A+

[SF.Designer]

Salut,

Patrick aurais tu la possibilité de me dire comment l'utiliser ce lisp, je me rend fou depuis un baille pour améliorer mes dcl avec des images !!!

[Patrick_35]

Salut

 

Tout est expliqué dans le lien de la réponse #3.

L'idée esr de générer un txt (ou une liste) depuis un bmp pour ensuite utiliser la routine LM:DisplayBitmap qui appel la fonction vector_image

 

@+

[SF.Designer]

Oui je le connaissais ce lien sur swamp par Lee !!!

Je vais essayer d'approfondir mais je me rend fou surtout pour transformer mon BMP en TXT !!!

Il y a un coté concret a tous ça et une façon d'utiliser DCLBitmap de Lee que j'arrive a pas a capter...

Je m’énerve moi même des fois !!!

 

 

[Patrick_35]

Et le lisp donné en réponse #4 ?

 

@+

[SF.Designer]

Je dois être un boulet aujourd'hui, mais ça me sors une erreur, pourtant BMP de 50x50 en 24bits ...

 

type d'argument incorrect: VLA-OBJECT nil

 

Note pour plus tard: 4 jours sans dormir c'est jamais très bon pour le cerveau !!!

[Patrick_35]

Ah oui, c'est la fonction (vlax-create-object "ScriptControl") qui ne fonctionne plus.

Va falloir trouver autre chose pour les lectures binaires

 

@+