Discussion :

[tourlourou]

Bonjour,

Une petite question, car j'ai de la suite dans les idées, ou de la suite, mais pas d'idées !

Est-il possible d'adjoindre à un TStringGrid un comportement mimant l'événement se produisant en fin d'édition du contenu d'une cellule, permettant au choix de l'utilisateur le retour à la valeur antérieure ou à une valeur arbitraire (comme pour les StringGrid de Lazarus) ?

Sans dériver la classe, sinon, ce serait facile !

[tourlourou]

J'ai pensé à utiliser des approches suggérées par cette discussion, ou à biaiser comme suggéré ici.

Sinon, je peux envisager d'utiliser un objet qui gèrera des StringGrids qu'on lui aura confiées : il associera l'état de chacun aux événements qu'il en recevra, pour détecter l'entrée en mode édition et la sortie (OnEditingDone mais EditorMode False ?) en détournant leurs événements OnSelectCell et OnEditingDone. Mais est-ce bien propre ?

En dérivant la grille, il suffit de :

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
  // type natif sous Lazarus, dont les StringGrids permettent la validation de saisie
  TValidateEntryEvent = procedure(Sender: TObject; aCol, aRow: Integer; const aOldValue: string; var aNewValue: String) of Object;
 
  // descendant implémentant les fonctionnalités présentes sous Lazarus
  TdySQliteGrid = class(TStringGrid)
   private
    EditorPrevMode   : Boolean;
    EditorPrevCol    : LongInt;
    EditorPrevRow    : LongInt;
    EditorPrevValue  : string;
    FOnValidateEntry : TValidateEntryEvent;
   protected
    procedure WndProc(var Message: TMessage); override;
   public
    constructor Create(AOwner: TComponent); override;
    procedure Clear;
    property OnValidateEntry : TValidateEntryEvent read FOnValidateEntry write FOnValidateEntry;
  end;
 
//...
 
constructor TdySQliteGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EditorPrevCol    := Col;
  EditorPrevRow    := Row;
  EditorPrevMode   := False;
  EditorPrevValue  := '';
end;
 
procedure TdySQliteGrid.WndProc(var Message: TMessage);
var
  NewValue : string;
begin
 inherited;
 if EditorMode <> EditorPrevMode then
  begin
    EditorPrevMode := EditorMode;
    if EditorMode then
     begin // entrée dans le mode édition
       EditorPrevCol   := Col;
       EditorPrevRow   := Row;
       EditorPrevValue := Cells[Col, Row];
     end
    else
     begin // sortie du mode édition
       NewValue := Cells[EditorPrevCol, EditorPrevRow];
       if (NewValue <> EditorPrevValue) and Assigned(FOnValidateEntry) then
       begin // demande de validation de la saisie
         FOnValidateEntry(self, EditorPrevCol, EditorPrevRow, EditorPrevValue, NewValue);
         if NewValue <> Cells[EditorPrevCol, EditorPrevRow] then
           Cells[EditorPrevCol, EditorPrevRow] := NewValue; // entrée non validée
       end;
     end;
  end;
end;

mais je trouverais plus simple d'utiliser le type natif...

[anapurna]

salut

perso je passerais par le TInplaceEdit

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
 
TStringGrid = Class(Grids.TStringGrid)
    function CreateEditor: TInplaceEdit; Override;
 
   ....
   Property OnEnterEdit ....
   Property OnExitEdit ....
  end;
....
function TStringGrid.CreateEditor: TInplaceEdit;
var
  Scaling : Boolean;
begin
  result := Inherited CreateEditor;
  Result.onEnter := OnEnterEdit;
  Result.onExit    :=OnExitEdit;
end;

[tourlourou]

Bonjour,
Je n'ai malheureusement pas réussi à l'implémenter de cette façon :
- sous Tokyo 10.2, les événements TInPlaceEDit.OnEnter et OnExit sont protected ;
- en utilisant un transtypage dans une classe de hack les exposant, pas de passage à l'exécution dans les événements affectés !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
type
  TMyInplaceEdit = class(Vcl.Grids.TInplaceEdit)
   public
    property OnEnter;
    property OnExit;
  end;
 
