English
Source / code snippets

Window Getcursorpos Getwindowrect Hover mouse Mouse Screentoclient Window Windowfrompoint

 

Julian
Schmidt
many functions around Mouse and Window.
Def SetCursorPos(2)!"User32","SetCursorPos"
Windowstyle 10
Window Title "Beispiel for GetwindowRect, GetCursorPos, ScreenToClient, WindowfromPoint and your Anwendung"
CLS
WindowZ(%hwnd,-1)
Var pic1&=Create("hNewPic", 100, 100, RGB(0,0,255))
Var pic2&=Create("hNewPic", 100, 100, RGB(255,0,0))
Var picbt&=Create("PicButton",%hwnd,0,(width(%hwnd)-100)/2,(height(%hwnd)-100)/2,100,100)
Settext picbt&,"Bildbutton to demonstration one Hoverbuttons with HandleHover"
Var text&=Create("Text",%hwnd,"",0,0,width(%hwnd),16)
Var pos&=Create("Text",%hwnd,"",0,height(%hwnd)-16,width(%hwnd),16)
Var Dlg&=Create("Text",%hwnd,"",0,16,width(%hwnd),16)
Line width(%hwnd)/2,0 - width(%hwnd)/2,height(%hwnd)
User Messages 16

WhileNot (%umessage=16) or iskey(27)

    Waitinput 30
    Sendmessage(picbt&,$F7 | 247,0,If(HandleHover()=picbt&,pic1&,pic2&))'Hover-Button with HandleHover(), alternatively The usage of IsMouseHover()
    Settext text&,IF(IsMouseInDg(%hwnd, 0, 0, width(%hwnd)/2, height(%hwnd))=1,"Maus on linker Page ",IF(IsMouseInDg(%hwnd, width(%hwnd)/2, 0, width(%hwnd), height(%hwnd))=1,"Maus on right Page ","Maus outside the Client_Bereichs of hWnd"))
    Settext pos&, "Position of %hwnd (global): "+Str $(WindowRect(%hwnd,"X1"))+"x"+Str $(WindowRect(%hwnd,"Y1"))
    Settext Dlg&, "Maus over the lever '"+Str $(HandleHover())+"' with the cover '"+Mid$(Gettext$(HandleHover()),1,45)+"...'"
    Settext %hwnd, "CursorPosGlobal: "+Str $(CursorPos("X1"))+"x"+Str $(CursorPos("Y1"))+" - CursorPosLokal on hWnd: "+Str $(CursorPos("X1",%hwnd))+"x"+Str $(CursorPos("Y1",%hwnd))

EndWhile

deleteobject pic1&
deleteobject pic2&
end

Proc IsMouseHover

    Parameters hdl&
    Return Between(CursorPos("X1"), WindowRect(hdl&,"X1"), WindowRect(hdl&,"X2"), CursorPos("Y1"), WindowRect(hdl&,"Y1"), WindowRect(hdl&,"Y2"))

ENDPROC

Proc IsMouseIn

    Parameters x1%,y1%,x2%,y2%
    Return Between(CursorPos("X1"), x1%, x2%, CursorPos("Y1"), y1%, y2%)

ENDPROC

Proc IsMouseInDg

    Parameters hdl&,x1%,y1%,x2%,y2%
    Return Between(CursorPos("X1",hdl&), x1%, x2%, CursorPos("Y1",hdl&), y1%, y2%)

ENDPROC

Proc WindowSize

    Parameters hdl&,x%,y%
    SetWindowPos hdl& = WindowRect(hdl&,"X1"),WindowRect(hdl&,"Y1") - x%,y%

ENDPROC

Proc WindowZ

    Parameters hdl&, mode%
    'mode =  0 : TOP| 1 : BOTTOM | -1 : TOP-MOST | -2 : BOTTOM-MOST
    SetWindowPos hdl& = WindowRect(hdl&,"X1"),WindowRect(hdl&,"Y1") - WindowRect(hdl&,"Breite"),WindowRect(hdl&,"Höhe"); mode%

ENDPROC

