tourlourou

Dans le cadre d'un projet personnel en lien avec SQLite, je me suis trouvé bloqué sous Delphi 5, pour rendre les modifications bidirectionnelles du TStringGrid vers la BDD, sans le dériver, une contrainte que je m'étais fixée étant d'utiliser des objets de base.

Lazarus (CodeTyphon) m'a apporté une solution, sa grille déclenchant l'événement OnValidateEntry en fin d'édition d'une cellule, pour contrôler la validité d'une saisie.

De retour sous Delphi (merci pour la Communauty Edition Tokyo 1.02.3 !), je retrouve le problème et cherche à nouveau comment mimer ce comportement. Parti sur plusieurs pistes, c'est finalement en les mixant que j'ai conçu un objet prenant en charge l'ajout de cette fonctionnalité à une grille en interceptant ses messages :

Envoyé par tourlourou

Ça ne l'a en effet pas été ! Je n'ai pas réussi à le faire fonctionner convenablement tel quel.

Mais en mixant mes essais issus de différentes approches, j'obtiens ce que je souhaitais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit Unit3;

// https://stackoverflow.com/questions/5055811/how-can-i-detect-when-a-user-is-finished-editing-a-tstringgrid-cell

// https://www.developpez.net/forums/d1899042/environnements-developpement/delphi/composants-vcl/mimer-tstringgrid-onvalidateentry-lazarus/#post10515665

// https://www.experts-exchange.com/questions/28713957/Event-leaving-a-cell-in-a-TStringGrid.html

interface

uses
  Vcl.Grids, Winapi.Windows, Winapi.Messages, System.Classes;

type
  TOnValidateEntry = procedure(Sender: TObject; aCol, aRow: Integer; const aOldValue: String; var aNewValue: String) of Object;

  TStringGridMessageObserver = class
   private
    FGrid: TStringGrid;
    hGrid: HWND;
    OldWndProc, NewWndProc: TFarProc;
    FOnValidateEntry: TOnValidateEntry;
    OldValue: string;
    PrevCol, PrevRow: LongInt;
    PreviousMode: Boolean;
    procedure HookGridMessages(hw: HWND);
    procedure NewGridWndProc(var Message: TMessage);
    procedure UnHookGridMessages(hw: HWND);
   public
    constructor Create;
    destructor Destroy; override;
    function AddStringGridValidationMethod(aGrid: TStringGrid; aOnValidateEntry: TOnValidateEntry): Boolean;
  end;

implementation

constructor TStringGridMessageObserver.Create;
begin
  FOnValidateEntry := nil;
  OldWndProc := nil;
  NewWndProc := nil;
  FGrid := nil;
  hGrid := 0;
  PreviousMode := False;
  OldValue := '';
  PrevCol := -1;
  PrevRow := -1;
end;

function TStringGridMessageObserver.AddStringGridValidationMethod(aGrid: TStringGrid; aOnValidateEntry: TOnValidateEntry): Boolean;
begin
  Result := False;
  if not Assigned(FGrid) and (aGrid is TStringGrid) and Assigned(aOnValidateEntry) then
  begin
    FOnValidateEntry := aOnValidateEntry;
    FGrid := aGrid;
    HookGridMessages(aGrid.Handle);
    Result := True;
  end;

end;

procedure TStringGridMessageObserver.HookGridMessages(hw: HWND);
begin
    OldWndProc := TFarProc(GetWindowLong(hw, GWL_WNDPROC));
    NewWndProc := MakeObjectInstance(NewGridWndProc);
    SetWindowLong(hw, GWL_WNDPROC, LongInt(NewWndProc));
    hGrid := hw;
end;

procedure TStringGridMessageObserver.NewGridWndProc(var Message: TMessage);
var
  GridIsEditing: Boolean;
  NewValue: string;
begin
  // appel au traitement de base de la grille
 Message.Result := CallWindowProc(OldWndProc, hGrid, Message.Msg, Message.wParam, Message.lParam);

 GridIsEditing := FGrid.EditorMode;

 if GridIsEditing <> PreviousMode then
  begin
    PreviousMode := GridIsEditing;
    with FGrid do
    if GridIsEditing then
     begin // entrée dans le mode édition
       PrevCol   := Col;
       PrevRow   := Row;
       OldValue  := Cells[Col, Row];
     end
    else
     begin // sortie du mode édition
       NewValue := Cells[PrevCol, PrevRow];
       if (NewValue <> OldValue) and Assigned(FOnValidateEntry) then
       begin // demande de validation de la saisie
         FOnValidateEntry(FGrid, PrevCol, PrevRow, OldValue, NewValue);
         if NewValue <> Cells[PrevCol, PrevRow] then
           Cells[PrevCol, PrevRow] := NewValue; // entrée non validée
       end;
     end;
  end;
 end;

procedure TStringGridMessageObserver.UnHookGridMessages(hw: HWND);
begin
  if hGrid = hw then
  begin
    SetWindowLong(hw, GWL_WNDPROC, LongInt(OldWndProc));
    hGrid := 0;
    if Assigned(NewWndProc) then
    begin
      FreeObjectInstance(NewWndProc);
      NewWndProc := nil;
    end;
  end;
end;

destructor TStringGridMessageObserver.Destroy;
begin
  UnHookGridMessages(hGrid);
  inherited;
end;

end.

Et il suffit de l'appeler comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  StringGridMessageObserver := TStringGridMessageObserver.Create;
  StringGridMessageObserver.AddStringGridValidationMethod(StringGrid1, MyOnValidateEntry);

pour adjoindre à une grille le déclenchement d'une callback en fin d'édition d'une cellule.

Bien évidemment, ceci n'est pê pas portable ailleurs que sous Windows, mais c'est natif sous Lazarus pour Linux.