寻求源代码：在DBGrid中通过右键单击出现弹出式菜单的源码？

Question

比如你可以封装以下类
TMyDbGrid = class(TDBGrid)
...
private
  procedure OnDbGridClick (Column: TColumn);
public 
  constructor create (AOwner: TComponent);
end ;constructor TMyDbGrid.create(AOwner: TComponent);
begin
  OnCellClick := OnDbGridClick ;
  inherited Create(AOwner) ;
end ;procedure TMyDbGrid.OnDbGridClick(Column: TColumn);
begin
  Column.PopupMenu := PopupMenu1 ;
end;菜单点击后怎么操作我就不多说了,你自己根据实际情况写.
有问题可以Email给我.OK

Answer 1

问题是我想将POPOP Menu随着GRID的产生而自动产生，你这样，我可能还要在每个FORM中
放一个POPOP MENU

Answer 2

以下代码可以实现popupmenu随Grid产生自动产生,
程序在Delphi3下调试通过,希望能对你有帮助.{*******************************************************}
{*本程序自己建一个MyDBGrid对象,对象中创建一个弹出菜单  *}
{*当弹出菜单按下"new"时使Label1.caption='1'按下"open"时*}
{*使Label1.capiton='2' 仅作为一个例子供参考            *}
{*按下Button1创建MyGrid对象*}
{*******************************************************}unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, DBTables, Grids, DBGrids, Menus;type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    DataSource1: TDataSource;
    Table1: TTable;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;type
TMyDbGrid = class(TDBGrid)
private
  popmenu  : TPopupMenu ;  //弹出式菜单
  procedure OnDbGridClick (Column: TColumn);  //DBGrid的 OnCellClick事件
  procedure OnMenuItemClick(Sender: TObject); //菜单的OnClick 事件
public
  constructor create (AOwner: TComponent);
end ;var
  Form1: TForm1;
  Grid : TMyDbGrid ; //自建的DBGridimplementation{$R *.DFM}
constructor TMyDbGrid.create(AOwner: TComponent);
var
  Item : TMenuItem ;
begin
  popmenu := TPopupMenu.Create(AOwner);
  Item := TMenuItem.Create(popmenu);
  Item.Name := 'new' ;
  Item.Caption := 'new' ;
  Item.Tag := 1 ;
  Item.OnClick := OnMenuItemClick ;
  popmenu.Items.Add(Item);  Item := TMenuItem.Create(popmenu);
  Item.Name := 'open' ;
  Item.Caption := 'open' ;
  Item.Tag := 2 ;
  Item.OnClick := OnMenuItemClick ;
  popmenu.Items.Add(Item);  OnCellClick := OnDbGridClick ;
  inherited Create(AOwner) ;
end ;procedure TMyDbGrid.OnDbGridClick(Column: TColumn);
begin
  Column.PopupMenu := PopMenu ;
end;procedure TMyDbGrid.OnMenuItemClick (Sender : TObject);
begin
  case (Sender as TMenuItem).Tag of
    1 : Form1.Label1.Caption := '1' ;
    2 : Form1.Label1.Caption := '2' ;
  end ;end ;procedure TForm1.Button1Click(Sender: TObject);
begin
  Grid := TMyDBGrid.create(Application);
  Grid.Parent := Form1 ;
  Grid.DataSource := DataSource1 ;
  Grid.Visible := TRUE ;
  Grid.Enabled := TRUE ;
  Grid.Top  := 100 ;
  Grid.Left := 100 ;
  Grid.Height := 300 ;
  Grid.Width  := 400 ;
end;end.

Answer 3

unit slkDBGrid;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids,Menus;
type
  TslkDBGrid = class(TDBGrid)
   private
   protected
    procedure OnMenuItemClick(Sender: TObject);
    procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:integer);override;
  public
  published
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Data Controls', [TslkDBGrid]);
end;
procedure TslkDBGrid.OnMenuItemClick(Sender: TObject);
begin
(Sender as TMenuItem).Checked:=not (Sender as TMenuItem).Checked;
Columns[(Sender as TMenuItem).Tag].Visible:=(Sender as TMenuItem).Checked;
end;
procedure TslkDBGrid.MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:integer);
var
popmenu:TPopupMenu;
popitems : TMenuItem ;
i:integer;
begin
  if Button=mbRight then
  begin
  popmenu := TPopupMenu.Create(self);
  if Columns.count>0 then
    begin
     for i:=0 to Columns.count-1 do
     begin
     popitems:=Tmenuitem.Create(self);
     popitems.caption:=Columns[i].fieldname;
     popitems.checked:=Columns[i].Visible;
     popitems.tag:=i;
     popitems.OnClick:=OnMenuItemClick;
     popmenu.items.Add(popitems);
    end;
   PopupMenu := PopMenu;
  end;
  end;
  inherited MouseDown(Button,Shift,X,Y);
