Ruler Gadget - Beta 1 sourcecode library

QuimV · Post by **QuimV** » Sun Dec 16, 2007 10:46 am

@netmaestro

I'm using PB v4.10 and I use the link from June 1, but when I execute the installer, I get 4 error lines, one for every file included in the installer and I don't know what's happening ....

Please, Could I have these 4 files, but without the installer? I'l install them manually.

Thanks in advanced.

netmaestro · Post by **netmaestro** » Sun Dec 16, 2007 7:03 pm

Yes I see, it seems to be a problem with the installer, which I can't fix. The link for April 13 is updated with the 4.10 version files in a zip.

QuimV · Post by **QuimV** » Sun Dec 16, 2007 8:29 pm

@netmaestro
I've installed the files manually and all runs properly.
Thanks a lot for share your code and quickly help.

Dare · Post by **Dare** » Mon Dec 17, 2007 1:11 am

Thank you.

netmaestro · Post by **netmaestro** » Thu Jan 29, 2009 12:57 am

Jan 28/2009: Code updated to run on 4.30

NikitaOdnorob98 · Post by **NikitaOdnorob98** » Thu May 09, 2013 8:26 am

Code for PureBasic v5.11

Code: Select all

;================================================================= 
; Program:         Ruler Gadget 
; Author:          Lloyd Gallant (netmaestro) 
; Date:            April 9, 2007 
; Target OS:       Microsoft Windows All 
; Target Compiler: PureBasic 4.0 and later 
; License:         Free, unrestricted, credit appreciated 
;                  but not required 
; Version:         Beta 1.0 
;================================================================= 

#RulerUnits_Pixels = 0 
#RulerUnits_Inches = 1 

#RulerEvent_TabStopAdd      = #WM_APP + 31 
#RulerEvent_TabStopRemove   = #WM_APP + 32 
#RulerEvent_TabStopChange   = #WM_APP + 33 
#RulerEvent_SliderPosChange = #WM_APP + 34 

Structure Ruler 
  oldproc.l 
  slider1.l 
  slider2.l 
  slider3.l 
  base.l 
  baseimg.l 
  tabimg.l 
  tabregion.l 
  buddycontrol.l 
EndStructure 

