OLDSKOOL BITMAP FONT (POLICE BITMAP)
JulioDelphi
Messages postés
2226
Date d'inscription
dimanche 5 octobre 2003
Statut
Membre
Dernière intervention
18 novembre 2010
-
28 nov. 2006 à 18:33
JulioDelphi Messages postés 2226 Date d'inscription dimanche 5 octobre 2003 Statut Membre Dernière intervention 18 novembre 2010 - 27 avril 2009 à 17:36
JulioDelphi Messages postés 2226 Date d'inscription dimanche 5 octobre 2003 Statut Membre Dernière intervention 18 novembre 2010 - 27 avril 2009 à 17:36
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/40502-oldskool-bitmap-font-police-bitmap
https://codes-sources.commentcamarche.net/source/40502-oldskool-bitmap-font-police-bitmap
27 avril 2009 à 17:36
Voir les erreurs, les trouver dans des recherches ne peut qu'induire en erreur, non ?
27 avril 2009 à 17:29
A l'attention des administrateurs...
Je télécharge pas mal de codes, histoire d'apprendre et de ne pas réinventer la roue...
Dans beaucoup de commentaires je trouve des messages du style :
Autre idée plus performante pour ta fonction toto()
puis suivent quelques lignes de code...
Je sais que ce serait relativement lourd mais ne serait-il pas intéressant de fournir l'ancien code avant le nouveau pour que les débutants puissent comprendre les améliorations amenées par le nouveau ?
En effet, quand on télécharge le code, les corrections ont déjà été effectuées !
Je vous laisse juger, je ne développerai pas de polémique là-dessus, ce n'est qu'une idée.
Merci de votre attention, cordialement, Patrice.
29 nov. 2006 à 12:14
il te suffit d'appeler comme suis :
var CharsMap : TCharsMap;
MapStr : TMappedString;
procedure FormX.OnCreate(sender : TObject);
begin
CreateCharsMap(' !"****''()'+
'**,-. 0123'+
'456789:*<='+
'>**ABCDEFG'+
'HIJKLMNOPQ'+
'RSTUVWXYZ*', 0, CharsMap);
CharsMap['*'] := 0;
CopyUpIndexToLo(CharsMap);
end;
et ensuite, n'importe ou avant le dessins :
CreateMappedStr('Hello World!', CharsMap, MapStr);
ce qui donneras :
MapStr(40,37,44,44,47,0,55,47,50,44,36,2)
29 nov. 2006 à 08:58
Aie oui en effet, j'ai même pas fait attention. Et Delphi me l'a pas fait remarqué.
"remplacement des panels de centrage de la fiche du zoom par des TBevel en mode bsSpacer (plus leger)"
Ah oui en effet j'avais pas pensé à ça.
"vidage preventif du tableau de bitmap avant tout autre chose :"
Tant qu'à faire autant faire for i := Low(Font) ... de plus j'ai une fonction qui fait ça alors autant l'appeller ^^
"preference a utiliser MessageDLG plutot que MessageBoxA (n'est pas une erreur ...)"
J'aime pas MessageDlg. Sinon j'aurais pu faire Application.MessageBox mais bon.
"beaucoup trop d'appel a StrToInt (preferer un stockage en variable integer)"
Ah c'est possible, j'ai pas fait attention :)
"faire attention a ne pas faire des trucs trop alambiqué :
bPrev.Enabled := CurrentIndex > 0;
bNext.Enabled := CurrentIndex < Main_Form.TotalChars-1;"
C'est pour activer/désactiver les boutons de la fenêtre zoom.
"ensuite la routine StrToIndex est beaucoup trop lourde, voici une version allégée :
(ne pas oublier qu'il n'y a que 256 caracteres dans la table Ascii, le type byte est donc suffisant au lieu du type word ou plus grand !)"
OK pour le type Byte j'avais pas pensé non plus ;)
const
SPECIAL_CHARS_SET : set of char = ['!','<','>','''',',','-','.',':'];
SPECIAL_CHARS : array[0..7] of TSpecialChar = (
// (i: 0 ; c: ' '), toujours 0 pour espace // ça dépend de ton bitmap
(i: 1 ; c: '!'),
(i: 8 ; c: '<'),
(i: 9 ; c: '>'),
(i: 7 ; c: ''''),
(i: 12 ; c: ','),
(i: 13 ; c: '-'),
(i: 14 ; c: '.'),
(i: 26 ; c: ':')
);
...
if C in ['a'..'z'] then Dec(C,$20); //bien vu pour le in ['a'..'z'] :)
Merci bien pour toutes ces précisions :)
Quand à ta deuxième méthode je jetterais un oeil cet après midi peut être.
29 nov. 2006 à 03:04
type
// contient les index des caracteres dans l'image
TCharsMap = array[char] of byte;
// permet de stocker une chaine "mappée"
TMappedString = array of byte;
// methode a appeler en premier
// CharsEnum correspond aux lettres presente dans l'image
// dans l'ordre (gauche haut > droite bas) d'apparition
// NullIndex correspond a l'index "vide" pour les caracteres non presents (0 par exemple)
procedure CreateCharsMap(const CharsEnum : string; const NullIndex : byte; var CharsMap : TCharsMap);
var N : integer;
C : char;
begin
// on remplis avec NullIndex
FillChar(CharsMap, 256, NullIndex);
// pour chaque caracteres present on assigne l'index dans l'image
for N := 1 to Length(CharsEnum) do
CharsMap[CharsEnum[N]] := N-1;
end;
// methode permettant de transposer les index des caracteres majuscule au caracteres minuscule
procedure CopyUpIndexToLo(var CharsMap : TCharsMap);
var pS,pD : ^Char;
begin
pS := @CharsMap;
pD := @CharsMap;
inc(pS,$41); {'A'}
inc(pD,$61); {'a'}
Move(pS^,pD^,26); {de 'A'..'Z' a 'a'..'z'}
end;
// methode permettant de transposer les index des caracteres minuscule au caracteres majuscule
procedure CopyLoIndexToUp(var CharsMap : TCharsMap);
var pS,pD : ^Char;
begin
pS := @CharsMap;
pD := @CharsMap;
inc(pS,$61); {'a'}
inc(pD,$41); {'A'}
Move(pS^,pD^,26); {de 'a'..'z' a 'A'..'Z'}
end;
// Mapping d'une chaine ...
// S est la chaine a mapper
// CharsMap est la table d'index a utiliser pour le mapping
// MappedString est la table d'index resultante
procedure CreateMappedStr(const S : string; const CharsMap : TCharsMap; var MappedString : TMappedString);
var N : integer;
begin
for N := 1 to Length(S) do
MappedString[N-1] := CharsMap[S[N]];
end;
avantages :
+polyvalente : permet d'utiliser des fontes bitmaps differente plus ou moins complete et une utilisation plus large sur les traitements graphique en aval avec la gdi, gdi+, directX ou OpenGL, grace a son independance complete par rapport a ces derniers.
+performante : routines de traitements d'indexation et mapping plus simples, tout est pré-calculé avant les lourds traitements graphiques et reste stocké jusqu'a la fermeture du programme. Les ressources sont plus legere avec une consomation de 255 octets seulement pour chaque table d'index et un traitement rapide du mapping de chaine.
+ludique : un debutant saurat l'utiliser et l'implementer sans difficultées avec un minimum d'indications, un infographiste comprendrat immediatement comment construire l'image de la fonte, un developeur comprendras egalement trés vite qu'il peu enregistrer dans un fichier la chaine de base pour l'indexation (CharsEnum) et cela pour chaque fonte, ce qui permet de construire des programmes plus elaborés et plus souple niveau customisation/mise a jours.
29 nov. 2006 à 02:06
variable Font private de la fiche principale, masque la propriété Font de la dite fiche ...
remplacement des panels de centrage de la fiche du zoom par des TBevel en mode bsSpacer (plus leger)
vidage preventif du tableau de bitmap avant tout autre chose :
if Length(Font) <> 0 then
for i := 0 to high(font) do Font[i].Free;
CharsCount := (_font_src.Width div il.Width) * (_font_src.Height div il.Height);
SetLength(Font, CharsCount);
for i := 0 to CharsCount - 1 do
begin
Font[i] := TBitmap.Create;
Font[i].Width := il.Width;
Font[i].Height := il.Height;
end;
preference a utiliser MessageDLG plutot que MessageBoxA (n'est pas une erreur ...)
beaucoup trop d'appel a StrToInt (preferer un stockage en variable integer)
faire attention a de trop nombreux appel a IntToStr (a remplacer par format a partir de 2 appels) :
sb.SimpleText := 'Character ID : ' + IntToStr(CurrentIndex) + ' (Total : ' + IntToStr(TotalChars) + ')';
sb.SimpleText := format('Character ID : %d (Total : %d)',[CurrentIndex,TotalChars]);
faire attention a ne pas faire des trucs trop alambiqué :
bPrev.Enabled := CurrentIndex > 0;
bNext.Enabled := CurrentIndex < Main_Form.TotalChars-1;
bien que cela ne soit pas faux, on peu egalement ecrire :
procedure TZoom_Form.bPrevClick(Sender: TObject);
begin
dec(CurrentIndex);
Main_Form.ZoomOnChar(CurrentIndex);
end;
procedure TZoom_Form.bNextClick(Sender: TObject);
begin
inc(CurrentIndex);
Main_Form.ZoomOnChar(CurrentIndex);
end;
ensuite la routine StrToIndex est beaucoup trop lourde, voici une version allégée :
(ne pas oublier qu'il n'y a que 256 caracteres dans la table Ascii, le type byte est donc suffisant au lieu du type word ou plus grand !)
type
TSpecialChar = record
i : byte;
c : char;
end;
const
SPECIAL_CHARS_SET : set of char = ['!','<','>','''',',','-','.',':'];
SPECIAL_CHARS : array[0..7] of TSpecialChar = (
// (i: 0 ; c: ' '), toujours 0 pour espace
(i: 1 ; c: '!'),
(i: 8 ; c: '<'),
(i: 9 ; c: '>'),
(i: 7 ; c: ''''),
(i: 12 ; c: ','),
(i: 13 ; c: '-'),
(i: 14 ; c: '.'),
(i: 26 ; c: ':')
);
procedure StrToIndex(const S : string; var CharsIndexArray : array of byte);
var
i,j : Integer;
C : char;
begin
for i := 0 to Length(S)-1 do begin
C := S[i+1];
if C in ['a'..'z'] then Dec(C,$20);
if C in #32,'A'..'Z','0'..'9' then
CharsIndexArray[i] := Byte(C)-32
else
if C in SPECIAL_CHARS_SET then
for j := 0 to high(SPECIAL_CHARS) do
if C = SPECIAL_CHARS[j].c then begin
CharsIndexArray[i] := SPECIAL_CHARS[j].i;
Break;
end;
end;
end;
voila...
28 nov. 2006 à 21:50
"sans parler des nombreuses erreur et lourdeur du code..." lourdeur de code sans doute mais les erreurs je veux bien savoir où histoire de progresser :)
Quand a faire des décalages à la place des divisions j'y pense jamais :/
Et en effet le tableau de bitmap c'est lourd en effet. J'ai fait ce que j'ai pu ^^
28 nov. 2006 à 20:16
il fallait lire :
[32x8=256]
< debut >
...
for N := 0 to 7 do begin
I := N shl 5; {* 32}
....
28 nov. 2006 à 20:12
je vais etre dur, mais je vais etre clair :
sans parler des nombreuses erreur et lourdeur du code...
il y a une piste plus simple a choisir.
cette piste consiste a definir un tableau d'image de cette maniere :
Type
TCharsMap = array[char] of TPoint
et ensuite de suivre un ordre precis pour la disposition des lettres dans le bitmap :
[23x4]
< debut >
ligne 1 : < vide 0..31 >[espace en position 32]
ligne 2 : !"#$%&'()*+,-./0123456789:;<=>?@
ligne 3 : ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
ligne 4 : abcdefghijklmnopqrstuvwxyz{|}~
ligne 5 : < vide 0..32 >
ligne 6 : < vide 0..32 >
ligne 7 : < vide 0..32 >
ligne 8 : < vide 0..32 >
< fin >
il n'y a plus qu'a decouper ensuite chaque caracteres selon leurs taille
cW := BMPFont.Width shr 5; {div 32}
cH := BMPFont.Height shr 3; {div 8}
puis a remplir le tableau avec les parametres :
var
N,C,I : byte;
for N := 0 to 7 do begin
I := N shl 5; {div 32}
for C := 0 to 31 do
CharsMap[char(N+I)] := point(cW*C,cH*N);
et finallement, il suffit d'utiliser copyrect pour copier un caractere directement :
procedure StrToBmp(const S : string; const OffsetX,OffsetY : integer; Bmp : TBitmap);
var P : Pchar;
i : integer;
Dr,Sr: TRect;
begin
P := PChar(S);
for i := 0 to Length(S)-1 do begin
Sr.TopLeft := CharsMap[P[i]];
Sr.BottomRight := point(Dr.Left+cW, Dr.Top+cH);
Dr.TopLeft := point(OffSetX+(cW*i), OffSetY);
Dr.BottomRight := Point(OffSetX+(cW*(i+1)), OffSetY+cH);
BMP.Canvas.CopyRect(Dr, BMPFont.Canvas, Sr);
end;
end;
ou tout autre methode permettant de sortir l'image correspondante au caractere, avec des variantes (affichage vertical, Harmonic, Circular, RandomOffset etc...)
On pourrait meme adapter le tout pour fonctionner avec les images PNG et ainsi avoir une vrai transparence, des effets d'ombres, glow ect..
finalement on gagne enormement en code et performance, surtout en memoire, puisque qu'on ne travail qu'avec des les coordonnées et l'image complete (et non avec un tableau de bitmap gourmant en ressource).
28 nov. 2006 à 18:46