runtime popupmenu on specific TDBGrid cell

[question]

several Grids from several Forms will show the same popupmenu,therefore i have used the following procedure and if i can this procedure in every form on show event handler then it creates the popupmenu but the problem is, it creates the popupmenu in every cell of the Grids,but i want to check specific Grid cell to show popupmenu on specific Grid cell.

Code:

procedure TForm1.NewPopMenu(Sender:TObject);
begin
if (Sender is TDBGrid) then
        begin
          NewPopup := TPopupMenu.(TDBGrid(Sender));
          MenuItem := TMenuItem.Create(TDBGrid(Sender));
          MenuItem.Caption := 'Send-Click';
          MenuItem.OnClick := NextSection;
          TDBGrid(Sender).PopupMenu.Items.Add(MenuItem);
end;

if i call this function in every Form OnShow event then it creates the popupmenu in every Form but how can i check the value of Grid cell so that popupmenu appear only on specific cell?

[Bummi]

Maybe this could give some inspiration. On Popupmenu and one OnMouseUpEvent for all Grids on all Forms.

Delphi-Quellcode:

procedure TMainForm.PopUpProcedure1Click(Sender: TObject);
begin
  Showmessage(TPopupMenu(TMenuItem(Sender).Owner).PopupComponent.Name);
end;

Procedure TMainform.AddPopupItem(Popup:TPopupMenu; aCaption:String;Event:TNotifyEvent);
var
 MenuItem : TMenuItem;
begin
   MenuItem := TMenuItem.Create(Popup);
   MenuItem.Caption := aCaption;
   MenuItem.OnClick := Event;
   Popup.Items.Add(MenuItem);
end;

Procedure TMainForm.PreparePopupAndPopup(Sender:TDBgrid; Field:TField;p:TPoint);
begin
  if Assigned(Sender.PopupMenu) then
  begin
     Sender.PopupMenu.Items.Clear;
     if (Sender.Name='MyGrid1') then
        begin  // PopUpProcedure1Click should be different for different actions needed
            If Field.FieldName='ID'  then AddPopupItem(Sender.PopupMenu,'ID',PopUpProcedure1Click)
            else If Field.FieldName='Name'  then  AddPopupItem(Sender.PopupMenu,'Name',PopUpProcedure1Click)
        end
     else if (Sender.Name='MyGrid2') then
        begin
            If Field.FieldName='XX'  then  AddPopupItem(Sender.PopupMenu,'XX',PopUpProcedure1Click)
            else If Field.FieldName='YY'  then  AddPopupItem(Sender.PopupMenu,'YY',PopUpProcedure1Click)
        end;
     Sender.PopupMenu.PopupComponent := Sender;
     Sender.PopupMenu.Popup(p.X,p.y);
  end;

end;



procedure TMainForm.AllGridsEveryWhereMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  c : TGridCoord;
  p : TPoint;
  offs:Integer;
begin
  if Button = mbRight then
    begin
      if dgIndicator in TDBGrid(Sender).Options then
        offs := -1
      else
        offs := 0;
      c :=TDBGrid(Sender).MouseCoord (X, Y);
      TDBGrid(Sender).Columns[c.X + offs].Field;
      if NOT ( (c.X = 0) or (c.Y = 0)) then
         PreparePopupAndPopup(TDBGrid(Sender), TDBGrid(Sender).Columns[c.X + offs].Field ,TDBGrid(Sender).ClientToScreen (Point (X, Y)));
    end
end;

[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