CompilerIf Defined(RULEROBJECTMOVE, #PB_Structure) = 0 
  Structure RULEROBJECTMOVE 
    OldPos.w 
    NewPos.w 
    Slider.b 
  EndStructure 
CompilerEndIf 

UseJCALG1Packer()

Procedure DestroyExtraTabs(hwnd, param) 
  Static numtabs=0 
  If hwnd = 0 
    numtabs=0 
    ProcedureReturn 0 
  EndIf 
  GetWindowRect_(hwnd, @wr.RECT) 
  If wr\left = param 
    If GetProp_(hwnd, "TABSTOP") 
      numtabs + 1 
      If numtabs > 1 
        FreeGadget(GetDlgCtrlID_(hwnd)) 
      EndIf 
    EndIf 
  EndIf 
  ProcedureReturn 1 
EndProcedure 

Procedure Timer2(buddycontrol) 
  While GetAsyncKeyState_(#VK_LBUTTON) & 32768 
    Delay(1) 
  Wend 
  InvalidateRect_(buddycontrol,0,1) 
  RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
EndProcedure  

Procedure TabProc(hwnd, msg, wparam, lparam) 

   Protected sRec.RECT ; Portion of the slider area requiring redraw 
   With sRec           ; when in collision with a tabstop 
     \left   = 0       ; Only this portion will be updated 
     \top    = 0       ; to eliminate flickering of the slider 
     \right  = 8 
     \bottom = 5 
   EndWith 

   *gadgetdata.Ruler = GetWindowLong_(hwnd,#GWL_USERDATA) 
   With *gadgetdata 
     oldproc      = \oldproc 
     cSlider1     = \Slider1 
     cSlider2     = \Slider2 
     cSlider3     = \Slider3 
     cBase        = \base 
     iTab         = \tabimg 
     rTab         = \tabregion 
     buddycontrol = \buddycontrol 
   EndWith 
  result=CallWindowProc_(oldproc,hwnd, msg, wparam, lparam) 
  gadget=GetDlgCtrlID_(hwnd) 

  buddygadget = GetDlgCtrlID_(buddycontrol) 
  GetWindowRect_(buddycontrol, @bc.RECT) 
  buddyheight = bc\bottom - bc\top - 5 
  
  Select msg 
  
    Case #WM_PAINT 

      If GadgetX(gadget) <= GadgetX(cSlider2)+8 And GadgetX(gadget) >= GadgetX(cSlider2)-6 
        ValidateRect_(GadgetID(cSlider2),@sRec) 
      EndIf 
      If GadgetX(gadget) <= GadgetX(cSlider3)+8 And GadgetX(gadget) >= GadgetX(cSlider3)-6 
        ValidateRect_(GadgetID(cSlider3),@sRec) 
      EndIf 

      SetGadgetState(ig,ImageID(iTab)) 
      RedrawWindow_(GadgetID(gadget),0,@rTab,#RDW_UPDATENOW) 

      If GadgetX(gadget) <= GadgetX(cSlider2)+8 And GadgetX(gadget) >= GadgetX(cSlider2)-6 
        InvalidateRect_(GadgetID(cSlider2),@sRec,0)          
      EndIf 
      If GadgetX(gadget) <= GadgetX(cSlider3)+8 And GadgetX(gadget) >= GadgetX(cSlider3)-6 
        InvalidateRect_(GadgetID(cSlider3),@sRec,0)    
      EndIf        
      
    Case #WM_RBUTTONDOWN 
        
       *msglParam.RULEROBJECTMOVE = AllocateMemory(SizeOf(RULEROBJECTMOVE)) 
       *msglParam\OldPos = GetProp_(hwnd, "X") 
       *msglParam\NewPos = 0 
       PostThreadMessage_(GetCurrentThreadId_(), #RulerEvent_TabStopRemove, cBase, *msglParam) 
       FreeGadget(GetDlgCtrlID_(hwnd)) 
          
    Case #WM_ERASEBKGND 
      If GetProp_(hwnd, "Preexisting") = 0 
        SetProp_(hwnd, "Preexisting", 1) 
        GetWindowRect_(hwnd, @wp.RECT) 
        MapWindowPoints_(0,GadgetID(cBase),@wp,1) 
        wp\left + GadgetX(cBase)-GadgetX(buddygadget)-3 
        InvalidateRect_(buddycontrol,0,1) 
        RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
        penwrite=CreatePen_(#PS_DOT,0,#Black) 
        dc = GetDC_(buddycontrol) 
        SelectObject_(dc,penwrite) 
        MoveToEx_(dc,wp\left, 0, 0) 
        LineTo_(dc,wp\left,buddyheight) 
        DeleteObject_(penwrite)        
        ReleaseDC_(buddycontrol, dc) 
        CreateThread(@Timer2(),buddycontrol) 
        SendMessage_(hwnd, #WM_LBUTTONDOWN,0,0) 
      EndIf 
        
     Case #WM_LBUTTONDOWN 
  
       GetWindowRect_(hwnd, @wp.RECT) 
       MapWindowPoints_(0,GadgetID(cBase),@wp,1) 
       wp\left + GadgetX(cBase)-GadgetX(buddygadget)-3 
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       penwrite=CreatePen_(#PS_DOT,0,#Black) 
       dc = GetDC_(buddycontrol) 
       SelectObject_(dc,penwrite) 
       MoveToEx_(dc,wp\left, 0, 0) 
       LineTo_(dc,wp\left,buddyheight) 
       DeleteObject_(penwrite)        
       ReleaseDC_(buddycontrol, dc) 
      
       ig = GetDlgCtrlID_(GetWindow_(GadgetID(gadget),#GW_CHILD)) 
       GetWindowRect_(hwnd,@wr.RECT) 
       GetCursorPos_(@cp.POINT) 
       MapWindowPoints_(0,GadgetID(cBase),@cp,1) 
       xoffset = cp\x - GadgetX(gadget)      
       yoffset = cp\y-GadgetY(gadget) 

       DisableGadget(cSlider2, 1) 
       DisableGadget(cSlider3, 1) 
  
       oldx = 0 
       While GetAsyncKeyState_(#VK_LBUTTON) & 32768 
          
         GetCursorPos_(@cp.POINT) 
         MapWindowPoints_(0,GadgetID(cBase),@cp,1) 
         If cp\x <> oldx ; Only redraw if tab has moved 
           oldx = cp\x 
  
             If GadgetX(gadget) <= GadgetX(cSlider2)+8 And GadgetX(gadget) >= GadgetX(cSlider2)-6 
               ValidateRect_(GadgetID(cSlider2),@sRec) 
             EndIf 
             If GadgetX(gadget) <= GadgetX(cSlider3)+8 And GadgetX(gadget) >= GadgetX(cSlider3)-6 
               ValidateRect_(GadgetID(cSlider3),@sRec) 
             EndIf 
             ResizeGadget(gadget,cp\x-xoffset,9,#PB_Ignore,#PB_Ignore) 
             InvalidateRect_(GadgetID(gadget), 0, 0) 
             RedrawWindow_(GadgetID(gadget),0,@rTab,#RDW_UPDATENOW) 
             If GadgetX(gadget) <= GadgetX(cSlider2)+8 And GadgetX(gadget) >= GadgetX(cSlider2)-6 
               InvalidateRect_(GadgetID(cSlider2),@sRec,0)          
             EndIf 
             If GadgetX(gadget) <= GadgetX(cSlider3)+8 And GadgetX(gadget) >= GadgetX(cSlider3)-6 
               InvalidateRect_(GadgetID(cSlider3),@sRec,0)    
             EndIf        
             GetWindowRect_(GadgetID(gadget),@wr.RECT) 
             MapWindowPoints_(0, GadgetID(cBase),@wr,1) 
             RedrawWindow_(GadgetID(cBase),@wr,0,#RDW_UPDATENOW) 
  
         Else 
            If cp\y >= 20 Or GadgetX(gadget) < 3 Or GadgetX(gadget) > 696 
              *msglParam.RULEROBJECTMOVE = AllocateMemory(SizeOf(RULEROBJECTMOVE)) 
              *msglParam\OldPos = GetProp_(hwnd, "X") 
              *msglParam\NewPos = 0 
              PostThreadMessage_(GetCurrentThreadId_(), #RulerEvent_TabStopRemove, cBase, *msglParam) 
              
              FreeGadget(gadget) 
              Break 
            EndIf 
         EndIf 
         Delay(1) 
       Wend 
        
       DisableGadget(cSlider2, 0) 
       DisableGadget(cSlider3, 0) 
  
       ; Snap to 1/16-inch grid 
       If IsGadget(gadget) 
          ValidateRect_(GadgetID(cSlider2),0) 
          ValidateRect_(GadgetID(cSlider3),0) 
         cur = GadgetX(gadget) % 6+2 
         If cur <= 3 
           ResizeGadget(gadget,GadgetX(gadget)-cur,9,#PB_Ignore,#PB_Ignore) 
         Else 
           ResizeGadget(gadget,GadgetX(gadget)+6-cur,9,#PB_Ignore,#PB_Ignore) 
         EndIf 
          
         GetWindowRect_(hwnd, @wp.RECT) 
         MapWindowPoints_(0,GadgetID(cBase),@wp,1) 
         wp\left + GadgetX(cBase)-GadgetX(buddygadget)-4 
         oldpos = GetProp_(hwnd, "X") 
         SetProp_(hwnd, "X", wp\left) 
         If oldpos <> wp\left 
            *msglParam.RULEROBJECTMOVE = AllocateMemory(SizeOf(RULEROBJECTMOVE)) 
            *msglParam\OldPos = oldpos 
            *msglParam\NewPos = wp\left 
            PostThreadMessage_(GetCurrentThreadId_(), #RulerEvent_TabStopChange, cBase, *msglParam) 
         EndIf 
          
         ; Tab is dropped now, delete it if there is already a tab here 
        
         GetWindowRect_(GadgetID(gadget),@wr.RECT) 
         EnumChildWindows_(GadgetID(cBase), @DestroyExtraTabs(), wr\left) 
         CallFunctionFast(@DestroyExtraTabs(),0,0) ; Clear the tab counter for next time 
          
         If IsGadget(gadget) 
            
           SetGadgetState(ig,ImageID(iTab)) 
           InvalidateRect_(GadgetID(cSlider2),0,0)          
           InvalidateRect_(GadgetID(cSlider3),0,0)    
           InvalidateRect_(buddycontrol,0,1) 
           RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
         EndIf 

       EndIf 
        
      Case #WM_WINDOWPOSCHANGED 

       *wp.WINDOWPOS = lParam 
       *wp\x+GadgetX(cBase)-GadgetX(buddygadget)-3 
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       penwrite=CreatePen_(#PS_DOT,0,#Black) 
       dc = GetDC_(buddycontrol) 
       SelectObject_(dc,penwrite) 
       MoveToEx_(dc,*wp\x, 0, 0) 
       LineTo_(dc,*wp\x,buddyheight) 
       DeleteObject_(penwrite)        
       ReleaseDC_(buddycontrol, dc) 
  
    Case #WM_NCDESTROY 
      
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       RemoveProp_(hwnd, "TABSTOP") 
       RemoveProp_(hwnd, "Preexisting") 
       RemoveProp_(hwnd, "X") 
   EndSelect 
  ProcedureReturn result 
EndProcedure 


Procedure FindTab(hwnd, param) 
  GetWindowRect_(hwnd, @wr.RECT) 
  *cp.POINT = param 
  If PtInRect_(@wr, *cp\x | *cp\y<<32) 
    If GetProp_(hwnd, "TABSTOP") 
      SendMessage_(hwnd,#WM_LBUTTONDOWN,0,0) ; if we found a tab we want to click it 
      ProcedureReturn 0 
    EndIf 
  EndIf 
  ProcedureReturn 1 
EndProcedure 

ProcedureDLL RG_AddTabStop(ruler, x.f, units) 

  Protected oldproc,cSlider1,cSlider2,cSlider3,cBase,buddycontrol,gadget,buddy,buddyheight,buddygadget 
   *gadgetdata.Ruler = GetWindowLong_(GadgetID(ruler),#GWL_USERDATA) 
   With *gadgetdata 
     oldproc      = \oldproc 
     cSlider1     = \Slider1 
     cSlider2     = \Slider2 
     cSlider3     = \Slider3 
     cBase        = \base 
     iTab         = \tabimg 
     rTab         = \tabregion 
     buddycontrol = \buddycontrol 
   EndWith 

   buddygadget = GetDlgCtrlID_(buddycontrol) 

   ; See if a tab already exists where a new one would be dropped 
   ; after being snapped to the 6-pixel grid 
   Protected cp.POINT 

   If units = #RulerUnits_Inches 
     cp\x = x*96 
   Else 
     cp\x = x 
   EndIf 
    
   cp\x + 3 ; offset of the image gadget in the base container 
   cp\y = GadgetY(cBase)+10 

   cp\y=10 
   cur = cp\x % 6+2 
   If cur <= 3 
     cp\x - cur 
   Else 
    cp\x+6-cur 
   EndIf 
   MapWindowPoints_(GadgetID(cBase),0,@cp,1) 
  
   If Not EnumChildWindows_(GadgetID(cBase), @FindTab(), @cp) 
     foundtab = #True 
   Else 
     foundtab = #False 
   EndIf 
    
   ; Now we know if there is already a tab at the drop spot 
   ; Do not create a new one if one exists now 
      
   If Not foundtab 
    
     MapWindowPoints_(0,GadgetID(cBase),@cp,1) 
    
     If cp\y <=15 And cp\y >=9 

       OpenGadgetList(cBase) 
       tabstop = ContainerGadget(#PB_Any,cp\x,9,6,6) 
       SetProp_(GadgetID(tabstop), "X", cp\x+GadgetX(cBase)-GadgetX(buddygadget)-4 ) 
       rTab = ExtCreateRegion_(0, 64, ?tabstop) 
       SetWindowRgn_(GadgetID(tabstop), rTab, #True); 
    
       ti = ImageGadget(#PB_Any,0,0,6,6,ImageID(iTab)) 
       CloseGadgetList() 
       CloseGadgetList() 
    
       SetProp_(GadgetID(tabstop), "TABSTOP", 1) 
       oldproc = SetWindowLong_(GadgetID(tabstop),#GWL_WNDPROC,@TabProc()) 
       SetWindowLong_(GadgetID(tabstop),#GWL_USERDATA, *gadgetdata) 

       SetGadgetState(ti, ImageID(iTab)) 
       DisableGadget(ti, 1) 
        
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       If IsGadget(tabstop) 
         ValidateRect_(GadgetID(cSlider2),0) 
         InvalidateRect_(GadgetID(tabstop),0,1) 
         InvalidateRect_(GadgetID(cSlider2),0,1) 
        
          *msglParam.RULEROBJECTMOVE = AllocateMemory(SizeOf(RULEROBJECTMOVE)) 
          *msglParam\OldPos = 0 
          *msglParam\NewPos = GetProp_(GadgetID(tabstop), "X") 
          
          PostThreadMessage_(GetCurrentThreadId_(), #RulerEvent_TabStopAdd, cBase, *msglParam)          
          
       EndIf 
            
     EndIf 
   EndIf 

EndProcedure 


Procedure BaseProc(hwnd, msg, wparam, lparam) 

  Protected oldproc,cSlider1,cSlider2,cSlider3,cBase,buddycontrol,gadget,buddy,buddyheight,buddygadget 
   *gadgetdata.Ruler = GetWindowLong_(hwnd,#GWL_USERDATA) 
   With *gadgetdata 
     oldproc      = \oldproc 
     cSlider1     = \Slider1 
     cSlider2     = \Slider2 
     cSlider3     = \Slider3 
     cBase        = \base 
     iTab         = \tabimg 
     rTab         = \tabregion 
     buddycontrol = \buddycontrol 
   EndWith 
    
   result = CallWindowProc_(oldproc, hwnd, msg, wparam, lparam) 
      
   Select msg 
     Case #WM_RBUTTONDOWN 
       foundtab = #False 
       GetCursorPos_(@tp.POINT) 
       For i=1 To 5 
         tp\y+1 
         If GetProp_(WindowFromPoint_(tp\x|tp\y<<32), "TABSTOP") 
           SendMessage_(WindowFromPoint_(tp\x|tp\y<<32),#WM_RBUTTONDOWN,0,0) 
           Break 
         EndIf 
       Next 
        
     Case #WM_LBUTTONDOWN 
       GetCursorPos_(@cp.POINT) 
       If EnumChildWindows_(GadgetID(cBase), @FindTab(), @cp.POINT) 
         MapWindowPoints_(0,GadgetID(cBase),@cp,1) 
         x.f = cp\x-3 ; 3 = offset of image gadget in base container 
         RG_AddTabStop(cBase, x, #RulerUnits_Pixels) 
       EndIf 
    EndSelect 
    
   ProcedureReturn result 
    
EndProcedure 

Procedure SliderProc(hwnd, msg, wparam, lparam) 
   Protected oldproc,cSlider1,cSlider2,cSlider3,cBase,buddycontrol,gadget,buddy,buddyheight,buddygadget 
   *gadgetdata.Ruler = GetWindowLong_(hwnd,#GWL_USERDATA) 
   With *gadgetdata 
     oldproc      = \oldproc 
     cSlider1     = \Slider1 
     cSlider2     = \Slider2 
     cSlider3     = \Slider3 
     cBase        = \base 
     buddycontrol = \buddycontrol 
   EndWith 
    
   result = CallWindowProc_(oldproc, hwnd, msg, wparam, lparam) 
   gadget=GetDlgCtrlID_(hwnd) 
   buddygadget = GetDlgCtrlID_(buddycontrol) 
   GetWindowRect_(buddycontrol, @bc.RECT) 
   buddyheight = bc\bottom - bc\top - 5 

   Select gadget 
     Case cSlider1, cSlider2 
       left = 0 
       buddy = cSlider3 
       right = GadgetX(buddy)-GadgetWidth(gadget) 
     Case cSlider3 
       If GadgetX(cSlider2)>GadgetX(cSlider1) 
         buddy = cSlider2 
       Else 
         buddy = cSlider1 
       EndIf 
       left = GadgetX(buddy)+GadgetWidth(buddy) 
       right = 696 
   EndSelect    
  
   Select msg 

     Case #WM_LBUTTONDOWN 
       GetWindowRect_(hwnd, @wp.RECT) 
       MapWindowPoints_(0,GadgetID(cBase),@wp,1) 
       wp\left + GadgetX(cBase)-GadgetX(buddygadget)+2 
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       penwrite=CreatePen_(#PS_DOT,0,#Black) 
       dc = GetDC_(buddycontrol) 
       SelectObject_(dc,penwrite) 
       MoveToEx_(dc,wp\left, 0, 0) 
       LineTo_(dc,wp\left,buddyheight) 
       DeleteObject_(penwrite)        
       ReleaseDC_(buddycontrol, dc) 
      
       oldpos = GetProp_(hwnd, "X") 
       GetWindowRect_(hwnd,@wr.RECT) 
       offset=DesktopMouseX()-wr\left 
       While GetAsyncKeyState_(#VK_LBUTTON) & 32768 
         GetCursorPos_(@cp.POINT) 
         MapWindowPoints_(0,GadgetID(cBase),@cp,1) 
         If GadgetX(gadget)<>cp\x-offset 
           ResizeGadget(gadget, cp\x-offset,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
           GetWindowRect_(GadgetID(gadget),@wr.RECT) 
           MapWindowPoints_(0, GadgetID(cBase),@wr,1) 
           RedrawWindow_(GadgetID(cBase),@wr,0,#RDW_UPDATENOW) 
           RedrawWindow_(GadgetID(gadget),0,0,#RDW_UPDATENOW) 
         EndIf 
         Delay(1) 
       Wend 
       ; Snap to 1/16-inch grid 
       cur = GadgetX(gadget) % 6 
       If cur <= 3 And gadget <> cSlider3 
         ResizeGadget(gadget,GadgetX(gadget)-cur,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
       Else 
         ResizeGadget(gadget,GadgetX(gadget)+6-cur,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
       EndIf 
        
       SetProp_(hwnd, "X", GadgetX(cBase)-GadgetX(buddygadget)+GadgetX(gadget)) 
  
       *msglParam.RULEROBJECTMOVE = AllocateMemory(SizeOf(RULEROBJECTMOVE)) 
       *msglParam\OldPos = oldpos 
       *msglParam\NewPos = GetProp_(hwnd, "X") 
       *msglParam\Slider = GetProp_(hwnd, "SLIDER") 
       PostThreadMessage_(GetCurrentThreadId_(), #RulerEvent_SliderPosChange, cBase, *msglParam)          

       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
        
     Case #WM_WINDOWPOSCHANGED 
       *wp.WINDOWPOS = lParam 
       *wp\x+GadgetX(cBase)-GadgetX(buddygadget)+2 
       InvalidateRect_(buddycontrol,0,1) 
       RedrawWindow_(buddycontrol,0,0,#RDW_UPDATENOW) 
       penwrite=CreatePen_(#PS_DOT,0,#Black) 
       dc = GetDC_(buddycontrol) 
       SelectObject_(dc,penwrite) 
       MoveToEx_(dc,*wp\x, 0, 0) 
       LineTo_(dc,*wp\x,buddyheight) 
       DeleteObject_(penwrite)        
       ReleaseDC_(buddycontrol, dc) 
        
     Case #WM_WINDOWPOSCHANGING 

       *wp.WINDOWPOS = lParam 
       If *wp\x > right 
         *wp\x=right 
         result=0 
       EndIf 
       If *wp\x < left 
         *wp\x = left 
         result=0 
       EndIf 
        
     Case #WM_MOVE 
        SetProp_(hwnd, "X", GadgetX(cBase)-GadgetX(buddygadget)+GadgetX(gadget)) 
        
     Case #WM_NCDESTROY 
       RemoveProp_(hwnd, "SLIDER") 
       RemoveProp_(hwnd, "X") 
        
   EndSelect 
    
   ProcedureReturn result 
    
EndProcedure 

ProcedureDLL RulerGadget(GadgetNumber, x, y, buddycontrol) 
  
  Global NewList RG_gTabs() ; used for ExamineTabStops() 
  
  cBase = ContainerGadget(GadgetNumber, x, y, 750, 25) 
  If GadgetNumber<>#PB_Any 
    cBase = GadgetNumber 
  EndIf 
  
  buddygadget = GetDlgCtrlID_(buddycontrol) 
  
  bf = GetSysColor_(#COLOR_BTNFACE) 
  *unpacked = AllocateMemory(672) 
  UncompressMemory(?PicPak, ?EndPicPak-?PicPak, *unpacked, 672) 
  img0 = CatchImage(#PB_Any, *unpacked, 672) 
  FreeMemory(*unpacked) 
  StartDrawing(ImageOutput(img0)) 
    For i=0 To 8:For j=0 To 21:If Point(i,j)=$FF00FF:Plot(i,j,bf):EndIf:Next:Next 
  StopDrawing() 
  
  ; Get Slider images 
  iSlider1 = GrabImage(img0, #PB_Any, 0, 0, 9, 8) 
  iSlider2 = GrabImage(img0, #PB_Any, 0, 8, 9, 14) 
  iSlider3 = GrabImage(img0, #PB_Any, 0, 8, 9, 8) 
  FreeImage(img0) 
  
  ; Draw the ruler bar 
  iBase = CreateImage(#PB_Any, 700,14,24) 
  StartDrawing(ImageOutput(iBase)) 
    Box(0,0,700,14,#White):Box(577,0,123,14,bf) 
    DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT)) 
    DrawingMode(#PB_2DDrawing_Transparent) 
    cc=0:For i=93 To 675 Step 96:cc+1:DrawText(i, 1, Str(cc)):Next 
    For i = 11 To 686 Step 12 
      If i<>95 And i<>191 And i<>287 And i<>383 And i<>479 And i<>575 And i<>671 
        Box(i,7,1,2) 
      EndIf 
    Next 
    For i=47 To 686 Step 96:Box(i,5,1,5):Next 
  StopDrawing() 
  
  gBase = ImageGadget(#PB_Any,3,0,0,0,ImageID(iBase),#PB_Image_Border) 
  DisableGadget(gBase,1) 
  
  cSlider1 = ContainerGadget(#PB_Any,0,0,9,8) 
  SetProp_(GadgetID(cSlider1), "SLIDER", 1) 
  SetProp_(GadgetID(cSlider1), "X", GadgetX(cBase)-GadgetX(buddygadget)+GadgetX(cSlider1)) 
  gSlider1 = ImageGadget(#PB_Any,0,0,0,0,ImageID(iSlider1)) 
  
  CloseGadgetList() ; cSlider1 
  cSlider2 = ContainerGadget(#PB_Any,0,10,9,14) 
  SetProp_(GadgetID(cSlider2), "SLIDER", 2) 
  SetProp_(GadgetID(cSlider2), "X", GadgetX(cBase)-GadgetX(buddygadget)+GadgetX(cSlider2)) 
  gSlider2 = ImageGadget(#PB_Any,0,0,0,0,ImageID(iSlider2)) 
  CloseGadgetList() ; cSlider2 
  cSlider3 = ContainerGadget(#PB_Any,552,10,9,8) 
  SetProp_(GadgetID(cSlider3), "SLIDER", 3)    
  SetProp_(GadgetID(cSlider3), "X", GadgetX(cBase)-GadgetX(buddygadget)+GadgetX(cSlider3))  
  gSlider3 = ImageGadget(#PB_Any,0,0,0,0,ImageID(iSlider3)) 
  CloseGadgetList() ; cSlider3 
  CloseGadgetList() ; cBase 
  
  DisableGadget(gSlider1, 1) 
  DisableGadget(gSlider2, 1) 
  DisableGadget(gSlider3, 1) 
  
  ; Apply Clipping Regions 
  hRegion1 = ExtCreateRegion_(0, 112, ?down) 
  SetWindowRgn_(GadgetID(cSlider1), hRegion1, #True); 
  hRegion2 = ExtCreateRegion_(0, 112, ?upleft) 
  SetWindowRgn_(GadgetID(cSlider2), hRegion2, #True); 
  hRegion3 = ExtCreateRegion_(0, 112, ?upright) 
  SetWindowRgn_(GadgetID(cSlider3), hRegion3, #True); 
  
  rTab = ExtCreateRegion_(0, 64, ?tabstop) 
    
  iTab=CreateImage(#PB_Any,6,6,24) 
  StartDrawing(ImageOutput(iTab)) 
    Box (2,0,4,4,#White) 
  StopDrawing()  
  
  ; Apply SubClasses 
  oldproc = SetWindowLong_(GadgetID(cSlider1), #GWL_WNDPROC, @SliderProc()) 
  *gadgetdata.Ruler = AllocateMemory(SizeOf(Ruler)) 
  With *gadgetdata 
    \oldproc = oldproc 
    \Slider1 = cSlider1 
    \Slider2 = cSlider2 
    \Slider3 = cSlider3 
    \base    = cBase 
    \baseimg = iBase 
    \tabimg  = iTab 
    \tabregion = rTab 
    \buddycontrol = buddycontrol 
  EndWith 
  SetWindowLong_(GadgetID(cSlider1),#GWL_USERDATA,*gadgetdata) 
  
  oldproc = SetWindowLong_(GadgetID(cSlider2), #GWL_WNDPROC, @SliderProc()) 
  SetWindowLong_(GadgetID(cSlider2),#GWL_USERDATA,*gadgetdata) 

  oldproc = SetWindowLong_(GadgetID(cSlider3), #GWL_WNDPROC, @SliderProc()) 
  SetWindowLong_(GadgetID(cSlider3),#GWL_USERDATA,*gadgetdata) 

  oldproc = SetWindowLong_(GadgetID(cBase), #GWL_WNDPROC, @BaseProc()) 
  SetWindowLong_(GadgetID(cBase),#GWL_USERDATA,*gadgetdata) 

  SetGadgetState(gBase,ImageID(iBase)) 
  SetGadgetState(gSlider1,ImageID(iSlider1)) 
  SetGadgetState(gSlider2,ImageID(iSlider2)) 
  SetGadgetState(gSlider3,ImageID(iSlider3)) 
  InvalidateRect_(GadgetID(cBase),0,1) 
  
  DataSection 
    ; Regions 
    upleft: 
    Data.b $20,$00,$00,$00,$01,$00,$00,$00,$05,$00,$00,$00,$50,$00 
    Data.b $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$09,$00,$00,$00,$0E,$00 
    Data.b $00,$00,$04,$00,$00,$00,$00,$00,$00,$00,$05,$00,$00,$00,$01,$00 
    Data.b $00,$00,$03,$00,$00,$00,$01,$00,$00,$00,$06,$00,$00,$00,$02,$00 
    Data.b $00,$00,$02,$00,$00,$00,$02,$00,$00,$00,$07,$00,$00,$00,$03,$00 
    Data.b $00,$00,$01,$00,$00,$00,$03,$00,$00,$00,$08,$00,$00,$00,$04,$00 
    Data.b $00,$00,$00,$00,$00,$00,$04,$00,$00,$00,$09,$00,$00,$00,$0E,$00 
    Data.b $00,$00,$00 
    
    upright: 
    Data.b $20,$00,$00,$00,$01,$00 
    Data.b $00,$00,$05,$00,$00,$00,$50,$00,$00,$00,$00,$00,$00,$00,$00,$00 
    Data.b $00,$00,$09,$00,$00,$00,$08,$00,$00,$00,$04,$00,$00,$00,$00,$00 
    Data.b $00,$00,$05,$00,$00,$00,$01,$00,$00,$00,$03,$00,$00,$00,$01,$00 
    Data.b $00,$00,$06,$00,$00,$00,$02,$00,$00,$00,$02,$00,$00,$00,$02,$00 
    Data.b $00,$00,$07,$00,$00,$00,$03,$00,$00,$00,$01,$00,$00,$00,$03,$00 
    Data.b $00,$00,$08,$00,$00,$00,$04,$00,$00,$00,$00,$00,$00,$00,$04,$00 
    Data.b $00,$00,$09,$00,$00,$00,$08,$00,$00,$00 
      
    down: 
    Data.b $20,$00,$00,$00,$01,$00 
    Data.b $00,$00,$05,$00,$00,$00,$50,$00,$00,$00,$00,$00,$00,$00,$00,$00 
    Data.b $00,$00,$09,$00,$00,$00,$08,$00,$00,$00,$00,$00,$00,$00,$00,$00 
    Data.b $00,$00,$09,$00,$00,$00,$04,$00,$00,$00,$01,$00,$00,$00,$04,$00 
    Data.b $00,$00,$08,$00,$00,$00,$05,$00,$00,$00,$02,$00,$00,$00,$05,$00 
    Data.b $00,$00,$07,$00,$00,$00,$06,$00,$00,$00,$03,$00,$00,$00,$06,$00 
    Data.b $00,$00,$06,$00,$00,$00,$07,$00,$00,$00,$04,$00,$00,$00,$07,$00 
    Data.b $00,$00,$05,$00,$00,$00,$08,$00,$00,$00,$09 

    tabstop: 
    Data.b $20,$00,$00,$00,$01,$00,$00,$00,$02,$00 
    Data.b $00,$00,$20,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$06,$00 
    Data.b $00,$00,$06,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$02,$00 
    Data.b $00,$00,$04,$00,$00,$00,$00,$00,$00,$00,$04,$00,$00,$00,$06,$00 
    Data.b $00,$00,$06,$00,$00,$00,$00 
      
    ; Bitmaps 
    PicPak: 
    Data.b $4A,$43,$A0,$02,$00,$00,$44,$0E,$C3,$9D,$BA,$A9,$D0,$20,$69,$14 
    Data.b $11,$08,$12,$CA,$08,$B0,$4A,$16,$A5,$84,$0C,$30,$46,$02,$89,$81 
    Data.b $A0,$76,$60,$10,$D8,$42,$9D,$43,$7B,$15,$30,$7E,$C0,$24,$52,$00 
    Data.b $FF,$E5,$0E,$B3,$06,$2C,$B8,$00,$E3,$2A,$1B,$D5,$98,$C3,$DE,$87 
    Data.b $6D,$FC,$36,$06,$94,$61,$79,$86,$51,$1F,$4A,$A3,$30,$87,$0E,$F3 
    Data.b $0C,$E3,$5C,$86,$51,$2C,$95,$D9,$C5,$61,$59,$33,$9A,$1D,$A4,$94 
    Data.b $35,$B1,$91,$08,$44,$DF,$00,$00,$00,$00 
    EndPicPak:
    
  EndDataSection 
  
  If GadgetNumber = #PB_Any 
    ProcedureReturn cBase 
  Else 
    ProcedureReturn GadgetID(cBase) 
  EndIf 
  
EndProcedure 

Procedure EnumTabStops(hwnd, param) 
  
 ;Static NewList tabs() 
  
  Select hwnd 
    Case -2 
      ClearList(RG_gTabs()) 
      Result = 0 
    Case -1 
      ResetList(RG_gTabs()) 
      Result = 0 
    Case 0 
      If NextElement(RG_gTabs()) 
        Result = RG_gTabs() 
      Else 
        Result = 0 
      EndIf 
    Default 
      If GetProp_(hwnd, "TABSTOP") 
        AddElement(RG_gTabs()) 
        RG_gTabs() = GetProp_(hwnd, "X") 
      EndIf 
      Result = 1 
  EndSelect 
  
  ProcedureReturn Result 
  
EndProcedure 

ProcedureDLL RG_ExamineTabStops(ruler) 
  CallFunctionFast(@EnumTabStops(), -2, 0)               ; Clear the list out 
  EnumChildWindows_(GadgetID(ruler), @EnumTabStops(), 0) ; fill the list 
  CallFunctionFast(@EnumTabStops(),-1, 0)               ; reset the list for iterating later 
EndProcedure 

ProcedureDLL RG_NextTabStop() 
  Result = CallFunctionFast(@EnumTabStops(), 0, 0) 
  ProcedureReturn result 
EndProcedure 

ProcedureDLL RG_RemoveTabStop(ruler, x.f, units) 
  cp.POINT 
  If units 
    cp\x = x * 96 + 4 
  Else 
    cp\x = x + 4 
  EndIf 
  cp\y = 9 
  MapWindowPoints_(GadgetID(ruler),0,@cp, 1) 
  tabstop = WindowFromPoint_(cp\x|cp\y<<32) 
  dc=GetDC_(0) 
  SetPixel_(dc, cp\x,cp\y, #Red) 
  If GetProp_(tabstop, "TABSTOP") 
    FreeGadget(GetDlgCtrlID_(tabstop)) 
  EndIf 
EndProcedure 

Procedure SetSliderPos(hwnd, *mem) 
  slider = PeekL(*mem) 
  x      = PeekL(*mem+4) 
  If GetProp_(hwnd, "SLIDER") = slider 
    gadget = GetDlgCtrlID_(hwnd) 
    ResizeGadget(gadget, x, #PB_Ignore, #PB_Ignore, #PB_Ignore) 

    ; Snap to 1/16-inch grid 
    cur = GadgetX(gadget) % 6 
    If cur <> 0 
      ResizeGadget(gadget,GadgetX(gadget)+6-cur,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
    EndIf 
    ProcedureReturn 0 
  EndIf 
  ProcedureReturn 1 
EndProcedure 

ProcedureDLL RG_SetSliderPos(ruler, slider, x.f, units) 
  *mem = AllocateMemory(8) 
  If units 
    x = 96 * x 
  EndIf 
  PokeL(*mem, slider) 
  PokeL(*mem+4, Int(x)) 
  EnumChildWindows_(GadgetID(ruler), @SetSliderPos(), *mem) 
EndProcedure 

Procedure GetSliderPos(hwnd, slider) 
  Static x 
  
  If hwnd = 0 
    ProcedureReturn x 
  EndIf 
  
  If GetProp_(hwnd, "SLIDER") = slider 
    gadget = GetDlgCtrlID_(hwnd) 
    x = GetProp_(hwnd, "X") 
    ProcedureReturn 0 
  EndIf 
  ProcedureReturn 1 
  
EndProcedure 

ProcedureDLL RG_GetSliderPos(ruler, slider) 
  EnumChildWindows_(GadgetID(ruler), @GetSliderPos(), slider) 
  ProcedureReturn CallFunctionFast(@GetSliderPos(),0,0) 
EndProcedure

NikitaOdnorob98 · Post by **NikitaOdnorob98** » Thu May 09, 2013 8:28 am

Will the possibility of creating a vertical gadget, gadget arbitrary width?

netmaestro · Post by **netmaestro** » Thu Nov 06, 2014 7:34 am

Code updated to PB 5.31

Fixes required:
-updated unpacking calls to use current commands
-moved labels out of procedure as labels in procedures are local now
-changed #WM_CLOSE to #PB_Event_CloseWindow as #WM_CLOSE is no longer supported
-removed deprecated CreateGadgetList()

Kwai chang caine · Post by **Kwai chang caine** » Thu Nov 06, 2014 5:26 pm

I had not seen this great code

Now yes !!!

Thanks for sharing

Thade · Post by **Thade** » Thu Nov 06, 2014 10:30 pm

Seems to work for everybody but not me ...

Or do I expect something which is not there?

So what shall this Demo do?
I expect that the Text I put inside the Editorgadgets below the Ruler Gadgets starts where the left slider is located and when I insert Tabs the next character continues below a Tab Sign?

netmaestro · Post by **netmaestro** » Thu Nov 06, 2014 10:37 pm

Sorry, I should have explained that the ruler gadget provides functionality of the tab stops and margin markers and will report their locations when asked, but the buddy gadget (in this case the editor) has to be given code separately to actually respond to what's on the ruler. That part isn't done for this demo, though it would have made sense to add it. iirc I ran out of time and had to stop but hopefully in the next few weeks I'll be able to pick up where I left off and create a complete working demo. Or maybe someone else will do it and add the code to the thread.

Thade · Post by **Thade** » Thu Nov 06, 2014 10:45 pm

Thank you, netmaestro, for making that clear ... I am really interested how this formatting could be done.

Ok. Waiting for further versions

PureBasic Forums - English

Ruler Gadget - Beta 1 sourcecode library

Re: Ruler Gadget - Beta 1, downloadable compiled lib

Re: Ruler Gadget - Beta 1, downloadable compiled lib

Re: Ruler Gadget - Beta 1 sourcecode library

Re: Ruler Gadget - Beta 1 sourcecode library

Re: Ruler Gadget - Beta 1 sourcecode library

Re: Ruler Gadget - Beta 1 sourcecode library

Re: Ruler Gadget - Beta 1 sourcecode library