【飞鸟集】WINDOWS API 编程的另一种方式实现 (高级应用见12楼)

highflybird

windows API 编程 在lisp中的实现，aroom和nonsmall做了很多工作，我这里提供另外一种思路：
利用excel.vba的实现，比较完美，实现过程中没有出现什么对话框，可以得到返回值。
主干部分还是比较简单。呵呵。
大家不防讨论一下。

下面实现了在背景中画一个白色椭圆（以为不能恢复的，不要惊慌，刷新一下屏幕一下就可以了）

2. 
   
3. (defun c:API (/ wsh oEx oBk Mod str)
   
4.   (setq wsh (vlax-create-object "wscript.Shell"))
   
5.   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\11.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")
   
6.   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\12.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")
   
7.   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\14.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")
   
8.   
   
9.   (setq oEx (vlax-create-object "excel.application"))
   
10.   (setq obk (vlax-invoke (vlax-get oEx 'workbooks) 'add))
    
11.   (setq mod (vlax-invoke (vlax-get (vlax-get obk 'VBProject) 'VBComponents) 'add 1))
    
12.   (setq str
    
13. "Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    
14. Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
    
15. Declare Function Ellipse Lib "gdi32" Alias "Ellipse" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    
16. Sub MyMacro(x as Long, y as Long)
    
17. SetCursorPos x, y
    
18. Ellipse GetDC(0),0,0,x,y
    
19. End Sub"
    
20.   )
    
21.   (vlax-invoke (vlax-get mod 'CodeModule) 'AddFromString str)
    
22.   (vlax-invoke oEx 'run "MyMacro" 800 600)
    
23.   (vlax-put oEx 'DisplayAlerts 0)
    
24.   (vlax-invoke obk 'close)
    
25.   (vlax-invoke oEx 'quit)
    
26.   (vlax-release-object mod)
    
27.   (vlax-release-object obk)
    
28.   (vlax-release-object oEx)
    
29.   (vlax-release-object wsh)
    
30.   (princ)
    
31. )
    

<br /> (defun c:API (/ wsh oEx oBk Mod str)<br />   (setq wsh (vlax-create-object "wscript.Shell"))<br />   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\11.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")<br />   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\12.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")<br />   (vlax-invoke wsh 'RegWrite "HKEY_CURRENT_USER\\Software\\Microsoft\\Office\\14.0\\Excel\\Security\\AccessVBOM" 1 "REG_DWORD")<br />   <br />   (setq oEx (vlax-create-object "excel.application"))<br />   (setq obk (vlax-invoke (vlax-get oEx 'workbooks) 'add))<br />   (setq mod (vlax-invoke (vlax-get (vlax-get obk 'VBProject) 'VBComponents) 'add 1))<br />   (setq str<br /> "Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long<br /> Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long<br /> Declare Function Ellipse Lib "gdi32" Alias "Ellipse" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long <br /> Sub MyMacro(x as Long, y as Long)<br /> SetCursorPos x, y<br /> Ellipse GetDC(0),0,0,x,y<br /> End Sub"<br />   )<br />   (vlax-invoke (vlax-get mod 'CodeModule) 'AddFromString str)<br />   (vlax-invoke oEx 'run "MyMacro" 800 600)<br />   (vlax-put oEx 'DisplayAlerts 0)<br />   (vlax-invoke obk 'close)<br />   (vlax-invoke oEx 'quit)<br />   (vlax-release-object mod)<br />   (vlax-release-object obk)<br />   (vlax-release-object oEx)<br />   (vlax-release-object wsh)<br />   (princ)<br /> )<br />

xiagood

高手，佩服。。敬礼了。

xhq1954425

哈哈……画到视口外面去了！厉害！不知有什么用途？

highflybird

xhq1954425 发表于 2010-12-16 14:05
哈哈……画到视口外面去了！厉害！不知有什么用途？

呵呵，如果能利用api的话，将极大地扩展lisp的编程能力，因为它已经是触及到windows底层。
譬如可以利用它来进行多线程编程，等等。
下面我上传一个windowsAPI编程帮助，从中可以看到，它几乎有点无所不能。

这种实现的方式有个缺点，就是要利用excel,万一别人没装的话，就可能用不了
好处就是据说excel的vb比vb还要vb。

mccad

就怕启动Excel会慢。

cnks

要是这样用api很别扭，把lisp当做绘图工具还是不错的。

nonsmall

mark

混合开发的路没有尽头

它山之石

绿色版的EXCEL，无效

caiqs

开一个autocad就好,再调用excel,效率很低,运算多的程序运行会很慢

liu_kunlun

不愧为高手！