1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
| unit Main;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, SysUtils, eventlog, FileUtil, LResources, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
// La listbox
ListBox1: TListBox;
// le timer
Timer1: TTimer;
// evenement OnDrawItem de ListBox1
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
// evenement OnTimer de Timer1
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
// procedure qui permet d'ajouter une chaine (S) avec une couleur (aColor)
// différente ou non des autres dans ListBox1
procedure AddLog(const S: string; const aColor: LongInt= clBlack);
end;
var
Form1: TForm1;
implementation
{ TForm1 }
// on definit quelques couleurs
const
colorAction = clPurple; // couleur du texte d'une action
colorDanger = $000095; // couleur du texte quand il y à danger
colorAttaque= clNavy; // couleur du texte pour les attaques
colorDefense= clGreen; // couleur du texte pour les defense
colorInfos = clGray; // couleur du texte pour les infos
colorMort = clRed; // couleur du texte pour un joueur qui meurt
// la procedure AddLog
// ajoute la chaine S dans listBox1 avec une couleur de texte
// definit par aColor (noir si non définit).
procedure TForm1.AddLog(const S: string; const aColor: LongInt= clBlack);
begin
// si il n'y a pas encore de texte dans ListBox1
if ListBox1.Items.Count = 0 then
// on ajoute S avec Add
ListBox1.Items.Add(S)
else
// sinon on inser S en première position (index 0)
ListBox1.Items.Insert(0, S);
// si aColor est diférent de noir
if aColor <> clBlack then
// on précise la couleur de la chaine en utilisant
// la propriété Objects[] de Items (TStrings)
ListBox1.Items.Objects[0] := TObject(aColor);
end;
// procedure de dessin des items de listBox1
// qui est appelé pour déssiner chaque chaine.
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
var vColor : LongInt; // permet de récupérer la couleur de la chaine
vListBox : TListBox; // stock temporairement ListBox1
vStyle : TTextStyle; // definit le style du texte
begin
// on récupère la listbox appelante de cette procedure
vListBox := TListBox(Control);
// si Objects[index] est différent d'une valeur nulle
if vListBox.Items.Objects[index] <> nil then
// on récupère la couleur de définit pour cette chaine dans vColor
vColor := LongInt(vListBox.Items.Objects[index])
else
// sinon on ecrit en noir par défaut
vColor := clBlack;
// on éfface le contenus de la zone de la chaine
vListBox.Canvas.FillRect(ARect);
// on définit la couleur de la police d'écriture
vListBox.Canvas.Font.Color := vColor;
// on définit quelques propriétés supplémentaire pour
// que le dessin se fasse comme on le souhaite
vStyle.Alignment := taLeftJustify; // aligné à gauche
vStyle.Clipping := false; // pas de clipping
vStyle.ExpandTabs := false; // ne prend pas en charge les tabulations
vStyle.Layout := tlCenter; // aligné verticalement au centre
vStyle.Opaque := true; // n'est pas transparent
vStyle.SingleLine := true; // on ecrit sur une seule ligne
vStyle.Wordbreak := false; // on ne coupe pas les phrase
// enfin, on ecrit la chaine dans la listbox.
vListBox.Canvas.TextRect(ARect, ARect.Left+2, ARect.Top, vListBox.Items[index], vStyle);
end;
{ démonstration automatique du resultat }
var
C : LongInt = 0; // compteur d'appel à l'evenement OnTimer de Timer1
// evenement OnTimer de Timer1
// ajoute une phrase dans listbox1 via la procedure AddLog
// toute les X secondes (selon réglage du timer)
procedure TForm1.Timer1Timer(Sender: TObject);
begin
// par rapport à la valeur en cours de la variable C
case C of
0: AddLog('Démarrage de la partie', colorInfos);
1: AddLog('Des goblins vous attaques!', colorDanger);
2: AddLog('Perceval prépare un plan d''attaque', colorAction);
3: AddLog('Arthur attaque le goblin le plus proche', colorAttaque);
4: AddLog('Caradoc commet une maladresse et se tue', colorMort);
5: AddLog('Bohort s''enfuis comme un lache', colorAction);
6: AddLog('Le maitre du jeux s''ennuis', colorInfos);
end;
// on incremente C dans l'intervalle 0 à 6 uniquement (voir le case)
C := (C + 1) mod 7;
end;
initialization
{$I Main.lrs}
end. |