move a label with the mouse at runtime

Windows specific questions.
Post Reply
Jermy
Posts: 14
Joined: Apr 12, 2016 10:29

move a label with the mouse at runtime

Post by Jermy »

how can I move and resize a label on a form with the mouse?
I can do this with a button, but not with a label
Xusinboy Bekchanov
Posts: 783
Joined: Jul 26, 2018 18:28

Re: move a label with the mouse at runtime

Post by Xusinboy Bekchanov »

Jermy wrote:how can I move and resize a label on a form with the mouse?
I can do this with a button, but not with a label
Show the code and we will help you. For the label and button, the code must be the same.
Jermy
Posts: 14
Joined: Apr 12, 2016 10:29

Re: move a label with the mouse at runtime

Post by Jermy »

I made an example with the problem.
There are two controls on the form, only the button can be moved and resized.
the label is not movable

Code: Select all


#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

const ID_BUTTON = 1000
const ID_LABEL = 1001


DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
Declare FUNCTION ButtonProc ( BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM, BYVAL uIdSubclass AS UINT_PTR, BYVAL dwRefData AS DWORD_PTR ) AS LRESULT
Declare Function HitTest(Byval hCtl As HWND, Byval lParam As LPARAM) As Integer

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   pWindow.Create(NULL, "Moving controls at runtime", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(500, 320)
   ' // Centers the window
   pWindow.Center

   ' // Adds a button
  ' pWindow.AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)

   pWindow.AddControl ( "Button", _                       
                                                   pWindow.hWindow, _                                    
                                                    ID_BUTTON, _                                           
                                                   "&Button", _                                   
                                                   250, _                                               
                                                   150, _                                               
                                                   75, _
                                                   23, _ 
                                                   -1, _ 
                                                   -1, _ 
                                                   Null, _                                  
                                                  CAST(SUBCLASSPROC, @ButtonProc ),  ID_BUTTON, CAST(DWORD_PTR, @pWindow)) 
                                                  
   pWindow.AddControl ( "Label", _                       
                                                   pWindow.hWindow, _                                    
                                                   ID_LABEL, _                                           
                                                   "&Label", _                                   
                                                   350, _                                               
                                                   250, _                                               
                                                   75, _
                                                   23, _ 
                                                   -1, _ 
                                                   -1, _ 
                                                   Null, _                                  
                                                  CAST(SUBCLASSPROC, @ButtonProc ), ID_LABEL, CAST(DWORD_PTR, @pWindow)) 

   ' // Displays the window and dispatches the Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' handles run-time controls
' ButtonProc used for the button and label
' ========================================================================================
FUNCTION ButtonProc ( BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM, BYVAL uIdSubclass AS UINT_PTR, BYVAL dwRefData AS DWORD_PTR ) AS LRESULT
     
    Select Case uMsg
         
              
    Case WM_LBUTTONDOWN

              ReleaseCapture()
              SendMessage(Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
              Return 0
         
    Case WM_EXITSIZEMOVE
         
         Dim  Rect as RECT
            GetWindowRect(hWnd, @Rect)
            MapWindowPoints(HWND_DESKTOP, GetParent(hwnd), Cast(LPPOINT, @Rect), 2)
           
                   
    Case WM_LBUTTONDBLCLK
                           MessageBox(Hwnd, "WM_LBUTTONDBLCLK",   "some tekst" , MB_OK)
            Return 0
     
    Case WM_RBUTTONDOWN
             .DestroyWindow(Hwnd)
             Return 0
       
    Case WM_NCHITTEST
             Return HitTest(Hwnd,lParam)
       
    Case WM_DESTROY
             RemoveWindowSubclass( Hwnd, @ButtonProc, uIdSubclass)  
     
    End Select
     
    FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)
End Function


' ========================================================================================
' detects location of mouse in object, makes moveing controls allowd
' HitTest(hControl, lParam)
' ========================================================================================
Function HitTest(Byval hCtl As HWND, Byval lParam As LPARAM) As Integer

    Static pt As Point

    Static rc As RECT

    pt.x = Loword(lparam)
    pt.y = Hiword(lparam)

    ScreenToClient (hCtl, @pt)
    GetWindowRect  (hCtl, @rc)

    MapWindowPoints(HWND_DESKTOP, GetParent(hCtl), Cast(LPPOINT,@rc), 2)

    If pt.y < 4 And pt.x < 4 Then

        Return HTTOPLEFT
    Elseif pt.y < 4 And pt.x >= (rc.right - rc.left - 4) Then

        Return HTTOPRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) And pt.x >= (rc.right - rc.left - 4) Then

        Return HTBOTTOMRIGHT
    Elseif pt.x < 4 And pt.y >= (rc.bottom - rc.top - 4) Then

        Return HTBOTTOMLEFT
    Elseif pt.y < 4 Then

        Return HTTOP
    Elseif pt.x < 4 Then

        Return HTLEFT
    Elseif pt.x >= (rc.right - rc.left - 4) Then

        Return HTRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) Then

        Return HTBOTTOM
    Else

        Return HTCLIENT
    End If