Proc HandleHover

    Declare mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Var hdl&=External("USER32","WindowFromPoint",long(mpos#,0),long(mpos#,4))
    Dispose mpos#
    Return hdl&

ENDPROC

Proc HandleHoverPos

    Parameters x&,y&
    Return External("USER32","WindowFromPoint",x&,y&)

ENDPROC

Proc CursorPos

    Parameters mode$
    mode$=Lower$(mode$)
    Declare x%, mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Case @&(2)<>0 : External("USER32","ScreenToClient",@&(2),mpos#)
    Case mode$="x1" : x%=long(mpos#,0)
    Case mode$="y1" : x%=long(mpos#,4)
    Case mode$="x2" : x%=IF(@&(2)<>0,WindowRect(@&(2),"Breite"),%maxx)-long(mpos#,0)
    Case mode$="y2" : x%=IF(@&(2)<>02,WindowRect(@&(2),"Höhe"),%maxy)-long(mpos#,4)
    Dispose mpos#
    Return x%

ENDPROC

Proc WindowRect

    Parameters hdl&,mode$
    mode$=Lower$(mode$)
    Declare x%, b#
    Dim b#,16
    External("USER32", "GetWindowRect",hdl&,b#)
    Case @&(3)<>0 : External("USER32","ScreenToClient",@&(3),b#) : External("USER32","ScreenToClient",@&(3),b#+8)
    Case mode$="breite" : x%=Long(b #,8)-Long(b #,0)
    Case mode$="höhe" : x%=Long(b #,12)-Long(b #,4)
    Case mode$="x1" : x%=Long(b #,0)
    Case mode$="y1" : x%=Long(b #,4)
    Case mode$="x2" : x%=Long(b #,8)
    Case mode$="y2" : x%=Long(b #,12)
    Dispose b#
    Return x%

ENDPROC

Proc Workarea

    Parameters mode$
    mode$=lower$(mode$)
    Declare Rect#,x%
    Dim Rect#,16
    External("User32","SystemParametersInfoA",48,0,Rect#,0)
    case mode$="x1" : x%=Long(Rect#,0)
    case mode$="y1" : x%=Long(Rect#,4)
    case mode$="x2" : x%=Long(Rect#,8)
    case mode$="y2" : x%=Long(Rect#,12)
    Dispose Rect#
    Return x%

ENDPROC


Nachtrag of iF: 

Martin Kempf (21.01.2016)
thanks, super thing, functions.
Info yet: I work with 2 Bildschirmen: The Proc HandleHover produced a crash, if The mouse from the a to that others screen jumping.
 
XProfan X2
˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
02/06/12  
 



i'd of it dissuade Own functions with API-Funktionsnamen To occupy -

so there GetCursorPos (  [...]  ) already and if one z.B. XPSE uses then can simply APIs write without To deklarieren and who likes already dahingehende Kollisionen.
 
02/07/12  
 




E.T.
iF (07.02.12)
... and if one z.B. XPSE uses then can simply APIs write...


Ah, want always The API's so write, How tappt im dunkeln me fallen

but time in the serious: who knows already any API-terms ?? correctly.: XPSE !!
the would I still saponaceous time as Idea for The next XPSE-Version aufgreifen:
Kollisions-control of Function-names with API-Funktionsnamen .

one(n) gönnt itself Yes otherwise nothing, except XProfan & XPSE 
 
Grüße aus Sachsen... Mario
WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte...
02/07/12  
 



These control isn't necessary there one with ~ explizit on API-functions verweisen can, so goes so To discern:

and XPSE can so thoroughly make possible API-gleichnamige Own functions To deklarieren.

my council related hold sooner hereon a Own setPixel-function the better distinction because of sooner z.B. mySetPixel To name
 
02/07/12  
 




Julian
Schmidt
updated
 
XProfan X2
Win7 Professional, SP1, AMD FX(tm)-8350 Eight-Core Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
01/01/13  
 



Martin Kempf (21.01.2016)
thanks, super thing, functions.
Info yet: I work with 2 Bildschirmen: The Proc HandleHover produced a crash, if The mouse from the a to that others screen jumping.
 
01/21/16  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

14.277 Views

Untitledvor 0 min.
H.Brill vor 20 Tagen
Rainer Hoefs04/29/23
RudiB.09/12/22
p.specht11/18/21
More...

Themeninformationen

this Topic has 3 subscriber:

iF (3x)
Julian Schmidt (2x)
E.T. (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie