怎么动态建立TOOLBUTTON并且释放? ( 积分: 200 )

  • 主题发起人 主题发起人 蓝叶菱
  • 开始时间 开始时间

蓝叶菱

Unregistered / Unconfirmed
GUEST, unregistred user!
问题是这样的,我打算通过数据库存储功能。每个用户登录或者切换用户的时候,初始化按钮。代码如下。
procedure TFrmMain.ClearModule;
var
i:integer;
AButton:TToolButton;
begin
//清空快捷按钮
for i:=ToolBarMain.ButtonCount-1 downto 0 do
begin
AButton:=ToolBarMain.Buttons;
ToolBarMain.RemoveControl(AButton);
AButton.Free;
end;
end;
procedure TFrmMain.SetToolBar;
begin
ToolBarMain.AutoSize:=False;
with ToolBarMain,DM.QFunction do
begin
Close;
sql.Clear;
sql.Add('SELECT * FROM v_RoleFunction');
sql.Add('where (RoleID='+MyFrame.RoleID+')');
sql.Add('and (PageName=:p1)');
sql.Add('order by ORDERNO desc');
Parameters.ParamByName('p1').Value:='快捷工具条';
Open;
First;
CreateMyToolButton(tbsButton,'退出','tbExit',4,100);
CreateMyToolButton(tbsButton,'重新注销','tbLogin',3,111);
CreateMyToolButton(tbsSeparator,'','sep1',0,0);
while not eof do
begin
CreateMyToolButton(tbsButton,FieldByName('模块简称').AsString,'tb'+FieldByName('ID').AsString,
FieldByName('图像索引').AsInteger,FieldByName('模块索引').AsInteger);
Next;
end; //while
//-----两个快捷通用条
//TButton(FindComponent('sep1')).Width:=4;
ToolBarMain.AutoSize:=True;
end;
end;
//----
procedure TFrmMain.CreateMyToolButton(AStyle: TToolButtonStyle;
ACaption: String; AToolName:String;AImageIndex, TagIndex: integer);
var
CurButton:TToolButton;
begin
CurButton:=TToolButton.Create(ToolBarMain); //没有OWNDER,specotr就无法设定宽度。
CurButton.Caption:=ACaption;
CurButton.Parent:=ToolBarMain;
CurButton.ImageIndex:=AImageIndex;
CurButton.Style:=AStyle;
CurButton.Tag:=TagIndex;
CurButton.Height:=42;
CurButton.Width:=4;
CurButton.Visible:=True;
CurButton.Name:=AToolName;
if ACaption<>'' then
begin
CurButton.OnClick:=tb_CenterClick;
CurButton.Width:=42;
end;
//ToolBarMain.InsertControl(CurButton);
end;
切换用户的调用是这样的先调用ClearModule清除快捷按钮,再调用SetToolBar来初始化界面。Toolbuttonmain就是TToolbutton组件。
问题是这样的。。这个代码第一次进入没有问题,切换第一次没有,调用第三次,就出现抽象错误。再调用就出现访问错误。
如果CurButton:=TToolButton.Create(ToolBarMain); 改成CurButton:=TToolButton.Create(nil);就没有问题。
要么偶尔出现该组件已经存在。。。问题就是怎么动态建立或者清除ToolButton..
 
如果所有者是ToolButton就可能清除按钮就清不掉。。
 
procedure TForm1.Button1Click(Sender: TObject);
begin
tbn:=TToolButton.Create(self);
tbn.Caption:='测试';
tbn.Parent:=ToolBar1;

tbn.Show;


end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:Integer;
begin
for i:=ComponentCount-1 downto 0 do
begin
if Components is TToolButton then
Components.Free;
end;
end;
 
暂时不考虑扫描搜有组件的方法。。
我依然试试,依然第一次没有错误,第二次就出现访问错误。
也是不同。
 
创建的宿主不同当然会引起错误,就想你说的
如果CurButton:=TToolButton.Create(ToolBarMain); 改成CurButton:=TToolButton.Create(nil);就没有问题。
我想是这个问题!
我没遇到过这样的问题过
我设的宿主都是nil,有容器的话就是容器了
 
