PureBasic Forums - English

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

Draw Ruler Line On Form

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

Page 1 of 1

Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 6:50 am
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

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 9:06 am
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?

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 11:22 am
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.

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 11:41 am
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

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 12:51 pm
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

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 5:03 pm
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).

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 5:11 pm
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.

Re: Draw Ruler Line On Form

Posted: Thu Jan 14, 2016 7:03 pm
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

Re: Draw Ruler Line On Form

Posted: Fri Jan 15, 2016 11:34 am
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))

Re: Draw Ruler Line On Form

Posted: Fri Jan 15, 2016 6:33 pm
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

Re: Draw Ruler Line On Form

Posted: Mon Jan 18, 2016 6:34 pm
by collectordave
Thanks TI-994A

The display corruption has now disappeared and still no flickering.

Cheers
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited