PureBasic Forums - English

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