Wingdings 2 dans une StringGrid

Version imprimable

Bonsoir à tous,

J'utilise la police wingdings 2 pour afficher une case à cocher dans une stringgrid, cependant, je rencontre un problème d'affichage.
Exemple:
Quand je clique sur la ligne 3 par exemple pour afficher la case cocher et ensuite sur la ligne 4, il n'y a pas de problème. Ensuite, je clique de nouveau sur la ligne 3 et il m'affiche la case non coché, mais il le fait aussi sur la ligne 4.
Voici le code sous Delphi 2009

Code:

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
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1Click(Sender: TObject);
  private
    { Déclarations privées }
    iACol: integer;
    iARow: integer;
  public
    { Déclarations publiques }
    Value: String;
  end;
 
const
  sCheckOff = '0';
  sCheckOn  = 'R';
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i := StringGrid1.FixedRows to StringGrid1.RowCount -1 do
  begin
    Value:= sCheckOff;
  end;
end;
 
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  iACol:= TStringGrid(StringGrid1).Col;
  iARow:= TStringGrid(StringGrid1).Row;
 
  Value:= sCheckOff;
  if StringGrid1.Cells[iACol, iARow] = sCheckOff then
    Value:= sCheckOn;
end;
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if ACol = 1 then
  begin
    with TStringGrid(Sender), Canvas do
    begin
      Font.Name:= 'Wingdings 2';
      Font.Size:= 15;
 
      Cells[iACol, iARow]:= Value;
 
      TextOut(Rect.Left +25, Rect.Top +1, Value);
    end;
  end;
end;
 
end.

Quelqu'un pourrait-il éclairer ma lanterne ?
Jeankiki

17/03/2010, 08h28
Andnotor

Il faut écrire directement dans la cellule.
Comme fait actuellement, tu ne peux garantir que Value ait la valeur de la cellule devant être repeinte.

Bonjour,

Dans :
Code:

1 2 3 4 5 6 7 8 9 with TStringGrid(Sender), Canvas do begin Font.Name:= 'Wingdings 2'; Font.Size:= 15; Cells[iACol, iARow]:= Value; TextOut(Rect.Left +25, Rect.Top +1, Value); end;
... il manque déjà Font.Charset:=SYMBOL_CHARSET;
... pour le reste faut voir.

A+ :D

17/03/2010, 22h21
Jeankiki

Gilbert :
La ligne Font.Charset:=SYMBOL_CHARSET; est elle vraiment nécessaire?

Andnotor :
Faut il redessinner la cellule à chaque fois dans le OnClick avec un TextOut ?
18/03/2010, 09h12
Andnotor

Non, non !
Ecrire dans la cellule entraînera obligatoirement une repeinture, donc un appel à OnDrawItem ;).
18/03/2010, 11h52
Gilbert Geyer

Bonjour,

Citation:

Gilbert :
La ligne Font.Charset:=SYMBOL_CHARSET; est elle vraiment nécessaire?

... En tous cas elle m'a été nécessaire pour pouvoir afficher correctement des Wingdings dans un RichEdit.
... mais rien n'empêche d'essayer avec et sans dans ton StringGrid ça côute au grand max une seule instruction de plus ou de moins.

A+.:D
18/03/2010, 15h12
Jeankiki

ok, mais comment faire alors pour que l'affichage soit correct dans la StringGrid? Un petit coup de pouce :P

Code:

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
procedure TForm7.FormCreate(Sender: TObject);
var
  i: integer;
begin
  with StringGrid1 do
    for i := FixedRows to RowCount -1 do
      Cells[1, i] := sCheckOff;
end;
 
procedure TForm7.StringGrid1Click(Sender: TObject);
begin
  with TStringGrid(Sender) do
    if Col = 1 then
    begin
      if Cells[Col, Row] = sCheckOff
      then Cells[Col, Row] := sCheckOn
      else Cells[Col, Row] := sCheckOff;
    end;
end;
 
procedure TForm7.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  s :string;
 
begin
  with TStringGrid(Sender), Canvas do
    if aCol = 1 then
    begin
      Font.Name:= 'Wingdings 2';
      Font.Size:= 15;
 
      s := Cells[aCol, aRow];
      FillRect(Rect);
      TextRect(Rect, s, [tfCenter, tfVerticalCenter]);
    end;
end;

18/03/2010, 23h12
Jeankiki

Merci à vous deux pour votre aide et merci à toi Andnotor pour le code.
Il faut toujours que je cherche des complications là où il n'y en a pas. :lol:
Jeankiki