Une pseudo-police bitmap

Malgré tous mes essais, je n'ai pas réussi à créer une police reconnue par Windows, dans laquelle je puisse mettre des images bitmap à la place de chaque caractère.

Dans un autre post, j'avais déjà publié un lien vers un outil extraordinaire qui permet d'afficher n'importe quel caractère Unicode, et d'exporter sont image sous forme bitmap dans un fichier. Cette bitmap fait en général 500x500 pixels, mais étant donné qu'elle est en noir et blanc uniquement (un seul bit de profondeur de couleur), ces bitmaps sont très petits. On peut ainsi facilement extraire tous les caractères Unicode voulus. Le lien vers cet outil est ici: Unicode Lab Report.

Alors, j'ai fait un outil avec lequel je peux remplir une table de 256 caractères, en remplaçant chaque caractère par une image bitmap. Cela peut être une de ces bitmaps Unicode, mais également n'importe quelle bitmap, même des photos. On peut aussi utiliser des images JPG et PNG. Et cela peut même être des clip-arts ou des photos. On n'est pas obligé de remplacer tous les caractères par des images, seulement ceux pour lesquels ce sera utile. On peut ensuite enregistrer cette pseudo-police, on peut la réouvrir pour modification, on peut même effacer une image mise en place dans la police. Et on peut saisir un petit texte "échantillon" de 8 caractères qui sera ensuite affiché en utilisant cette pseudo-police, à titre d'exemple. Tout caractère non remplacé par une image sera imprimé tel quel.

Voici le code:

Code:: ' Bitmap_Font_image.bas

label newfont, openfont, savefont, selchar, changefont
label loadimage, setimage, resetimage, testfont

dim res%, nom$, i%, j%, x%, y%, lig%, col%, dl%, dc%, img$, s$
dim flags%(255)

dll_on "KGF.dll"

width 0,830 : height 0,600
combo 1 : left 1,330 : width 1,200 : font_names_load 1 : on_click 1,changefont
res% = dll_call2("SelectComboBoxItem",handle(1),1)

open_dialog 3
save_dialog 4
image 5

button 11 : left 11,10 : caption 11,"Nouveau" : on_click 11,newfont
button 12 : left 12,110 : caption 12,"Ouvrir" : on_click 12,openfont
button 13 : left 13,210 : caption 13,"Enregistrer" : on_click 13,savefont

picture 21 : top 21,30 : left 21,10 : width 21,512 : height 21,512 : on_click 21,selchar
font_name 21,text$(1)

picture 22 : top 22,30 : left 22,530 : width 22,100 : height 22,100
button 23 : top 23,30 : left 23,640 : caption 23,"Ouvrir image" : on_click 23,loadimage
button 24 : top 24,60 : left 24,640 : caption 24,"Placer image" : on_click 24,setimage
button 25 : top 25,90 : left 25,640 : caption 25,"Effacer image" : on_click 25,resetimage

alpha 31 : top 31,160 : left 31,530 : caption 31,"Echantillon:"
edit 32 : top 32,180 : left 32,530 : width 32,70
picture 33 : top 33,210 : left 33,530 : width 33,256 : height 33,32
font_name 33,text$(1)
2d_target_is 33
2d_pen_color 0,0,0
2d_fill_color 255,255,255
2d_fill_on
2d_rectangle 0,0,256,32
for i%=1 to 7
2d_line i%*32,0,i%*32,32
next i%
button 34 : top 34,180 : left 34,640 : caption 34,"Tester" : on_click 34,testfont

gosub newfont

end

changefont:
font_name 33,text$(1)
displayarea()
return

sub displayarea()
2d_target_is 21
2d_fill_color 255,255,255
col% = -1
lig% = -1
print_target_is 21
font_size 21,6 : font_color 21,0,0,0
font_name 21,"Arial"
2d_pen_width 1
for i%=0 to 15
for j%=0 to 15
if flags%(i%*16+j%)=1
2d_fill_off
else
2d_fill_on
end_if
2d_rectangle j%*32,i%*32,(j%+1)*32+1,(i%+1)*32+1
if flags%(i%*16+j%)=0
print_locate j%*32 + 2,i%*32 + 2
print str$(i%*16+j%)
end_if
next j%
next i%
font_bold 21 : font_color 21,0,0,255
font_name 21,text$(1)
for i%=0 to 15
for j%=0 to 15
if flags%(i%*16+j%)=0
print_locate j%*32 + 14,i%*32 + 16
print chr$(i%*16+j%)
end_if
next j%
next i%
font_bold_off 21
end_sub

' réinitialiser tout
newfont:
nom$ = ""
caption 0,"Bitmap_Font - <nouveau>"
col% = -1
lig% = -1
color 22,255,255,255
for i%=0 to 255
flags%(i%) = 0
next i%
displayarea()
return

' ouvrir les fichiers pbm et bmp
openfont:
filter 3,"Police bitmap|*.pbm"
nom$ = file_name$(3)
if nom$="_" then return
if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
if file_exists(nom$)=0
message "Oups...non trouvé !"
return
end_if
caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
file_open_read 1,nom$
file_readln 1,s$
if s$<>file_extract_name$(nom$)
message "Oups - structure de police invalide !"
file_close 1
return
end_if
file_readln 1,s$
if len(s$)<>256
message "Oups - structure de police invalide !"
file_close 1
return
end_if
for i%=0 to 255
flags%(i%) = val(mid$(s$,i%+1,1))
next i%
file_load 21,left$(nom$,len(nom$)-4)+".bmp"
lig% = -1
col% = -1
return

