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. |