Source/ Codesnippets | | | | 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
|
| | | | |
| | | 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: 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
|
| | | | |
| | | 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! |
| | | | |
|
Zum QuelltextOptions du sujet | 6.337 Views |
Themeninformationencet Thema hat 2 participant: |