PrintLen on Test

[hmgchang]

Dear Sirs,
I do some test on PrintLen...

PrintLen on Test.JPG (166.22 KiB) Viewed 5854 times

Both side are for monospace and non-fixed fonts...
BTW, how to tell font is monospace or not ?

the ssw :

Code: Select all

#include <hmg.ch>

Function Main
  MEMVAR _HMG_SYSDATA
  Load Window Main
  Main.Center
  Main.Activate

Return NIL

FUNCTION TestFontWidth()
  LOCAL aFont, aFontSize, aText
  LOCAL cFontName, cText, cText1, cNum
  LOCAL nFontSize, nOneInch, nPAWidth, nPAHeight, nPAHorOffset, nPAVerOffset, nI
  LOCAL nRow1, nRow2, nCol1, nCol2, nRow, nCol, nOneCm, nPrintLen, nJ
  LOCAL nVSpace, nMyPrintLen
  LOCAL lSuccess
  MEMVAR _HMG_SYSDATA
  
  aText := {  "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789", ;
              "abcdefghijklmnopqrstuvwxyz0123456789", ;
              "人的一生，平安就好。", ;
              hb_UChar( 0x250C) + Replicate( hb_UChar ( 0x2500),20) + hb_UChar( 0x2510), ;
              hb_UChar( 0x2502) + "12345678901234567890" + hb_UChar( 0x2502)}
  
  aFontSize := { 10, 12, 14}
  
  aFont := { "CONSOLAS", "COURIER"}
              
  *- cText := "123456789012345678901234567890123456789012345678901234567890"
  
  *- aFont := GetFont()
  *- cFontname := aFont[ 1] && "CONSOLAS"
  *- nFontSize := 12

  SELECT PRINTER DIALOG TO lSuccess PREVIEW

  IF lSuccess
    nOneInch := 25.4
    nOneCm   := 10
    nPAWidth     := GetPrintableAreaWidth()
		nPAHeight    := GetPrintableAreaHeight()
		nPAHorOffset := GetPrintableAreaHorizontalOffset()
		nPAVerOffset := GetPrintableAreaVerticalOffset()
    
    START PRINTDOC
      START PRINTPAGE
      
        CmBlock( nPAWidth, nPAHeight)
                
        nRow := 5
        nCol := 0
        nVSpace := 5
        FOR nI := 1 TO LEN( aFontSize)
          nFontSize := aFontSize[ nI]
          nVSpace := nFontSize / 2 + 1
          nRow += nVSpace
          
          FOR nJ := 1 TO LEN( aText)
            cText := aText[ nJ]
            
            *- nRow += nFontSize
            *- nRow1 := nRow2 := nRow
            *- @ nRow1, 0 PRINT LINE TO nRow2, nPAWidth PENWIDTH 0.1 COLOR SILVER
            
            nRow += nVSpace + 3
            FOR nC := 1 TO LEN( aFont)
              cFontName := aFont[ nC]
              nCol := ( nC-1) * 110
              cText1 := cText + PADL( nFontSize, 3)
              
              @ nRow, nCol PRINT cText1 FONT cFontName SIZE nFontSize
              
              *- nRow += nI
              *- nRow1 := nRow2 := nRow
              *- @ nRow1, 0 PRINT LINE TO nRow2, nPAWidth PENWIDTH 0.1 COLOR SILVER
            
              nPrintLen := PrintLen( cText, nFontSize, cFontName)
              nMyPrintLen := MyPrintLen( cText, nFontSize)
              cText1 := "PrintLen : " + PADL( nPrintLen, 5) + ", me : " + PADL( nMyPrintLen, 5) + " mm."
              *- nRow += nVSpace
              @ nRow + nVSpace, nCol PRINT cText1 FONT cFontName SIZE nFontSize COLOR BLUE
            NEXT
            
            nRow += nVSpace
            
            
            *- @ nRow, nCol PRINT cText1 FONT cFontName SIZE nI BOLD
            *- nRow += nI
            *- @ nRow, nCol PRINT cText1 FONT cFontName SIZE nI ITALIC
            
          NEXT  
        NEXT
      END PRINTPAGE
    END PRINTDOC
  ENDIF
  
  RETURN NIL

