|
PRÉSENTATION :
Ce programme permet d'imprimer sur une double page la liste des mots de 2 et 3 lettres admis au Scrabble.
NOTES :
Ce n'est pas simplement une liste alphabétique, le programme trie les mots de trois lettres par extension avant ou arrière des mots de trois lettres.
C'est très utile pour étudier des coups de maçonnerie dans le jeu.
Ce programme est un exemple de traitement d'un fichier texte, et d'impression directe en utilisant le TPrinter.
CODE :
Unit Unit1;
Interface
Uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Type
TForm1 = Class(TForm)
Ouvrir: TOpenDialog;
Button1: TButton;
Procedure Button1Click(Sender: TObject);
Private
{ Déclarations privées }
Public
{ Déclarations publiques }
End;
Var
Form1: TForm1;
Implementation
Uses Printers;
{$R *.dfm}
Var
Tableau2:Array[1..1000]Of String[2];
Tableau3:Array[1..1000]Of String[3];
TableauB:Array[1..1000]Of Boolean;
Tableau4:Array[1..1000]Of String[4];
Nombre2:Integer;
Nombre3:Integer;
Const NombreY=60;
Lettres='JKQWXYZ';
Procedure TForm1.Button1Click(Sender: TObject);
Var Liste:TStrings;
TempStr:ShortString;
i,j,k:Integer;
Nombre:Integer;
X,Y :Integer;
Base :Integer;
Begin
If Not Ouvrir.Execute Then Exit;
Liste:=TStringList.Create;
Try
// Lecture du fichier
Liste.LoadFromFile(Ouvrir.FileName);
Nombre2:=0;
Nombre3:=0;
For i:=0 To Liste.Count-1 Do If (Liste[i]<>'') And (Liste[i][1]<>';') Then
Begin
If Length(Liste[i])=2
Then Begin
Inc(Nombre2);
Tableau2[Nombre2]:=UpperCase(Liste[i]);
End;
If Length(Liste[i])=3
Then Begin
Inc(Nombre3);
Tableau3[Nombre3]:=UpperCase(Liste[i]);
End;
End;
// Tri des tableaux
For j:=1 To Nombre2-1 Do For k:=j+1 To Nombre2 Do If Tableau2[j]>Tableau2[k]
Then Begin TempStr:=Tableau2[j];Tableau2[j]:=Tableau2[k];Tableau2[k]:=TempStr;End;
For j:=1 To Nombre3-1 Do For k:=j+1 To Nombre3 Do If Tableau3[j]>Tableau3[k]
Then Begin TempStr:=Tableau3[j];Tableau3[j]:=Tableau3[k];Tableau3[k]:=TempStr;End;
// Suppression des doublons
i:=1;
While i<Nombre2 Do
Begin
If Tableau2[i]=Tableau2[i+1]
Then Begin
For j:=i To Nombre2-1 Do Tableau2[j]:=Tableau2[j+1];
Dec(Nombre2);
End
Else Begin
Inc(i);
End;
End;
i:=1;
While i<Nombre3 Do
Begin
If Tableau3[i]=Tableau3[i+1]
Then Begin
For j:=i To Nombre3-1 Do Tableau3[j]:=Tableau3[j+1];
Dec(Nombre3);
End
Else Begin
Inc(i);
End;
End;
// Création de la liste des mots
Liste.Clear;
FillChar(TableauB,SizeOf(TableauB),#0);
For i:=1 To Nombre2 Do
Begin
Liste.Add('_'+Tableau2[i]+'_');
Nombre:=0;
For j:=1 To Nombre3 Do
Begin
If Pos(Tableau2[i],Tableau3[j])=1
Then Begin
Inc(Nombre);
Tableau4[Nombre]:='_'+Tableau3[j];
TableauB[j]:=True;
End;
If Pos(Tableau2[i],Tableau3[j])=2
Then Begin
Inc(Nombre);
Tableau4[Nombre]:=Tableau3[j]+'_';
TableauB[j]:=True;
End;
End;
For j:=1 To Nombre-1 Do For k:=j+1 To Nombre Do If Tableau4[j]>Tableau4[k]
Then Begin TempStr:=Tableau4[j];Tableau4[j]:=Tableau4[k];Tableau4[k]:=TempStr;End;
For j:=1 To Nombre Do Liste.Add(Tableau4[j]);
Liste.Add('');
End;
// Impression
With Printer Do With Printer.Canvas Do
Begin
// En mode paysage
Orientation:=poLandscape;
BeginDoc;
// Il faut toujours adapter la taille de la police à la résolution de l'imprimante !!!
Font.Name:='Courier New';
Y:=PageHeight Div (NombreY+8);
Font.Height:=-Y;
X:=TextWidth('A');
// Impression des mots 'croisés'
Base:=0;
MoveTo(Base*X*7+X*5,y*6);
LineTo(Base*X*7+X*5,y*6+NombreY*Y);
For i:=0 To Liste.Count-1 Do
Begin
TempStr:=Liste[i];
While Pos('_',TempStr)<>0 Do TempStr[Pos('_',TempStr)]:=' ';
TextOut(((i Div NombreY)+Base)*X*7+X*6,(i Mod NombreY)*Y+Y*6,TempStr);
If (i Mod NombreY)=0
Then Begin
MoveTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6);
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6+NombreY*Y);
End;
If TempStr=''
Then Begin
MoveTo(((i Div NombreY)+Base )*X*7+X*5,(i Mod NombreY)*Y+Y*6+(Y Div 2));
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,(i Mod NombreY)*Y+Y*6+(Y Div 2));
End;
End;
// Impression des autres mots
Liste.Clear;
Base:=17;
MoveTo(Base*X*7+X*5,y*6);
LineTo(Base*X*7+X*5,y*6+NombreY*Y);
For i:=1 To Nombre3 Do If Not TableauB[i] Then Liste.Add(Tableau3[i]);
For i:=0 To Liste.Count-1 Do
Begin
TempStr:=Liste[i];
TextOut(((i Div NombreY)+Base)*X*7+X*6,(i Mod NombreY)*Y+Y*6,TempStr);
If (i Mod NombreY)=0
Then Begin
MoveTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6);
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6+NombreY*Y);
End;
End;
// Impression du titre
Font.Name:='Arial';
Font.Height:=-2*Y;
TextOut(X*7,Y*3,'MOTS DE TROIS LETTRES GROUPES PAR EXTENSION D''UN MOT DE DEUX LETTRES');
NewPage;
Font.Name:='Courier New';
Font.Height:=-Y;
// Impression mots de deux lettres
Liste.Clear;
Base:=0;
MoveTo(Base*X*7+X*5,y*6);
LineTo(Base*X*7+X*5,y*6+NombreY*Y);
For i:=1 To Nombre2 Do Liste.Add(Tableau2[i]);
For i:=0 To Liste.Count-1 Do
Begin
TempStr:=Liste[i];
TextOut(((i Div NombreY)+Base)*X*7+X*6,(i Mod NombreY)*Y+Y*6,TempStr);
If (i Mod NombreY)=0
Then Begin
MoveTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6);
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6+NombreY*Y);
End;
End;
// Impression des mots de trois lettres
Liste.Clear;
Base:=3;
MoveTo(Base*X*7+X*5,y*6);
LineTo(Base*X*7+X*5,y*6+NombreY*Y);
For i:=1 To Nombre3 Do Liste.Add(Tableau3[i]);
For i:=0 To Liste.Count-1 Do
Begin
TempStr:=Liste[i];
TextOut(((i Div NombreY)+Base)*X*7+X*6,(i Mod NombreY)*Y+Y*6,TempStr);
If (i Mod NombreY)=0
Then Begin
MoveTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6);
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6+NombreY*Y);
End;
End;
// Impression des mots avec lettres chères
For k:=1 To Length(Lettres) Do
Begin
Liste.Clear;
Base:=14+K;
MoveTo(Base*X*7+X*5,y*6);
LineTo(Base*X*7+X*5,y*6+NombreY*Y);
For i:=1 To Nombre2 Do If Pos(Lettres[k],Tableau2[i])<>0 Then Liste.Add(Tableau2[i]);
For i:=1 To Nombre3 Do If Pos(Lettres[k],Tableau3[i])<>0 Then Liste.Add(Tableau3[i]);
For i:=0 To Liste.Count-1 Do
Begin
TempStr:=Liste[i];
TextOut(((i Div NombreY)+Base)*X*7+X*6,(i Mod NombreY)*Y+Y*6,TempStr);
If (i Mod NombreY)=0
Then Begin
MoveTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6);
LineTo(((i Div NombreY)+Base+1)*X*7+X*5,y*6+NombreY*Y);
End;
End;
End;
// Impression du titre
Font.Name:='Arial';
Font.Height:=-2*Y;
TextOut(X*7,Y*3,'LISTE COMPLETE DES MOTS DE DEUX ET TROIS LETTRES');
EndDoc;
End;
Finally
Liste.Free;
End;
End;
End.
|
| |
