CAD中的mp3播放器,纯lisp

xshrimp

我也来个mp3播放器. V1.0


[pcode=lisp,true]
(defun c:mp3()
(defun gps->formatpath (string)
  (while (vl-string-search "/" string)
    (setq string (vl-string-subst "\\" "/" string))
  )
  (while (vl-string-search "\\\\" string)
    (setq string (vl-string-subst "\\" "\\\\" string))
  )
  (setq string (strcase string))
   string
)
(defun gps->browsedir (msg / WinShell shFolder path catchit rtn)
  (if (null msg) (setq msg "选择目录"))
  (if (setq winshell (vlax-create-object "Shell.Application"))
    (progn
      (setq shFolder
                     (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
            catchit
                     (vl-catch-all-apply
                       '(lambda ()
                          (setq shFolder (vlax-get-property shFolder 'self))
                          (setq path     (vlax-get-property shFolder 'path))
                        )
                     )
      )
      (if shFolder (vlax-release-object shFolder))      
      (vlax-release-object winshell)
      (if (vl-catch-all-error-p catchit)
        (setq rtn nil)
        (setq rtn (gps->formatpath path))
      )
    )
  )
  rtn
)
(defun gps->dcl-list-show(key lst)
(start_list key)
(mapcar
'(lambda(x)(if (= (type x) 'STR)(add_list x) (add_list (vl-princ-to-string x))) )
lst
)
(end_list)

)

;   getAudioLanguageDescription (1)
;   getAudioLanguageID (1)
;   getLanguageName (1)
;   next ()
;   pause ()
;   play ()
;   playItem (1)
;   previous ()
;   step (1)
;   stop ()
;;;play
(defun dcl-play(key)
(setq ckstr "dcl-pause")
  (start_image key)
  (fill_image 0 0 (dimx_tile key)(dimy_tile key) -15)
  (dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 8 8 19)
        (LIST 18 7 12)
        (LIST 8 19 8)
        (LIST 7 12 18)
        (LIST 190 190 190)
);mapcar
(end_image)   
);defun


;;;pause
(defun dcl-pause (key)
(setq ckstr "dcl-play")
(start_image key)
(fill_image 0 0 (dimx_tile key)(dimy_tile key) -15)
(dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 13 16 16 13 8 11 11 8)
        (LIST 18 18 7 7 18 18 7 7)
        (LIST 16 16 13 13 11 11 8 8)
        (LIST 18 7 7 18 18 7 7 18)
        (LIST 190 190 190 190 190 190 190 190)
);mapcar
(end_image)
);defun
;;;stop
(defun dcl-stop (key)
  (start_image key)
  (dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 7 17 17 7)
        (LIST 7 7 17 17)
        (LIST 17 17 7 7)
        (LIST 7 17 17 7)
        (LIST 190 190 190 190)
);mapcar
(end_image)
);defun
;;;next
(defun dcl-next (key)
  (start_image key)
  (dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 4 4 12 20 12 12 21 20 20 21)
        (LIST 8 8 12 12 8 8 8 8 16 16)
        (LIST 4 12 4 12 20 12 20 20 21 21)
        (LIST 16 12 16 16 12 16 8 16 16 8)
        (LIST 190 190 190 190 190 190 190 190 190 190)
);mapcar
(end_image)
);defun

;;;previous
(defun dcl-previous (key)
(start_image key)
(dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 12 12 4 12 20 20 3 4 4 3)
        (LIST 8 8 12 12 8 8 8 8 16 16)
        (LIST 12 4 12 20 12 20 4 4 3 3)
        (LIST 16 12 16 16 12 16 8 16 16 8)
        (LIST 190 190 190 190 190 190 190 190 190 190)
);mapcar
(end_image)

);defun


;;;fastForward
(defun dcl-fastForward (key)
(start_image key)
(dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 13 13 21 13 5 5)
        (LIST 8 8 12 12 8 8)
        (LIST 13 21 13 5 13 5)
        (LIST 16 12 16 16 12 16)
        (LIST 190 190 190 190 190 190)
);mapcar
(end_image)

);defun

;;;fastReverse
(defun dcl-fastReverse (key)
(start_image key)
(dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 19 19 11 4 11 11)
        (LIST 8 8 12 12 8 8)
        (LIST 19 11 19 11 4 11)
        (LIST 16 12 16 16 12 16)
        (LIST 190 190 190 190 190 190)
);mapcar
(end_image)
);defun