function printLen( cString, nFontsize, cFontname)
  return round(gettextwidth(Nil,cString,cFontname)*0.0254*nFontsize,2)
  
FUNCTION MyPrintLen( cString, nFontSize)
  LOCAL nFontWidth
  nFontWidth := nFontSize * .555
  RETURN( LEN( cString) * nFontWidth * 25.4 / 72.272)
    
FUNCTION CmBlock( nPAWidth, nPAHeight)    
  LOCAL cNum
  LOCAL nOneCm, nOneInch
  LOCAL nI, nRow, nRow1, nRow2, nCol, nCol1, nCol2
  MEMVAR _HMG_SYSDATA
  
  nOneCm := 10
  nOneInch := 25.4
  
  *- Vertical Line
  nI := 0
  DO WHILE nI < nPAWidth
    * cm V-Line
    IF MOD( nI, nOneCm) == 0
      nRow1 := 0
      nRow2 := nPaHeight
      nCol1 := nCol2 := nI
      @ nRow1, nCol1 PRINT LINE TO nRow2, nCol2 PENWIDTH 0.05 COLOR AQUA
      
      cNum := ALLTRIM( STR( INT( MOD( nI, 110))))
      @ 0, nCol1 PRINT cNum FONT "CONSOLAS" SIZE 10
      @ nPAHeight - 5, nCol2 PRINT cNum FONT "CONSOLAS" SIZE 10
    ENDIF
    
    * Inch V-Line
    IF MOD( nI, nOneInch) == 0
      nRow1 := 0
      nRow2 := nPaHeight
      nCol1 := nCol2 := nI
      @ nRow1, nCol1 PRINT LINE TO nRow2, nCol2 PENWIDTH 0.05 COLOR SILVER
    ENDIF
    
    nI++
  ENDDO
  
  *- Horizonal Line
  nI := 0
  DO WHILE nI < nPAHeight 
    IF MOD( nI, nOneCm) == 0
      nRow1 := nRow2 := nI
      nCol1 := 0
      nCol2 := nPAWidth
      @ nRow1, nCol1 PRINT LINE TO nRow2, nCol2 PENWIDTH 0.05 COLOR AQUA
    ENDIF
    nI++
  ENDDO

  RETURN NIL

TIA

rgds,
Chang

[Rathinagiri]

I think there is no function to find out.

We can compare with the following box drawing chars. If the box is misaligned it is proportional font. If the box is rightly aligned, then it is monospace.

The following is in monospace font.

Code: Select all

┌─┐ ┌┬┐ [example of line drawing characters]
│ │ ├┼┤ [requires fixed-width, especially with spaces]
└─┘ └┴┘ [otherwise they are mis-aligned, as in the bottom.]

Same text, in proportional font.
┌─┐ ┌┬┐ [example of line drawing characters]
│ │ ├┼┤
└─┘ └┴┘

[Rathinagiri]

We can write a small function to find out whether the given font is a monospace or not.

Use this small sample to find out the list of monospaced fonts in your system.

Code: Select all

#include <hmg.ch>

Function Main
   public aFontList := {}
   public aMonoSpaced := {}
   
   GetFontList ( NIL, NIL, DEFAULT_CHARSET, NIL, NIL, NIL, @aFontList )

   define window main at 0, 0 width 800 height 600 main
      define label selectfont
         row 10
         col 10
         width 200
         value 'Select a font'
      end label
      define combobox fonts
         row 10
         col 210
         width 200
         items aFontList
         onchange if( checkfont_ismono( this.item( this.value ) ), main.ismono.value := 'This is a monospaced font', main.ismono.value := 'This is a proportional font' )
      end combobox
      define label ismono
         row 40
         col 10
         width 400
         fontbold .t.
      end label
   end window
   main.fonts.value := 1
   for i := 1 to hmg_len( aFontList )
      if checkfont_ismono( aFontList[ i ] )
         aadd( aMonoSpaced, aFontList[ i ] )
      endif   
   next i
   if hmg_len( aMonoSpaced )  > 0
      debugmsg( aMonoSpaced )
   endif   
   Main.Center
   Main.Activate

