Code: Select all
; http://forum.oryaaaaa.com/viewtopic.php?t=26
; Purebasic forum in JAPAN ()
; Author akira
; 2006.04.27
; "Automatic scroll in table"
Enumeration
#Window_0
EndEnumeration
Enumeration
#ScrollArea_0
#StatusBar
EndEnumeration
#WM_VSCROLL= $115
#SB_LINEUP=0
#SB_LINEDOWN=1
Procedure scrollU()
rrr.l=SendMessage_(GadgetID(#ScrollArea_0),#WM_VSCROLL , #SB_LINEUP,0)
EndProcedure
Procedure scrollD()
rrr.l=SendMessage_(GadgetID(#ScrollArea_0),#WM_VSCROLL , #SB_LINEDOWN,0)
EndProcedure
Procedure fkchk()
For i=9 To 123
If GetAsyncKeyState_(i)=-32767
Break
ElseIf i=13
i=36
ElseIf i=40
i=111
EndIf
Next
If i=13 ;CR is converted into TAB.
keybd_event_(#VK_RETURN, 0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_TAB,0,0,0) ; TAB key down.
keybd_event_(#VK_TAB,0,#KEYEVENTF_KEYUP,0)
ElseIf i=38 ;UP is converted into shift+TAB.
GadgetID=EventGadget()
keybd_event_(#VK_UP, 0, #KEYEVENTF_KEYUP, 0)
keybd_event_(#VK_SHIFT,0,0,0)
keybd_event_(#VK_TAB,0,0,0)
keybd_event_(#VK_TAB,0,#KEYEVENTF_KEYUP,0)
keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0)
EndIf
If EventType()=#PB_EventType_Focus
SendMessage_(GadgetID(EventGadget()),#EM_SETSEL,0,99999)
EndIf
ProcedureReturn i
EndProcedure
Procedure gamen(lno.l)
y=1 ;100 ;y coordinates at slip position
tt=120
border=0 ;#PB_String_BorderLess
For i=0 To lno-1
TextGadget(tt+i, 3, y+i*21, 31, 21, Str(i+1), #PB_Text_Center | #PB_Text_Border)
SetGadgetFont(tt+i, FontID1)
SetGadgetColor(tt+i,#PB_Gadget_FrontColor,$FFFFFF)
SetGadgetColor(tt+i,#PB_Gadget_BackColor,$6496FF)
Next
For i=0 To lno-1
ss=200
StringGadget(ss+i*5, 34, y+i*21, 32, 21, "",border )
SendMessage_(GadgetID(ss+i*5), #EM_LIMITTEXT, 3, 0)
SetGadgetFont(ss+i*5, FontID1)
SetGadgetColor(ss+i*5,#PB_Gadget_FrontColor,0)
SetGadgetColor(ss+i*5,#PB_Gadget_BackColor,$C8FAFF)
ss+1
StringGadget(ss+i*5, 66, y+i*21, 48, 21, "" ,border )
SendMessage_(GadgetID(ss+i*5), #EM_LIMITTEXT, 5, 0)
SetGadgetFont(ss+i*5, FontID1)
SetGadgetColor(ss+i*5,#PB_Gadget_FrontColor,0)
SetGadgetColor(ss+i*5,#PB_Gadget_BackColor,$C8FAFF)
ss+1
StringGadget(ss+i*5, 114, y+i*21, 336, 21, "",border )
SendMessage_(GadgetID(ss+i*5), #EM_LIMITTEXT, 40, 0)
SetGadgetFont(ss+i*5, FontID1)
SetGadgetColor(ss+i*5,#PB_Gadget_FrontColor,0)
SetGadgetColor(ss+i*5,#PB_Gadget_BackColor,$C8FAFF)
ss+1
StringGadget(ss+i*5, 450, y+i*21, 72, 21, "",2 |border )
SendMessage_(GadgetID(ss+i*5), #EM_LIMITTEXT, 8, 0)
SetGadgetFont(ss+i*5, FontID1)
SetGadgetColor(ss+i*5,#PB_Gadget_FrontColor,0)
SetGadgetColor(ss+i*5,#PB_Gadget_BackColor,$C8FAFF)
ss+1
StringGadget(ss+i*5, 522, y+i*21, 38, 21, "",border )
SendMessage_(GadgetID(ss+i*5), #EM_LIMITTEXT, 7, 0)
SetGadgetFont(ss+i*5, FontID1)
SetGadgetColor(ss+i*5,#PB_Gadget_FrontColor,0)
SetGadgetColor(ss+i*5,#PB_Gadget_BackColor,$C8FAFF)
Next
EndProcedure
Procedure bkc(it.l,a.l)
If a>0
SetGadgetColor(it,#PB_Gadget_FrontColor,0)
SetGadgetColor(it,#PB_Gadget_BackColor,$C8FAFF)
Else
SetGadgetColor(it,#PB_Gadget_FrontColor,0)
SetGadgetColor(it,#PB_Gadget_BackColor,$FFFFFF)
EndIf
EndProcedure
Procedure Open_Window_0()
If OpenWindow(#Window_0, 243, 50, 676, 336, "Automatic scroll in table", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
ScrollAreaGadget(#ScrollArea_0, 24, 42, 600, 260, 580, 528, 21)
gamen(20)
CloseGadgetList()
If CreateStatusBar(#StatusBar, WindowID(#Window_0) )
AddStatusBarField(WindowWidth(#Window_0))
EndIf
EndIf
EndProcedure
Open_Window_0()
Repeat
fkchk()
Event = WaitWindowEvent()
WindowID = EventWindow()
GadgetID = EventGadget()
EventType = EventType()
If Event=#PB_Event_Gadget
Select EventType
Case #PB_EventType_LostFocus
bkc(iti,1)
Case #PB_EventType_Focus
bkc(GadgetID,0)
iti=GadgetID
If GadgetID%5=0
hh=GetScrollPos_(GadgetID(#ScrollArea_0), #SB_VERT)
yy=GadgetY(iti)
StatusBarText(#StatusBar, 0, Str(yy-hh))
If yy-hh>222
scrollD()
EndIf
ElseIf GadgetID%5=4
hh=GetScrollPos_(GadgetID(#ScrollArea_0), #SB_VERT)
yy=GadgetY(iti)
StatusBarText(#StatusBar, 0, Str(yy-hh))
If yy-hh<1
scrollU()
EndIf
EndIf
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
End