XProfan

- Page 2 -

« this Posting watts as Solution marked. »

- Page 2 -

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

iF (21.09.11)

you have already a fat block: case (%mouseXheight(%hWnd)-10) : hwnd.scaleByMouse()

iF (21.09.11)

there can You still the hWnd.scaleByMouse-Proc as Parameter transfer which corner/ edge meant was in order to Ersparen the You, the in Proc first again detect must.

the goes me somehow against whom Strich

This will usually over The Message WM_NCHITTEST geregelt.

here time one small example for a skalier / verschiebbaren Button. ought to itself well for a Window adjust let.

Compile Mark Separation

 $H windows.ph
 $H Messages.ph
 $H Structs.ph
STRUCT TRect         = ~Rect
STRUCT TPoint        = ~Point

Proc HitTest

    Parameters hCtl&,lParam&
    Declare Point#
    Declare Rect#
    Dim Point#,TPoint
    Dim Rect#,TRect
    Point#.x& = LoWord(lParam&)
    Point#.y& = HiWord(lParam&)
    ~ScreenToClient(hCtl&,Point#)
    ~GetWindowRect(hCtl&,Rect#)
    ~MapWindowPoints(~GetDesktopWindow(),%Hwnd,Rect#,2)

    If (Point#.y& < 4) AND (Point#.x& < 4)

        Dispose Point#,Rect#
        Return  ~HTTOPLEFT

    ElseIf (Point#.y& < 4) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))

        Dispose Point#,Rect#
        Return  ~HTTOPRIGHT

    ElseIf (Point#.y& >= (Rect#.bottom& - Rect#.top&-4)) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))

        Dispose Point#,Rect#
        Return  ~HTBOTTOMRIGHT

    ElseIf (Point#.x& < 4) AND (Point#.y& >= (Rect#.bottom& - Rect#.top& - 4))

        Dispose Point#,Rect#
        Return  ~HTBOTTOMLEFT

    ElseIf Point#.y& < 4

        Dispose Point#,Rect#
        Return  ~HTTOP

    ElseIf Point#.x& < 4

        Dispose Point#,Rect#
        Return ~HTLEFT

    ElseIf Point#.x& >= (Rect#.right& - Rect#.left& - 4)

        Dispose Point#,Rect#
        Return ~HTRIGHT

    ElseIf Point#.y& >= (Rect#.bottom& - Rect#.top& - 4)

        Dispose Point#,Rect#
        Return ~HTBOTTOM

    Else

        Dispose Point#,Rect#
        Return ~HTCAPTION

    EndIf

ENDPROC

SubClassProc

    If SubClassMessage(&sWnd,~WM_NCHITTEST)

        Set("WinProc", 0)
        Return HitTest(&swnd,&slParam)

    Endif

ENDPROC

cls
Var Ende& = 0
Var Button& = Create("Button",%hwnd,"OK",10,10,120,30)
SubClass Button&,1

whilenot ende&

    waitinput

endwhile

Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage : [...]

XProfan X2
Win7 Home Premium, SP1, Core(TM)2 Duo E6750 @ 2.66GHz

i don't know whether it sinnvoller is z.B. with eachone Mausbewegung instead of only einmalig to Click To Verify in whom area clicked watts. oO

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Well, at least becomes with Mausbewegung same the right Cursor displayed and not first to ''KLICK''

XProfan X2
Win7 Home Premium, SP1, Core(TM)2 Duo E6750 @ 2.66GHz

Hm, Better get going still at 1. example moreover too:

Compile Mark Separation

'URL: https://XProfan.com/intl/de/forum/skalierbares-window-create-without-fat-welt/
/*
{$cleq}
{$compiler c:\XProfan11\}
{$runtime c:\XProfan11\}
*/
windowstyle 1 | 2 | 8 | 16 | 512
window 640,480
userMessages 16,513,20//wm_close,wm_lButtonDown,wm_eraseBkGnd
subClass %hWnd,1

while 1

    waitInput

    select %uMessage

        caseof 16 : break

        caseof 513

        case (%mouseX>width(%hWnd)-10) and (%mouseY>height(%hWnd)-10) : hWnd.scaleByMouse()

    endSelect

wend

end

subClassProc

    case subClassMessage(%hWnd, 512):useCursor (%mouseX>width(%hWnd)-10) and (%mouseY>height(%hWnd)-10)*7//wm_mouseMove

endProc

proc hWnd.scaleByMouse

    declare m#
    dim m#,8
    external("user32","GetCursorPos",m#)
    var omx%=long(m#,0)
    var omy%=long(m#,4)
    var wi&=%winRight-%winLeft
    var he&=%winBottom-%winTop

    while isKey(1)

        waitInput 10
        external("user32","GetCursorPos",m#)
        setWindowPos %hWnd=%winLeft,%winTop - wi&-omx%+long(m#,0),he&-omy%+long(m#,4)

    wend

    dispose m#

endProc

-

is hold wm_mouseMove instead of wm_ncHitTest.

Nachtrag: Ah, now see I the Difference and benefit!

Julian
Schmidt

The View source with wm_ncHitTest functions really super! thanks Andreas

Compile Mark Separation

 $H windows.ph
 $H Messages.ph
 $H Structs.ph
STRUCT TRect = ~Rect
STRUCT TPoint = ~Point

Proc HitTest

    Parameters hCtl&,lParam&
    Declare Point#
    Declare Rect#
    Dim Point#,TPoint
    Dim Rect#,TRect
    Point#.x& = LoWord(lParam&)
    Point#.y& = HiWord(lParam&)
    ~ScreenToClient(hCtl&,Point#)
    ~GetWindowRect(hCtl&,Rect#)
    ~MapWindowPoints(~GetDesktopWindow(),%Hwnd,Rect#,2)

    If (Point#.y& < 4) AND (Point#.x& < 4)

        Dispose Point#,Rect#
        Return  ~HTTOPLEFT

    ElseIf (Point#.y& < 4) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))

        Dispose Point#,Rect#
        Return  ~HTTOPRIGHT

    ElseIf (Point#.y& >= (Rect#.bottom& - Rect#.top&-4)) AND (Point#.x& >= (Rect#.right& - Rect#.left&-4))

        Dispose Point#,Rect#
        Return  ~HTBOTTOMRIGHT

    ElseIf (Point#.x& < 4) AND (Point#.y& >= (Rect#.bottom& - Rect#.top& - 4))

        Dispose Point#,Rect#
        Return  ~HTBOTTOMLEFT

    ElseIf Point#.y& < 4

        Dispose Point#,Rect#
        Return  ~HTTOP

    ElseIf Point#.x& < 4

        Dispose Point#,Rect#
        Return ~HTLEFT

    ElseIf Point#.x& >= (Rect#.right& - Rect#.left& - 4)

        Dispose Point#,Rect#
        Return ~HTRIGHT

    ElseIf Point#.y& >= (Rect#.bottom& - Rect#.top& - 4)

        Dispose Point#,Rect#
        Return ~HTBOTTOM

    Else

        Dispose Point#,Rect#
        Return ~HTCAPTION

    EndIf

ENDPROC

SubClassProc

    If SubClassMessage(&sWnd,~WM_NCHITTEST)

        Set("WinProc", 0)
        Return HitTest(&swnd,&slParam)

    Endif

ENDPROC

windowstyle 2+16+64
window 600,400
cls 255
var dg&=Create("Window",%hwnd,"",10,10,200,100)
StartPaint dg&
cls 255
EndPaint
SubClass dg&,1
SubClass %hwnd,1

while 1

    waitinput 30
    case iskey(27) : end

endwhile

09/22/11 ▲

Jörg
Sellmeyer

well - if not Rolf for its ROC use can, white ich's neither. Irgendwer woltte still too time Edits skalieren. one here of course not reinschreiben but for a Entwurfsmodus is the still splendid!!

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

XProfan X2
Win7 Home Premium, SP1, Core(TM)2 Duo E6750 @ 2.66GHz

Perhaps. yet NEN move with install.

Jörg
Sellmeyer

goes so already!

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

XProfan X2
WinXP, SP3, 1.73GHz

Ah, certainly because of else HTCAPTION.

Jörg
Sellmeyer

Can the so arrange, that it with Statics ditto functions?

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

11/11/11 ▲

XProfan X2
WinXP, SP3 v.3244, P4 3.06GHz

From Andreas its Variante by wm_ncHitTest white I not but with "meiner" analogeren Variante went it too with unsichtbaren Controls: [...]

11/11/11 ▲

Jörg
Sellmeyer

what mean You with unsichtbaren Controls?
somehow likes I The Variante of Andreas More, though your too interestingly is.
The of Andreas shining me systemnäher.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

11/11/11 ▲