Я пытался создать очень простую игру 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