However, I also need to restrict the resize of the gadgets such that they can only be stretched along X. The code adds the #WS_SIZEBOX flag, and this gives the ability to resize the sample gadget (does not work with all gadget types, but StringGadget is a good one for my project). It has two issues though:
1) It adds an ugly border - I need to keep the gadget as-is, no border.
2) It allows the gadget to be resized in Y, I need to restrict resize to X only.
So, I think this is basically the wrong way to go about it, although it gets really close to what is needed.......
Code: Select all
Enumeration
#Win
#Gdt
EndEnumeration
Structure SubClassGadget
hWnd.i
oldWndProc.i
mouseDown.i
mouseOffX.i
mouseOffY.i
EndStructure
Global NewList gadgets.SubClassGadget()
Procedure GadgetCallback(hWnd,Msg,wParam,lParam)
;----------------------------------------------
Select Msg
Case #WM_LBUTTONDOWN
ForEach gadgets()
If gadgets()\hWnd = hWnd
gadgets()\mouseOffX = lParam & $FFFF
gadgets()\mouseOffY = (lParam>>16) & $FFFF
gadgets()\mouseDown = 1
SetFocus_(hWnd)
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
ProcedureReturn 0
EndIf
Next
Case #WM_SIZING
If wParam & #MK_LBUTTON
ForEach gadgets()
If gadgets()\hWnd = hWnd And gadgets()\mouseDown
SetCursor_(LoadCursor_(0,#IDC_SIZEWE))
ResizeGadget(GetWindowLongPtr_(hWnd,#GWL_ID), #PB_Ignore, #PB_Ignore, #PB_Ignore, 30)
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
SetCapture_(hWnd)
ProcedureReturn 0
EndIf
Next
ElseIf wParam = 0
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
EndIf
Case #WM_MOUSEMOVE
If wParam & #MK_LBUTTON
ForEach gadgets()
If gadgets()\hWnd = hWnd And gadgets()\mouseDown
GetCursorPos_(p.POINT)
MapWindowPoints_(0,WindowID(#Win),@p,1)
x = p\x - gadgets()\mouseOffX
y = p\y - gadgets()\mouseOffY
If x < 0 : x = 0 : EndIf
If y < 0 : y = 0 : EndIf
GetClientRect_(hWnd,rect.RECT)
GetClientRect_(WindowID(#Win),rect2.RECT)
If x > rect2\right - rect\right : x = rect2\right - rect\right : EndIf
If y > rect2\bottom - rect\bottom : y = rect2\bottom - rect\bottom : EndIf
ResizeGadget(GetWindowLongPtr_(hWnd,#GWL_ID), x, #PB_Ignore, #PB_Ignore, #PB_Ignore)
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
SetCapture_(hWnd)
ProcedureReturn 0
EndIf
Next
ElseIf wParam = 0
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
EndIf
Case #WM_LBUTTONUP
ForEach gadgets()
If gadgets()\hWnd = hWnd
gadgets()\mouseDown = 0
EndIf
Next
SetCursor_(LoadCursor_(0,#IDC_SIZEALL))
SetCapture_(0)
ProcedureReturn 0
Case #WM_LBUTTONDBLCLK
ForEach gadgets()
If gadgets()\hWnd = hWnd
FreeGadget(GetWindowLongPtr_(hWnd,#GWL_ID))
EndIf
Next
ProcedureReturn 0
EndSelect
ForEach gadgets()
If gadgets()\hWnd = hWnd
ProcedureReturn CallWindowProc_(gadgets()\oldWndProc,hWnd,Msg,wParam,lParam)
EndIf
Next
EndProcedure
Procedure AddGadget(hGadget)
;---------------------------
If IsGadget(hGadget)
hWnd = GadgetID(hGadget) ; for #PB_Any
Else
hWnd = hGadget
EndIf
If hWnd
LastElement(gadgets())
AddElement(gadgets())
gadgets()\hWnd = hWnd
gadgets()\oldWndProc = SetWindowLongPtr_(hWnd,#GWL_WNDPROC,@GadgetCallback())
EndIf
ProcedureReturn hGadget
EndProcedure
If OpenWindow(#Win, 0, 0, 500, 300, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(#Win, RGB(100,60,60))
AddGadget(StringGadget(#Gdt, 20, 20, 100, 30, "Test", #PB_String_BorderLess|#PB_String_ReadOnly|#PB_Text_Center|#WS_SIZEBOX))
;AddGadget(ContainerGadget(#Gdt, 20, 20, 100, 30, #WS_SIZEBOX))
;AddGadget(CanvasGadget(#Gdt, 20, 20, 100, 30, #WS_SIZEBOX))
SetGadgetColor(#Gdt,#PB_Gadget_BackColor,RGB(175,255,175))
Repeat
iEvent = WaitWindowEvent(1)
Until iEvent = #PB_Event_CloseWindow
EndIf
End