问题答案:
问题在于CurButton:=TToolButton.Create(ToolBarMain); 改成
CurButton:=TToolButton.Create(nil); //不明白,试用self,Toolbuttonbar,都是错误的。只能使用nil.

ToolBarMain.RemoveControl(AButton);
AButton.Free;//删除这句,我估计释放的时候不需要在试用toolbutton.free.
就一切OK。。。不知道为什么这样就OK了。哪位告诉我。
 
暂时不考虑扫描搜有组件的方法。。
我依然试试,依然第一次没有错误,第二次就出现访问错误。
也是不同。

没看懂你在说什么^_^
以上代码在D7中很正常,我依次点击Button1和Button2几十次也没有问题
 
按道理来讲,宿主是Toolbar或Self,与nil没有什么不同。Toolbar应该就是这个容器啊。
估计在RemoveControl释放的时候出现了问题,没有深度看。。不知道哪位告诉告诉我。。
 
浪人:
你的代码我在测试的时候,建立的DEMO没有任何问题。我才正式使用的,也测试N遍之后才使用的。。
开始的时候我使用的是NIL没有任何问题,但是发现分割线不好看,改成SELF,居然非常的美观。可是反复的操作发现。会出现一些BUG。。

一次性循环建立按钮,并且又重复的一次性清除,又一次性的建立所有的按钮就会出错。后来我发现我的兄弟告诉我的不正确,应该这样改。只要加入放缩就可以了。也就说
Toolbar.autosize:=FALSE;
.....
Toolbar.autosize:=True;就解决了分隔线的美观了。
现在只要改成NIL就OK了。。
至于DELPHI7我没有测试过。我使用的是DELPHI6,SP3。
我估计和无论是Component.free.和Abutton.free没有本质的不同。
关键是在RemoveControl之后的Free就是没有必要了。并且nil不知道和容器为什么设定OWNER就出现了问题。。。感觉奇怪,奇怪的更是,第一次没有问题,以后就有问题了。
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ToolWin, ComCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
ToolBar1: TToolBar;
Button2: TButton;
ToolButton1: TToolButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure tb_CenterClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure CreateMyToolButton(AStyle: TToolButtonStyle;
ACaption: String; AToolName:String;AImageIndex, TagIndex: integer);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
AButton:TToolButton;
begin
//清空快捷按钮
for i:=ToolBar1.ButtonCount-1 downto 0 do
begin
AButton:=ToolBar1.Buttons;
ToolBar1.RemoveControl(AButton);
AButton.Free;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
tbn:TToolButton;
i:Integer;
begin
{tbn:=TToolButton.Create(nil);
tbn.Parent:=ToolBar1;
tbn.Show; }
for i:=0 to 9 do
begin
CreateMyToolButton(tbsButton,'测试','TestBtn_'+inttostr(i),-1,0);
end;
end;

procedure tform1.CreateMyToolButton(AStyle: TToolButtonStyle;
ACaption: String; AToolName:String;AImageIndex, TagIndex: integer);
var
CurButton:TToolButton;
begin
CurButton:=TToolButton.Create(ToolBar1); //没有OWNDER,specotr就无法设定宽度。
CurButton.Caption:=ACaption;
CurButton.Parent:=ToolBar1;
CurButton.ImageIndex:=AImageIndex;
CurButton.Style:=AStyle;
CurButton.Tag:=TagIndex;
CurButton.Height:=42;
CurButton.Width:=4;
CurButton.Visible:=True;
CurButton.Name:=AToolName;
if ACaption<>'' then
begin
CurButton.OnClick:=tb_CenterClick;
CurButton.Width:=42;
end;
//ToolBarMain.InsertControl(CurButton);
end;


procedure TForm1.tb_CenterClick(Sender: TObject);
begin
//
end;

end.

以上代码在D7中依然没有问题
 
我操,这个世界没有天理了~~~~~ MD,老虎不发威,当我是病猫
 
自己搞定,分白送
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
630
import
I
S
回复
0
查看
937
SUNSTONE的Delphi笔记
S
后退
顶部