' enregistrer les fichiers pbm et bmp
savefont:
filter 4,"Police bitmap|*.pbm"
nom$ = file_name$(4)
if nom$="_" then return
if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
if file_exists(nom$)=1
if message_confirmation_yes_no("Cette police existe déjà. Remplacer ?")<>1 then return
end_if
caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
file_open_write 1,nom$
file_writeln 1,file_extract_name$(nom$)
s$ = ""
for i%=0 to 255
s$ = s$ + str$(flags%(i%))
next i%
file_writeln 1,s$
file_close 1
file_save 21,left$(nom$,len(nom$)-4)+".bmp"
return

selchar:
2d_target_is 21
x% = mouse_x_left_down(21)
y% = mouse_y_left_down(21)
if col%>=0
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 0,0,0
if flags%(lig%*16+col%)=1
2d_fill_off
else
2d_fill_color 255,255,255
end_if
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
if flags%(lig%*16+col%)=0
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
end_if
end_if
col% = int((x%+31)/32) - 1
lig% = int((y%+31)/32) - 1
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 255,0,0
if flags%(lig%*16+col%)=1
2d_fill_off
else
2d_fill_color 255,255,0
end_if
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
if flags%(lig%*16+col%)=0
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
end_if
2d_fill_on
2d_pen_color 0,0,0
return

loadimage:
filter 3,"Images|*.bmp;*.jpg;*.png"
img$ = file_name$(3)
if img$="_" then return
if file_exists(img$)=0
message "Oups - image non trouvée !"
return
end_if
res% = dll_call1("LoadAnyImageFile",adr(img$))
res% = dll_call2("ResizePicture",100,100)
2d_target_is 22
clipboard_paste 22
return

setimage:
if col%<0
message "Oups - pas de caractère choisi !"
return
end_if
clipboard_copy 22
res% = dll_call2("ResizePicture",32,32)
2d_target_is 21
clipboard_paste 5
2d_image_paste 5,col%*32,lig%*32
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 0,0,0
2d_fill_off
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
2d_fill_on
flags%(lig%*16+col%) = 1
return

resetimage:
if col%=0
message "Oups - pas de caractère choisi !"
return
end_if
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 255,0,0
2d_fill_color 255,255,0
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
flags%(lig%*16+col%) = 0
return

testfont:
s$ = text$(32)
if len(s$)=0 then return
if len(s$)>8
s$ = left$(s$,8)
text 32,s$
end_if
for i%=1 to len(s$)
j% = asc(mid$(s$,i%,1))
if flags%(j%)=1
2d_target_is 21
y% = int(j%/16)
x% = j% - y%*16
2d_image_copy 5,x%*32,y%*32,(x%+1)*32,(y%+1)*32
2d_target_is 33
2d_image_paste 5,(i%-1)*32,0
else
print_target_is 33
font_size 33,12
print_locate (i%-1)*32+9,6
print mid$(s$,i%,1)
end_if
next i%
print_target_is 21
2d_target_is 21

return

C'est un exercice de style, mais cela peut être intéressant...

EDIT

J'ai ajouté une combo pour pouvoir choisir la police de base (pour les caractères non remplacées par des images).

Bonjour Klaus !

J'ai pas encore testé mais je vais regarder cela !
C'est le type d'outil que je recherchais pour GPP.

Voici une version légèrement modifiée, avec un agrandissement de la zone d'échantillon:

Code:: ' Bitmap_Font_image.bas

label newfont, openfont, savefont, selchar, changefont
label loadimage, setimage, resetimage, testfont

dim res%, nom$, i%, j%, x%, y%, lig%, col%, dl%, dc%, img$, s$
dim flags%(255), imgs$(255)

dll_on "KGF.dll"

width 0,830 : height 0,700
combo 1 : left 1,330 : width 1,200 : font_names_load 1 : on_click 1,changefont
  res% = dll_call2("SelectComboBoxItem",handle(1),1)

open_dialog 3
save_dialog 4
image 5

button 11 : left 11,10 : caption 11,"Nouveau" : on_click 11,newfont
button 12 : left 12,110 : caption 12,"Ouvrir" : on_click 12,openfont
button 13 : left 13,210 : caption 13,"Enregistrer" : on_click 13,savefont

picture 21 : top 21,30 : left 21,10 : width 21,512 : height 21,512 : on_click 21,selchar
  font_name 21,text$(1)

picture 22 : top 22,30 : left 22,530 : width 22,100 : height 22,100
button 23 : top 23,30 : left 23,640 : caption 23,"Ouvrir image" : on_click 23,loadimage
button 24 : top 24,60 : left 24,640 : caption 24,"Placer image" : on_click 24,setimage
button 25 : top 25,90 : left 25,640 : caption 25,"Effacer image" : on_click 25,resetimage

alpha 31 : top 31,560 : left 31,10 : caption 31,"Echantillon:"
edit 32 : top 32,560 : left 32,80 : width 32,140
picture 33 : top 33,590 : left 33,10 : width 33,512 : height 33,32
  font_name 33,text$(1)
' 2d_target_is 33
' 2d_pen_color 0,0,0
' 2d_fill_color 255,255,255
' 2d_fill_on
' 2d_rectangle 0,0,256,32
' for i%=1 to 7
' 2d_line i%*32,0,i%*32,32
' next i%
button 34 : top 34,560 : left 34,230 : caption 34,"Tester" : on_click 34,testfont

gosub newfont

end

changefont:
  font_name 33,text$(1)
  displayarea()
  return