function TMyStringGrid.CreateEditor: TInplaceEdit;
begin
  Result := inherited CreateEditor;
  TMyInplaceEdit(Result).OnEnter := OnEnterEdit;
  TMyInplaceEdit(Result).OnExit  := OnExitEdit;
end;

[SergioMaster]

Bonjour,

le problème n'est pas récent. Sur un autre site dont je tairai le nom j'ai trouvé ce code

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
...
const
  WM_INPLACEEDIT_EXIT = WM_USER + $100;
 
type
  TStringGridHelper = Class(TStringGrid);
 
...
TForm1 = class(TForm)
...
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure StringGrid1Exit(Sender: TObject);
...
    OldWndProc, NewWndProc: TFarProc;
    hCurrentInplaceEdit: HWND;
    procedure HookInplaceEdit(hw: HWND);
    procedure InplaceEditWndProc(var Message: TMessage);
    procedure UnHookInplaceEdit(hw: HWND);
    procedure InplaceEditOnExit(var Message: TMessage); message WM_INPLACEEDIT_EXIT;
...
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  hCurrentInplaceEdit := 0;
  OldWndProc := nil;
  NewWndProc := nil;
end;
 
procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,
  ARow: Integer; var Value: String);
begin
  if Assigned(TStringGridHelper(StringGrid1).InplaceEditor) then
    HookInplaceEdit(TStringGridHelper(StringGrid1).InplaceEditor.Handle);
end;
 
procedure TForm1.StringGrid1Exit(Sender: TObject);
begin
  if Assigned(TStringGridHelper(StringGrid1).InplaceEditor) then
    UnHookInplaceEdit(TStringGridHelper(StringGrid1).InplaceEditor.Handle);
end;
 
procedure TForm1.HookInplaceEdit(hw: HWND);
begin
  if hCurrentInplaceEdit = 0 then
  begin
    OldWndProc := TFarProc(GetWindowLong(hw, GWL_WNDPROC));
    NewWndProc := Classes.MakeObjectInstance(InplaceEditWndProc);
    SetWindowLong(hw, GWL_WNDPROC, LongInt(NewWndProc));
    hCurrentInplaceEdit := hw;
    //SendMessage(Self.Handle, WM_INPLACEEDIT_EXIT, 1, 0);
  end;
end;
 
procedure TForm1.UnHookInplaceEdit(hw: HWND);
begin
  if hCurrentInplaceEdit > 0 then
  begin
    SetWindowLong(hw, GWL_WNDPROC, LongInt(OldWndProc));
    hCurrentInplaceEdit := 0;
    if Assigned(NewWndProc) then
    begin
      Classes.FreeObjectInstance(NewWndProc);
      NewWndProc := nil;
    end;
    //SendMessage(Self.Handle, WM_INPLACEEDIT_EXIT, 2, 0);
  end;
end;
 
procedure TForm1.InplaceEditWndProc(var Message: TMessage);
begin
  //call old proc
  Message.Result := CallWindowProc(OldWndProc, hCurrentInplaceEdit, Message.Msg,
    Message.wParam, Message.lParam);
 
  if Message.Msg = WM_KILLFOCUS then
  begin
    PostMessage(Self.Handle, WM_INPLACEEDIT_EXIT, 0, MakeLong(StringGrid1.Col, StringGrid1.Row));
  end;
end;
 
procedure TForm1.InplaceEditOnExit(var Message: TMessage);
begin
  if Message.WParam = 0 then
  begin
    StringGrid1.Cells[Message.LParamLo, Message.LParamHi] := '111';
  end;
end;

Ce que j'aime c'est qu'il ne nécessite aucun développement de composant à vérifier si cela fonctionne et peut convenir

[tourlourou]

Merci, Serge ; à étudier et adapter au besoin. Ce ne sera pas immédiat !