PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Ruler Gadget - Beta 1 sourcecode library

https://www.purebasic.fr/english/viewtopic.php?t=26593

Page 1 of 4

Ruler Gadget - Beta 1 sourcecode library

Posted: Sun Apr 08, 2007 8:59 pm
by netmaestro
November 5, 2014: Updated for PB 5.31

I'll start this here because this is where it'll ultimately wind up, but it's only partly finished. Todo items include: 1) setting/clearing tabstops(*done*), 2) Drawing a dotted line down from the sliders when clicked (*done*), 3) hopefully reduce some flicker. (*solved*) Any and all help is appreciated!

Usage for the end user:

-Left-click anywhere on the ruler window (white section) to add a tabstop.
-Remove a tabstop by right-clicking on it or you can drag it off the ruler window downwards.
-Move a tabstop by dragging it left or right. Dropping a tabstop directly on another tabstop will merge them into one tabstop, if you miss by a few px it will snap in place beside it.
-Drag a margin marker to move it where you want it.


Update Monday Apr 9:

- restructured the code to be tighter and self-contained enough to allow multiple rulers at once

- added dotted-line indicators to the sliders when they are being moved

- added snap-to-grid in 1/16-inch increments for the sliders

Update Tuesday April 10:

- added tabstop functionality; The tabstops work just like the Wordpad ruler except you can also delete a tabstop by rightclicking

Update Wednesday, April 11:

Added 3 new commands:

RG_AddTabStop(ruler, x, units) // units are either #RulerUnits_Pixels or #RulerUnits_Inches

RG_ExamineTabStops(ruler) // initializes the list of a ruler's tabstops for iterating

RG_NextTabStop() // retrieve the next tabstop (in pixels mapped to the buddy), 0 if there are no more

Update Thu Apr 12:

- Gadget is mostly finished, enters Beta stage

- Added 3 new commands:

RG_RemoveTabStop(ruler, x, units) // clears a tabstop

RG_SetSliderPos(ruler, slider, x.f, units) // Sets a slider position (top slider is 1, bottomleft slider is 2, bottomright is 3)

RG_GetSliderPos(ruler, slider) // retrieve the slider position (in pixel units mapped to the buddy)

Update Fri Apr 13:

Sourcecode is included. No help included yet, but soon. Waiting to see if anything needs changed first.

Update Saturday Apr 14:

- Added event messaging for all significant events happening on the ruler

- Finetuned the tabstop movement slightly, removal behaviour is more consistent

