XProfan

there missing but yet some, The Berechnungen and modes for Changes etc. your Subclassingnachrichten are but Windowsnäher, I fit in the sc.subClassProc The Include hereon on. Methodenfrage ists not, but one gelungener Verbesserungsvorschlag!

Frank
Abbing

is none plenty what missing, z.B. can the control directly in the Size changed go, without plenty hoisted.
for Case SubClassMessage(area&, WM_COMMAND): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam) ought to better since, so be I not yet pleased, Perhaps werd I tonight a little bit moreover tüfteln.
I say here too again, I iF already said having. The code should its Inc not supplant, separate not more than bereichern. for me position it a alternative dar.

Frank
Abbing

an improved Version, not yet perfect, but much better:
Compile Mark Separation

 {$cleq}
Declare a&,x&,y&,text$,area&, klasse$,last&
Declare isx&,isy&,xx!,yy!,maxx&,maxy&,rect#,vs#
Declare virtx&,virty&,so!,but1&,but2&,but3&,but4&,but5&
Dim rect#,16
Dim vs#,512
virtx&=800
virty&=800

SubClassProc

    x&=GetKeyState(1) & $8000

    If x&

        If ( SubClassMessage(area&, WM_VSCROLL) and (&sLParam=0) )

            GetWindowRect(area&,rect#)
            maxy&=Long(rect#,12)-Long(rect#,4)+1
            x&=&sWParam & $0000ffff
            a&=1

            If x&=SB_LINEDOWN

                isy&=8

            ElseIf x&=SB_PAGEDOWN

                isy&=maxy&

            ElseIf x&=SB_LINEUP

                isy&=-8

            ElseIf x&=SB_PAGEUP

                isy&=-maxy&

            ElseIf x&=SB_THUMBTRACK

                so!=yy!
                yy!=&sWParam >> 16
                isy&=-(so!-yy!)
                a&=0

            EndIf

            If a&

                yy!=yy!+isy&

                If yy!<0

                    isy&=(isy&+(0-yy!))
                    yy!=0

                EndIf

                If yy!>(virty&-maxy&)

                    isy&=isy&-(yy!-(virty&-maxy&))
                    yy!=virty&-maxy&

                EndIf

            Endif

            Long vs#,0=28
            Long vs#,4=SIF_ALL
            Long vs#,12=virty&
            Long vs#,16=maxy&
            Long vs#,20=yy!
            SetScrollInfo(area&,SB_VERT,vs#,TRUE)
            ScrollWindow(area&,0,-isy&,0,0)
            UpdateWindow(area&)

        ElseIf (SubClassMessage(area&, WM_HSCROLL) and (&sLParam=0))

            GetWindowRect(area&,rect#)
            maxx&=Long(rect#,8)-Long(rect#,0)+1
            x&=&sWParam & $0000ffff
            a&=1

            If x&=SB_LINERIGHT

                isx&=8

            ElseIf x&=SB_PAGERIGHT

                isx&=maxx&

            ElseIf x&=SB_LINELEFT

                isx&=-8

            ElseIf x&=SB_PAGELEFT

                isx&=-maxx&

            ElseIf x&=SB_THUMBTRACK

                so!=xx!
                xx!=&sWParam >> 16
                isx&=-(so!-xx!)
                a&=0

            EndIf

            If a&

                xx!=xx!+isx&

                If xx!<0

                    isx&=(isx&+(0-xx!))
                    xx!=0

                EndIf

                If xx!>(virtx&-maxx&)

                    isx&=isx&-(xx!-(virtx&-maxx&))
                    xx!=virtx&-maxx&

                EndIf

            Endif

            Long vs#,0=28
            Long vs#,4=SIF_ALL
            Long vs#,12=virtx&
            Long vs#,16=maxx&
            Long vs#,20=xx!
            SetScrollInfo(area&,SB_HORZ,vs#,TRUE)
            ScrollWindow(area&,-isx&,0,0,0)
            UpdateWindow(area&)

        EndIf

    EndIf

    Case %sMessage=WM_COMMAND: SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
    Case (SubClassMessage(area&, WM_HSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)
    Case (SubClassMessage(area&, WM_VSCROLL) and (&sLParam<>0)): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)

EndProc

Cls GetSysColor(15)
Usefont MS Sans Serif,10,0,0,0,0
SetDialogFont 1
klasse$=#32770
text$=
area&=CreateWindowEx($20000,addr(klasse$),addr(text$),$50300000,48 ,8 ,400 ,300 ,%hwnd,0,%hinstance,0)
but1&=Create(Button,area&,Testbutton 1,8 ,8 ,80,20)
but2&=Create(Listbox,area&,Testbutton 2,200 ,52 ,200,60)
AddString(but2&,Testzeile 1)
AddString(but2&,Testzeile 2)
AddString(but2&,Testzeile 3)
AddString(but2&,Testzeile 4)
AddString(but2&,Testzeile 5)
but3&=Control(MSCTLS_TRACKBAR32, Trackbar01, $54000000, 100, 200, 200, 20, area&, 2011, %hInstance, $00010004)
but4&=Create(ChoiceBox, area&, 1, 8, 300, 120, 80)
AddString(but4&,Testzeile 1)
AddString(but4&,Testzeile 2)
AddString(but4&,Testzeile 3)
AddString(but4&,Testzeile 4)
AddString(but4&,Testzeile 5)
GetWindowRect(area&,rect#)
maxy&=Long(rect#,12)-Long(rect#,4)+1
Long vs#,0=28
Long vs#,4=SIF_ALL
Long vs#,12=virty&
Long vs#,16=maxy&
Long vs#,20=yy!
SetScrollInfo(area&,SB_VERT,vs#,TRUE)
maxx&=Long(rect#,8)-Long(rect#,0)+1
Long vs#,0=28
Long vs#,4=SIF_ALL
Long vs#,12=virtx&
Long vs#,16=maxx&
Long vs#,20=xx!
SetScrollInfo(area&,SB_HORZ,vs#,TRUE)
SubClass area&, 1

While 1

    WaitInput
    Case %key=2:Break

    If Clicked(but1&)

        SetText %hwnd,Button 1 gedrückt

    ElseIf Clicked(but2&)

        SetText %hwnd,Listbox gedrückt

    ElseIf Clicked(but4&)

        SetText %hwnd,Choicebox gedrückt

    EndIf

    If GetFocus(but3&)

        x&=SendMessage(but3&,$400,0,0)

        If x&<>last&

            last&=x&
            SetText %hwnd,Trackbar auf Position +Str$(x&)

        EndIf

    EndIf

Endwhile

SubClass area&, 0
ef='./../../Function-References/XProfan/dispose/'>Dispose rect#
Dispose vs#
End

Thread shared of ScrollControl [...]

and ScrollControl2 umbenannt.

Frank
Abbing

The Demos the ScrollControl.inc functions correct by me, but in large Projekten with plenty Subclassings hakt it apparently. Mitunter go The Childcontrols not klicked or the Scrolling stockt.

have The equal Problems with of my Inc. there's there well sooner a Unverträglichkeit with the Webcam, or. if I diverse Webcam-Messages using, comes it To delays or Verhinderungen the Messagehandlings. What exactly guilt is, can I not yet say. iFs Scroll-Inc is But integrally sure not!

06/29/08 ▲