XProfan

Como fehlt aber todavía einiges, el Berechnungen y Métodos para Los cambios etc. Su Subclassingnachrichten son aber Windowsnäher, Yo passe en el sc.subClassProc Incluya el darauf a. Methodenfrage ists no, aber una gelungener Verbesserungsvorschlag!

Frank
Abbing

Ist nada viel qué fehlt, z.B. puede Control direkt en el Grösse verändert voluntad, sin viel Aufwand.
Für Case SubClassMessage(area&, WM_COMMAND): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam) debería Besseres her, así bin Todavía no zufrieden, tal vez werd Yo heute abend una wenig más tüfteln.
Yo sag hier auch otra vez, Yo IF ya dijo hatte. Der Code se seine Inc no sustituir, pero höchstens bereichern. Für mich stellt él una Alternative dar.

Frank
Abbing

Un verbesserte Versión, todavía no perfekt, aber viel mejor:
Kompilieren Marca Separación

 {$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/disponer/'>Disponer rect#
Disponer vs#
End

Hilo geteilt de ScrollControl [...]

y ScrollControl2 umbenannt.

Frank
Abbing

El Demos el ScrollControl.inc trabajo einwandfrei en me, aber en großen Proyectos con viel Subclassings hakt lo anscheinend. Mitunter voluntad el Childcontrols no angeklickt oder el Scrolling stockt.

Posesiones el gleichen Problemas con meiner Inc. Lo son como wohl más una Unverträglichkeit con el Webcam, o. si yo diverse Webcam-Messages benutzte, kommt lo a Verzögerungen oder Verhinderungen des Messagehandlings. Was genau Schuld es, kann Todavía no sagen. iFs Scroll-Inc es aber bastante sicher no!

29.06.2008 ▲