sub displayarea()
  2d_target_is 21
  2d_fill_color 255,255,255
  col% = -1
  lig% = -1
  print_target_is 21
  font_size 21,6 : font_color 21,0,0,0
  font_name 21,"Arial"
  2d_pen_width 1
  for i%=0 to 15
   for j%=0 to 15
   if flags%(i%*16+j%)=1
   2d_fill_off
   else
   2d_fill_on
   end_if
   2d_rectangle j%*32,i%*32,(j%+1)*32+1,(i%+1)*32+1
   if flags%(i%*16+j%)=0
   print_locate j%*32 + 2,i%*32 + 2
   print str$(i%*16+j%)
   end_if
   next j%
  next i%
  font_bold 21 : font_color 21,0,0,255
  font_name 21,text$(1)
  for i%=0 to 15
   for j%=0 to 15
   if flags%(i%*16+j%)=0
   print_locate j%*32 + 14,i%*32 + 16
   print chr$(i%*16+j%)
   end_if
   next j%
  next i%
  font_bold_off 21
end_sub

' réinitialiser tout
newfont:
  nom$ = ""
  caption 0,"Bitmap_Font - <nouveau>"
  col% = -1
  lig% = -1
  color 22,255,255,255
  for i%=0 to 255
   flags%(i%) = 0
  next i%
  displayarea()
  return

' ouvrir les fichiers pbm et bmp
openfont:
  filter 3,"Police bitmap|*.pbm"
  nom$ = file_name$(3)
  if nom$="_" then return
  if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
  if file_exists(nom$)=0
   message "Oups...non trouvé !"
   return
  end_if
  caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
  file_open_read 1,nom$
  file_readln 1,s$
  if s$<>file_extract_name$(nom$)
   message "Oups - structure de police invalide !"
   file_close 1
   return
  end_if
  file_readln 1,s$
  if len(s$)<>256
   message "Oups - structure de police invalide !"
   file_close 1
   return
  end_if
  for i%=0 to 255
   flags%(i%) = val(mid$(s$,i%+1,1))
  next i%
  for i%=1 to 255
   file_readln 1,s$
   j% = instr(s$,"=")
   if j%=0
   message "Oups - structure de police invalide !"
   file_close 1
   return
   end_if
   imgs$(i%) = mid$(s$,j%+1,len(s$))
  next i%
  file_close 1
  file_load 21,left$(nom$,len(nom$)-4)+".bmp"
  lig% = -1
  col% = -1
  return

' enregistrer les fichiers pbm et bmp
savefont:
  filter 4,"Police bitmap|*.pbm"
  nom$ = file_name$(4)
  if nom$="_" then return
  if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Cette police existe déjà. Remplacer ?")<>1 then return
  end_if
  caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
  file_open_write 1,nom$
  file_writeln 1,file_extract_name$(nom$)
  s$ = ""
  for i%=0 to 255
   s$ = s$ + str$(flags%(i%))
  next i%
  file_writeln 1,s$
  for i%=0 to 255
   file_writeln 1,str$(i%)+"="+imgs$(i%)
  next i%
  file_close 1
  file_save 21,left$(nom$,len(nom$)-4)+".bmp"
  return

selchar:
  2d_target_is 21
  x% = mouse_x_left_down(21)
  y% = mouse_y_left_down(21)
  if col%>=0
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 0,0,0
   if flags%(lig%*16+col%)=1
   2d_fill_off
   else
   2d_fill_color 255,255,255
   end_if
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   if flags%(lig%*16+col%)=0
   font_bold_off 21 : font_color 21,0,0,0
   print_locate col%*32 + 2,lig%*32 + 2
   print str$(lig%*16+col%)
   font_bold 21 : font_color 21,0,0,255
   print_locate col%*32 + 14,lig%*32 + 16
   print chr$(lig%*16+col%)
   end_if
  end_if
  col% = int((x%+31)/32) - 1
  lig% = int((y%+31)/32) - 1
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 255,0,0
   if flags%(lig%*16+col%)=1
   2d_fill_off
   else
   2d_fill_color 255,255,0
   end_if
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   if flags%(lig%*16+col%)=0
   font_bold_off 21 : font_color 21,0,0,0
   print_locate col%*32 + 2,lig%*32 + 2
   print str$(lig%*16+col%)
   font_bold 21 : font_color 21,0,0,255
   print_locate col%*32 + 14,lig%*32 + 16
   print chr$(lig%*16+col%)
   end_if
   2d_fill_on
   2d_pen_color 0,0,0
  return

loadimage:
  filter 3,"Images|*.bmp;*.jpg;*.png"
  img$ = file_name$(3)
  if img$="_" then return
  if file_exists(img$)=0
   message "Oups - image non trouvée !"
   return
  end_if
  res% = dll_call1("LoadAnyImageFile",adr(img$))
  res% = dll_call2("ResizePicture",100,100)
  2d_target_is 22
  clipboard_paste 22
  return

setimage:
  if col%<0
   message "Oups - pas de caractère choisi !"
   return
  end_if
  clipboard_copy 22
  res% = dll_call2("ResizePicture",32,32)
  2d_target_is 21
  clipboard_paste 5
  2d_image_paste 5,col%*32,lig%*32
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 0,0,0
   2d_fill_off
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   2d_fill_on
  flags%(lig%*16+col%) = 1
  imgs$(lig%*16+col%) = img$
  return