Return

function checkfont_ismono( cFontName )
   local aChars := { ' ', 'i', 'W' }
   local aLens := { 0, 0, 0 }
   local i
   local nFontSize := 14
   for i := 1 to len( aChars )
      aLens[ i ] := printlen( aChars[ i ], nFontSize, cFontName )
   next i
   lMono := .t.
   for i := 2 to len( aLens )
      if aLens[ 1 ] <> aLens[ i ]
         lMono := .f.
         exit
      endif
   next i
return lMono
         
         
function printLen( cString, nFontsize, cFontname)
  return round( gettextwidth( OpenPrinterGetDC(), cString, _HMG_CREATEFONT( OpenPrinterGetDC(), cFontname, nFontSize ) ) * 0.0254 * nFontsize, 2 )         
  
function DebugMSG
   local i, aTemp := {}
   
   for i := 1 to pcount()
      aadd( aTemp, hb_PValue(i))
   next i
   msgbox(hb_valtoexp(aTemp), "Debug Informations")
 return  
  
#pragma BEGINDUMP

#include "SET_COMPILE_HMG_UNICODE.ch"

#ifndef COMPILE_HMG_UNICODE
   #define COMPILE_HMG_UNICODE   // Force to compile in UNICODE
#endif

#include "HMG_UNICODE.h"

#include <windows.h>
#include "hbapi.h"

HB_FUNC ( _HMG_CREATEFONT )
  
{
   HFONT hFont ;
   int bold = FW_NORMAL;
   int italic = 0;
   int underline = 0;
   int strikeout = 0;

   if ( hb_parl (4) )
      bold = FW_BOLD;

   if ( hb_parl (5) )
      italic = 1;

   if ( hb_parl (6) )
      underline = 1;

   if ( hb_parl (7) )
      strikeout = 1;

   HDC hDC = (HDC) HMG_parnl (1);
   TCHAR *FontName = (TCHAR *) HMG_parc (2);
   INT FontSize = hb_parni (3);

   SetGraphicsMode (hDC, GM_ADVANCED);

   FontSize = FontSize * GetDeviceCaps (hDC, LOGPIXELSY) / 72;   // Size of font in logic points

   hFont = CreateFont (0-FontSize, 0, 0, 0, bold, italic, underline, strikeout,
           DEFAULT_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH | FF_DONTCARE, FontName);

   HMG_retnl ((LONG_PTR) hFont );
}

#pragma enddump
  
  

[Rathinagiri]

Thank you Chang for opening this thread.

You are an eye opener!

I have to correct some other programs according to the new calculations.

I have a doubt too.

Why in the picture above, printing in "Courier 10" doesn't have the same width for 'ABCDE...' and 'abcde...'? The font is a fixed width font...

[Pablo César]

Nice work Rathi !

You are an eye opener!

Yes ! And this is very good !

You always with new ideas...

Congrats both of you !

[Javier Tovar]

Excelente Sr. Rathinagiri muy bien

Saludos

////////////////////////////////////////////////////////////////////////
Excellent Mr. Rathinagiri very well

regards

[hmgchang]

Dear Sirs,
Thks Mr. Rathinagiri...
i tried by get this error

[hmgchang]

Dear Master,

i still cannot find any accurate calculation...
Could you pls share ... ?



TIA

ths n rgds
Chang

[Rathinagiri]

Which version of HMG are you using? It compiles right in HMG 3.3.1

[hmgchang]

Thks Sir,
I am still using hmg 3.2
And will upgrade !

Thks n rgds
Chang