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
move a label with the mouse at runtime
-
- Posts: 789
- Joined: Jul 26, 2018 18:28
Re: move a label with the mouse at runtime
Show the code and we will help you. For the label and button, the code must be the same.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
Re: move a label with the mouse at runtime
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
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
' ========================================================================================
Re: move a label with the mouse at runtime
I don't have "Afx/CWindow.inc"
But, roughly, in the win api.
I have set the window theme to XP for win 10.
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 )
Re: move a label with the mouse at runtime
@ Dodicat
you are a very clever fellow!
you are a very clever fellow!
Re: move a label with the mouse at runtime
Thx for the example
It will take some puzzling to get it working with afx, but I'll figure it out
It will take some puzzling to get it working with afx, but I'll figure it out
Re: move a label with the mouse at runtime
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.
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.
Re: move a label with the mouse at runtime
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
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
Re: move a label with the mouse at runtime
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