resetimage:
  if col%=0
   message "Oups - pas de caractère choisi !"
   return
  end_if
  dl% = 1
  dc% = 1
  if lig%=15 then dl% = 0
  if col%=15 then dc% = 0
  2d_pen_color 255,0,0
  2d_fill_color 255,255,0
  2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
  font_bold_off 21 : font_color 21,0,0,0
  print_locate col%*32 + 2,lig%*32 + 2
  print str$(lig%*16+col%)
  font_bold 21 : font_color 21,0,0,255
  print_locate col%*32 + 14,lig%*32 + 16
  print chr$(lig%*16+col%)
  flags%(lig%*16+col%) = 0
  imgs%(lig%*16+col%) = ""
  return

testfont:
  s$ = text$(32)
  if len(s$)=0 then return
  if len(s$)>16
   s$ = left$(s$,16)
   text 32,s$
  end_if
  for i%=1 to len(s$)
   j% = asc(mid$(s$,i%,1))
   if flags%(j%)=1
   2d_target_is 21
   y% = int(j%/16)
   x% = j% - y%*16
   2d_image_copy 5,x%*32+1,y%*32+1,(x%+1)*32,(y%+1)*32
   2d_target_is 33
   2d_image_paste 5,(i%-1)*32,0
   else
   print_target_is 33
   font_size 33,12
   print_locate (i%-1)*32+9,6
   print mid$(s$,i%,1)
   end_if
  next i%
  print_target_is 21
  2d_target_is 21

  return

Cette version mémorise les noms et chemins de tous les fichiers d'images dans la pseudo_police. On peut ainsi construire un texte avec cette police, directement à partir des images d'origine, en utilisant LoadAnyImageFile, suivi de ResizePicture, puis 2d_image_copy suivi de 2d_image_paste, afin d'avoir une représentation de bonne qualité, quelque soit la taille de l'écriture souhaitée.

Voici une capture d'écran:
Une pseudo-police bitmap Aa110

C'est clair que ça peut être sympa de faire des jeux, des menus et autres fichiers d'aide à base de caractères modifiés Wink

Et voici une version avec une prévisualisation d'un texte, en choisissant la taille de la police/ Cette prévisualisation a lieu dans une fenêtre pop-up qui contient un picture recevant le texte construit:

Code:: ' Bitmap_Font_image.bas

label newfont, openfont, savefont, selchar, changefont
label loadimage, setimage, resetimage, testfont, previewfont, closepreview

dim res%, nom$, i%, j%, x%, y%, lig%, col%, dl%, dc%, img$, s$, siz%
dim flags%(255), imgs$(255)

dll_on "KGF.dll"

width 0,830 : height 0,700
combo 1 : left 1,330 : width 1,200 : font_names_load 1 : on_click 1,changefont
  res% = dll_call2("SelectComboBoxItem",handle(1),1)

open_dialog 3
save_dialog 4
image 5

button 11 : left 11,10 : caption 11,"Nouveau" : on_click 11,newfont
button 12 : left 12,110 : caption 12,"Ouvrir" : on_click 12,openfont
button 13 : left 13,210 : caption 13,"Enregistrer" : on_click 13,savefont

picture 21 : top 21,30 : left 21,10 : width 21,512 : height 21,512 : on_click 21,selchar
  font_name 21,text$(1)

picture 22 : top 22,30 : left 22,530 : width 22,100 : height 22,100
button 23 : top 23,30 : left 23,640 : caption 23,"Ouvrir image" : on_click 23,loadimage
button 24 : top 24,60 : left 24,640 : caption 24,"Placer image" : on_click 24,setimage
button 25 : top 25,90 : left 25,640 : caption 25,"Effacer image" : on_click 25,resetimage

alpha 31 : top 31,560 : left 31,10 : caption 31,"Echantillon:"
edit 32 : top 32,560 : left 32,80 : width 32,140
picture 33 : top 33,590 : left 33,10 : width 33,512 : height 33,32
  font_name 33,text$(1)
button 34 : top 34,560 : left 34,230 : caption 34,"Tester" : on_click 34,testfont
combo 35 : top 35,560 : left 35,350 : width 35,90
  item_add 35,"20x20 pixels"
  item_add 35,"32x32 pixels"
  item_add 35,"40x40 pixels"
  item_add 35,"64x64 pixels"
  item_add 35,"128x128 pixels"
  res% = dll_call2("SelectComboBoxItem",handle(35),2)
button 36 : top 36,560 : left 36,450 : caption 36,"Visualiser" : on_click 36,previewfont

form 100 : hide 100 : height 100,300 : width 100,screen_x : top 100,100
  caption 100,"Visualisation" : on_close 100,closepreview
picture 101 : parent 101,100 : full_space 101

gosub newfont

end

changefont:
  font_name 33,text$(1)
  displayarea()
  return

sub displayarea()
  2d_target_is 21
  2d_fill_color 255,255,255
  col% = -1
  lig% = -1
  print_target_is 21
  font_size 21,6 : font_color 21,0,0,0
  font_name 21,"Arial"
  2d_pen_width 1
  for i%=0 to 15
   for j%=0 to 15
   if flags%(i%*16+j%)=1
   2d_fill_off
   else
   2d_fill_on
   end_if
   2d_rectangle j%*32,i%*32,(j%+1)*32+1,(i%+1)*32+1
   if flags%(i%*16+j%)=0
   print_locate j%*32 + 2,i%*32 + 2
   print str$(i%*16+j%)
   end_if
   next j%
  next i%
  font_bold 21 : font_color 21,0,0,255
  font_name 21,text$(1)
  for i%=0 to 15
   for j%=0 to 15
   if flags%(i%*16+j%)=0
   print_locate j%*32 + 14,i%*32 + 16
   print chr$(i%*16+j%)
   end_if
   next j%
  next i%
  font_bold_off 21
