Не удается получить GetWindowRect для возврата правильных размеров окна в PowerPoint - PullRequest
0 голосов
/ 09 февраля 2020

Я пытался создать очень простую игру PowerPoint, в которой я могу щелкнуть изображение в презентации, переместить его по экрану, а затем щелкнуть его еще раз, чтобы остановить и оставить его в новом положении (щелкните и перетащите).

Я запустил игру в полноэкранном режиме, однако, когда я пытаюсь открыть окно, у кода возникают проблемы с определением размера и положения окна, если оно не касается верхней части экрана.

Код использует GetCursorPos для получения позиции курсора, затем использует WindowFromPoint для выбора окна PowerPoint и затем GetWindowRect для получения верхнего, нижнего, левого и правого размеров окна.

Я считаю, что Проблема в том, что функция GetWindowRect на весь экран возвращает разрешение одного из моих экранов, как и должно быть. если окно касается верхней части экрана, оно также кажется правильным, однако, если окно просто плавает где-то на одном из экранов, оно возвращает объединенное разрешение обоих моих мониторов.

Код ниже:

  Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long


  Type POINTAPI
     X_Pos As Long
     Y_Pos As Long
  End Type

  Public Type RECT
    lleft As Long
    ltop As Long
    lright As Long
    lbottom As Long
  End Type

  Private movemode As Boolean

  Sub Get_Cursor_Pos(gamepiece As Shape)

  movemode = Not movemode ' toggles gamepiece movement on and off by clicking the shape

  While movemode = True

  Dim mwind As Long ' handle for the selected window
  Dim WR As RECT ' window coordinates
  Dim ox As Long
  Dim oy As Long
  Dim mousepos As POINTAPI 'Dimension the variable that will hold the x and y cursor positions

  GetCursorPos mousepos 'Place the cursor positions in variable mousepos
  mwind = WindowFromPoint(mousepos.X_Pos, mousepos.Y_Pos)
  GetWindowRect mwind, WR

  ox = WR.lleft ' sets the origin point of the screen
  oy = WR.ltop

  scalex = (WR.lright - WR.lleft) / ActivePresentation.PageSetup.SlideWidth ' sets the scale factor to relate the powerpoint window to the screen
  scaley = (WR.lbottom - WR.ltop) / ActivePresentation.PageSetup.SlideHeight

  gamepiece.Left = ((mousepos.X_Pos - ox) / scalex) - (gamepiece.Width / 2) ' moves the game piece to the mouse location
  gamepiece.Top = ((mousepos.Y_Pos - oy) / scaley) - (gamepiece.Height / 2)


  'for trouble shooting
  gamepiece.TextFrame.TextRange = "ox:" + CStr(mwind) + " oy:" + CStr(oy) + "scalex:" + CStr(scaley) + " scaley:" + CStr(scalex) + "wrt:" + CStr(WR.ltop) + " wrbt:" + CStr(WR.lbottom) + "wrl:" + CStr(WR.lleft) + " wrri:" + CStr(WR.lright) + " slide size:" + CStr(ActivePresentation.PageSetup.SlideSize) + "img width:" + CStr(gamepiece.Width)

  DoEvents ' keeps live rather than crashing
  Wend
  End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...