PureBoard

Code: Alles auswählen

If OpenWindow(0, 0, 0, 300, 30, "Fenster Maus-Monitor", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CreateGadgetList(WindowID(0))
      TextGadget(0, 10, 6, 200, 20, "")
    
    Repeat
      Event = WaitWindowEvent(20) ; kehre mindestens alle 20 ms für ein Update zurück
      
      SetGadgetText(0, "Fenster Maus-Position: " + Str(WindowMouseX(0)) + "," + Str(WindowMouseY(0)))
    Until Event = #PB_Event_CloseWindow
  EndIf

Code: Alles auswählen

If OpenWindow(0, 0, 0, 300, 30, "Fenster Maus-Monitor", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    CreateGadgetList(WindowID(0))
      TextGadget(0, 10, 6, 200, 20, "")
   
    Repeat
      Event = WaitWindowEvent(20) ; kehre mindestens alle 20 ms für ein Update zurück
      wmx=WindowMouseX(0)
      wmy=WindowMouseY(0)
      SetGadgetText(0, "Fenster Maus-Position: " + Str(wmx) + "," + Str(wmy))
      StartDrawing(WindowOutput(0))
        Box(wmx,wmy,1,1,255)
      StopDrawing()
    Until Event = #PB_Event_CloseWindow
  EndIf 

Code: Alles auswählen

EnableExplicit

Declare WndProc(hwnd.l, msg.l, wParam.l, lParam.l)

Define.l hwnd, rc.RECT
Define.s szAppName
Define msg.MSG

szAppName.s = "Fenster"
Define wndclass.WNDCLASS

wndclass\style = #CS_HREDRAW | #CS_VREDRAW
wndclass\lpfnWndProc = @WndProc()
wndclass\cbClsExtra = 0
wndclass\cbWndExtra = 0
wndclass\hInstance = 0
wndclass\hIcon = LoadIcon_(0, #IDI_APPLICATION)
wndclass\hCursor = LoadCursor_(0, #IDC_ARROW)
wndclass\hbrBackground = GetStockObject_(#WHITE_BRUSH)
wndclass\lpszMenuName = 0
wndclass\lpszClassName = @szAppName

If Not RegisterClass_(@wndclass)
	MessageRequester("Fehler", "Fensterklasse nicht registriert")
	End
EndIf

rc\left = 30
rc\top = 50
rc\right = 330
rc\bottom = 350
AdjustWindowRectEx_(@rc, #WS_CAPTION | #WS_SYSMENU, 0, #WS_EX_ACCEPTFILES)
hwnd = CreateWindowEx_(#WS_EX_ACCEPTFILES, szAppName, "Fenstername", #WS_CAPTION | #WS_SYSMENU, rc\left, rc\top, rc\right - rc\left, rc\bottom - rc\top, 0, 0, 0, 0)

If hwnd = 0
	MessageRequester("Fehler", "Fenster konnte nicht geöffnet werden")
	End
EndIf	

ShowWindow_(hwnd, #SW_SHOWNORMAL)
UpdateWindow_(hwnd)

While GetMessage_(msg, 0, 0, 0)
	TranslateMessage_(msg)
	DispatchMessage_(msg)
Wend
End

Procedure.l WndProc(hwnd.l, msg.l, wParam, lParam)
	Protected hdc, ps.PAINTSTRUCT, RPn, APn, OutTxt.s, tm.TEXTMETRIC, ay, rc.RECT
	Static mx, my, mp.POINT
	
	Select msg
		Case #WM_MOUSEMOVE
			GetCursorPos_(@mp)
			ScreenToClient_(hwnd, @mp)
			mx = lParam & $FFFF
			my = lParam >> 16
			InvalidateRect_(hwnd, 0, #True)
			ProcedureReturn 0
			
		Case #WM_PAINT
			If GetUpdateRect_(hwnd, #NULL, #False)
				hdc = BeginPaint_(hwnd, @ps)
				RPn = CreatePen_(#PS_SOLID, 1, RGB(255, 0, 0))
				APn = SelectObject_(hdc, RPn)
				Rectangle_(hdc, 0, 0, 300, 300)
				GetTextMetrics_(hdc, @tm)
				ay = tm\tmHeight + tm\tmExternalLeading + tm\tmInternalLeading
				OutTxt.s = "X: " + Str(mx)
				TextOut_(hdc, 5, 5, @OutTxt, Len(OutTxt))
				OutTxt.s = "Y: " + Str(my)
				TextOut_(hdc, 5, 5 + ay, @OutTxt, Len(OutTxt))
				OutTxt.s = "MX: " + Str(mp\x)
				TextOut_(hdc, 5, 5 + 2 * ay, @OutTxt, Len(OutTxt))
				OutTxt.s = "MY: " + Str(mp\y)
				TextOut_(hdc, 5, 5 + 3 * ay, @OutTxt, Len(OutTxt))
				DeleteObject_(SelectObject_(hdc, APn))
				EndPaint_(hwnd, @ps)
			EndIf
			ProcedureReturn 0
			
		Case #WM_DESTROY
			PostQuitMessage_(0)
			ProcedureReturn 0
	EndSelect
	
	ProcedureReturn DefWindowProc_(hwnd, msg, wParam, lParam)
EndProcedure