end_sub

' réinitialiser tout
newfont:
  nom$ = ""
  caption 0,"Bitmap_Font - <nouveau>"
  col% = -1
  lig% = -1
  color 22,255,255,255
  for i%=0 to 255
   flags%(i%) = 0
   imgs$(i%) = ""
  next i%
  displayarea()
  return

' ouvrir les fichiers pbm et bmp
openfont:
  filter 3,"Police bitmap|*.pbm"
  nom$ = file_name$(3)
  if nom$="_" then return
  if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
  if file_exists(nom$)=0
   message "Oups...non trouvé !"
   return
  end_if
  caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
  file_open_read 1,nom$
  file_readln 1,s$
  if s$<>file_extract_name$(nom$)
   message "Oups - structure de police invalide !"
   file_close 1
   return
  end_if
  file_readln 1,s$
  if len(s$)<>256
   message "Oups - structure de police invalide !"
   file_close 1
   return
  end_if
  for i%=0 to 255
   flags%(i%) = val(mid$(s$,i%+1,1))
  next i%
  for i%=0 to 255
   file_readln 1,s$
   j% = instr(s$,"=")
   if j%=0
   message "Oups - structure de police invalide !"
   file_close 1
   return
   end_if
   imgs$(i%) = mid$(s$,j%+1,len(s$))
  next i%
  file_close 1
  file_load 21,left$(nom$,len(nom$)-4)+".bmp"
  lig% = -1
  col% = -1
  return

' enregistrer les fichiers pbm et bmp
savefont:
  filter 4,"Police bitmap|*.pbm"
  nom$ = file_name$(4)
  if nom$="_" then return
  if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
  if file_exists(nom$)=1
   if message_confirmation_yes_no("Cette police existe déjà. Remplacer ?")<>1 then return
  end_if
  caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
  file_open_write 1,nom$
  file_writeln 1,file_extract_name$(nom$)
  s$ = ""
  for i%=0 to 255
   s$ = s$ + str$(flags%(i%))
  next i%
  file_writeln 1,s$
  for i%=0 to 255
   file_writeln 1,str$(i%)+"="+imgs$(i%)
  next i%
  file_close 1
  file_save 21,left$(nom$,len(nom$)-4)+".bmp"
  return

selchar:
  2d_target_is 21
  x% = mouse_x_left_down(21)
  y% = mouse_y_left_down(21)
  if col%>=0
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 0,0,0
   if flags%(lig%*16+col%)=1
   2d_fill_off
   else
   2d_fill_color 255,255,255
   end_if
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   if flags%(lig%*16+col%)=0
   font_bold_off 21 : font_color 21,0,0,0
   print_locate col%*32 + 2,lig%*32 + 2
   print str$(lig%*16+col%)
   font_bold 21 : font_color 21,0,0,255
   print_locate col%*32 + 14,lig%*32 + 16
   print chr$(lig%*16+col%)
   end_if
  end_if
  col% = int((x%+31)/32) - 1
  lig% = int((y%+31)/32) - 1
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 255,0,0
   if flags%(lig%*16+col%)=1
   2d_fill_off
   else
   2d_fill_color 255,255,0
   end_if
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   if flags%(lig%*16+col%)=0
   font_bold_off 21 : font_color 21,0,0,0
   print_locate col%*32 + 2,lig%*32 + 2
   print str$(lig%*16+col%)
   font_bold 21 : font_color 21,0,0,255
   print_locate col%*32 + 14,lig%*32 + 16
   print chr$(lig%*16+col%)
   end_if
   2d_fill_on
   2d_pen_color 0,0,0
  return

loadimage:
  filter 3,"Images|*.bmp;*.jpg;*.png"
  img$ = file_name$(3)
  if img$="_" then return
  if file_exists(img$)=0
   message "Oups - image non trouvée !"
   return
  end_if
  res% = dll_call1("LoadAnyImageFile",adr(img$))
  res% = dll_call2("ResizePicture",100,100)
  2d_target_is 22
  clipboard_paste 22
  return

setimage:
  if col%<0
   message "Oups - pas de caractère choisi !"
   return
  end_if
  clipboard_copy 22
  res% = dll_call2("ResizePicture",32,32)
  2d_target_is 21
  clipboard_paste 5
  2d_image_paste 5,col%*32,lig%*32
   dl% = 1
   dc% = 1
   if lig%=15 then dl% = 0
   if col%=15 then dc% = 0
   2d_pen_color 0,0,0
   2d_fill_off
   2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
   2d_fill_on
  flags%(lig%*16+col%) = 1
  imgs$(lig%*16+col%) = img$
  return

resetimage:
  if col%=0
   message "Oups - pas de caractère choisi !"
   return
  end_if
  dl% = 1
  dc% = 1
  if lig%=15 then dl% = 0
  if col%=15 then dc% = 0
  2d_pen_color 255,0,0
  2d_fill_color 255,255,0
  2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
  font_bold_off 21 : font_color 21,0,0,0
  print_locate col%*32 + 2,lig%*32 + 2
  print str$(lig%*16+col%)
  font_bold 21 : font_color 21,0,0,255
  print_locate col%*32 + 14,lig%*32 + 16
  print chr$(lig%*16+col%)
  flags%(lig%*16+col%) = 0
  imgs$(lig%*16+col%) = ""
  return

