Текст:Frontpage:Как установить макросом положение курсора

Материал из свободной русской энциклопедии «Традиция»
Перейти к навигации Перейти к поиску

Задача и решение[править | править код]

При написании различных расширений, вспомогательных макросов для Frontpage, часто возникает задача установить (из макроса), положение (строку и столбец) курсора в окне редактирования. Например, если вызывать различные внешние валидаторы, то при ошибке, нужно точно позиционировать пользователя на ее предполагаемое место. К сожалению, открытое API не позволяет этого сделать. Однако есть несколько обходной, хакерский путь.

Суть его состоит в том, чтобы «найти» правильный идентификатор самого глубокого вложенного окна редактирования Frontpage (эвристическая процедура GetFrontpage2002Hwnd, как следует из ее названия работает с «Frontpage 2002» и для других версий, возможно потребует адаптации), и, посылая ему клавиатурные сообщения, отпозиционироваться сначала в начало первой строки, а затем, «клавишами» вниз и вправо, переползти на нужную колонку нужной строки.

Код[править | править код]

<code-vb> Option Explicit '**************************************************************** 'some Windows API -based hacks and heuristics for Frontpage 2002 '---------------------------------------------------------------- '(c) 2003 Stas Fomin '****************************************************************

'Not all declared API functions are used here... Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long Private Declare Function PostThreadMessage Lib "user32.dll" Alias "PostThreadMessageA" (ByVal idThread As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long

Private Declare Function PostThreadMessageA Lib "user32.dll" (ByVal idThread As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function PostThreadMessageW Lib "user32.dll" (ByVal idThread As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long


Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'to get hwnd handle from callback functions Public g_hwnd As Long


'Keys and messages Const WM_SETFOCUS As Long = &H7 Const WM_KEYDOWN As Long = &H100 Const WM_KEYUP As Long = &H101 Const VK_CONTROL As Long = &H11 Const VK_HOME As Long = &H24 Const VK_RIGHT As Long = &H27 Const VK_DOWN As Long = &H28 Const WS_VISIBLE = &H10000000 Const GWL_STYLE = (-16)


'Heuristic for determine Frontpage 2002 Hwnd handle 'It did not tested for others versions of FP, ' but I think can be easy adapted for them. Public Function GetFrontpage2002Hwnd() As Long Dim hwnd As Long Dim ls_caption As String GetFrontpage2002Hwnd = 0

ls_caption = Application.ActiveWebWindow.Caption hwnd = FindWindow("FrontPageExplorerWindow40", ls_caption) If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "AfxMDIFrame42", "") If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "AfxWnd42", "") If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "AfxMDIFrame42", "") If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "AfxFrameOrView42", "") If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "AfxFrameOrView42", "") If hwnd = 0 Then Exit Function


'hATLWnd = FindWindowEx(hWnd, 0, "ATL:33957BC0", "") Call EnumChildWindows(hwnd, AddressOf FindVisibleWindow, &H0) hwnd = g_hwnd If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "FrontPageEditorDocumentFrame", "") If hwnd = 0 Then Exit Function

Dim hWndChild As Long

hWndChild = FindWindowEx(hwnd, 0, "AfxFrameOrView42", "") If hWndChild = 0 Then Exit Function

While (hWndChild <> 0) And ((GetWindowLong(hWndChild, GWL_STYLE) And WS_VISIBLE) <> WS_VISIBLE)

   hWndChild = FindWindowEx(hwnd, hWndChild, "AfxFrameOrView42", "")

Wend hwnd = hWndChild If hwnd = 0 Then Exit Function

hwnd = FindWindowEx(hwnd, 0, "RichEdit20W", "") If hwnd = 0 Then Exit Function

GetFrontpage2002Hwnd = hwnd End Function


'Heuristic for setting line and column in HTML-view ' of FP. (HTML-view must be active). Public Sub SetFrontpageLineAndCol(li_line As Long, li_col As Long)

  If li_line < 0 Then Exit Sub
  If li_col < 0 Then li_col = 0
  Dim hwnd As Long
  hwnd = GetFrontpage2002Hwnd()
  If hwnd = 0 Then Exit Sub
  
  Dim l_lparam As Long
  Dim l_wparam As Long
  Dim l_res As Long
  l_lparam = &H24
  l_wparam = &H1470001
  l_res = PostMessage(hwnd, WM_KEYDOWN, l_lparam, l_wparam)

'Sending a burst of PageUp's for parking in line 1, col 1 'I failed to use Ctrl-Home for this purpose

  l_lparam = &H21
  l_wparam = &H1490001
  Dim i As Long
  For i = 1 To 10
      l_res = PostMessage(hwnd, WM_KEYDOWN, l_lparam, l_wparam)
  Next

'Sending some DOWN_ARROW for positioning the line

  If li_line > 1 Then
      l_lparam = &H28
      l_wparam = &H1500001
      For i = 1 To li_line - 1
          l_res = PostMessage(hwnd, WM_KEYDOWN, l_lparam, l_wparam)
      Next
  End If
   

'Sending some RIGHT_ARROW for positioning the column

  If li_col > 1 Then
       l_lparam = &H27
       l_wparam = &H14D0001
       For i = 1 To li_col - 1
          l_res = PostMessage(hwnd, WM_KEYDOWN, l_lparam, l_wparam)
       Next
  End If

End Sub


'Callback function, for selecting first child visible window Private Function FindVisibleWindow(ByVal hwnd As Long, ByVal lParam As Long) As Long

  FindVisibleWindow = 1
  g_hwnd = 0
  If IsWindowVisible(hwnd) Then
       g_hwnd = hwnd
       FindVisibleWindow = 0
  End If

End Function

</code-vb>
По крайней мере часть этого текста взята с ресурса http://lib.custis.ru/ под лицензией GDFL.Список авторов доступен на этом ресурсе в статье под тем же названием.