Soyez le premier à donner votre avis sur cette source.
Vue 5 950 fois - Téléchargée 480 fois
{ ################################################################################ # 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.
3 août 2004 à 14:52
pour les autres : a vous de faire la modif :p
a bientot
3 août 2004 à 14:38
function ExtractFileExt(constFileName:string):string;
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.