testfont:
  s$ = text$(32)
  if len(s$)=0 then return
  if len(s$)>16
   s$ = left$(s$,16)
   text 32,s$
  end_if
  for i%=1 to len(s$)
   j% = asc(mid$(s$,i%,1))
   if flags%(j%)=1
   2d_target_is 21
   y% = int(j%/16)
   x% = j% - y%*16
   2d_image_copy 5,x%*32+1,y%*32+1,(x%+1)*32,(y%+1)*32
   2d_target_is 33
   2d_image_paste 5,(i%-1)*32,0
   else
   print_target_is 33
   font_size 33,12
   print_locate (i%-1)*32+9,6
   print mid$(s$,i%,1)
   end_if
  next i%
  print_target_is 21
  2d_target_is 21
  return

closepreview:
  to_foreground 0
  active 0
  return

previewfont:
  s$ = text$(32)
  if len(s$)=0 then return
  inactive 0
  show 100
  color 101,255,255,255
  s$ = text$(35)
  i% = instr(s$,"x")
  siz% = val(left$(s$,i%-1))
  s$ = text$(32)
  for i%=1 to len(s$)
   j% = asc(mid$(s$,i%,1))
   if flags%(j%)=1
   img$ = imgs$(j%)
   res% = dll_call1("LoadAnyImageFile",adr(img$))
   pause 200
   res% = dll_call2("ResizePicture",siz%,siz%)
   pause 200
   clipboard_paste 5
   pause 200
   2d_target_is 101
   2d_image_paste 5,(i%-1)*siz%,0
   else
   print_target_is 101
   select siz%
   case 20
   font_size 101,12
   print_locate (i%-1)*siz%+2,2
   case 32
   font_size 101,16
   print_locate (i%-1)*siz%+6,5
   case 40
   font_size 101,24
   print_locate (i%-1)*siz%+12,6
   case 64
   font_size 101,32
   print_locate (i%-1)*siz%+18,15
   case 128
   font_size 101,64
   print_locate (i%-1)*siz%+21,18
   end_select
   print mid$(s$,i%,1)
   end_if
  next i%
  print_target_is 21
  2d_target_is 21
  return

  return

Il y a aussi la correction d'une erreur d'indice lors du chargement d'une pseudo-police existante.

EDIT

