XProfan

là fehlt mais encore einiges, qui Berechnungen et Methoden pour Changements etc. Votre Subclassingnachrichten sommes mais Windowsnäher, je passe dans qui sc.subClassProc qui Include puis à. Methodenfrage ists pas, mais un gelungener Verbesserungsvorschlag!

Frank
Abbing

Ist gar pas viel quoi fehlt, z.B. peux cela Contrôle direct dans qui Grösse modifié volonté, sans viel Aufwand.
Pour Cas SubClassMessage(area&, WM_COMMAND): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam) sollte Besseres her, avec cela suis je encore pas zufrieden, peut-être werd je ce soir un peu plus tüfteln.
je sag ici aussi nochmal, quoi je iF déjà dit hatte. qui Code soll sa Inc pas ersetzen, mais au maximum bereichern. Pour mich stellt il une Alternative dar.

Frank
Abbing

une verbesserte Version, encore pas parfait, mais viel besser:
Kompilieren Marque Séparation

 {$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#
Fin

Fil geteilt de ScrollControl [...]

et dans ScrollControl2 umbenannt.

Frank
Abbing

qui Demos qui ScrollControl.inc marcher einwandfrei chez mir, mais dans grand Projekten avec viel Subclassings hakt es anscheinend. Mitunter volonté qui Childcontrols pas angeklickt ou bien cela Scrolling stockt.

Habe qui gleichen Probleme avec meiner Inc. il y a là wohl plutôt une Unverträglichkeit avec qui Webcam, bzw. si je diverse Webcam-Messages benutzte, venez es trop Verzögerungen ou bien Verhinderungen des Messagehandlings. quoi oui c'est ca Schuld ist, peux je encore pas dire. iFs Scroll-Inc ist es mais entier sûrement pas!

29.06.2008 ▲