;;播放列表
(defun dcl-playlist (key)
  (start_image key)
  (dcl-rectang key 190)
(mapcar 'vector_image
        (LIST 7 13 9 9 18 18 7)
        (LIST 18 5 12 12 18 14 14)
        (LIST 18 16 13 16 18 7 7)
        (LIST 18 12 5 12 14 14 18)
        (LIST 190 190 190 190 190 190 190)
);mapcar
(end_image)
);defun
(defun dcl-logo (key)
(start_image key)
(dcl-rectang key 6)
(mapcar 'vector_image
        (LIST 22 22 23 23 23 23 23 23 25 25 28 28 27 26 26 26 26 26 26 25 23 23 24 24 24 25 25 25 25 22 23 22 26 26 25 25 25 26 26 24 23 23 23 22 22 22 23 23 23 24 24 25 24 28 28 27 27 26 26 26 26 26 26 24 27 27 24 24 24 25 25 23 8 6 5 3 2 2 1 1 0 0 0 0 0 1 2 3 5 9 14 19 24 29 0 11)
        (LIST 24 24 22 21 19 17 15 14 8 7 11 11 12 12 11 11 10 5 5 5 12 12 11 10 9 8 7 5 4 10 5 6 3 2 2 3 2 0 0 4 3 2 2 4 4 3 0 0 24 23 22 22 21 24 23 22 22 25 25 25 24 21 20 19 16 20 20 17 16 15 15 15 1 2 2 3 4 4 5 5 6 6 7 8 8 10 11 13 14 18 21 24 26 29 18 0)
        (LIST 22 22 22 23 23 23 23 23 26 25 28 28 28 27 26 26 26 26 26 26 23 23 23 24 24 24 25 25 25 24 23 24 26 26 27 25 25 25 26 24 24 23 25 21 22 22 22 23 23 23 24 24 25 28 28 28 27 25 26 26 26 26 26 26 24 27 27 24 24 25 25 28 11 8 6 5 3 2 2 1 1 0 0 0 0 0 1 2 3 5 9 14 19 24 29 0)
        (LIST 25 24 24 22 21 19 17 15 9 8 9 11 11 12 12 11 11 10 5 5 12 12 12 11 10 9 8 7 5 8 9 5 4 3 2 4 3 2 0 4 4 3 2 5 4 4 3 0 24 24 23 22 22 24 24 23 22 24 25 25 25 24 21 18 17 16 20 21 17 17 15 14 1 1 2 2 3 4 4 5 5 6 6 7 8 8 10 11 13 14 18 21 24 26 29 29)
        (LIST 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6)
);mapcar
(end_image)
)
;;;亮显列表
(defun list-set()
;;;playState:integer; 播放状态，1=停止，2=暂停，3=播放，6=正在缓冲，9=正在连接，10=
;;;取得状态
(setq playState (vlax-get-property #wmplayer# 'playState))
(cond
  ((= playState 3 )
    (dcl-pause "play")
    (setq mp3name (vlax-get-property (vlax-get-property #wmplayer# 'currentMedia) 'sourceURL))
    (setq mp3name (strcat (vl-filename-base  mp3name)(vl-filename-extension mp3name)))      
    (setq nnth (- (length mp3lst$) (length (member mp3name mp3lst$))))
    (set_tile "list" (itoa nnth))
  )
)
(if #wmplayer#
(progn
(setq cvolume
  (vlax-get-property
      (vlax-get-property #wmplayer# 'settings)
      'volume   
  )
)
(set_tile "slider" (itoa cvolume))
(set_tile "txt"    (strcat "音量:" (itoa cvolume) "%"))
)
)
)
(defun dcl-slider-act()
  (if #wmplayer#
    (progn
      (setq tmp1 (get_tile "slider"))
      (set_tile "txt" (strcat "音量:" tmp1 "%"))
      (gps->wmplayervolume (atoi tmp1))
    )
  )
)

(defun dcl-previous-act( / tmpnum)
  (if mp3lst$
    (progn
      (setq tmpnum (1- (atoi (get_tile "list"))))
      (if (>= tmpnum 0)
        (progn
           (set_tile "list" (itoa tmpnum))
           (gps->wmplayercontrols 'previous)
        )
      )
    )
  )
)
(defun dcl-next-act( / len tmpnum)
  (if mp3lst$
    (progn
    (setq len (length mp3lst$))   
    (setq tmpnum (1+ (atoi (get_tile "list"))))
    (if (< tmpnum len)
      (progn
        (set_tile "list" (itoa tmpnum))
        (gps->wmplayercontrols 'next)
      )
    )
    )
  )
  )


(defun dcl-play-act()
(eval (read (strcat "(" ckstr " \"play\")")))
;;;playState:integer; 播放状态，1=停止，2=暂停，3=播放，6=正在缓冲，9=正在连接，10=
;;4 fastForward
;;;取得状态
(setq playState (vlax-get-property #wmplayer# 'playState))
(cond
  ((= playState 3 )
    (gps->wmplayercontrols 'pause)
               
  )
  ((= playState 2 )
  (gps->wmplayercontrols 'play)
  )
)
)
;(gps->wmplayercontrols 'fastForward)
;(gps->wmplayercontrols 'fastReverse)

;绘制矩形.
(defun dcl-rectang(key col / dimx dimy)
  (setq dimx (- (dimx_tile key) 1) dimy (- (dimy_tile key) 1))
  (setq x 0 y 0)
  (vector_image x y x dimy col)
  (vector_image x y dimx y col)
  (vector_image dimx y dimx dimy col)
  (vector_image x dimy dimx dimy col)
)

(defun dcl-playlist-act()
(if (setq mp3dir$ (gps->browsedir "选择mp3所在目录:"))
(progn
(setq mp3lst$ (append (vl-directory-files mp3dir$ "*.mp3")  (vl-directory-files mp3dir$ "*.wma")))
(setq #MediaCollection# (vlax-get-property #wmplayer# 'MediaCollection))
(setq #currentPLayList# (vlax-get-property #wmplayer# 'currentPLayList))
(setq newmp3lst mp3lst$)
  (foreach n mp3lst$
   ;;;(vl-string-search "?" str)
   (setq songurl (strcat mp3dir$ "\\" n))   
   (setq RValue (vl-catch-all-apply 'gps->wmplayeradd-2playlst (list songurl)))
   (if (vl-catch-all-error-p RValue)
     (progn
       (setq newmp3lst  (vl-remove n mp3lst$))
       (vl-catch-all-error-message RValue)
       )
      RValue
   );返回值
   ;;有的歌曲添加不进.应重新修正..
  )
  (setq  mp3lst$ newmp3lst)
  (gps->dcl-list-show "list" mp3lst$)
  )
)
)
(defun dcl-list-act()
  (if (= $reason 4)
    (progn         
;      (setq mp3 (strcat mp3dir$ "\\" (nth (atoi $value) mp3lst$)))
;      (gps->wmplayer mp3)
;      (dcl-pause "play")   
(setq song (vlax-get-property    #currentPLayList#   'item (atoi $value)))
;(vlax-dump-object song T)
(vlax-invoke-method  
  (vlax-get-property #wmplayer# 'controls)
  'playItem
   song
)
      
     )
   )
)
;;;xshrimp 2010.8.16
;(gps->wmplayer "D:\\mp3\\09.mp3")
;(gps->wmplayer "D:\\mp3\\Lovegame.mp3")
;(gps->wmplayercontrols 'pause) ;暂停
;(gps->wmplayercontrols 'play)  ;播放
;(gps->wmplayercontrols 'stop)  ;停止
;(gps->wmplayervolume 50)       ;控制音量
;;;;(vlax-release-object #wmplayer#)
;(gps->wmplayercontrols 'next) ;下一曲.
(defun gps->wmplayer (filename / w)
  (vl-load-com)   
  (if (findfile filename)
     (progn
       (setq #wmplayer# (cond (#wmplayer#)((vlax-create-object "wmplayer.ocx"))))
       (vlax-put-property #wmplayer# 'URL filename)
     )
  )  
)
;;;播放,暂停,停止等.
(defun gps->wmplayercontrols (cont)
  (vlax-invoke-method  
  (vlax-get-property #wmplayer# 'controls)
  cont
  )
)
;;;声音控制.
;;;volume 取值0-100
(defun gps->wmplayervolume (volume)
  (vlax-put-property
    (vlax-get-property #wmplayer# 'settings)
    'volume
    volume
  )
)
;(setq cvolume
;  (vlax-get-property
;      (vlax-get-property #wmplayer# 'settings)
;      'volume   
;  )
;)
;(set_tile "txt"

;;;添加歌曲到播放列表
;;(setq #MediaCollection# (vlax-get-property #wmplayer# 'MediaCollection))
;;(setq #currentPLayList# (vlax-get-property #wmplayer# 'currentPLayList))

(defun gps->wmplayeradd-2playlst(songurl / losong)
   (setq losong(vlax-invoke-method    #MediaCollection#   'add  songurl))
   (vlax-invoke-method    #currentPLayList#  'AppendItem  losong  )
)
;;(setq losong(vlax-invoke-method    #MediaCollection#   'add  "D:\\mp3\\09.mp3"  ))
;;(vlax-invoke-method    #currentPLayList#  'AppendItem  losong  )


(setq #wmplayer# (cond (#wmplayer#)((vlax-create-object "wmplayer.ocx"))))
(setq dclname
(cond  
((setq tempname (vl-filename-mktemp "gps-dcl-tmp.dcl") filen (open tempname "w"))
(foreach stream  
'(  
"mmmm:image_button{aspect_ratio=1;color=dialog_background;fixed_height=true;fixed_width=true;\n"
"height=1.89;width=4.09;horizontal_margin=none;vertical_margin=none;}\n"
"wmplayer:dialog{ label=\"mp3播放器V1.0版本\";\n"
"  :spacer{}\n"
"  :row{\n"
"  :mmmm{key=\"play\";}\n"
"  :mmmm{key=\"stop\";}\n"
"  :mmmm{key=\"previous\";}\n"
"  :mmmm{key=\"next\";}\n"
"  :mmmm{key=\"fastForward\";}\n"
"  :mmmm{key=\"fastReverse\";}\n"
"  :mmmm{key=\"playlist\";}\n"
"  }\n"
"  :row{\n"
"    :text {  label=\"音量:\"; key= \"txt\";    }\n"
"    :slider { key=\"slider\";   min_value=0;max_value=100; }\n"
"  }\n"
"  :list_box{height=15;key=\"list\";}\n"
"  :row{\n"
"    cancel_button;\n"
"    :image{color=dialog_background;fixed_height=true;fixed_width=true;height=2.28;width=4.92;key=\"logo\";}\n"
"   }\n"
"}\n"
)
(princ stream filen)
)
(close filen)
tempname
)))



(setq dclid (load_dialog dclname))  
(setq loop T)
(while loop
(if (not (new_dialog "wmplayer" dclid)) (progn (alert "dcl对话框加载失败.")(exit)))
(dcl-logo "logo")
(dcl-play  "play")
;(dcl-pause  "play")
(dcl-stop  "stop")
(dcl-next  "next")
(dcl-previous  "previous")
(dcl-fastForward  "fastForward")
(dcl-fastReverse  "fastReverse")
(dcl-playlist "playlist")
(if mp3lst$ (gps->dcl-list-show "list" mp3lst$))
;;;亮显列表
(list-set)
(action_tile "slider" "(dcl-slider-act)")
(action_tile "play" "(dcl-play-act)")
(action_tile "list" "(dcl-list-act)")
(action_tile "stop" "(gps->wmplayercontrols 'stop)")
;(set_tile "list" (1- (atoi (get_tile "list")) ))
(action_tile "next"         "(dcl-next-act)")
(action_tile "previous"  "(dcl-previous-act)")
(action_tile "playlist" "(dcl-playlist-act)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq dd (start_dialog))
(cond((= 0 dd) (setq Loop nil))
))(unload_dialog dclid)
(vl-file-delete dclname)
)
(princ "\nmp3播放器 V1.0 运行命令mp3")
(princ "\nbug发至xshrimp@163.com.网络U盘http:\\\\shlisp.ys168.com")
(princ)







[/pcode]

dwg001

挺好,cad操作时又多了一种乐趣。

ScmTools

很有创意的想法

SmartStar

太给力了，这也行！

Highflybird

一个小Bug,在CAD里面关闭了程序，但音乐却还在继续播放。

sicky111

我喜欢源码。

hao3ren

直接复制源码到CAD,好像少几个括号，补全输入mp3出现DCL-LOGO，你们的正常吗

sachindkini

dear sir,

nice code
thx for sharing

zyhandw

我的机器怎么播不了？:L

yjht

我也同样出现错误

莫紫

我的怎么出错啊！怎么回事，求指教？

819534890

太牛了，用了没问题

dz-2011

晓东论坛都是高手,就是牛！

莫紫

求指点哦！

莫紫

819534890 发表于 2013-9-4 17:11
太牛了，用了没问题

我的怎么不行？求指点？