On voit que la routine previewfont (c'est elle qui affiche la prévisualisation en différentes tailles) configure séparément, pour chaque caractère, la taille de la police et la position du caractère dans le carré prévu. On peut évidemment ajouter: attributs graphiques comme gras, italique etc, la couleur et ainsi de suite, et ceci pour chaque caractère, puisque les caractères (non-images) sont imprimés individuellement !

Bravo Klaus !
Celui là, je le garde au chaud !

Sujet: Re: Une pseudo-police bitmap Mar 1 Sep 2015 - 1:08

Nouvelle version:
Le programme peut maintenant générer n'importe quel caractère Unicode directement, sans passer par un fichier bmp créé par un outil externe. Le caractère Unicode (valeur entre 0 et 65535) est généré directement, à l'aide de la toute nouvelle version V5.01 de KGF.dll, sans passer par un fichier bmp. Et un tel caractère peut être placé n'importe où dans la police de 256 caractères, exactement comme une image quelconque. Voici le code:

Code:: ' Bitmap_Font_image.bas

label newfont, openfont, savefont, selchar, changefont
label loadimage, setimage, resetimage, testfont, previewfont, closepreview
label loadunicode, setunicode, resetunicode, copypreview

dim res%, nom$, i%, j%, x%, y%, lig%, col%, dl%, dc%, img$, s$, siz%, unicode%
dim flags%(255) : ' 0=caractère normal 1=image 2=unicode
dim imgs$(255) : ' chemin et nom de l'image, ou valeur unicode

dll_on "KGF.dll"

width 0,830 : height 0,700
combo 1 : left 1,330 : width 1,200 : font_names_load 1 : on_click 1,changefont
res% = dll_call2("SelectComboBoxItem",handle(1),1)

open_dialog 3
save_dialog 4
image 5

button 11 : left 11,10 : caption 11,"Nouveau" : on_click 11,newfont
button 12 : left 12,110 : caption 12,"Ouvrir" : on_click 12,openfont
button 13 : left 13,210 : caption 13,"Enregistrer" : on_click 13,savefont

picture 21 : top 21,30 : left 21,10 : width 21,512 : height 21,512 : on_click 21,selchar
font_name 21,text$(1)

picture 22 : top 22,30 : left 22,530 : width 22,100 : height 22,100
button 23 : top 23,30 : left 23,640 : caption 23,"Ouvrir image" : on_click 23,loadimage : width 23,120
button 24 : top 24,60 : left 24,640 : caption 24,"Placer image" : on_click 24,setimage : width 24,120
button 25 : top 25,90 : left 25,640 : caption 25,"Effacer image" : on_click 25,resetimage : width 25,120

picture 26 : top 26,140 : left 26,530 : width 26,100 : height 26,100
button 27 : top 27,140 : left 27,640 : caption 27,"Générer Unicode" : on_click 27,loadunicode : width 27,120
button 28 : top 28,170 : left 28,640 : caption 28,"Placer Unicode" : on_click 28,setunicode : width 28,120
button 29 : top 29,200 : left 29,640 : caption 29,"Effacer Unicode" : on_click 29,resetunicode : width 29,120

alpha 31 : top 31,560 : left 31,10 : caption 31,"Echantillon:"
edit 32 : top 32,560 : left 32,80 : width 32,140
picture 33 : top 33,590 : left 33,10 : width 33,512 : height 33,32
font_name 33,text$(1)
button 34 : top 34,560 : left 34,230 : caption 34,"Tester" : on_click 34,testfont
combo 35 : top 35,560 : left 35,350 : width 35,90
item_add 35,"20x20 pixels"
item_add 35,"32x32 pixels"
item_add 35,"40x40 pixels"
item_add 35,"64x64 pixels"
item_add 35,"128x128 pixels"
res% = dll_call2("SelectComboBoxItem",handle(35),2)
button 36 : top 36,560 : left 36,450 : caption 36,"Visualiser" : on_click 36,previewfont

form 100 : hide 100 : height 100,300 : width 100,screen_x : top 100,100
caption 100,"Visualisation" : on_close 100,closepreview
picture 101 : parent 101,100 : full_space 101
button 102 : parent 102,100 : top 102,height(101)-30 : left 102,10 : caption 102,"Copier"
on_click 102,copypreview

gosub newfont

end

changefont:
font_name 33,text$(1)
displayarea()
return

sub displayarea()
2d_target_is 21
2d_fill_color 255,255,255
col% = -1
lig% = -1
print_target_is 21
font_size 21,6 : font_color 21,0,0,0
font_name 21,"Arial"
2d_pen_width 1
for i%=0 to 15
for j%=0 to 15
if flags%(i%*16+j%)>0
2d_fill_off
else
2d_fill_on
end_if
2d_rectangle j%*32,i%*32,(j%+1)*32+1,(i%+1)*32+1
if flags%(i%*16+j%)=0
print_locate j%*32 + 2,i%*32 + 2
print str$(i%*16+j%)
end_if
next j%
next i%
font_bold 21 : font_color 21,0,0,255
font_name 21,text$(1)
for i%=0 to 15
for j%=0 to 15
if flags%(i%*16+j%)=0
print_locate j%*32 + 14,i%*32 + 16
print chr$(i%*16+j%)
end_if
next j%
next i%
font_bold_off 21
end_sub

' réinitialiser tout
newfont:
nom$ = ""
caption 0,"Bitmap_Font - <nouveau>"
col% = -1
lig% = -1
color 22,255,255,255
for i%=0 to 255
flags%(i%) = 0
imgs$(i%) = ""
next i%
displayarea()
return

' ouvrir les fichiers pbm et bmp
openfont:
filter 3,"Police bitmap|*.pbm"
nom$ = file_name$(3)
if nom$="_" then return
if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
if file_exists(nom$)=0
message "Oups...non trouvé !"
return
end_if
caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
file_open_read 1,nom$
file_readln 1,s$
if s$<>file_extract_name$(nom$)
message "Oups - structure de police invalide !"
file_close 1
return
end_if
file_readln 1,s$
if len(s$)<>256
message "Oups - structure de police invalide !"
file_close 1
return
end_if
for i%=0 to 255
flags%(i%) = val(mid$(s$,i%+1,1))
next i%
for i%=0 to 255
file_readln 1,s$
j% = instr(s$,"=")
if j%=0
message "Oups - structure de police invalide !"
file_close 1
return
end_if
imgs$(i%) = mid$(s$,j%+1,len(s$))
next i%
file_close 1
file_load 21,left$(nom$,len(nom$)-4)+".bmp"
lig% = -1
col% = -1
return

' enregistrer les fichiers pbm et bmp
savefont:
filter 4,"Police bitmap|*.pbm"
nom$ = file_name$(4)
if nom$="_" then return
if lower$(right$(nom$,4))<>".pbm" then nom$ = nom$ + ".pbm"
if file_exists(nom$)=1
if message_confirmation_yes_no("Cette police existe déjà. Remplacer ?")<>1 then return
end_if
caption 0,"Bitmap_Font - "+file_extract_name$(nom$)
file_open_write 1,nom$
file_writeln 1,file_extract_name$(nom$)
s$ = ""
for i%=0 to 255
s$ = s$ + str$(flags%(i%))
next i%
file_writeln 1,s$
for i%=0 to 255
file_writeln 1,str$(i%)+"="+imgs$(i%)
next i%
file_close 1
file_save 21,left$(nom$,len(nom$)-4)+".bmp"
return

selchar:
2d_target_is 21
x% = mouse_x_left_down(21)
y% = mouse_y_left_down(21)
if col%>=0
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 0,0,0
if flags%(lig%*16+col%)>0
2d_fill_off
else
2d_fill_color 255,255,255
end_if
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
if flags%(lig%*16+col%)=0
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
end_if
end_if
col% = int((x%+31)/32) - 1
lig% = int((y%+31)/32) - 1
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 255,0,0
if flags%(lig%*16+col%)>0
2d_fill_off
else
2d_fill_color 255,255,0
end_if
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
if flags%(lig%*16+col%)=0
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
end_if
2d_fill_on
2d_pen_color 0,0,0
return

loadimage:
filter 3,"Images|*.bmp;*.jpg;*.png"
img$ = file_name$(3)
if img$="_" then return
if file_exists(img$)=0
message "Oups - image non trouvée !"
return
end_if
res% = dll_call1("LoadAnyImageFile",adr(img$))
res% = dll_call2("ResizePicture",100,100)
2d_target_is 22
clipboard_paste 22
return

setimage:
if col%<0
message "Oups - pas de caractère choisi !"
return
end_if
clipboard_copy 22
res% = dll_call2("ResizePicture",32,32)
2d_target_is 21
clipboard_paste 5
2d_image_paste 5,col%*32,lig%*32
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 0,0,0
2d_fill_off
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
2d_fill_on
flags%(lig%*16+col%) = 1
imgs$(lig%*16+col%) = img$
return

resetimage:
if col%=0
message "Oups - pas de caractère choisi !"
return
end_if
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 255,0,0
2d_fill_color 255,255,0
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
font_bold_off 21 : font_color 21,0,0,0
print_locate col%*32 + 2,lig%*32 + 2
print str$(lig%*16+col%)
font_bold 21 : font_color 21,0,0,255
print_locate col%*32 + 14,lig%*32 + 16
print chr$(lig%*16+col%)
flags%(lig%*16+col%) = 0
imgs$(lig%*16+col%) = ""
return

loadunicode:
if message_input("Code d'un caractère unicode","Valeur (0...65535):","273")=0 then return
s$ = message_text$
if numeric(s$)=0
message "Oups - valeur non numérique !"
return
end_if
res% = val(s$)
if (res%<0) or (res%>65535)
message "Oups - valeur hors limites !"
return
end_if
unicode% = res%
res% = dll_call2("GetUnicodeGraphic",unicode%,100)
clipboard_paste 26
return

setunicode:
if col%<0
message "Oups - pas de caractère choisi !"
return
end_if
clipboard_copy 26
res% = dll_call2("ResizePicture",32,32)
2d_target_is 21
clipboard_paste 5
2d_image_paste 5,col%*32,lig%*32
dl% = 1
dc% = 1
if lig%=15 then dl% = 0
if col%=15 then dc% = 0
2d_pen_color 0,0,0
2d_fill_off
2d_rectangle col%*32,lig%*32,(col%+1)*32+dc%,(lig%+1)*32+dl%
2d_fill_on
flags%(lig%*16+col%) = 2
imgs$(lig%*16+col%) = str$(unicode%)
return

resetunicode:
return

testfont:
s$ = text$(32)
if len(s$)=0 then return
if len(s$)>16
s$ = left$(s$,16)
text 32,s$
end_if
for i%=1 to len(s$)
j% = asc(mid$(s$,i%,1))
if flags%(j%)>0
2d_target_is 21
y% = int(j%/16)
x% = j% - y%*16
2d_image_copy 5,x%*32+1,y%*32+1,(x%+1)*32,(y%+1)*32
2d_target_is 33
2d_image_paste 5,(i%-1)*32,0
else
print_target_is 33
font_size 33,12
print_locate (i%-1)*32+9,6
print mid$(s$,i%,1)
end_if
next i%
print_target_is 21
2d_target_is 21
return

closepreview:
to_foreground 0
active 0
return

previewfont:
s$ = text$(32)
if len(s$)=0 then return
inactive 0
show 100
color 101,255,255,255
s$ = text$(35)
i% = instr(s$,"x")
siz% = val(left$(s$,i%-1))
s$ = text$(32)
for i%=1 to len(s$)
j% = asc(mid$(s$,i%,1))
if flags%(j%)>0
img$ = imgs$(j%)
if flags%(j%)=1
res% = dll_call1("LoadAnyImageFile",adr(img$))
pause 200
res% = dll_call2("ResizePicture",siz%,siz%)
pause 200
clipboard_paste 5
pause 200
2d_target_is 101
2d_image_paste 5,(i%-1)*siz%,0
else
res% = dll_call2("GetUnicodeGraphic",int(val(img$)),siz%)
clipboard_paste 26
clipboard_paste 5
pause 200
2d_target_is 101
2d_image_paste 5,(i%-1)*siz%,0
end_if
else
print_target_is 101
select siz%
case 20
font_size 101,12
print_locate (i%-1)*siz%+2,2
case 32
font_size 101,16
print_locate (i%-1)*siz%+6,5
case 40
font_size 101,24
print_locate (i%-1)*siz%+12,6
case 64
font_size 101,32
print_locate (i%-1)*siz%+18,15
case 128
font_size 101,64
print_locate (i%-1)*siz%+21,18
end_select
print mid$(s$,i%,1)
end_if
next i%
print_target_is 21
2d_target_is 21
return

copypreview:
clipboard_copy 101
message "L'image a été placée dans le presse-papier !"
return

Voilà de quoi faire facilement un clavier chinois, cyrillique ou autre, à l'aide de pictures contenant les bitmaps générés pour chaque caractère, ou d'écrire un mot ou une phrase dans ces langues, d'utiliser les symboles mathématiques ou électroniques, etc. Il y a aussi un bouton permettant de copier la prévisualisation dans le presse-papier. De là, on en fait ce qu'on veut - par un programme Panoramic, par un outil de traitement d'images, etc.

Nombre de messages : 1594 Date d'inscription : 19/01/2014

Bonjour.

Je suis preneur pour ce magnifique outil.

Une question se pose: après avoir créé la police '.bmp', comment l'installer pour qu'elle soit reconnue par Panoramic ?

Je suppose que 'font_name' ne fonctionnera pas, ladite police devant être installée dans le dossier Windows où se trouvent les autres polices.

Merci de la réponse.

Sujet: Re: Une pseudo-police bitmap Mar 1 Sep 2015 - 9:01

J'ai bien appelé cela une pseudo-police. Ce n'est pas une police normale. Elle ne peut servir qu'à construire des images bmp du texte. On ne peut pas l'utiliser à l'intérieur d'un objet Panoramic.

Lorsque j'aurai trouvé le moyen de créer une "vraie" police bitmap, cela se convertira facilement.

» un bitmap et sa dimention
» Rotation de bitmap
» Rotation de bitmap (bis)
» Générateur de nombres pseudo-aléatoires
» Pseudo-objet - Générateur de code