Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Unicode textbox Добавлено: 03.01.10 01:54  

Автор вопроса:  Winand | Web-сайт: winandfx.narod.ru
У кого нибудь есть сабж? И чтобы зависимости никакой. От WinForms.
Хочу сделать на апи. Столкнулся с проблемой такого характера: пытаюсь сделать сабклассинг через асм. Ну тот что sne где-то стырил. В юзерконтроле текстбокс вообще перестаёт реагировать на что либо, а в классе перестаёт отрисовываться, хотя сообщения системы до него доходят.

Ответить

  Ответы Всего ответов: 2  

Номер ответа: 1
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #1 		Добавлено: 03.01.10 01:58
Класс
  1. Option Explicit
  2. Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, _
  3.                         ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
  4.                         ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
  5.                         ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  6. Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
  7. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  8. Private Const GWL_WNDPROC As Long = -4
  9. Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  10. Private Const WS_EX_WINDOWEDGE As Long = &H100&
  11. Private Const WS_EX_CLIENTEDGE As Long = &H200&
  12. Private Const WS_EX_OVERLAPPEDWINDOW As Long = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
  13. Private Const WS_VISIBLE As Long = &H10000000
  14. Private Const WS_CHILD As Long = &H40000000
  15. Private Const ES_AUTOHSCROLL As Long = &H80&
  16. Private Const ES_NOHIDESEL As Long = &H100&
  17. Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  18. Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
  19. Private ASMArr() As Byte
  20. Private editproc As Long
  21. Private editwnd As Long
  22.  
  23. Public Function EditWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  24.     Debug.Print uMsg
  25.     Select Case uMsg
  26. '    Case WM_COPYDATA:
  27. '        Call CopyMemory(cds, ByVal lParam, Len(cds))
  28. '        ReDim buf(cds.cbData - 1) As Byte
  29. '        Call CopyMemory(buf(0), ByVal cds.lpData, cds.cbData)
  30. '        If Not audicaLoaded Then
  31. '            commandBuffer.Add buf
  32. '        Else
  33. '            qDebug "WM_COPYDATA from hInstance=" & wParam, time
  34. '            LoadFromCommand buf
  35. '            Form1.show
  36. '        End If
  37. '    Case WM_WHEEL:
  38. '        For Each obj In notifyWheel
  39. '            Call obj.slotNotifyWheel(lParam, getModificators)
  40. '        Next obj
  41. '    Case WM_KEYS:
  42. '        kbd_presses = IIf(lParam > 0, True, False)
  43. '        For Each obj In keyboardPress
  44. '            Call obj.slotKeyboardPress(kbd_presses)
  45. '        Next obj
  46. '    Case WM_REGHOOK:
  47. '        qDebug "Hook tool resposed", lParam
  48. '        hookwnd = lParam
  49.     End Select
  50.     EditWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
  51. End Function
  52.  
  53. 'Private Sub UserControl_Resize()
  54. '    MoveWindow editwnd, 0, 0, ScaleWidth, ScaleHeight, 1
  55. 'End Sub
  56.  
  57. Private Sub StartSubclass(ByRef ASM() As Byte, ByVal hwnd As Long, ByRef OldWndProc As Long, Optional ByVal ProcNumber As Long)                 ' Сабклассинг с пом. ASM (автора не знаю...)
  58.     Dim lng As Long, tPtr As Long
  59.     lng = Len(AsmMain) \ 2&
  60.  
  61.     ReDim ASM(0 To lng - 1)
  62.  
  63.     For lng = 0 To lng - 1
  64.         ASM(lng) = val("&H" & Mid$(AsmMain, (lng) * 2& + 1, 2&))
  65.     Next
  66.  
  67.     Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
  68.     Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
  69.  
  70.     Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
  71.     Call CopyMemory(ASM(28), lng, 4&)
  72.  
  73.     OldWndProc = SetWindowLong(hwnd, &HFFFC, VarPtr(ASM(0)))
  74. End Sub
  75.  
  76. Private Sub StopSubclass(ByVal hwnd As Long, ByVal OldWndProc As Long)
  77.     Call SetWindowLong(hwnd, &HFFFC, OldWndProc)
  78. End Sub
  79.  
  80.  
  81. Private Sub Class_Initialize()
  82.     editwnd = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, ByVal StrPtr("EDIT"), _
  83.                 ByVal StrPtr(""), WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NOHIDESEL, _
  84.                 0, 0, Form1.ScaleWidth, 20, Form1.hwnd, 0, App.hInstance, ByVal 0&)
  85.     Call StartSubclass(ASMArr, editwnd, editproc)
  86. End Sub
  87.  
  88. Private Sub Class_Terminate()
  89.     If editproc Then
  90.         Call StopSubclass(editwnd, editproc)
  91.         editproc = 0
  92.     End If
  93.     DestroyWindow editwnd
  94. End Sub


