runtime popupmenu on specific TDBGrid cell

[question]

Hi
Since few days,i am trying to solve one problem, but still now not suscess I have a TDBGrid: DBGrid1, i want to create runtime cotext menu by right mouse click on the grid cell. For example, if i right click on the DBGrid cell then it will check the value of the selected cell and if the value is true only then it will show the popup menu
i cannot use any event handler(onmouse up or on mousedown or onclick), its possible to create the popupmenu 'onshow event' using the following code but then it shows the popupmenu everywhere i click on the DBGrid but i want to show the popup menu on specific cell,could anybody please tell me, how to do it?

Code:

procedure TForm2.FormShow(Sender: TObject);
var
NewPopup: TPopupmenu;
MenuItem: TMenuItem;
begin
// i have tried here to set the condition, for example: 
//s := DBGrid1.DataSource.DataSet.FieldByName('tutorial_id').AsInteger;
if s=10 then // but it does not work 
NewPopup := TPopupMenu.Create(nil);
MenuItem := TMenuItem.Create(NewPopup);
MenuItem.Caption := 'Send-Click';
NewPopup.Items.Add(MenuItem);
DBGrid1.PopupMenu := NewPopup;
end;

[Volker Z.]

Hallo,

if I' ve got it right, you want to display a popup menu next to the selected cell of your grid only if some conditions are fulfilled.
Why do you wanna create the popup menu at runtime? I can' t see any need. I would suggest:

• put a TPopup component on your form
• create all the menu items you need
• set the AutoPopup property of your popup menu to false
• set the PopupMenu property of your TDBGrid component to the popup menu
• provide a OnMouseUp event handler to your TDBGrid component with code like the following

Delphi-Quellcode:

procedure TForm1.DBGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  c : TGridCoord;
  p : TPoint;
begin
  if Button = mbRight then
    begin
      c := DBGrid1.MouseCoord (X, Y);
      if (c.X = 0) or (c.Y = 0) then
        // no popup on a fixed col or row
        Exit;

      if YourConditionsAreFulfilled then
        begin
          // do some adjustment to the popup menu
          p := DBGrid1.ClientToScreen (Point (X, Y));
          PopupMenu1.Popup (p.X, p.Y)
        end
    end
end;

That should do.


Best regards

[question]

Hi, thanks for your reply, i have tried it ,it works but i have several grid in one form and several Form contains several grids , if i use this approach then i need to add many popup components(dbgrids,dbgrid2...and so on) ,therefore i am looking for a option ,so that i can create in runtime,is that possible

[Volker Z.]

Hallo,

Zitat:

[...] i have several grid in one form and several Form contains several grids

Ok, so what' s your goal? Several grids on a form, each grid should have its own popup menu created at runtime. And, does the popups have always the same number of items, actions, etc? Please give a bit more information.

Best regards

[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