Example program shows what events are available and how to use them, help is not written yet

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 

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 Timer(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(@Timer(),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) 
  UseJCALG1Packer()
  UncompressMemory(?PicPak, ?PicPakEnd-?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) 
  
  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 

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 
  PicPakEnd:
  
EndDataSection
Test prog:

Code: Select all

IncludeFile "RulerGadget.pbi"

OpenWindow(0,0,0,722,600,"Ruler Gadgets Demo Program",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

EditorGadget(0,0,76,722,200) 
RulerGadget(1,10,50,GadgetID(0)) 
EditorGadget(2,0,340,722,250) 
RulerGadget(3,10,312,GadgetID(2)) 

RG_AddTabStop(1, 0.5, #RulerUnits_Inches)
RG_AddTabStop(1, 1.5, #RulerUnits_Inches)
RG_AddTabStop(1, 2.5, #RulerUnits_Inches)
RG_AddTabStop(3, 3.5, #RulerUnits_Inches)
RG_AddTabStop(3, 4.5, #RulerUnits_Inches)
RG_AddTabStop(3, 5.5, #RulerUnits_Inches)

Debug "Tabstops for Ruler 1:"
RG_ExamineTabStops(1) ; List tabstops for rulergadget 1
result = RG_NextTabStop()
While result
  Debug result
  result = RG_NextTabStop()
Wend

Debug ""
Debug "Tabstops for Ruler 3:"

RG_ExamineTabStops(3) ; List tabstops for rulergadget 3
result = RG_NextTabStop()
While result
  Debug result
  result = RG_NextTabStop()
Wend

RG_SetSliderPos(1,2,2.5,#RulerUnits_Inches)
RG_SetSliderPos(1,3,5.25,#RulerUnits_Inches)

Debug ""
Debug "Slider positions for Ruler 1:"
For i=1 To 3
  Debug RG_GetSliderPos(1,i)
Next

Debug ""
Debug "Slider positions for Ruler 3:"
For i=1 To 3
  Debug RG_GetSliderPos(3,i)
Next

Debug ""
Debug "All results are pixel locations on the buddy gadget"
Debug ""

Repeat
  EventID = WaitWindowEvent()
  
  Select EventID
      
    Case #RulerEvent_TabStopChange
      *msglParam.RULEROBJECTMOVE = EventlParam()
      Debug "Tabstop moved from "+Str(*msglParam\OldPos)+"  to "+Str(*msglParam\NewPos)+" for ruler "+Str(EventwParam())
      
    Case #RulerEvent_TabStopAdd
      *msglParam.RULEROBJECTMOVE = EventlParam()
      Debug "Tabstop added at "+Str(*msglParam\NewPos)+" for ruler "+Str(EventwParam())
      
    Case #RulerEvent_TabStopRemove
      *msglParam.RULEROBJECTMOVE = EventlParam()
      Debug "Tabstop removed from "+Str(*msglParam\OldPos)+" for ruler "+Str(EventwParam())
      
    Case #RulerEvent_SliderPosChange
      *msglParam.RULEROBJECTMOVE = EventlParam()
      Debug "Slider "+Str(*msglParam\Slider)+" moved from "+Str(*msglParam\OldPos)+" to "+Str(*msglParam\NewPos)+" for ruler "+Str(EventwParam())
      
  EndSelect
  
Until EventID= #PB_Event_CloseWindow

Posted: Sun Apr 08, 2007 9:25 pm
by mueckerich
:D Cool,

thanks for sharing

Posted: Sun Apr 08, 2007 9:34 pm
by flaith
:shock: amazing piece of code, thanks

Posted: Sun Apr 08, 2007 10:13 pm
by SCRJ
really cool :D
thx for sharing

Posted: Sun Apr 08, 2007 10:40 pm
by rsts
You've done it again :D Simply brilliant.

I don't know how you continue to pull these things off, but I am thankful we have such a valuable contributor (one of several) active in the forums.

"My happyness"

cheers

Posted: Sun Apr 08, 2007 11:53 pm
by srod
Nice. Great work.

Allow for any kind of scaling (e.g. logical inches, logical cm etc.) and this would be awesome. :)

I think you will need to wrap the gadget up a little more into a self contained unit as you can't currently use two such gadgets at the same time. Still, looks easy enough to adjust.

Thanks.

Posted: Mon Apr 09, 2007 12:11 am
by netmaestro
The multiple rulers is easy enough, it's just the shared vars preventing it. Those can be moved into Window Properties with the others and it'll work without problems. As to the logical measurements you refer to, I'm not sure I know what you mean, if you can describe it further I'd appreciate it.

Posted: Mon Apr 09, 2007 12:26 am
by AND51
The small arrows sometimes don't react or jump away when clicking.
All in all, it works fine!

Additionally: Does it make sense, that you can move the right slider can overtake the left slider(s)?

Code: Select all

---------------------V--------------------
----^-------------------------------------

Posted: Mon Apr 09, 2007 12:33 am
by netmaestro
Solved the problem of other sliders flickering when moving one slider. Posted code is updated with the fix.

@And51: It shouldn't allow any overtaking, hopefully it isn't?

[edit] Ah, I see what you mean now. Fixed.

Posted: Mon Apr 09, 2007 12:52 am
by srod
Aye, I realised it was the shared variables. Probably stick these in a structure and use a window property to point to them etc. :)

It would be fab to be able to choose the units of measurement on the ruler; e.g. inches, cm etc. But rather than use physical inches on the screen (via GetDevCaps_() etc.) it would obviously make sense to scale the measurements so that the ruler is more easily viewed.

This is where logical inches come in, which are generally speaking bigger than a real inch. GetDevCaps_(#LOGPIXELSX) will return the number of pixels per logical inch along the screen width. The great thing is that this quantity, when obtained for a printer hdc, will correspond exactly to a physical inch on the paper; so you just need to switch a screen dc to a printer dc when printing etc. The thing is as well that if a user changes the dpi of the display through the control panel, our app (if using logical inches) will keep pace with the whole windows gui and rescale according to the users wishes.

Logical units are a great way of scaling certain drawings and I think is perfect for a ruler gadget like this.

Posted: Mon Apr 09, 2007 12:53 am
by AND51
Have a look at my [ video ] to be sure!

First, you can see upper left arrow CANNOT overtake right arrow. *
Second, you can see right arrow CANNOT overtake lower left arrow.
Third, you can see upper arrow BEAMS itself in front of the lower right arrow when you want to click and hold it! *



* Does this make sense or am I missing an idea?

Posted: Mon Apr 09, 2007 8:15 pm
by netmaestro
Updated Monday Apr 9/07 - code and details in first post. Please test thoroughly if you can, it's appreciated.

Posted: Mon Apr 09, 2007 8:32 pm
by Brice Manuel
Although I don't exactly have a need for this, I like it so much, I must find a way to integrate it into one of my projects. Its very good work :!:

Posted: Mon Apr 09, 2007 9:31 pm
by rsts
Image

Posted: Mon Apr 09, 2007 9:43 pm
by Fred
Very nice work :!:
All times are UTC+01:00
Page 1 of 4

Powered by phpBB® Forum Software © phpBB Limited