Français
Source/ Codesnippets

Scrollwindow

 

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.

là je cela Thema la fois angeschnitten habe, habe je meinen Code plus entwickelt, qui une autre Possibilité aufzeigt, un Scrollcontrol trop realisieren. iFs Methode ist hierbei pas qui gängige, mais stellt plutôt une Art Provisorum dar.
mon Code ist encore unausgegoren et verlangt diverse Changements pour bestimmte Arten de Childcontrols, inbesondere pour TrackBars et Controls avec Scrollern. mais cela Demo ist petite et fonctionne déjà bestens, en supplément ist dans reinem XProfan geschrieben. cela Ganze sollte mais encore comme Inc mise en œuvre volonté. peut-être findet sich quelqu'un, qui cela volontiers erledigen voudrais. Code ist courir ab XProfan 11. virtx& et virty& se mettre qui Grösse qui virtuellen plaine dar.
KompilierenMarqueSéparation
 {$cleq}
Declare a&,x&,y&,text$,area&, klasse$
Declare isx&,isy&,xx!,yy!,maxx&,maxy&,rect#,vs#
Declare virtx&,virty&,so!,but1&,but2&
Dim rect#,16
Dim vs#,48
virtx&=800
virty&=800

SubClassProc

    x&=GetKeyState(1) & $8000

    If x&

        If SubClassMessage(area&, WM_VSCROLL)

            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)

            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 SubClassMessage(area&, WM_COMMAND): SendMessage(%hwnd,%sMessage,&sWParam,&sLParam)

EndProc

Cls GetSysColor(15)
klasse$=#32770
text$=
area&=CreateWindowEx($20000,addr(klasse$),addr(text$),$50300000,48 ,8 ,400 ,300 ,%hwnd,0,%hinstance,1000)
but1&=Create(Button,area&,Testbutton 1,8 ,8 ,200,20)
but2&=Create(Button,area&,Testbutton 2,8 ,32 ,200,20)
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,Button 2 gedrückt

    EndIf

Endwhile

SubClass area&, 0
Dispose rect#
Dispose vs#
Fin
 
23.06.2008  
 



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!
 
24.06.2008  
 




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.
 
24.06.2008  
 




Frank
Abbing
une verbesserte Version, encore pas parfait, mais viel besser:
KompilierenMarqueSé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
 
24.06.2008  
 



Fil geteilt de ScrollControl [...]  et dans ScrollControl2 umbenannt.
 
24.06.2008  
 




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  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

6.337 Views

Untitledvor 0 min.
RudiB.29.12.2021
H.Brill30.06.2021
Frank16.04.2021
Georg Teles02.11.2020
plus...

Themeninformationen

cet Thema hat 2 participant:

Frank Abbing (4x)
iF (2x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie