nonsmall 发表于 2011-7-18 16:08:27

[不死猫出品] Lisp钢琴演奏家 （完整源码+演奏乐谱）

本帖最后由 nonsmall 于 2013-4-24 17:40 编辑

呵呵 工作之余还可以放松下下
这个简谱 大家都可以弹一弹^_^





(defun c:piano()
(vl-load-com)
(setq reg_path "HKEY_LOCAL_MACHINE\\SOFTWARE\\Autodesk\\piano_v1.0")
(setq Wsh (vlax-create-object "Wscript.Shell"))
(setq WMP (vlax-get-or-create-object "wmplayer.ocx"))
    (setq control (vlax-get-property WMP 'controls))
    (setq setting (vlax-get-property WMP 'settings))
    (setq path (vl-registry-read reg_path "path"))
    (if (or (not path) (= path ""))
      (setq path (strcat (vl-string-trim "\\" (vl-filename-directory (getfiled "请选择钢琴声音文件" "" "wav" 0))) "\\"))
    )
(vl-registry-write reg_path "path" path)
(setq i -2)
(repeat 14
(set (read (strcat "n" (itoa i))) (Vlax-Invoke-Method wmp 'newMedia (strcat path (itoa i) ".wav") ))
    (setq i (1+ i))
)
(vl-registry-write reg_path "path" path)
(print "开始弹奏")
(print "按照乐谱在小键盘上面弹奏 空格退出 <C>改变音乐文件目录")
(print)
(setq go 1)
(while go
    (setq get(grread 1))
    (setq wrong 1)
    (cond
      ((/= 2 (car get))
      (setq wrong 0)
      )
      ((and (= 2 (car get)) (= 48 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia n-2)
      )
      ((and (= 2 (car get)) (= 46 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia n-1)
      )
      ((and (= 2 (car get)) (= 13 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia n0)
      )
      ((and (= 2 (car get)) (= 43 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia n10)
      )
      ((and (= 2 (car get)) (= 47 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia n11)
      )
      ((and (= 2 (car get)) (= 32 (cadr get)))
      (setq go nil)
      (setq wrong -1)
      )
      ((and (= 2 (car get)) (= 99 (cadr get)))
      (setq path (strcat (vl-string-trim "\\" (vl-filename-directory (getfiled "请选择钢琴声音文件" "" "wav" 0))) "\\"))
      
      (setq i -2)
      (repeat 14
          (set (read (strcat "n" (itoa i))) (Vlax-Invoke-Method wmp 'newMedia (strcat path (itoa i) ".wav") ))
          (setq i (1+ i))
      )
      (vl-registry-write reg_path "path" path)
      )
      ((and (= 2 (car get)) (< 48 (cadr get)) (> 58 (cadr get)))
      (Vlax-Put-Property wmp 'currentMedia (eval (read (strcat "n" (itoa (- (cadr get) 48))))))
      )
      (1
      (setq wrong 0)
      )
    )
    (cond
      ((= wrong 1)
      (print (strcat "正确弹奏" (itoa (cadr get))))
      )
      ((= wrong -1)
      (print (strcat "退出"))
      )
    )
)
(vl-registry-write reg_path "path" path)
(vlax-release-object Wsh)
(vlax-release-object WMP)
(princ)
)
(print "nonsmall原创vlisp作品之 <<钢琴演奏 v1.0>> 使用命令:piano 推荐使用小键盘弹奏 空格退出 (电脑越快效果越好)")
(princ)

nonsmall 发表于 2011-7-18 16:10:01

本帖最后由 nonsmall 于 2011-7-18 16:11 编辑

源码、使用说明、声音文件都在一楼的压缩包里
免币下载



198526 发表于 2011-7-18 16:15:35

谢谢！下来试试

sachindkini 发表于 2011-7-18 16:18:46

Dear Sir,
thx for source

fanfanfsj 发表于 2011-7-18 17:58:32

感谢分享！

gzbccy 发表于 2011-7-18 17:59:00

真是厉害！来看看

祥子 发表于 2011-7-18 18:12:58

顶下,老猫总会带给大家惊喜

革天明 发表于 2011-7-18 21:33:44

楼主厉害！

zwqgdhl 发表于 2011-7-18 21:36:24

真的是大强大啦，下载先，谢谢啦

zwqgdhl 发表于 2011-7-18 21:42:37

真的是大强大啦，下载先，谢谢啦
页: [1] 2 3 4 5
查看完整版本: [不死猫出品] Lisp钢琴演奏家 （完整源码+演奏乐谱）