end;
end.

Answer 4

我大概看了一下你的代码,你把建立弹出菜单放在MouseDown事件处理函数中实现,
我觉得不妥,因为你每次按下鼠标都会创建一个popupmenu,你无法定位现在弹出的
是那一个popupmenu,另外你这样做有可能造成资源耗尽的危险.你应在
TslkDBGrid.create 中创建popupmenu和menuitem,如果你需要在鼠标按下后根据
当前数据显示不同的弹出菜单,可以通过修改menuitem的caption ,enabled ,visible
等属性变通实现.请认真阅读我写的代码,如果你有何问题,可以讲具体一些

Answer 5

以上问题本人已解决，是在MOUSEDOWN中解决的，我在POPMENU生成前，加上了
if popmenu=nil进行判断，并同时生成menuitem，以后在MOUSEDOWN时，
不会再生成popmenu，并在DBGRID的destructor事件中进行popmenu.free操作，
现在没有问题。现在有如下问题请教：控件源代码中有如下语句，
PreviewFormEh := TPreviewFormEh.Create(Application.MainForm);
其在EXE中没有问题，但将它放在DLL中就出错，请问是Create的问题吗？
谢谢

Answer 6

我觉得你应把Application.MainForm 
作为一个 TForm 参数带入Dll,在Create时
用这个参数，而不是Appliction.MainForm.
因为在Dll中很可能不能直接得到 Application.MainForm.

Answer 7

是这样的，我在DLL中调试时，Application.MainForm是可以访问得到的，如CAPTION
属性，但Create不能，会出现Access Violation错误。你说的将TForm作为参数传入
DLL，具体如何，我现在可访问CAPTION属性，用参数有用吗？

Answer 8

你的TPreviewFormEh 是怎么定义的?
基类是什么?
如果是TForm的话，应写成 PreviewFormEh := TPreviewFormEh.Create(Application);

Answer 9

我按你的想法改动了控件，但还是不行，各位大侠如有兴趣，可到
http://member.netease.com/~tomcar/file/ehlib154.zip下载研究一下，我觉得它
还是不错的，可惜有这个BUG，我现在只有把报表放在EXE中，很是不爽。这个论坛上贴实在不方便！

Answer 10

我用你的代码做了一个Dll ,显示PrvFormEh 窗体一切正常
下面是部分代码,你可以看一看.
{Project1.dpr}
library Project1;uses
  SysUtils,
  Classes,
  PrvFrmEh in 'Prvfrmeh.pas' {PreviewFormEh},
  init in 'init.pas';
  exports
  InitForm;
beginend.{Init.pas}
unit init;interface
procedure InitForm ; stdcall ; //注意stdcall是关键，你也可以用其他对齐方式，
                               //注意在调用Dll时对齐方式一定
                               //要和你定义的对齐方式一致，如你用stdcall,
                               //调用时也要用stdcall  
implementation
uses PrvFrmEh,Forms ;
var
  PrvFormEh : TPreviewFormEh ;
procedure InitForm ;
begin
  PrvFormEh := TPreviewFormEh.Create(Application);
  PrvFormEh.show ;
end;end.{以下为调用Project1.dll的程序主界面的代码}unit mainfrm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
  TInitForm = procedure ; stdcall ; //注意这里的stdcall和上面定义的是一致的
                                    //如果不一致就会出错.  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  InitForm : TInitForm ;
implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);//按下Button1后载入动态库
//并运行InitForm，显示PrvFormEh窗体.
var
  DllHandle : integer ;
begin
  DllHandle := LoadLibrary('project1.dll');
  if DllHandle <> 0 then
  begin
    InitForm := GetProcAddress(DllHandle,'InitForm');
    if Integer(@InitForm) <> 0 then   InitForm ;
  end 
end;end.

Answer 11

是这样的，我做的其它DLL程序都没有问题，但只要在中用到那个控件的Preview功能就会
出错，跟踪到错误在上述语句。你如有兴趣可Download下来试用一下.为
http://member.netease.com/~tomcar/file/ehlib154.zip
谢谢