UserControl (сабклассинг врубается по UserControl_Click, ибо в UserControl_Initialize крашится ide, когда я нахожусь в дизайн-тайм, а узнать в той же процедуре design это тайм или run нельзя, потому что объект Ambient еще не создан или типа того)
  1. Option Explicit
  2. Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, _
  3.                         ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
  4.                         ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
  5.                         ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  6. Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
  7. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  8. Private Const GWL_WNDPROC As Long = -4
  9. Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  10. Private Const WS_EX_WINDOWEDGE As Long = &H100&
  11. Private Const WS_EX_CLIENTEDGE As Long = &H200&
  12. Private Const WS_EX_OVERLAPPEDWINDOW As Long = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
  13. Private Const WS_VISIBLE As Long = &H10000000
  14. Private Const WS_CHILD As Long = &H40000000
  15. Private Const ES_AUTOHSCROLL As Long = &H80&
  16. Private Const ES_NOHIDESEL As Long = &H100&
  17. Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  18. Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
  19. Private ASMArr() As Byte
  20. Private editproc As Long
  21. Private editwnd As Long
  22.  
  23. Public Function EditWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  24. '    Debug.Print uMsg
  25.     Select Case uMsg
  26. '    Case WM_COPYDATA:
  27. '        Call CopyMemory(cds, ByVal lParam, Len(cds))
  28. '        ReDim buf(cds.cbData - 1) As Byte
  29. '        Call CopyMemory(buf(0), ByVal cds.lpData, cds.cbData)
  30. '        If Not audicaLoaded Then
  31. '            commandBuffer.Add buf
  32. '        Else
  33. '            qDebug "WM_COPYDATA from hInstance=" & wParam, time
  34. '            LoadFromCommand buf
  35. '            Form1.show
  36. '        End If
  37. '    Case WM_WHEEL:
  38. '        For Each obj In notifyWheel
  39. '            Call obj.slotNotifyWheel(lParam, getModificators)
  40. '        Next obj
  41. '    Case WM_KEYS:
  42. '        kbd_presses = IIf(lParam > 0, True, False)
  43. '        For Each obj In keyboardPress
  44. '            Call obj.slotKeyboardPress(kbd_presses)
  45. '        Next obj
  46. '    Case WM_REGHOOK:
  47. '        qDebug "Hook tool resposed", lParam
  48. '        hookwnd = lParam
  49.     End Select
  50.     EditWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
  51. End Function
  52.  
  53. Private Sub UserControl_Click()
  54.  Call StartSubclass(ASMArr, editwnd, editproc)
  55. End Sub
  56.  
  57. Private Sub UserControl_Initialize()
  58.     
  59.     editwnd = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, ByVal StrPtr("EDIT"), _
  60.             ByVal StrPtr(""), WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NOHIDESEL, _
  61.             0, 0, ScaleWidth, ScaleHeight, hwnd, 0, App.hInstance, ByVal 0&)
  62. '    If Not UserControl.Ambient.UserMode Then Call StartSubclass(ASMArr, editwnd, editproc)
  63. '    SetWindowLong editwnd, GWL_WNDPROC, AddressOf EditWindowProc
  64. 'Debug.Print "Edit created", Now
  65. End Sub
  66.  
  67. Private Sub UserControl_InitProperties()
  68. '    editwnd = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, ByVal StrPtr("EDIT"), _
  69. '            ByVal StrPtr(""), WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NOHIDESEL, _
  70. '            0, 0, ScaleWidth, ScaleHeight, hwnd, 0, App.hInstance, ByVal 0&)
  71. '    If Not Ambient.UserMode Then Call StartSubclass(ASMArr, editwnd, editproc)
  72. End Sub
  73.  
  74. Private Sub UserControl_Resize()
  75.     MoveWindow editwnd, 10, 0, ScaleWidth, ScaleHeight, 1
  76. End Sub
  77.  
  78. Private Sub UserControl_Terminate()
  79.     If editproc Then
  80.         Call StopSubclass(editwnd, editproc)
  81.         editproc = 0
  82.     End If
  83.     DestroyWindow editwnd
  84. 'Debug.Print "Edit destroyed", Now
  85. End Sub
  86.  
  87. Private Sub StartSubclass(ByRef ASM() As Byte, ByVal hwnd As Long, ByRef OldWndProc As Long, Optional ByVal ProcNumber As Long)                 ' Сабклассинг с пом. ASM (автора не знаю...)
  88.     Dim lng As Long, tPtr As Long
  89.     lng = Len(AsmMain) \ 2&
  90.  
  91.     ReDim ASM(0 To lng - 1)
  92.  
  93.     For lng = 0 To lng - 1
  94.         ASM(lng) = val("&H" & Mid$(AsmMain, (lng) * 2& + 1, 2&))
  95.     Next
  96.  
  97.     Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
  98.     Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
  99.  
  100.     Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
  101.     Call CopyMemory(ASM(28), lng, 4&)
  102.  
  103.     OldWndProc = SetWindowLong(hwnd, &HFFFC, VarPtr(ASM(0)))
  104. End Sub
  105.  
  106. Private Sub StopSubclass(ByVal hwnd As Long, ByVal OldWndProc As Long)
  107.     Call SetWindowLong(hwnd, &HFFFC, OldWndProc)
  108. End Sub

Ответить

Номер ответа: 2
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | | #2 		Добавлено: 04.01.10 13:06
кароч написал класс. Единственная странность - пришлось в resize главной формы поставить Refresh, иначе проблемы с отрисовкой формы при maximize\restore. Ну и еще не могу сделать выделение текста при получении фокуса

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам