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

zbw 2000-04-05 02:45:00
本人想将DBGRID控件重载,封装RightClick事件,使之弹出POPUP MENU,其MENUITEM为各列的NAME或CAPTION,如此列的VISIBLE为TRUE,则相应MENUITEM的CHECKED为TRUE,否则为FALSE。我已实现在对象上的功能,但我想封装成另一个控件,以方便使用。因为有大量地方用到这个功能。
谢谢!
...全文
381 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
eaglet 2000-04-21
  • 打赏
  • 举报
回复
我用你的代码做了一个Dll ,显示PrvFormEh 窗体一切正常
下面是部分代码,你可以看一看.
{Project1.dpr}
library Project1;

uses
SysUtils,
Classes,
PrvFrmEh in 'Prvfrmeh.pas' {PreviewFormEh},
init in 'init.pas';
exports
InitForm;
begin

end.

{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;

interface

uses
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.
zbw 2000-04-21
  • 打赏
  • 举报
回复
是这样的,我做的其它DLL程序都没有问题,但只要在中用到那个控件的Preview功能就会
出错,跟踪到错误在上述语句。你如有兴趣可Download下来试用一下.为
http://member.netease.com/~tomcar/file/ehlib154.zip
谢谢
zbw 2000-04-19
  • 打赏
  • 举报
回复
我按你的想法改动了控件,但还是不行,各位大侠如有兴趣,可到
http://member.netease.com/~tomcar/file/ehlib154.zip下载研究一下,我觉得它
还是不错的,可惜有这个BUG,我现在只有把报表放在EXE中,很是不爽。

这个论坛上贴实在不方便!
eaglet 2000-04-14
  • 打赏
  • 举报
回复
你的TPreviewFormEh 是怎么定义的?
基类是什么?
如果是TForm的话,应写成 PreviewFormEh := TPreviewFormEh.Create(Application);
zbw 2000-04-11
  • 打赏
  • 举报
回复
是这样的,我在DLL中调试时,Application.MainForm是可以访问得到的,如CAPTION
属性,但Create不能,会出现Access Violation错误。你说的将TForm作为参数传入
DLL,具体如何,我现在可访问CAPTION属性,用参数有用吗?
eaglet 2000-04-11
  • 打赏
  • 举报
回复
我觉得你应把Application.MainForm
作为一个 TForm 参数带入Dll,在Create时
用这个参数,而不是Appliction.MainForm.
因为在Dll中很可能不能直接得到 Application.MainForm.

zbw 2000-04-11
  • 打赏
  • 举报
回复
以上问题本人已解决,是在MOUSEDOWN中解决的,我在POPMENU生成前,加上了
if popmenu=nil进行判断,并同时生成menuitem,以后在MOUSEDOWN时,
不会再生成popmenu,并在DBGRID的destructor事件中进行popmenu.free操作,
现在没有问题。现在有如下问题请教:控件源代码中有如下语句,
PreviewFormEh := TPreviewFormEh.Create(Application.MainForm);
其在EXE中没有问题,但将它放在DLL中就出错,请问是Create的问题吗?
谢谢
eaglet 2000-04-08
  • 打赏
  • 举报
回复
我大概看了一下你的代码,你把建立弹出菜单放在MouseDown事件处理函数中实现,
我觉得不妥,因为你每次按下鼠标都会创建一个popupmenu,你无法定位现在弹出的
是那一个popupmenu,另外你这样做有可能造成资源耗尽的危险.你应在
TslkDBGrid.create 中创建popupmenu和menuitem,如果你需要在鼠标按下后根据
当前数据显示不同的弹出菜单,可以通过修改menuitem的caption ,enabled ,visible
等属性变通实现.请认真阅读我写的代码,如果你有何问题,可以讲具体一些


eaglet 2000-04-07
  • 打赏
  • 举报
回复
以下代码可以实现popupmenu随Grid产生自动产生,
程序在Delphi3下调试通过,希望能对你有帮助.

{*******************************************************}
{*本程序自己建一个MyDBGrid对象,对象中创建一个弹出菜单 *}
{*当弹出菜单按下"new"时使Label1.caption='1'按下"open"时*}
{*使Label1.capiton='2' 仅作为一个例子供参考 *}
{*按下Button1创建MyGrid对象*}
{*******************************************************}

unit Unit1;

interface

uses
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 ; //自建的DBGrid

implementation

{$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.
zbw 2000-04-07
  • 打赏
  • 举报
回复
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.
eaglet 2000-04-06
  • 打赏
  • 举报
回复
比如你可以封装以下类
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
zbw 2000-04-06
  • 打赏
  • 举报
回复
问题是我想将POPOP Menu随着GRID的产生而自动产生,你这样,我可能还要在每个FORM中
放一个POPOP MENU

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