Soyez le premier à donner votre avis sur cette source.
Vue 7 701 fois - Téléchargée 1 019 fois
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, ExtDlgs, Spin; Const FLedOn = ClLIme; // LED ON de Couleur Lime FledOff = ClGray; // LED OFF de Couleur Gray type TForm1 = class(TForm) SEND: TButton; Image1: TImage; Memo1: TMemo; Timer1: TTimer; Edit1: TEdit; // Champs de Texte à faire déffiler procedure SENDClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; var Form1: TForm1; Bitmap:TBitmap; FLED : TCOLOR; S: String; //:= les lignes pour Memo1 D:Integer; // := Saut de Colonnes P: PbyteArray; // := le Scanline Tbl: Array Of Array of Integer; //:= les ligne du Memo1 implementation {$R *.dfm} procedure TForm1.SENDClick(Sender: TObject); Var X,Y,Z,N,K,Line: INTEGER; begin Bitmap := TBitmap.create; //Initialisation de image1 Image1.Picture := Nil; S:= ''; //*************************************// // ** Exportation du Text vers Image**// //************************************// Image1.Width := (Length(Edit1.Text)*5)+1; Image1.Canvas.TextOut(0,0,Edit1.Text) ; // Bloc Try ***** Finaly **// try Bitmap.Height := Image1.Height -1 ; Bitmap.Width := Image1.Width ; //**** Bitmap := Le contenu de l'Image1***// Bitmap.Assign(Image1.Picture); // Scan l'Image (X,Y [Height et Width]) ** for Y := 0 to Bitmap.Height-1 do Begin P := Bitmap.ScanLine[Y]; for X := 0 to Bitmap.Width-1 do P[Y] := X; end; // Deux Boucles Pour Extraire la Couleur Diff de Blache For Z:=0 To Bitmap.Width -1 do For N:=2 To (Bitmap.Height-11) do Begin FLED:= BItmap.Canvas.Pixels [Z,N]; If FLED <> ClWHite Then // SI la Couleur est <> Blanc S:= 1 S := S +'1' Else S := S +'0'; // Sinon S:= 0 If Length(S) = 12 Then // Chaque ligne du memo1 recevra une chaine S (String) ayant length de 12 Begin Memo1.Lines.Add(S); // initialisation de S S := ''; end; end; finally Bitmap.free; end; // une boucle pour effacer les 00 inutiles = plus de six (06) lignes de 00 effacer //le reste des Memo.Lines K:=0; For Line := 0 To Memo1.Lines.Count -1 do Begin If Memo1.Lines[Line]='000000000000' Then K:=K+1 else K := 0; While (K = 6) And (Memo1.Lines[Line]='000000000000') do Memo1.Lines.Delete(Line); end; Timer1.Enabled := True; end; procedure TForm1.Timer1Timer(Sender: TObject); Var H,J,F : Integer; begin //Boucle pour déterminer le saut de colonnes While D<J Do Begin // Boucle pour affecter l'image en 1 et 0 au tableau TBL (Array of array qui a les dim:[J,H]) For J:= 1 to Memo1.Lines.Count -1 do begin For H := 0 to 11 do Begin //Dim du tableau TBL SetLength(Tbl,Memo1.Lines.Count,12); If Memo1.Lines [J]<>'' Then Begin Tbl[J,H]:= StrToINT(Copy(Memo1.Lines[J],H,1)); // Variable qui recevra l'emplacement [J,H] soit un 1 ou un 0 F:= Tbl[J,H]; //Si F := 0 donc la LED est OFF If F=0 Then FLED:= FLedOff else // Sinon la LED est ON FLED := FLEDON; // FLED variable TCOLOR // Dessin de la Grille à LED et le déffilement en fonction de la Variable D Canvas.Pixels[((1+J)-D)*5, (10+H)*5]:= FLED; Canvas.Pixels[Succ(((1+J)-D)*5), Succ((10+H)*5)]:= FLED; Canvas.Pixels[Succ(Succ(((1+J)-D)*5)), Succ(Succ((10+H)*5))]:= FLED; Canvas.Pixels[((3+J)-D)*5, (10+H)*5]:= FLEDOFF; Canvas.Pixels[Succ(((3+J)-D)*5), Succ((10+H)*5)]:= FLEDOFF; Canvas.Pixels[Succ(Succ(((3+J)-D)*5)), Succ(Succ((10+H)*5))]:= FLEDOFF; end ; end; end; //// La variable D est pour déterminer le saut de colonne D:=D+2; end; If D >= J Then D:=0; end; procedure TForm1.FormCreate(Sender: TObject); begin Edit1.Text :='Tapez Votre Journal ici !'; MEMO1.Clear ; D:=0; end; procedure TForm1.Edit1Change(Sender: TObject); begin Timer1.Enabled := False; Memo1.Clear; S:= ''; end; end.
11 juin 2010 à 21:32
j'ai bien tester votre truc je trouve que:
1- c'est trop lent vue que ton principal code est totalement injecté dans le timer.
2- trop de variables inutiles.
3- je ne vois pas où est l'utilité de toutes les Successions (trop de succ).
mais l'idée reste bien, tant que sa peut être améliorée par des pros
ok je te donne un 4
6 mai 2010 à 10:08
Aller 1 peux plus de développement :p
20 avril 2010 à 21:00
n'oubliez pas de laisser une note ou commentaire sur la source !
merci
18 avril 2010 à 18:49
J'espérais avoir des commentaires ou des recommandations sur cette sources, car j'arrive pas à l'achever! mais je vois qu'elle n'inspire personne
dommage et désolé !
17 avril 2010 à 21:01
j'espère que je me suis bien exprimé !!
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.