Yet another question about codepage

General FreeBASIC programming questions.
Albom
Posts: 24
Joined: Oct 13, 2010 8:53
Location: Kharkiv, Ukraine
Contact:

Yet another question about codepage

Postby Albom » Nov 06, 2010 8:48

Hello!
For years programmers that use cyrrilics (from Russia, Ukraine, Belarus, ...) have a problem with print operator in graphic modes (screen 9 and above).
At russian FB forum there are several topics with vector and raster fonts to print strings. There is also a questionat this forum (not understood and not solved). So I write a problem again...

How to use cyrillic fonts (866 and 1251 codepages) in graphic modes to use build-in print and input operators? Or may be FB compiler should be modified? Where the modifications should be done?

Image
D.J.Peters
Posts: 7694
Joined: May 28, 2005 3:28

Postby D.J.Peters » Nov 06, 2010 10:49

hello Albom
FB used build in font's a part of the fbgfx library for the PRINT command.

But you can create your own font and print it with DRAW STRING
http://www.freebasic.net/wiki/wikka.php ... DrawString

Joshy
BasicScience
Posts: 474
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Nov 06, 2010 13:08

D.J.Peters
Posts: 7694
Joined: May 28, 2005 3:28

Postby D.J.Peters » Nov 06, 2010 14:13

Image

Code: Select all

' cp866.bas
function CreateFont(FontFile  as string, _
                    CharSize  as integer, _
                    FirstChar as integer, _
                    LastChar  as integer) as any ptr
  if screenptr()=0 then
    print "error: no active screeen mode !"
    beep:sleep:end
  end if
  dim as integer hFile = FreeFile()
  if open(FontFile,for binary,access read, as #hFile) then
    print "error: can't read '" & FontFile & "' !"
    beep:sleep:end
  end if
  ' get dimesion of the font picture
  dim as integer w,h
  get #hFile,19,w
  get #hFile,  ,h
  close #hFile
  ' create and load font image
  dim as any ptr pImage=ImageCreate(w,h)
  bload FontFile,pImage
  put (0,0),pImage
  ' create custom font with one extra row as header
  dim as integer nChars=(LastChar-FirstChar)+1
  dim as any ptr pFont=ImageCreate(CharSize*nChars,CharSize+1)
  dim as any ptr pChar=ImageCreate(CharSize,CharSize)
  dim as integer nRows=h\CharSize
  dim as integer nCols=w\CharSize
  windowtitle str(nCols) & "," & str(nRows)
  for y as integer = 0 to nRows-1
    for x as integer = 0 to nCols-1
       dim as integer n=y*16+x
       ' copy one char from font image to the custom font
       get pImage,(x*CharSize,y*CharSize+1)-step(CharSize-1,CharSize-1),pChar
       put pFont,(n*CharSize,1),pChar,pset
    next
  next
  ' write header from custom font
  dim as ubyte ptr pHeader
  ImageInfo pFont,,,,,pHeader
  pHeader[0]=0:pHeader[1]=FirstChar:pHeader[2]=LastChar
  for i as integer=1 to nChars
    pHeader[2+i] = CharSize
  next
  ImageDestroy pImage
  ImageDestroy pChar
  return pFont
end function

'
' main
'
chdir exepath
screenres 640,480,32

' create custom codepage 866 font
dim as any ptr font = CreateFont("cp866.bmp",17,32,255)

' test all chars
for y as integer = 2 to 15
  for x as integer = 0 to 15
    dim as integer code=y*16+x
    draw string (x*17,y*17),chr(code),,font,pset
  next
next
sleep
Last edited by D.J.Peters on Oct 03, 2017 5:34, edited 1 time in total.
Albom
Posts: 24
Joined: Oct 13, 2010 8:53
Location: Kharkiv, Ukraine
Contact:

Postby Albom » Nov 06, 2010 14:42

You didn't understand... I don't need a DrawString procedure (I have about 10 of them), I need Print operator...

From sources of fbgfx library I found that there are 3 fonts (fnt08x08.fnt, fnt08x14.fnt and fnt08x16.fnt). So now I am searching for fonts for 1251 codepage.
D.J.Peters
Posts: 7694
Joined: May 28, 2005 3:28

Postby D.J.Peters » Nov 06, 2010 19:17

Albom you can simple replace only the missing chars from the FB fonts.
After a Screen or Screenres command you can overwrite the missing chars with yours from codepage 866 or 1251.

Joshy

Code: Select all

type Font
  w as integer
  h as integer
  d as ubyte ptr
end type
extern Font8  alias "fb_font_8x8"  as Font
extern Font14 alias "fb_font_8x14" as Font
extern Font16 alias "fb_font_8x16" as Font

Code: Select all

' example to replace char 64 in 8x8 font
screenres 640,480
type Font
  w as integer
  h as integer
  d as ubyte ptr
end type
extern Font8  alias "fb_font_8x8"  as Font

with Font8
  .d[64*8+0] = &B11111111
  .d[64*8+1] = &B10000001
  .d[64*8+2] = &B10000001
  .d[64*8+3] = &B10000001
  .d[64*8+4] = &B10000001
  .d[64*8+5] = &B10000001
  .d[64*8+6] = &B10000001
  .d[64*8+7] = &B11111111
end with


while inkey=""
  locate 1+rnd*50,1+rnd*80
  color rnd*256
  print chr(64)
  sleep 10
wend

Code: Select all

' same with font8x14
screen 9

type Font
  w as integer
  h as integer
  d as ubyte ptr
end type
extern Font14 alias "fb_font_8x14" as Font
dim as integer char = 64*14
with Font14
  .d[char+ 0] = &B11111111
  .d[char+ 1] = &B10000001
  .d[char+ 2] = &B10000001
  .d[char+ 3] = &B10000001
  .d[char+ 4] = &B10000001
  .d[char+ 5] = &B10000001
  .d[char+ 6] = &B10000001
  .d[char+ 7] = &B10000001
  .d[char+ 8] = &B10000001
  .d[char+ 9] = &B10000001
  .d[char+10] = &B10000001
  .d[char+11] = &B10000001
  .d[char+12] = &B10000001
  .d[char+13] = &B11111111
end with


while inkey=""
  locate 1+rnd*23,1+rnd*79
  color rnd*256
  print chr(64)
  sleep 10
wend
Albom
Posts: 24
Joined: Oct 13, 2010 8:53
Location: Kharkiv, Ukraine
Contact:

Postby Albom » Nov 06, 2010 19:47

Thank you, D.J.Peters!
If this code works, then topic could be closed!
Albom
Posts: 24
Joined: Oct 13, 2010 8:53
Location: Kharkiv, Ukraine
Contact:

Postby Albom » Nov 15, 2010 17:33

So, the problem is solved. I have wrote a procedure for loading cyrillic fonts.

Image

You can download the library with an example from http://narod.ru/disk/27440637000/albom_ ... 1.zip.html
Albom
Posts: 24
Joined: Oct 13, 2010 8:53
Location: Kharkiv, Ukraine
Contact:

Postby Albom » Dec 28, 2010 19:31

Albom_font version 0.2. Codepage 866 is added.
http://narod.ru/disk/2352971001/albom_font_0.2.zip.html

Return to “General”

Who is online

Users browsing this forum: No registered users and 1 guest