End Function


' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg
      
    	CASE WM_DESTROY
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION
      
   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: move a label with the mouse at runtime

Post by dodicat »

I don't have "Afx/CWindow.inc"
But, roughly, in the win api.
I have set the window theme to XP for win 10.

Code: Select all

#include "windows.bi"
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long

Function WndProc(hwnd As hwnd, message As uint, wParam As wparam, lParam As lparam) As Integer
    #define inbox point_.x>mainrect.left And point_.x<mainrect.right And point_.y> mainrect.top And point_.y<mainrect.bottom
    Static As HWND label
    Static As Long flag
    Static As Integer cxclient,cyclient
    Static As rect rect, MainRect
    Static As Point point_
    Static As Point  curpoint
    Select Case message
    
    Case WM_CREATE
        label = CreateWindowex(0,"static", "Static moveable child window", WS_VISIBLE Or WS_CHILD , 50, 50, 50, 50, hwnd, NULL, NULL, NULL)
        
    Case WM_SIZE
        cxClient = Loword(lParam)
        cyClient = Hiword(lParam)
        SetWindowPos(label, NULL, cxClient/3,cyClient/4,cxClient/5,cyClient/2, SWP_SHOWWINDOW)
        
    Case WM_DESTROY
        PostQuitMessage(0)
        
    Case WM_LBUTTONDOWN
        flag=1
        GetWindowRect(label,@MainRect)
        GetCursorPos(@point_)
        
    Case WM_LBUTTONUP
        flag=0
        
    Case WM_MOUSEMOVE
        GetCursorPos(@curpoint)
        If flag And inbox Then
            GetWindowRect(hwnd, @Rect)
            Var dx=curpoint.x-rect.left-(cxClient/5)*.5
            Var dy=curpoint.y-rect.top -(cyClient/2)*.5
            MoveWindow(label, dx, dy,MainRect.right - MainRect.left, MainRect.bottom - MainRect.top,true)
        End If
        
    End Select
    Return DefWindowProc(hwnd, message, wParam, lParam)
End Function

Function WinMain ( Byval hInstance As HINSTANCE, _
    Byval hPrevInstance As HINSTANCE, _
    Byval szCmdLine As zstring Ptr, _
    Byval iCmdShow As Integer ) As Integer    
    
    Dim wMsg As MSG
    Dim wcls As WNDCLASS     
    Dim hWnd As HWND
    
    Function = 0
    
    With wcls
    	.style         = CS_HREDRAW Or CS_VREDRAW
    	.lpfnWndProc   = @WndProc
    	.cbClsExtra    = 0
    	.cbWndExtra    = 0
    	.hInstance     = hInstance
    	.hIcon         = LoadIcon( NULL, IDI_APPLICATION )
    	.hCursor       = LoadCursor( NULL, IDC_ARROW )
    	.hbrBackground = GetStockObject( WHITE_BRUSH )
    	.lpszMenuName  = NULL
    	.lpszClassName = @"Main Window"
    End With
    
    If( RegisterClass( @wcls ) = FALSE ) Then
        MessageBox( null, "Failed to register wcls", "Error", MB_ICONERROR )
        Exit Function
    End If
    
    hWnd = CreateWindowEx( 0, _
    @"Main window", _
    "Resizable window", _
    WS_OVERLAPPEDWINDOW, _
    CW_USEDEFAULT, _
    CW_USEDEFAULT, _
    1024, _
    768, _
    NULL, _
    NULL, _
    hInstance, _
    NULL )
    
    ShowWindow( hWnd, iCmdShow )
    UpdateWindow( hWnd )
    SetWindowTheme(hwnd," "," ")
    While( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )    
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    Wend
    
    Function = wMsg.wParam
    
