Composant tdbpfontimage : une image de texte a partir d'une string

Télécharger le projet
Commenter

Description

hello,
dbpFontImage sert a transformer du texte en image via votre font en .bmp, il est basé sur un TImage.

le zip contient le composant (pas et dcu), 2 fichiers.bmp de font, et une demo (exe et dpr)

Source / Exemple : 


{
################################################################################
# DBPFONTIMAGE                                                                 #
################################################################################
#                                                                              #
# VERSION       : 1.0                                                          #
# FICHIERS      : dbpFontImage.pas,.dcu,.dcr,.bmp,Font1,Font2.bmp,ReadMe.htm   #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 23 jul 2004                                                  #
# MODIFIEE      : 23 jul 2004                                                  #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : diabloporc@laposte.net                                       #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                 Lisez le ReadMe.htm !                                        #
#                                                                              #
################################################################################
}
unit dbpFontImage;

interface

uses
  Math, Types, Dialogs, Graphics, StrUtils, SysUtils, Classes, Controls, ExtCtrls;

type
  TdbpFontImage = class(TImage)
  private
    FText, FAbout: string;
    FCharSet: ShortString;
    FFont: TFileName;
    FBMP: TBitmap;
    FFontX, FFontY: Word;
    FTs: TStringList;
    FpointTL, FpointBR: TPoint;
    FRect: Trect;
    FChar: Word;

    procedure SetText(Texte: string);
    procedure SetFont(Filename: TFilename);
    procedure SetCharSet(CharSet: ShortString);

    function GetAbout: String;
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent);                   override;
    destructor  Destroy;                                      override;
  published
    property About:         String      read GetABout write FAbout;
    property CharSet:       ShortString read FCharSet write SetCharSet;
    property Picture_Font:  TFilename   read FFont    write SetFont;
    property Text:          String      read FText    write SetText;
  end;

procedure Register;

implementation

function TdbpFontImage.GetAbout: string;
begin
 Result := 'v1.0 par Julio P. (Diabloporc)';
end;

{** A chaque fois que le texte change, on recommence ça : **}
procedure TdbpFontImage.SetText(Texte: String);
var
 i: integer;
 BMPtemp: TBitmap;
 FCset: ShortString;
begin
 FText := Texte;
 FCset := FCharSet+' ';                                      // ajout d'un espace a la fin
 if FileExists(FFont) then                                   // verif de l'existence du fichier "Picture_Font"
  begin
   Fbmp := TBitmap.Create;                                   // creation du bitmap
   Fbmp.LoadFromFile(FFont);                                 // chargement du Picture_Font
   FfontX := floor(Fbmp.Width/(length(FCset)-1));            // detection de la largeur d'une lettre : largeur du bmp / nb de characteres du CharSet
   FfontY := Fbmp.Height;                                    // detection de la hauteur du bmp
   FpointTL.X := 0;
   FpointTL.Y := 0;
   FpointBR.X := FfontX;
   FpointBR.Y := FfontY;                                     // creation des 4 points
   Fts := tstringlist.Create;                                // creation de la stringlist : un caractere par "case"
   for i:=0 to length(FCset)-1 do
    begin
     Fts.Add(FCset[i]);
    end;                                                     // ajout des carateres
   Fts.CaseSensitive := true;                                // setup du cassesensitive (casse sensible)
   BMPtemp := TBitmap.Create;                                // creation du bitmap temporaire
   BMPtemp.Assign(nil);                                      // on le vide
   BMPtemp.Width  := Ffontx*length(FText);                   // setup de la largeur du TImage
   BMPtemp.Height := Ffonty;                                 // setup de sa hauteur
   for i:=0 to length(FText)-1 do
    begin
     FChar    := Fts.IndexOf(copy(FText,i+1,1))-1;
     FRect    := Rect(FfontX*FChar,0,Ffontx*(FChar+1),Ffonty);
     Fpointtl.X := FfontX*i;
     Fpointbr.X := Ffontx*i+Ffontx;
     BMPtemp.Canvas.CopyRect(Rect(FpointTL,FpointBR),Fbmp.Canvas,FRect);  // ici : la copie TRect ds le FBmp puis le temporaire le recupaire, pour la lettre suivante, on decale de x pixels (largeur d'une lettre)
    end;
   Picture.Bitmap := BMPtemp;                                // assignation du resultat au Picture du composant
   BMPtemp.free;
   FBmp.Free;
   FTs.free;                                                 // vidages
  end;
  if FText = '' then begin Width:=8; Height:=8; end;         // si le texte est vide alors on reduit la taille du compo
end;

procedure TdbpFontImage.SetFont(Filename: TFilename);        // verification de l'extension (ya mieux mais je ne me souviens pas)
var
 temp: string;
 n: word;
begin
 temp := ReverseString(FileName);
 n := pos('.',temp);
 temp := copy(temp,0,n-1);
 temp := ReverseString(temp);
 if Uppercase(temp) = 'BMP' then
  begin
   FFont := Filename;
   SetText(FText);
  end
 else
  if Filename='' then
   FFont := ''
  else
   MessageDlg('Seulement des fichiers ''BMP'' !',mtError,[mbOk],0);
end;

procedure TdbpFontImage.SetCharSet(CharSet: ShortString);
begin
 FCharSet := CharSet;
 SetText(FText);
end;

constructor TdbpFontImage.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Center       := true;
 AutoSize     := true;
 Proportional := true;
 FCharSet     := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@&#$çéèà?!.,;:''"*[]{}()<>/\^=+- _';  // CharSet de base pour la bmp donnée avec
end;

destructor TdbpFontImage.destroy;
begin
  inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpFontImage]);
end;

end.

Conclusion :


screen = screen de la demo donnée avec

bugs ou autres : msg ou mail merci
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)