XProfan

Da fehlt aber noch einiges, die Berechnungen und Methoden per Änderungen etc. Deine Subclassingnachrichten sind aber Windowsnäher, ich passe in der sc.subClassProc die Include darauf an. Methodenfrage ists nicht, aber ein gelungener Verbesserungsvorschlag!

Frank
Abbing

Ist gar nicht viel was fehlt, z.B. kann das Control direkt in der Grösse verändert werden, ohne viel Aufwand.
Für Case SubClassMessage(area&, WM_COMMAND): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam) sollte Besseres her, damit bin ich noch nicht zufrieden, vielleicht werd ich heute abend ein wenig weiter tüfteln.
Ich sag hier auch nochmal, was ich iF schon gesagt hatte. Der Code soll seine Inc nicht ersetzen, sondern höchstens bereichern. Für mich stellt er eine Alternative dar.

Frank
Abbing

Eine verbesserte Version, noch nicht perfekt, aber viel besser:
Kompilieren Markieren Separieren

 {$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='./../../funktionsreferenzen/xprofan/dispose/'>Dispose rect#
Dispose vs#
End

Thread geteilt von ScrollControl [...]

und in ScrollControl2 umbenannt.

Frank
Abbing

Die Demos der ScrollControl.inc funktionieren einwandfrei bei mir, aber in grande Projekten mit viel Subclassings hakt es anscheinend. Mitunter werden die Childcontrols nicht angeklickt oder das Scrolling stockt.

Habe die gleichen Probleme mit meiner Inc. Es gibt da wohl eher eine Unverträglichkeit mit der Webcam, bzw. wenn ich diverse Webcam-Messages benutzte, kommt es zu Verzögerungen oder Verhinderungen des Messagehandlings. Was genau Schuld ist, kann ich noch nicht sagen. iFs Scroll-Inc ist es aber ganz sicher nicht!

29.06.2008 ▲