POLICE BITMAP

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,jpeg, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Edit1: TEdit;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormPaint(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  base:Tbitmap;
  Police:Array[32..92]of Tbitmap;
  T: TPicture;
  Xpos,ypos:integer;
  ind:integer;
  IMG:Array[0..100]of Timage;

Procedure Charger_Police(F : String);
implementation

{$R *.DFM}

{*** Bon, je vais faire un effort sur les commentaires cette fois ! ***}

{*** Cette procédure remplit (d'où son nom) la fenêtre avec
     l'image chargée dans "T" (TPicture) et boucle sur les bords autant
     de fois que nécessaire (étirez la feuille, vous verrez qu'elle est texturée
     partout quelque soit sa taille) ***}

procedure remplir;
var
   xp,
   yp : integer;
begin
     xp := 0;
     yp := 0;
     repeat
           repeat
                 Form1.Canvas.draw( xp, yp, T.Graphic );
                 xp := xp + t.Width;
           until xp > Form1.Width;
           xp :=0 ;
           yp := yp + t.Height;
     until yp > Form1.height;
end;


{*** Dans le FormCreate :
     On charge la texture de fond
     On initialise le tableau qui contiendra la police
     On charge la police par défaut si elle existe ***}


procedure TForm1.FormCreate(Sender: TObject);
var
   n:byte;
begin
     T := TPicture.Create;
     If FileExists('FOND.BMP') 
       Then T.LoadFromFile('FOND.BMP')
       Else Begin
          ShowMessage('Impossible d''ouvrir le fichier FOND.BMP');
	  Application.Terminate;
       End;;


     Base:=Tbitmap.Create;
     Base.height:=16;
     Base.Width:=976; {*** 976 = 16 * 61 caractères ***}
     For n:=32 to 92 do begin
         Police[n]:=Tbitmap.Create;
         Police[n].Height:=16;
         Police[n].Width:=16;
     end;
     xpos:=0;
     ypos:=0;
     ind:=0;

     {*** S'il le fichier POLICE.BMP n'existe pas il faudra le chercher à la main ***}

     If FileExists('POLICE.BMP') Then Charger_Police('POLICE.BMP');
end;


{*** Chargement de la police, bien entendu le seul paramètre c'est le nom du
     fichier.
     Cette procédure "saucissone" l'image BASE en morceaux de 16*16 et les range
     dans le tableau POLICE initialisé dans le FormCreate.
     Si vous créez une police, faites gaffe que les caractères ne dépassent pas
     16*16 ***}

Procedure Charger_Police(F : String);
var
   n,v:byte;
   t:string;
Begin
   Base.LoadFromFile(F);
   For v:=32 to 92 do 
   begin
      n:=v-32;
      Police[v].Canvas.copyrect(rect(0,0,16,16),base.Canvas,rect(n*16,0,(n+1)*16,16))
   End;

   n:=Length(F);

   Repeat
     v:=n;
     dec(n);
   until F[n]=#92;

   t:=copy(F,v,(length(F)-3)-v);
   Form1.caption:=T;
   Form1.EDIT1.Enabled := True;
End;

{*** Charger une police grâce a un controle OpenDialog ***}

procedure TForm1.Button1Click(Sender: TObject);
begin
   if Form1.OpenDialog1.execute then 
      If FileExists(OpenDialog1.Filename) Then Charger_Police(OpenDialog1.FileName);
   If Edit1.Enabled Then Edit1.SetFocus;
end;

{*** Traiter les entrées de EDIT1
     Le programme traite le caractère ascii et le transforme en index du tableau
     POLICE (facile, si on crée la police dans l'ordre des codes ascii !!!
     Pour eviter de s'ennuyer avec des minuscules, tout est passé en majuscule (UpCase)
     Le programme crée donc une image IMGS a partir de POLICE et la place au bon endroit.
     Si l'utilisateur fait delete, la dernière image créée et detruite (sauf si
     on est sur une nouvelle ligne)
     Si l'utilisateur fait entrée, Le programme met la coordonnée horizontale à 0
     et ajoute 16 à la coordonnée verticale
     C pas sorcier non ?

     Petite remarque : si vous comptez Afficher plus de 100 caractères agrandissez
     la taille du tableau IMGS

***}


procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin

     Key:=Upcase(key);
     if key=#8 then begin
                   if xpos>=16 then begin
                    xpos:=xpos-16;
                    dec(ind);
                    img[ind].destroy;
                    end;
                    end
     else if key=#13 then begin
                    xpos:=0;
                    ypos:=ypos+16;
                    Form1.Edit1.text:='';
                    Key:=#0;
                    end
     else if (ord(key)>92) or (ord(key)<32) then key:=#0
     else begin
     {*** POUR EVITER UN DEBORDEMENT DU TABLEAU "IMGS" IL FAUT
          PLACER ICI UNE LIGNE DU STYLE
          If Ind => TAILLE_TABLEAU THEN EXIT;
          OU TAILLE_TABLEAU est la taille maximale du tableau IMGS ***}

     IMg[ind]:=Timage.create(form1);
     Img[ind].Parent:=Form1;
     Img[ind].Width:=16;
     Img[ind].Height:=16;
     Img[ind].left:=xpos;
     Img[ind].top:=ypos;
     Img[ind].canvas.copyrect(rect(0,0,16,16),Police[ord(key)].canvas,rect(0,0,16,16));
     xpos:=xpos+16;
     Img[ind].Visible:=True;
     inc(Ind);
     end;

end;

{*** C'est ici qu'on execute le remplissage de la feuille par la texture "T" ***}
procedure TForm1.FormPaint(Sender: TObject);
begin
     Remplir;
end;

{***
    J'ai aussi une procédure pour creer un mot sans forcément créer une image par lettre

    Variables :
    S est la chaine de caractères
    MON_IMAGE est le TPIcture réceptacle pour mon mot ou ma phrase
    MA_POLICE est mon TBitmap de caractères
    HAUTEUR_POLICE est la taille de mes caractères (donc MA_POLICE.Height = HAUTEUR_POLICE et MA_POLICE.Width = HAUTEUR_POLICE * 61)
    CANVAS_VIDE est un TBitmap de HAUTEUR_POLICE * HAUTEUR_POLICE contenant la couleur du fond (une sorte d'espace quoi) pour
    eviter d'afficher un carré noir

    Sans_Accent est une procédure qui me vire les accents d'une phrase
                é = e
                è = e
                ê = e
                ù = u
                ...
    et je met bien entendu ma chaine en majuscule

Procedure Creer_Canvas(S : String);
Var
   N,
   I   : Integer;
   T   : String;
Begin
     With MON_IMAGE Do
     Begin
          Height := HAUTEUR_POLICE;
	  For N  := 0 To Width Do
	    If (N mod HAUTEUR_POLICE) = 0
	      Then Canvas.CopyRect(Rect(N-HAUTEUR_POLICE,HAUTEUR_POLICE+1,N,-1),
                                   CANVAS_VIDE.Bitmap.Canvas,
                                   Rect(1,HAUTEUR_POLICE+1,HAUTEUR_POLICE,0));
          S := UpperCase(Sans_Accent(S));
          For N := 1 To Length(S) Do Begin
             I := Ord(UpCase(S[N]))-32;
             If (I <= 61)
               Then Begin
                 Canvas.CopyRect(rect(HAUTEUR_POLICE*(N-1),HAUTEUR_POLICE,HAUTEUR_POLICE*N,0),
                                 MA_POLICE.Canvas,
                                 Rect(I*HAUTEUR_POLICE,HAUTEUR_POLICE,(I+1)*HAUTEUR_POLICE,0));
                 T := T + S[N];
               End
               Else Begin
                    Canvas.CopyRect(rect(HAUTEUR_POLICE*(N-1),HAUTEUR_POLICE,HAUTEUR_POLICE*N,0),
                                    CANVAS_VIDE.Bitmap.Canvas,
                                    Rect(1,HAUTEUR_POLICE+1,HAUTEUR_POLICE,0));
                    T := T + #32;
               End
          End;
     End;
End;


***}

End.