runtime popupmenu on specific TDBGrid cell

[Volker Z.]

Hallo,

a further approach:

add a unit to your project like the following

Delphi-Quellcode:

unit Unit2;

interface

uses
  Vcl.Menus, Vcl.DBGrids;

var
  DBGridPopupMenu : TPopupMenu;

  procedure DBGridShowPopupMenu (const DBGrid : TDBGrid; const X, Y : Integer; const RequiredCellContent : string);

implementation

uses
  System.SysUtils, System.Types, Vcl.Grids;

procedure DBGridShowPopupMenu (const DBGrid : TDBGrid; const X, Y : Integer; const RequiredCellContent : string);
var
   p : TPoint;
   s : string;
begin
   if not (Assigned (DBGrid) and Assigned (DBGrid.SelectedField)) then
     Exit;

   s := DBGrid.SelectedField.AsString;
   if s = RequiredCellContent then
     begin
       p := DBGrid.ClientToScreen (Point (X, Y));
       DBGridPopupMenu.Popup (p.X, p.Y)
     end
end;

procedure CreateDBGridPopupMenu;
var
  m : TMenuItem;
begin
  DBGridPopupMenu := TPopupMenu.Create (nil);
  if Assigned (DBGridPopupMenu) then
    begin
      m := TMenuItem.Create (DBGridPopupMenu);
      if Assigned (m) then
        begin
          m.Caption := 'Send-Click';
          m.OnClick := nil;
          DBGridPopupMenu.Items.Add (m)
        end;
    end;
end;

procedure FreeDBGridPopupMenu;
begin
  FreeAndNil (DBGridPopupMenu)
end;

initialization
  CreateDBGridPopupMenu;
finalization
  FreeDBGridPopupMenu;
end.

on each of your forms two private methods, an event handler FormCreate and the unit in your uses section like this

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    function  DBGridGetRequiredCellContent (const DBGrid : TDBGrid) : string;
    procedure DBGridMouseUp (Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
  end;

implementation

{$R *.dfm}

uses
  Unit2;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DBGrid1.OnMouseUp := DBGridMouseUp;
  DBGrid2.OnMouseUp := DBGridMouseUp;
  // and so on if you have more DBGrids
end;

function TForm1.DBGridGetRequiredCellContent (const DBGrid : TDBGrid) : string;
begin
  // depending on the given DBGrid return the proper cell content which is required to display the popup menu
  if DBGrid = DBGrid1 then
    Result := 'Value1'
  else
    Result := 'Value2'
end;

procedure TForm1.DBGridMouseUp (Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
var
  g : TDBGrid;
begin
  if (Sender is TDBGrid) and (Button = mbRight) then
    begin
      g := TDBGrid (Sender);
      DBGridShowPopupMenu (g, X, Y, DBGridGetRequiredCellContent (g))
    end
end;

Best regards