End Function

WinMain( GetModuleHandle( null ), null, Command( ), SW_NORMAL ) 
bfuller
Posts: 362
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Re: move a label with the mouse at runtime

Post by bfuller »

@ Dodicat
you are a very clever fellow!
Jermy
Posts: 14
Joined: Apr 12, 2016 10:29

Re: move a label with the mouse at runtime

Post by Jermy »

Thx for the example

It will take some puzzling to get it working with afx, but I'll figure it out
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: move a label with the mouse at runtime

Post by dodicat »

I got afx, I see what your problem is.
I also tried briefly winapi simulating the afx method.
I had a similar problem, the static child behaves differently from the button or edit box, even with SS_NOTIFY flag, which lets a static window
behave like a button.

pWindow.AddControl ( "static", _
pWindow.hWindow, _
ID_LABEL, _
"&Label", _
350, _
250, _
75, _
23, _
WS_VISIBLE Or WS_CHILD Or SS_NOTIFY , _
-1, _
Null, _
CAST(SUBCLASSPROC, @ButtonProc ), ID_LABEL, CAST(DWORD_PTR, @pWindow))

Perhaps Josep Roca will come up with an alternative.

@bfuller
I am stuck for words.
Jermy
Posts: 14
Joined: Apr 12, 2016 10:29

Re: move a label with the mouse at runtime

Post by Jermy »

I hope there aren't more controls showing this weird behavior.
I want to create a script generator that displays the numbers and settings after drawing out.
I'll investigate further with spy ++ when I have the time
Jermy
Posts: 14
Joined: Apr 12, 2016 10:29

Re: move a label with the mouse at runtime

Post by Jermy »

I found some time to make a little demo.

Code: Select all

#define UNICODE
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Win/commctrl.bi"

' // Forward declarations
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)


DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
declare FUNCTION StaticProc ( BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM, BYVAL uIdSubclass AS UINT_PTR, BYVAL dwRefData AS DWORD_PTR ) AS LRESULT
declare Function HitTest(Byval hCtl As HWND, Byval lParam As LPARAM) As Integer

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG


   DIM wcexw AS WNDCLASSEXW
   DIM hWnd AS HWND
   DIM wszClassName AS WSTRING  *Len("Hello Win" ) +1 = "Hello Win"  

   FUNCTION = 0


Dim wcx AS WNDCLASSEXW, wAtom as atom     
          wcx.cbSize                  = Sizeof(WNDCLASSEXW)
          wcx.style                      = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
          wcx.lpfnWndProc        = @WndProc
       '  wcx.cbClsExtra            = 0
       '  wcx.cbWndExtra          = NULL
          wcx.hInstance              = hInstance
          wcx.hbrBackground      = Cast(HBRUSH, NULL +1)  
       '  wcx.lpszMenuName     = NULL
          wcx.lpszClassName     = @wszClassName
          wcx.hIcon                     = LoadIcon(NULL, IDI_APPLICATION)
          wcx.hCursor                 = LoadCursor(NULL, IDC_ARROW)
          wcx.hIconSm               = LoadIcon(NULL, IDI_APPLICATION)
          wAtom = RegisterClassExW(@wcx)  



   ' // Create a window using the registered class
   hwnd = CreateWindowExW(WS_EX_CONTROLPARENT, _            ' extended style
                              wszClassName, _                           ' window class name
                              "Freebasic Demo", _                   ' window caption
                              WS_VISIBLE Or WS_OVERLAPPEDWINDOW OR WS_CLIPCHILDREN, _                ' window style
                              CW_USEDEFAULT, _                  ' initial x position
                              CW_USEDEFAULT, _                  ' initial y position
                              CW_USEDEFAULT, _                  ' initial x nSize
                              CW_USEDEFAULT, _                  ' initial y nSize
                              NULL, _                                              ' parent window handle
                              0, _                                                  ' window menu handle
                              hInstance, _                                    ' program instance handle
                              NULL)                                                 ' creation parameters


   dim label as HWND  ' or WS_BORDER
        label = CreateWindowex(WS_EX_CLIENTEDGE, WC_STATIC, "Static 1001", WS_VISIBLE Or WS_CHILD, 50, 50, 200, 50, hwnd, NULL, NULL, NULL)
        SetWindowSubclass label, @StaticProc, 1001, 0

   dim hbutton as HWND
        hbutton = CreateWindowex(0,"Button", "Button 1002", WS_VISIBLE Or WS_CHILD , 150, 150, 200, 50, hwnd, NULL, NULL, NULL)
       SetWindowSubclass hbutton, @StaticProc, 1002, 0

   ' // Dispatch Windows messages
   DIM uMsg AS MSG
   WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
      IF IsDialogMessageW(hWnd, @uMsg) = 0 THEN
         TranslateMessage(@uMsg)
         DispatchMessageW(@uMsg)
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' handles run-time controls
' StaticProc used for the button and label
' ========================================================================================
FUNCTION StaticProc ( BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM, BYVAL uIdSubclass AS UINT_PTR, BYVAL dwRefData AS DWORD_PTR ) AS LRESULT
    
    Select Case uMsg

         case WM_WINDOWPOSCHANGING
          
