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

nonsmall

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

1. (defun c:piano()
   
2.   (vl-load-com)
   
3.   (setq reg_path "HKEY_LOCAL_MACHINE\\SOFTWARE\\Autodesk\\piano_v1.0")
   
4.   (setq Wsh (vlax-create-object "Wscript.Shell"))
   
5.   (setq WMP (vlax-get-or-create-object "wmplayer.ocx"))
   
6.     (setq control (vlax-get-property WMP 'controls))
   
7.     (setq setting (vlax-get-property WMP 'settings))
   
8.     (setq path (vl-registry-read reg_path "path"))
   
9.     (if (or (not path) (= path ""))
   
10.       (setq path (strcat (vl-string-trim "\\" (vl-filename-directory (getfiled "请选择钢琴声音文件" "" "wav" 0))) "\\"))
    
11.     )
    
12.   (vl-registry-write reg_path "path" path)
    
13.   (setq i -2)
    
14.   (repeat 14
    
15.   (set (read (strcat "n" (itoa i))) (Vlax-Invoke-Method wmp 'newMedia (strcat path (itoa i) ".wav") ))
    
16.     (setq i (1+ i))
    
17.   )
    
18.   (vl-registry-write reg_path "path" path)
    
19.   (print "开始弹奏")
    
20.   (print "按照乐谱在小键盘上面弹奏 空格退出 <C>改变音乐文件目录")
    
21.   (print)
    
22.   (setq go 1)
    
23.   (while go
    
24.     (setq get(grread 1))
    
25.     (setq wrong 1)
    
26.     (cond
    
27.       ((/= 2 (car get))
    
28.         (setq wrong 0)
    
29.       )
    
30.       ((and (= 2 (car get)) (= 48 (cadr get)))
    
31.         (Vlax-Put-Property wmp 'currentMedia n-2)
    
32.       )
    
33.       ((and (= 2 (car get)) (= 46 (cadr get)))
    
34.         (Vlax-Put-Property wmp 'currentMedia n-1)
    
35.       )
    
36.       ((and (= 2 (car get)) (= 13 (cadr get)))
    
37.         (Vlax-Put-Property wmp 'currentMedia n0)
    
38.       )
    
39.       ((and (= 2 (car get)) (= 43 (cadr get)))
    
40.         (Vlax-Put-Property wmp 'currentMedia n10)
    
41.       )
    
42.       ((and (= 2 (car get)) (= 47 (cadr get)))
    
43.         (Vlax-Put-Property wmp 'currentMedia n11)
    
44.       )
    
45.       ((and (= 2 (car get)) (= 32 (cadr get)))
    
46.         (setq go nil)
    
47.         (setq wrong -1)
    
48.       )
    
49.       ((and (= 2 (car get)) (= 99 (cadr get)))
    
50.         (setq path (strcat (vl-string-trim "\\" (vl-filename-directory (getfiled "请选择钢琴声音文件" "" "wav" 0))) "\\"))
    
51.         
    
52.         (setq i -2)
    
53.         (repeat 14
    
54.           (set (read (strcat "n" (itoa i))) (Vlax-Invoke-Method wmp 'newMedia (strcat path (itoa i) ".wav") ))
    
55.           (setq i (1+ i))
    
56.         )
    
57.         (vl-registry-write reg_path "path" path)
    
58.       )
    
59.       ((and (= 2 (car get)) (< 48 (cadr get)) (> 58 (cadr get)))
    
60.         (Vlax-Put-Property wmp 'currentMedia (eval (read (strcat "n" (itoa (- (cadr get) 48))))))
    
61.       )
    
62.       (1
    
63.         (setq wrong 0)
    
64.       )
    
65.     )
    
66.     (cond
    
67.       ((= wrong 1)
    
68.         (print (strcat "正确弹奏" (itoa (cadr get))))
    
69.       )
    
70.       ((= wrong -1)
    
71.         (print (strcat "退出"))
    
72.       )
    
73.     )
    
74.   )
    
75.   (vl-registry-write reg_path "path" path)
    
76.   (vlax-release-object Wsh)
    
77.   (vlax-release-object WMP)
    
78.   (princ)
    
79. )
    
80. (print "nonsmall原创vlisp作品之 <<钢琴演奏 v1.0>> 使用命令:piano 推荐使用小键盘弹奏 空格退出 (电脑越快效果越好)")
    
81. (princ)

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

nonsmall

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

198526

谢谢！下来试试

sachindkini

Dear Sir,
thx for source

fanfanfsj

感谢分享！

gzbccy

真是厉害！来看看

祥子

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

革天明

楼主厉害！

zwqgdhl

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

zwqgdhl

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