[Dukk]

Давно пользуюсь макросом для автоматического переключения языка в MTEXT, DTEXT, MTEDIT, DDEDIT после перехода с win7x32 на win7x64 перестал работать. Помогите исправить. У самого не получается. Макрос не мой взял отсюда http://dwg.ru/dnl/173.

[trir]

Попробуйте Punto Switcher

Как и думал, это WinAPI

Код:

[Выделить все]

Option Explicit

Private Declare Function LoadKeyboardLayout Lib "user32" _
  Alias "LoadKeyboardLayoutA" (ByVal HKL As String, ByVal Flags As Long) As Long

Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)

Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long


Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long


Private Declare Function RegisterHotKey Lib "user32" _
(ByVal hwnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long

Private Declare Function UnregisterHotKey Lib "user32" _
(ByVal hwnd As Long, _
ByVal id As Long) As Long

Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(lpMsg As Msg, _
ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long

Declare Function WaitMessage Lib "user32" () As Long

Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Const KEYEVENTF_KEYUP = &H2

Private Type POINTAPI
    x As Long
    y As Long
End Type


Private Type Msg
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Dim hTimer As Long
Dim TypingMode As Boolean
Dim MHK As Long


Public Function switchToRussian()
On Error Resume Next
  LoadKeyboardLayout "00000419", 1
End Function

Public Function switchToEnglish()
On Error Resume Next
  LoadKeyboardLayout "00000409", 1
End Function

Private Sub StartTimer()
On Error Resume Next
  hTimer = SetTimer(0, 0, 50, AddressOf TimerEvent)
End Sub

Private Sub EndTimer()
On Error Resume Next
  Call KillTimer(0, hTimer)
End Sub

Private Sub TimerEvent()
On Error Resume Next
Dim Message As Msg
 If TypingMode Then
  WaitMessage
  If PeekMessage(Message, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then ' ESC Pressed!
    Call ClearHookOnESC 'Release hotkey
    Call switchToEnglish
    'Call SendKeys("{ESC}") '- This function turn off NumLock unfortunately (when "NumLock calculator" is running)
    'Send ESCAPE to application (alternative method)
    Call keybd_event(vbKeyEscape, 0, 0, 0) 'KeyDown
    Call keybd_event(vbKeyEscape, 0, KEYEVENTF_KEYUP, 0) 'KeyUp
  End If
 End If
End Sub

Public Sub SetHookOnESC()
On Error Resume Next
  TypingMode = True 'set flag
  MHK = RegisterHotKey(Application.hwnd, &HBFFF&, 0, vbKeyEscape) 'Set hotkey (ESCAPE)
  Call StartTimer 'Start timer
End Sub

Public Sub ClearHookOnESC()
On Error Resume Next
  TypingMode = False 'clear flag
  Call EndTimer 'Stop timer
  Call UnregisterHotKey(Application.hwnd, &HBFFF&) 'release
End Sub

[gomer]

Пунто свитчер в танки мешает играть, так что не вариант...

[kifa]

Сообщение от gomer Пунто свитчер в танки мешает играть, так что не вариант...

Добавить танки в исключения пунто свитчера

[aam]

В последних версиях AutoCAD 64-bit по новому объявление функций WinAPI.
вместо Private Declare Function ... нужно Private Declare PtrSafe Function ...

[Boxa]

Сообщение от aam В последних версиях AutoCAD 64-bit по новому объявление функций WinAPI.

Это справедливо только для VBA 7.0 и выше. В VBA 6.5 (Acad 2012x64) так объявить функцию не получится.
Тут подробнее на тему адаптации : http://msdn.microsoft.com/en-us/libr.../gg264421.aspx

А вот как поправить код автора, чтобы он работал на х64 системах и с VBA версии ниже 7,0?

[Dukk]

Сообщение от aam В последних версиях AutoCAD 64-bit по новому объявление функций WinAPI. вместо Private Declare Function ... нужно Private Declare PtrSafe Function ...

Не помогло. Быстро прошелся и повставлял "PtrSafe", все равно прерывает где-то на выполнении "Application.hwnd"

[Boxa]

А тип данных с Long на LongLong Вы тоже поменяли?
Тут понятнее чем в MSDN: http://linkhelp.ucoz.ru/news/oshibka...2013-04-06-204

[aam]

попробуйте
Application.hwnd32

[Dukk]

Boxa спасибо на win7x64+Autocad_2014 работает. Теперь осталось дома посмотреть будет ли работать на win7x64+Autocad2012

[Boxa]

Сообщение от Dukk Теперь осталось дома посмотреть будет ли работать на win7x64+Autocad2012

А дома работать не будет, т.к.

Сообщение от Boxa В VBA 6.5 (Acad 2012x64) так объявить функцию не получится.

и тип данных LongLong там не реализован.