'          lParam '  A pointer to a WINDOWPOS structure that contains information about the window's new size and position.
' https://docs.microsoft.com/en-us/windows/win32/winmsg/wm-windowposchanging
     
'                          dim rect as RECT
'                GetClientRect(hwnd, @rect)
''                InvalidateRect(hwnd, @rect, TRUE)
                InvalidateRect(hwnd, NULL, TRUE)
'         case WM_EXITSIZEMOVE
'         case WM_NCMOUSEMOVE
         case WM_SETCURSOR
             select case  (LOWORD(lParam))    
'                case HTTOP:                     SetCursor(LoadCursor(NULL, IDC_SIZENS)):         return TRUE
'                case HTBOTTOM:             SetCursor(LoadCursor(NULL, IDC_SIZENS)):         return TRUE
'                case HTLEFT:                    SetCursor(LoadCursor(NULL, IDC_SIZEWE)):        return TRUE
'                case HTRIGHT:                  SetCursor(LoadCursor(NULL, IDC_SIZEWE)):        return TRUE
'                case HTTOPLEFT:             SetCursor(LoadCursor(NULL, IDC_SIZENWSE)):   return TRUE
'                case HTBOTTOMRIGHT:   SetCursor(LoadCursor(NULL, IDC_SIZENWSE)):   return TRUE
'                case HTTOPRIGHT:           SetCursor(LoadCursor(NULL, IDC_SIZENESW)):   return TRUE 
'                case HTBOTTOMLEFT:     SetCursor(LoadCursor(NULL, IDC_SIZENESW)):   return TRUE 
                case HTCLIENT:                SetCursor(LoadCursor(NULL, IDC_SIZEALL)):        return TRUE
'                case HTCAPTION
'                case HTSYSMENU
'                case HTMENU
'                case else :
		     end select	

'         case WM_NCPAINT
'         case WM_ERASEBKGND
'         case WM_WINDOWPOSCHANGED
'         case WM_MOVE
'         case WM_MOVING
'         case WM_CAPTURECHANGED
'         case WM_CHILDACTIVATE
'         case WM_MOUSEMOVE
'         case WM_NCCALCSIZE
'         case WM_SIZE
'         case WM_SIZING
'         case WM_MOUSEACTIVATE
'         case WM_GETDLGCODE
'         case WM_SYSCOMMAND
'         case WM_GETMINMAXINFO
'         case WM_ENTERSIZEMOVE
'         case WM_MOUSEACTIVATE
'         case WM_SYSCOMMAND
'         case WM_GETMINMAXINFO
'         case WM_ENTERSIZEMOVE             
'         case BM_SETSTYLE   
'         case WM_PAINT
                 
         case WM_NCLBUTTONDOWN
                 select case(wParam)
                        case HTTOP:                      SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_TOP, lParam)
                        case HTBOTTOM:              SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_BOTTOM, lParam)
                        case HTLEFT:                    SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_LEFT, lParam)
                        case HTRIGHT:                  SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_RIGHT, lParam)
                        case HTTOPLEFT:             SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_TOPLEFT, lParam)
                        case HTTOPRIGHT:           SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_TOPRIGHT, lParam)
                        case HTBOTTOMLEFT:     SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_BOTTOMLEFT, lParam)
                        case HTBOTTOMRIGHT:   SendMessage(hWnd, WM_SYSCOMMAND, SC_SIZE or WMSZ_BOTTOMRIGHT, lParam)
                        case else                
                 end select   
            return 0 
         
         Case WM_LBUTTONDOWN
                 SendMessageW(Hwnd, WM_SYSCOMMAND, SC_MOVE  or HTCAPTION, null)
            Return 0
           
         Case WM_LBUTTONDBLCLK
                 MessageBox(Hwnd, "WM_LBUTTONDBLCLK",   "Control ID: " & Cast(long,uIdSubclass)  , MB_OK)
            Return 0
   
         Case WM_RBUTTONDOWN
                 DestroyWindow(Hwnd)
            Return 0
            
         Case WM_NCHITTEST
            Return HitTest(Hwnd,lParam)
            
         Case WM_DESTROY
             RemoveWindowSubclass( Hwnd, @StaticProc, uIdSubclass)  
         End Select
     
    FUNCTION = DefSubclassProc(hwnd, uMsg, wParam, lParam)
