ScrollBar for return value can not convert in v4.0[Resolved]

Just starting out? Need help? Post your questions and find answers here.
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

ScrollBar for return value can not convert in v4.0[Resolved]

Post by Kwai chang caine »

Hello everyone

I found two superb codes to return the value of a scrollbargadget :D

But it is impossible to convert them into v4.0 with PbSourceConverter, and I am not strong enough to do it myself. :oops:

Somebody can it help me?

Prime code of Danilo (German site) :

Code: Select all

; http://www.purebasic.fr/english/viewtopic.php?t=7147&highlight=scrollbargadget

Procedure RealTimeScrollEvent(GadgetID,Pos) 
  ; Your stuff here, for each Scrollbar 
  Select GadgetID 

    Case GadgetID(1) ; Scrollbar 1 
      SetGadgetText(2,Str(Pos)) 

    Case GadgetID(3) ; Scrollbar 2 
      SetGadgetText(4,Str(Pos)) 

  EndSelect 
EndProcedure 


Procedure ScrollCallback(hWnd,Msg,wParam,lParam) 
  ; dont change this procedure 
  Shared DK_OldScrollCallback 
  If ((Msg = #WM_HSCROLL) Or (Msg = #WM_VSCROLL)) And (wParam & $FFFF) = #SB_THUMBTRACK 
    RealTimeScrollEvent(lParam,(wParam >> 16) & $FFFF) 
  EndIf 
  If DK_OldScrollCallback 
    ProcedureReturn CallWindowProc_(DK_OldScrollCallback,hWnd,Msg,wParam,lParam) 
  Else 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

Procedure SetScrollbarCallback(GadgetNr) 
  ; dont change this procedure 
  Shared DK_OldScrollCallback 
  DK_OldScrollCallback = SetWindowLong_(GetParent_(GadgetID(GadgetNr)),#GWL_WNDPROC,@ScrollCallback()) 
EndProcedure 


OpenWindow(0,200,200,200,200,#PB_Window_SystemMenu,"ScrollIt!") 
  CreateGadgetList(WindowID()) 

  ScrollBarGadget(1,20,20,15,160,1,1000,100,#PB_ScrollBar_Vertical) 
  TextGadget(2,0,0,100,20,"1") 
  ScrollBarGadget(3,40,20,100,15,1,8000,1) 
  TextGadget(4,100,0,100,20,"1") 

  SetScrollbarCallback(1) ; Gadget 1, first  Scrollbar 
  SetScrollbarCallback(3) ; Gadget 3, second Scrollbar 

Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow 
Second code of Froggerprogger (German Site) :

Code: Select all

; http://www.purebasic.fr/german/archive/viewtopic.php?t=1278&postdays=0&postorder=asc&highlight=scrollit&start=10

; 07.09.03 by Froggerprogger 
; 
; live-updating the scrollbarinfos 
  
Declare.l WindowCallback(WindowID, message, wParam, lParam) 

#Window_Title = "scrollbar-test" 
#Gadget_PBScroll = 1 
#Gadget_PBText = 2 

Global hPBSB.l 
Global hWindow.l 
Global actSB.SCROLLINFO 

hWindow = OpenWindow(0,0,0,800,80,#PB_Window_SystemMenu|#PB_Window_ScreenCentered, #Window_Title) 
  CreateGadgetList(hWindow) 
    TextGadget(#Gadget_PBText, 10, 10, 780, 20, "") 
    hPBSB = ScrollBarGadget(#Gadget_PBScroll, 10, 30 , 780, 20, 0, 0, 0) 
      actSB\cbSize = SizeOf(SCROLLINFO) 
      actSB\fMask = #SIF_ALL 
      actSB\nMin = 0 
      actSB\nMax = 1000 
      actSB\nPage = 100 
      actSB\nPos = 450 
      actSB\nTrackPos = 0 ; ignored by SetScrollInfo_() 
      SetScrollInfo_(hPBSB, #SB_CTL, @actSB, #True) 
      
SetWindowCallback(@WindowCallback()) 
SetGadgetText(#Gadget_PBText, "PB-Scrollbar: "+Str(GetGadgetState(#Gadget_PBScroll))) 

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow 
End 

;- Window-Callback-Procedure 
Procedure.l WindowCallback(WindowID, message, wParam, lParam) 
  Protected result.l : result = #PB_ProcessPureBasicEvents 
    
    Select message 

      Case #WM_COMMAND 
        If wParam = #Gadget_PBScroll And lParam = hPBSB 
          ; process all scrollbar-actions here. 
          SetGadgetText(#Gadget_PBText, "PB-Scrollbar: "+Str(GetGadgetState(#Gadget_PBScroll))) 
          result = 0 
        EndIf 
        
      Case #WM_CTLCOLORSCROLLBAR 
        MessageRequester("","#WM_CTLCOLORSCROLLBAR !",0) 
        result = CreateSolidBrush_($000066) 
        
    EndSelect 

  ProcedureReturn result 
EndProcedure 
Thank you
I wish you a good day
Last edited by Kwai chang caine on Tue Dec 18, 2007 9:18 pm, edited 5 times in total.
ImageThe happiness is a road...
Not a destination
gnozal
PureBasic Expert
PureBasic Expert
Posts: 4229
Joined: Sat Apr 26, 2003 8:27 am
Location: Strasbourg / France
Contact:

Post by gnozal »

Something like this ?

Code: Select all

Procedure RealTimeScrollEvent(GadgetID,Pos) 
  ; Your stuff here, for each Scrollbar 
  Select GadgetID 
    
    Case GadgetID(1) ; Scrollbar 1 
      SetGadgetText(2,Str(Pos)) 
      
    Case GadgetID(3) ; Scrollbar 2 
      SetGadgetText(4,Str(Pos)) 
      
  EndSelect 
EndProcedure 

Procedure ScrollCallback(hwnd,msg,wParam,lParam) 
  ; dont change this procedure 
  Shared DK_OldScrollCallback 
  If ((msg = #WM_HSCROLL) Or (msg = #WM_VSCROLL)) And (wParam & $FFFF) = #SB_THUMBTRACK 
    RealTimeScrollEvent(lParam,(wParam >> 16) & $FFFF) 
  EndIf 
  If DK_OldScrollCallback 
    ProcedureReturn CallWindowProc_(DK_OldScrollCallback,hwnd,msg,wParam,lParam) 
  Else 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

OpenWindow(0,200,200,200,200,"ScrollIt!",#PB_Window_SystemMenu) 
CreateGadgetList(WindowID(0)) 

ScrollBarGadget(1,20,20,15,160,1,1000,100,#PB_ScrollBar_Vertical) 
TextGadget(2,0,0,100,20,"1") 
ScrollBarGadget(3,40,20,100,15,1,8000,1) 
TextGadget(4,100,0,100,20,"1") 

DK_OldScrollCallback = SetWindowLong_(WindowID(0),#GWL_WNDPROC,@ScrollCallback()) 

Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
For free libraries and tools, visit my web site (also home of jaPBe V3 and PureFORM).
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

GNOZAL !!!

My hero :D

Like "A rideeeeeer goes out of the niiiiiiiiiight" (Un cavalieeeeeeeeeeeeer qui s'en va hors de la nuuuuuuuuuuuuit, ........)

A thousand thanks to you 8)
I love you :D

I wish you a very very good day.
ImageThe happiness is a road...
Not a destination
Post Reply