Draw Ruler Line On Form

Share your advanced PureBasic knowledge/code with the community.
Post Reply
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Draw Ruler Line On Form

Post by collectordave »

Simple programme to draw a ruler on a form.

Updated to use the vector drawing functions and some of the comments below.

This is the latest version.

Code: Select all

Global Window_0

Global cvsRuler

Declare Repaint()

LoadFont(0, "Times New Roman", 8)

Window_0 = OpenWindow(#PB_Any, x, y, 600, 70, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
cvsRuler = CanvasGadget(#PB_Any, 10, 10, 580, 50)
WindowBounds(Window_0, 400, 70, #PB_Ignore, #PB_Ignore)
BindEvent(#PB_Event_SizeWindow, @RePaint(),Window_0)

Procedure DrawRuler()

  If StartVectorDrawing(CanvasVectorOutput(cvsRuler,#PB_Unit_Millimeter))
    ;Uncomment these lines if you wish to clear the canvas first
    VectorSourceColor(RGBA(255, 255, 255, 255))
    AddPathBox(0,0,GadgetWidth(cvsRuler),GadgetHeight(cvsRuler))
    FillPath()
    VectorFont(FontID(0), 3)
   
    For i = 0 To VectorOutputWidth()
     
      If  Mod(i, 10) = 0
        MovePathCursor(i, 0)       
        AddPathLine(i,8)       
        MovePathCursor(i + 0.5,4)
        AddPathText(Str(i/10))
      ElseIf Mod(i, 5) = 0
        MovePathCursor(i, 0)
        AddPathLine(i,4)
      Else
        MovePathCursor(i, 0)
        AddPathLine(i,2)
      EndIf
     
    Next i
  EndIf
  VectorSourceColor(RGBA(100,100,100, 255))
  StrokePath(0.000000001)
  StopVectorDrawing()
 
EndProcedure

Procedure RePaint()
 
  ; Resize canvas
  W = WindowWidth(Window_0) - 20
  ResizeGadget(cvsRuler, #PB_Ignore, #PB_Ignore, W, #PB_Ignore)
  DrawRuler()
 
EndProcedure

DrawRuler()
RePaint()

Repeat
 
Until WaitWindowEvent() = #PB_Event_CloseWindow
Last edited by collectordave on Wed Jan 20, 2016 6:21 am, edited 2 times in total.
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
User avatar
TI-994A
Addict
Addict
Posts: 2741
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:
Contact TI-994A

Re: Draw Ruler Line On Form

Post by TI-994A »

Looks good, collectordave; nicely done.

You seem to be quite versed with the vector functions. I noticed in this example, and also remember reading somewhere, that the rendering measurements don't correlate to physical ones?

If you might know, is there any reason for this?
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Top
Mesa
Enthusiast
Enthusiast
Posts: 433
Joined: Fri Feb 24, 2012 10:19 am

Re: Draw Ruler Line On Form

Post by Mesa »

With me, each cm calculated is displayed with 2 cm on the ruler.

I had to change the collectordave's code with this:

Code: Select all

Global Window_0

Global cvsRuler,PPmm.d

Declare Repaint()
; ExamineDesktops()
; MessageRequester("Information d'affichage", "Résolution = "+Str(DesktopWidth(0))+"x"+Str(DesktopHeight(0))+"x"+Str(DesktopDepth(0)))

LoadFont(0, "Times New Roman", 8)


Window_0 = OpenWindow(#PB_Any, x, y, 600, 70, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
cvsRuler = CanvasGadget(#PB_Any, 10, 10, 580, 50)
WindowBounds(Window_0, 400, 70, #PB_Ignore, #PB_Ignore)
BindEvent(#PB_Event_SizeWindow, @RePaint(),Window_0)

Procedure GetPPmm()
  
  StartVectorDrawing(WindowVectorOutput(Window_0))
  PPmm = VectorResolutionX()/254.0
  ;Debug VectorResolutionX()
  StopVectorDrawing()
  
EndProcedure

Procedure DrawRuler()
  If StartDrawing(CanvasOutput(cvsRuler))
    ;Clear the ruler, otherwise we have a strange display)
    Box(0,0,GadgetWidth(cvsRuler),GadgetHeight(cvsRuler),RGB(255, 255, 255))
  EndIf 
  
  StopDrawing() 
  Length.d = GadgetWidth(cvsRuler)/PPmm
  
  If StartVectorDrawing(CanvasVectorOutput(cvsRuler,#PB_Unit_Millimeter))
    VectorFont(FontID(0), 2)
    
    For i = 1 To Length
      
      If  Mod(i, 10) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,10/2);i have to divide by 2 to get 10 mm ! ->Looks like a bug ?
        
        ;VectorSourceColor(RGBA(0,0,0, 255))
        MovePathCursor((i * PPmm) - 1,15/2)
        AddPathText(Str(i/10))
      ElseIf Mod(i, 5) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,5/2)
      Else
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,1/2)
      EndIf
      
    Next i
  EndIf
  ;Debug PPmm
  VectorSourceColor(RGBA(100,100,100, 255))
  StrokePath(PPmm/10)
  
  StopVectorDrawing()
  
EndProcedure

Procedure RePaint()
  
  ; Resize canvas
  W = WindowWidth(Window_0) - 20
  ResizeGadget(cvsRuler, #PB_Ignore, #PB_Ignore, W, #PB_Ignore)
  DrawRuler()
  
EndProcedure

GetPPmm()
DrawRuler()
RePaint()

Repeat
  
Until WaitWindowEvent() = #PB_Event_CloseWindow
M.
Top
User_Russian
Addict
Addict
Posts: 1549
Joined: Wed Nov 12, 2008 5:01 pm
Location: Russia

Re: Draw Ruler Line On Form

Post by User_Russian »

Fixed flicker when the window is resized.

Code: Select all

Global Window_0

Global cvsRuler,PPmm.d

Declare Repaint()
; ExamineDesktops()
; MessageRequester("Information d'affichage", "Résolution = "+Str(DesktopWidth(0))+"x"+Str(DesktopHeight(0))+"x"+Str(DesktopDepth(0)))

LoadFont(0, "Times New Roman", 8)


Window_0 = OpenWindow(#PB_Any, x, y, 600, 70, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
SmartWindowRefresh(Window_0, 1)
cvsRuler = CanvasGadget(#PB_Any, 10, 10, 580, 50)
WindowBounds(Window_0, 400, 70, #PB_Ignore, #PB_Ignore)
BindEvent(#PB_Event_SizeWindow, @RePaint(),Window_0)

Procedure GetPPmm()
  
  StartVectorDrawing(WindowVectorOutput(Window_0))
  PPmm = VectorResolutionX()/254.0
  ;Debug VectorResolutionX()
  StopVectorDrawing()
  
EndProcedure

Procedure DrawRuler()
;   If StartDrawing(CanvasOutput(cvsRuler))
;     ;Clear the ruler, otherwise we have a strange display)
;     Box(0,0,GadgetWidth(cvsRuler),GadgetHeight(cvsRuler),RGB(255, 255, 255))
;   EndIf 
;   
;   StopDrawing() 
  Length.d = GadgetWidth(cvsRuler)/PPmm
  
  If StartVectorDrawing(CanvasVectorOutput(cvsRuler,#PB_Unit_Millimeter))
    VectorFont(FontID(0), 2)
    VectorSourceColor(RGBA(255, 255, 255, 255))
    FillVectorOutput() ; Очистка области рисования.
    
    For i = 1 To Length
      
      If  Mod(i, 10) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,10/2);i have to divide by 2 to get 10 mm ! ->Looks like a bug ?
        
        ;VectorSourceColor(RGBA(0,0,0, 255))
        MovePathCursor((i * PPmm) - 1,15/2)
        AddPathText(Str(i/10))
      ElseIf Mod(i, 5) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,5/2)
      Else
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,1/2)
      EndIf
      
    Next i
  EndIf
  ;Debug PPmm
  VectorSourceColor(RGBA(100,100,100, 255))
  StrokePath(PPmm/10)
  
  StopVectorDrawing()
  
EndProcedure

Procedure RePaint()
  
  ; Resize canvas
  W = WindowWidth(Window_0) - 20
  ResizeGadget(cvsRuler, #PB_Ignore, #PB_Ignore, W, #PB_Ignore)
  DrawRuler()
  
EndProcedure

GetPPmm()
DrawRuler()
RePaint()

Repeat
  
Until WaitWindowEvent() = #PB_Event_CloseWindow
Top
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Draw Ruler Line On Form

Post by davido »

@collectordave,

An excellent example. Really does look just like a ruler.
Thank you very much for sharing. :D

I did notice that the main graduations are not exactly 1cm.
I am assuming that this is caused by PureBasic not being 'dpi aware'. Perhaps that might happen one day ....
http://www.purebasic.fr/english/viewtop ... 18#p472718
DE AA EB
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Draw Ruler Line On Form

Post by collectordave »

The problem I believe is with windows, it reports a setting and not the actual PPI of the screen. I found mine to be 100PPI not 96 as reported by windows. Apparently this is fixed in later versions of windows than mine (version 7).
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Draw Ruler Line On Form

Post by collectordave »

Thanks for the vector drawing functions they display half size on my computer. I used the 2d drawing library as I seem to get better lines that way.

Going to try the code though looks good.

Just one mystery. The vectorresolution functions return the PPI or pixels per inch and there are 25.4 mm per inch so dividing PPI by 25.4 should give the PPmm, pixels per millimetre. Why divide by 254? Am I missing something.
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Draw Ruler Line On Form

Post by collectordave »

Rewrote code using only vectordrawing functions so no PPmm needed. No flickering on my system.

Code: Select all

Global Window_0

Global cvsRuler

Declare Repaint()

LoadFont(0, "Times New Roman", 8)

Window_0 = OpenWindow(#PB_Any, x, y, 600, 70, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
cvsRuler = CanvasGadget(#PB_Any, 10, 10, 580, 50)
WindowBounds(Window_0, 400, 70, #PB_Ignore, #PB_Ignore)
BindEvent(#PB_Event_SizeWindow, @RePaint(),Window_0)

Procedure DrawRuler()

  If StartVectorDrawing(CanvasVectorOutput(cvsRuler,#PB_Unit_Millimeter))
    ;Uncomment these lines if you wish to clear the canvas first
    ;VectorSourceColor(RGB(255,255,255))
    ;AddPathBox(0,0,GadgetWidth(cvsRuler),GadgetHeight(cvsRuler))
    ;FillPath()
    VectorFont(FontID(0), 3)
   
    For i = 0 To VectorOutputWidth()
     
      If  Mod(i, 10) = 0
        MovePathCursor(i, 0)       
        AddPathLine(i,8)       
        MovePathCursor(i + 0.5,4)
        AddPathText(Str(i/10))
      ElseIf Mod(i, 5) = 0
        MovePathCursor(i, 0)
        AddPathLine(i,4)
      Else
        MovePathCursor(i, 0)
        AddPathLine(i,2)
      EndIf
     
    Next i
  EndIf
  VectorSourceColor(RGBA(100,100,100, 255))
  StrokePath(0.000000001)
  StopVectorDrawing()
 
EndProcedure

Procedure RePaint()
 
  ; Resize canvas
  W = WindowWidth(Window_0) - 20
  ResizeGadget(cvsRuler, #PB_Ignore, #PB_Ignore, W, #PB_Ignore)
  DrawRuler()
 
EndProcedure

DrawRuler()
RePaint()

Repeat
 
Until WaitWindowEvent() = #PB_Event_CloseWindow
Will have a look at printing a ruler and some kind of test
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
User avatar
TI-994A
Addict
Addict
Posts: 2741
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:
Contact TI-994A

Re: Draw Ruler Line On Form

Post by TI-994A »

collectordave wrote:Rewrote code using only vectordrawing functions...
The mensuration now correlates quite accurately. Thanks for the revision.

However, as you've indicated, it might be better to clear the canvas before redrawing, as the rendering gets a little corrupted each time. It appears that a standard RGB white doesn't work; simply replace it with:

Code: Select all

VectorSourceColor(RGBA(255, 255, 255, 255))
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
Top
infratec
Always Here
Always Here
Posts: 7620
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Draw Ruler Line On Form

Post by infratec »

A simplyfication for usage (I hope)

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf




Procedure DrawRuler(Gadget.i, Window.i=0)
  
  Protected Length.i, i.i
  Static PPmm.d
  
  
  If PPmm = 0
    StartVectorDrawing(WindowVectorOutput(Window))
    PPmm = VectorResolutionX()/254.0
    StopVectorDrawing()
  EndIf
    
  Length = GadgetWidth(Gadget)/PPmm
  
  If StartVectorDrawing(CanvasVectorOutput(Gadget, #PB_Unit_Millimeter))
    If IsFont(0)
      VectorFont(FontID(0), 2)
    EndIf
    VectorSourceColor(RGBA(255, 255, 255, 255))
    FillVectorOutput() ; ??????? ??????? ?????????.
   
    For i = 1 To Length
     
      If  Mod(i, 10) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,10/2);i have to divide by 2 to get 10 mm ! ->Looks like a bug ?
       
        ;VectorSourceColor(RGBA(0,0,0, 255))
        MovePathCursor((i * PPmm) - 1,15/2)
        AddPathText(Str(i/10))
      ElseIf Mod(i, 5) = 0
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,5/2)
      Else
        ;VectorSourceColor(RGBA(100,100,100, 255))
        MovePathCursor(i * PPmm, 0)
        AddPathLine(i * PPmm,1/2)
      EndIf
     
    Next i
  EndIf
  ;Debug PPmm
  VectorSourceColor(RGBA(100,100,100, 255))
  StrokePath(PPmm/10)
 
  StopVectorDrawing()
 
EndProcedure




Procedure RePaint()
  
  Protected EvWin.i, W.i, Gadget.i
  
  EvWin = EventWindow()
  W = WindowWidth(EvWin) - 20
  Gadget = EventGadget()
  ResizeGadget(Gadget, #PB_Ignore, #PB_Ignore, W, #PB_Ignore)
  DrawRuler(Gadget)
 
EndProcedure



Procedure RulerGadget(Gadget.i, x.i, y.i, Width.i, Height.i, Flags.i=0)
  
  Protected Result.i, Window.i
  
  
  Result = CanvasGadget(Gadget, x, y, Width, Height, Flags)
  
  If Result
    If Gadget = #PB_Any
      Gadget = Result
    EndIf
    
    Window = GetActiveWindow()
    
    DrawRuler(Gadget, Window)
    BindEvent(#PB_Event_SizeWindow, @RePaint(), Window, Gadget)
    
  EndIf
  
EndProcedure








CompilerIf #PB_Compiler_IsMainFile
  
  Define Window_0.i
  
  LoadFont(0, "Times New Roman", 8)
  
  
  Window_0 = OpenWindow(#PB_Any, 0, 0, 600, 70, "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
  WindowBounds(Window_0, 400, 70, #PB_Ignore, #PB_Ignore)
  SmartWindowRefresh(Window_0, 1)
  
  RulerGadget(0, 10, 10, 580, 50)
      
  Repeat
  
  Until WaitWindowEvent() = #PB_Event_CloseWindow

CompilerEndIf
The only bad thing is LoadFont() :oops:

Bernd
Top
collectordave
Addict
Addict
Posts: 1310
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Re: Draw Ruler Line On Form

Post by collectordave »

Thanks TI-994A

The display corruption has now disappeared and still no flickering.

Cheers
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
Top
Post Reply

Return to “Tricks 'n' Tips”