End Function
' ========================================================================================

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

static FShowGrid as boolean
static FGridBrush as HBRUSH

    SELECT CASE uMsg

            case WM_ERASEBKGND
  
              dim as RECT R
              GetClientRect(hwnd, @R)
              if FShowGrid then
                    Dim as HDC DC
                    dim as HDC mDc
                    dim as HBITMAP mBMP, pBMP
                    dim as RECT BrushRect = type(0, 0, 10, 10)
                    if FGridBrush then
                        DeleteObject(FGridBrush)
                    end if   
                    
                    DC = cast(HDC, wParam)
                    mDc   = CreateCompatibleDc(DC)
                    mBMP  = CreateCompatibleBitmap(DC, 10, 10)
                    pBMP  = SelectObject(mDc, mBMP)
                    FillRect(mDc, @BrushRect, cast(HBRUSH, 16))
                    SetPixel(mDc, 8, 8, 0)
                    'for lines use MoveTo and LineTo or Rectangle function or whatever...
                    FGridBrush = CreatePatternBrush(mBMP)
                    FillRect(DC, @R, FGridBrush)
                    SelectObject(mDc, pBMP)
                    DeleteObject(mBMP)
                    DeleteDc(mDc)
              else
                  FillRect(cast(HDC, wParam), @R, cast(HBRUSH, 16))
                  FShowGrid = true
              end if   
              return 1


    	CASE WM_DESTROY

         ' // End the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' detects location of mouse in object, makes moveing controls allowd
' HitTest(hControl, lParam)
' ========================================================================================
Function HitTest(Byval hCtl As HWND, Byval lParam As LPARAM) As Integer

    Static pt As Point

    Static rc As RECT

    pt.x = Loword(lparam)
    pt.y = Hiword(lparam)

    ScreenToClient (hCtl, @pt)              '  converts the screen coordinates of a specified point on the screen to client-area coordinates.
    GetWindowRect  (hCtl, @rc)           '  Retrieves the dimensions of the bounding rectangle of the specified window. The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen.

    MapWindowPoints(HWND_DESKTOP, GetParent(hCtl), Cast(LPPOINT,@rc), 2)

    If pt.y < 4 And pt.x < 4 Then
 
        Return HTTOPLEFT
 
    Elseif pt.y < 4 And pt.x >= (rc.right - rc.left - 4) Then

        Return HTTOPRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) And pt.x >= (rc.right - rc.left - 4) Then

        Return HTBOTTOMRIGHT
    Elseif pt.x < 4 And pt.y >= (rc.bottom - rc.top - 4) Then

        Return HTBOTTOMLEFT
    Elseif pt.y < 4 Then

        Return HTTOP
    Elseif pt.x < 4 Then

        Return HTLEFT
    Elseif pt.x >= (rc.right - rc.left - 4) Then

        Return HTRIGHT
    Elseif pt.y >= (rc.bottom - rc.top - 4) Then
      
        Return HTBOTTOM
    Else

        Return HTCLIENT
    End If

End Function



Post Reply