动态生产控件的方法和应用

一、Delphi中生成控件的两种方法 ---- 1、 Form(表单)设计中生成控件 ---- 在进行Form设计时，直接在控件工具箱选择所需控件，再设置其属性与响应事件，这种方法比较常见。 ---- 2、 程序中动态生成控件 ---- 有时候，我们需要在程序运行时动态生成控件，这样做有两大优点：一是可以增加程序的灵活性；二是如果生成控件的多少与程序中间运行结果相关，显然方法一是无法的实现的，必须用程序中动态生成方法。 ---- 程序中动态生成控件的方法分为三步，首先，定义生成的控件类型，再用Create函数生成控件，最后对控件的相关属性赋值。以TButton控件为例，步骤如下： ---- (1) 定义控件类型   var      Button1:TButton; ---- (2) 生成控件   Button1:=TButton. Create(self);   Button1.Parent:=Self;    //一般将其父控件设置为Self,如果不设置Parent的值，则控件不会在屏幕显示出来 ---- (3) 设置其它属性及定义相关事件响应函数，如Caption, Left, Top, Height, Width, Visible, Enabled, Hint和onClick事件响应函数等。 二、动态生成控件方法的应用 ---- 在开发生产调度与管理系统中，需要动态生成排产计划图，以甘特图表示，应用Shape控件来显示零件的加工状况(每道工序的加工开始时间与结束时间)是非常适合的。应用Chart控件，对加工设备利用率以三维直方图显示，非常直观。现分别将在程序中动态生成Shape控件和Chart控件的过程加以说明。 ---- 1、动态生成Shape控件显示排产计划图(甘特图)     procedure TCreateMultiCharts.ProcCreateCharts;     var       i,j,Rows,Columns,RowSpace,ChartsHeight:Integer;       ShapeChart:array of array of TShape;     begin       Rows:=16;        //Shape控件数组行数       Columns:=8;      // Shape控件数组列数       RowSpace:=20;   // Shape控件行间距       ChartsHeight:=20; // Shape控件高度       SetLength(ShapeChart,Rows,Columns);       //设置ShapeChart数组大小       for i:=0 to Rows do         for j:=0 to Columns do         begin       ShapeChart[i][j]:=TShape.Create(self);       with ShapeChart[i,j] do       begin         Parent:=Self;  //此行必不可少,否则Shape控件在屏幕显示不出         Shape:=stRectangle; // Shape控件形状为矩形         Top:=45+i*(RowSpace+ChartsHeight);         Left:=Round(180+Q[i,j].StartTime); //因Q[i,j].StartTime为实数,故需进行四舍五入取整         Width:=Round(Q[i,j].Value)         Height:=ChartsHeight;                 Brush.Color:=RandomColor; //自定义函数，说明附后         Brush.Style:=bsSolid; //设置填充方式         Enabled:=True;       end;     end; end; 　 ---- 注: ---- (1)Q为一记录型二维数组,定义如下:   type      TempData=Record      Value:Real;      StartTime:Real;    end;    Q:array of array of TempData ---- 并且在另一过程已对Q的分量进行赋值。 ---- (2)为了区分不同的零件，Shape以不同颜色显示，此时，调用了函数RandomColor。该函数为：    function TCreateMultiCharts.RandomColor;    var      red,green,blue:byte;    begin      red:=random(255);      green:=random(255);      blue:=random(255);      result:=red or (green shl 8) or (blue shl 16);    end; ---- 2、动态生成Charts控件的ChartSeries组件，显示设备利用率    procedure TFormMultiMachinesBurthen.    ShowMachineBurthenCharts;    var     i:Integer;     Burthen:Real;     SeriesClass:TChartSeriesClass;     NewSeries:array of TChartSeries;   begin     SetLength(NewSeries,CreateMultiCharts.Rows);     MachinesBurthenCharts.height:=200;     MachinesBurthenCharts.Width:=550;     for i:=0 to CreateMultiCharts.Rows do     begin       SeriesClass:=TBarSeries;  //设置形状为三维条形图       NewSeries[i]:=SeriesClass.Create(Self);       NewSeries[i].ParentChart:=MachinesBurthenCharts;       NewSeries[i].Clear;       Burthen:=MachineBurthen[i];       Burthen:=Round(Burthen*100)/100;  //只取小数点后两位数字       NewSeries[i].add(Burthen,'',NewSeries[i].SeriesColor);     end;   end; 　 ---- 注： ---- (1) MachineBurthen[i]为一实型数组，其值为对应设备的利用率，已在另一函数中计算得到； ---- (2) MachinesBurthenCharts为TChart控件，在type段说明。  <div style="BORDER-BOTTOM: #8ca6de 1px solid" align="right">2004-4-6 10:59:32    </div><div class="inputcaption" style="BORDER-BOTTOM: #8ca6de 1px solid"><table cellspacing="0" cellpadding="3" width="100%" border="0"> <tbody> <tr> <td> </td> <td align="right"><a href="http://www.delphibbs.com/keylife/iblog_comment.asp?xid=6917">查看评语»»»</a>    </td> </tr> </tbody></table></div> 2004-4-6 11:29:16    动态创建菜单全接触 [基本认识]：       在Delphi的程序开发环境中，封装的VCL减化了我们许多的开发工作，由在界面的设计上使开发的进度很快，但在很多的时候，我们需要自己来设计可视化的用户界面，而且是在程序的运行中，这时我们就得利用Delphi给我们提供的类来完成我们需要的工作了，下面笔者就和朋友们浅入的讨论一下动态创建"菜单"的基本知识，希望本文给那些刚入门的朋友来个抛砖引玉的作用。         在delphi的菜单设计中，有两个Delphi的菜单控件：       1：Tmainmenu;       2：Tpopupmenu;       前者是创建窗口的菜单，后者是创建右键弹出式菜单的控件，但在Delphi庞大的类库中有一个类与这两个控件密切相关，它就是：TMenuItem，窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。此TMenuItem类不出现在控件板上，在程序中用代码可创建其实例。 [基本知识]：       在tmainmenu,tpopupmenu控件中有一个属性是items，此属性是数组型，里面的参数为菜单项的索引值。 文件　编辑　查看　插入　格式　帮助 ---- ---- ---- ---- ---- ---- 新建　撤消　标尺　对象　字体　关于 打开　拷贝　源码　公式　颜色　       相信您看过上面的菜单简单表示之后是非常熟悉的，在此菜单中菜单头的索引值代表如下：       "文件"的菜单的items值为0；       "编辑"的菜单的items值为1；以此类推。       items属性是tmenuitem类型，而在此类型中还有一个属性,是items，如果您略懂"类"的关系，您就不难明白此类似"嵌套"的关系。"新建"菜单选项是"文件"菜单选项的子类，用代码表示为tmainmenu.items[0].items[0]，"打开"菜单选项为tmainmenu.items[0].items[1]，以此类推，而代表"编辑"菜单中的"拷贝"菜单选项的代码为tmainmenu.items[1].items[1]，其它菜单代码表示以此类推。 [基本实例]：       知道了菜单的items结构之后，我们就可以进一步大胆的创建自己有序的菜单了。       上面讨论到窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。那么我们就可以create它的一个实例，来添加自己想要的菜单了。 [示例过程]： 1：新建一个工程。 2：添加一个tmainmenu控件。 3：添加一个button控件，并在button的onclick事件中写入如下代码： procedure TForm1.Button1Click(Sender: TObject); var     files,edit:tmenuitem;{要有实例的声明} begin     files:=tmenuitem.Create(self);     edit:=tmenuitem.create(self);     files.Caption:='文件';     edit.caption:='编辑';     mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}     form1.MainMenu1.Items.Add(files);     form1.mainmenu1.items.add(edit); end;　　       运行后，出现如上面例举的菜单的部分结构，如此看来动态创建菜单项的方法是非常简单的，这无疑于Delphi把系统的函数进行了封装。菜单头我们创建完了，接下来就该创建菜单里的菜单项了，由"items属性是tmenuitem类型，而在此类型中还有一个属性,是items"此句话的意思我们可以创建菜单项，代码如下： 1：新建一个工程。 2：添加一个tmainmenu控件。 3：添加一个button控件，并在button的onclick事件中写入如下代码： procedure TForm1.Button1Click(Sender: TObject); var    files,edit:tmenuitem;    new,copy:tmenuitem; begin    files:=tmenuitem.Create(self);    edit:=tmenuitem.create(self);    files.Caption:='文件';    edit.caption:='编辑';    mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}    form1.MainMenu1.Items.Add(files);    form1.mainmenu1.items.add(edit);    {上部代码为创建菜单头}    new:=tmenuitem.create(self);    copy:=tmenuitem.create(self);    new.Caption:='新建';    copy.caption:='拷贝';    files.Add(new);    edit.add(copy);   {上部代码为创建菜单项} end;       运行效果和上面菜单结构表中基本一样，但此时点击菜单项时不出现任何的事件，显然这样的软件出售量不算理想，我们可以略改代码加个事件上去。 代码如下： 1：新建一个工程。 2：添加一个tmainmenu控件。 3: private   procedure abc(sender:tobject);   { Private declarations } var   Form1: TForm1; implementation {$R *.DFM} procedure tform1.abc(sender:tobject); begin    showmessage('welcome you click me!! :) xixi'); end; procedure TForm1.Button1Click(Sender: TObject); var    files,edit:tmenuitem;    new,copy:tmenuitem; begin    files:=tmenuitem.Create(self);    edit:=tmenuitem.create(self);    files.Caption:='文件';    edit.caption:='编辑';    mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}    form1.MainMenu1.Items.Add(files);    form1.mainmenu1.items.add(edit);    {上部代码为创建菜单头}    new:=tmenuitem.create(self);    copy:=tmenuitem.create(self);    new.Caption:='新建';    copy.caption:='拷贝';    copy.onClick:=abc;    new.onClick:=abc;    files.Add(new);    edit.add(copy);    {上部代码为创建菜单项} end;       这时这个软件就有了交互的功能。       有时菜单项中出现一个横的条线和出现一个子的菜单，那么这样的效果怎么用代码实现的呢，下面就是此效果的代码示例： 1：新建一个工程。 2：添加一个tmainmenu控件。 3： procedure TForm1.Button1Click(Sender: TObject); var    files,edit:tmenuitem;    new,copy:tmenuitem;    sub1,sub2,sub3,lines:tmenuitem; begin    files:=tmenuitem.Create(self);    edit:=tmenuitem.create(self);    files.Caption:='文件';    edit.caption:='编辑';    mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键}    form1.MainMenu1.Items.Add(files);    form1.mainmenu1.items.add(edit);   {上部代码为创建菜单头}    new:=tmenuitem.create(self);    copy:=tmenuitem.create(self);    new.Caption:='新建';    copy.caption:='拷贝';    files.Add(new);    edit.add(copy);   {上部代码为创建菜单项}    sub1:=tmenuitem.create(self);    sub2:=tmenuitem.create(self);    sub3:=tmenuitem.create(self);    lines:=tmenuitem.create(self);    lines.caption:='-';    sub1.caption:='子菜单1';    sub2.caption:='子菜单2';    sub3.caption:='子菜单3';    new.Add(sub1);    new.add(lines);    new.add(sub3);    copy.Add(sub2);   {上面代码出现多项子菜单和横线的效果} end;       到此讨论的内容就要结束，菜单的创建在Delphi中是非常简单的事，在tmenuitem类中还有许多的事件和方法及属性，如Add, Clear, Click, Create, Delete, Destroy, Find, IndexOf, Insert, Remove等方法的使用都是非常简单的. <div class="bline" align="right"> </div> 2004-4-6 11:30:34    TPagecontrol TTablesheet 动态创建 动态创建TPagecontrol, TTablesheet var   T : TTabSheet;   P : TPageControl; begin    // Create the PageControl    // need to reference the page control so we need a reference to it.   P := TPageControl.Create(application);   with P do begin     Parent := Form1;  // set how controls it.     Top := 30;     Left := 30;     Width := 200;     Height := 150;     end;  // with TPageControl     // Create 3 pages   T := TTabSheet.Create(P);   with T do begin     Visible := True;   // This is necessary or form does not repaint                        // correctly     Caption := 'Page 1';     PageControl := P;  // Assign Tab to Page Control     end;  // with   T := TTabSheet.Create(P);   with T do begin     Visible := True;   // This is necessary or form does not repaint                        // correctly     Caption := 'Page 2';     PageControl := P;  // Assign Tab to Page Control     end;  // with   T := TTabSheet.Create(P);   with T do begin     Visible := True;   // This is necessary or form does not repaint                        // correctly     Caption := 'Page 3';     PageControl := P;  // Assign Tab to Page Control     end;  // with     // Create 3 buttons, 1 per page   with tbutton.create(application) do begin     Parent := P.Pages[0];  // Tell which page owns the Button     Caption := 'Hello Page 1';     Left := 0;     Top := 0;     end; // with   with tbutton.create(application) do begin     Parent := P.Pages[1];  // Tell which page owns the Button     Caption := 'Hello Page 2';     Left := 50;     Top := 50;     end; // with   with tbutton.create(application) do begin     Parent := P.Pages[2];  // Tell which page owns the Button     Caption := 'Hello Page 3';     Left := 100;     Top :=  90;     end; // with     // This needs to be done or the Tab does not sync to the     // correct page, initially.  Only if you have more then     // one page.   P.ActivePage := P.Pages[1];   P.ActivePage := P.Pages[0];  // page to really show end;   <div class="bline" align="right"> </div> 2004-4-6 11:32:23    动态创建控件依次显示数据库值 var   Edit1: TEdit;   i: integer; begin   table1.First;   for i := 0 to table1.RecordCount - 1 do begin     Edit1 := TEdit.Create(Self);     Edit1.Parent := aForm;     Edit1.Left := 20;     Edit1.Top := 20 * i;     Edit1.Text := table1.fieldbyname('姓名').asString;     table1.next;   end;   edit1.Destroy; end; <div class="bline" align="right"> </div> 2004-4-6 11:40:25    动态加减pagecontrol的页数 --- 配合《TPagecontrol TTablesheet 动态创建》使用 动态添加：   tabsheet2:=ttabsheet.Create(self);   tabsheet2.Caption:='fkjsd';   tabsheet2.PageControl:=pagecontrol1; 删除：   tabsheet1.PageControl:=nil; <div class="bline" align="right"> </div> 2004-4-6 11:43:25    快速动态创建MenuItem --- 配合《动态创建菜单全接触》使用 在设计程序时,有时我们需要动态地创建菜单, 通常我们使用以下的语句   PopupMenu1 := TPopupMenu.Create(Self);   Item := TMenuItem.Create(PopupMenu1);   Item.Caption := 'First Menu';   Item.onClick := MenuItem1Click;   PopupMenu1.Items.Add(Item);   Item := TMenuItem.Create(PopupMenu1);   Item.Caption := 'Second Menu';   Item.onClick := MenuItem2Click;   PopupMenu1.Items.Add(Item);   Item := TMenuItem.Create(PopupMenu1);   Item.Caption := 'Third Menu';   Item.onClick := MenuItem3Click;   PopupMenu1.Items.Add(Item);   Item := TMenuItem.Create(PopupMenu1);   Item.Caption := '-';   PopupMenu1.Items.Add(Item);   Item := TMenuItem.Create(PopupMenu1);   Item.Caption := 'Fourth Menu';   Item.onClick := MenuItem4Click;   PopupMenu1.Items.Add(Item); 其实我们可以使用一种更快的方法达到同样的功能, 但使用很少的代码, 那就是用NewLine和NewItem, 看看下面的例子, 是不是很简单? PopupMenu1 := TPopupMenu.Create(Self); with PopUpMenu1.Items do begin   Add(NewItem('First Menu',0,False,True,MenuItem1Click,0,'MenuItem1'));   Add(NewItem('Second Menu',0,False,True,MenuItem2Click,0,'MenuItem2'));   Add(NewItem('Third Menu',0,False,True,MenuItem3Click,0,'MenuItem3'));   Add(NewLine); // 增加一个分割棒   Add(NewItem('Fourth Menu',0,False,True,MenuItem4Click,0,'MenuItem4'));   ... end; <div class="bline" align="right"> </div> 2004-4-6 11:45:54    [作者：guosoong]在QuickRep上面的动态报表建立 相信每一个到这里的人，都在100多页中寻找过帮助，或多或少都会感到痛苦的，如果你看到本文之后，如果有一丝快乐，就是我最大的快乐了。 话归正题! [项目要求]:一个字段动态建立的数据库文件(.dbf),用户要求查询打印或者把整个数据库都打印出来。 [解决方法]: 1.首先把当前Table或Query中的数据提取出来。 2.用户决定一页报表打印多少列，把提取的数据建立数据库文件。 3.建立一个QuickQep窗体，在程序运行时动态建立，并动态建立TQRDBText。 下面提供每个工作的源码。望大家修改并通知我谢谢。 1.首先把当前Table或Query中的数据提取出来。 首先定义数据库内有效数据的数据结构 type   printvalue = record   fidlecount: integer;  //当前数据库的行号(从0开始,完全是个人习惯)   fidlename: string;   //字段名称   fidlevalue: string;  //字段内容   end; pNowPrintvalue = ^printvalue;  //定义指针 这个结构大家可以随意修改 //这个命令是TTable的，用于把一个数据库文件全部提取出来  TQuery就留给大家自己做吧 procedure TForm1.CreateQRTlistByTTable(filename: string; ValueTlist: Tlist); var   temppoint: pNowPrintvalue;   tempTStrings: Tstrings;   temploop1,temploop2: integer;   temptable: TTable;   tempTString: Tstrings; begin   if filename = '' then exit;   if ValueTlist = nil then ValueTlist := Tlist.Create;   ValueTlist.Clear;   temptable := TTable.Create(nil);   tempTStrings := Tstringlist.Create;   try     if sysutils.FileExists(filename) then     begin       temptable.Close;       temptable.DatabaseName := sysutils.ExtractFilePath(filename);       temptable.TableName := sysutils.ExtractFileName(filename);       temptable.Open;       temptable.First;       tempTStrings := temptable.FieldList;       if tempTStrings.Count <= 0 then exit;       for temploop2 := 0 to temptable.RecordCount -1 do       begin         for temploop1 := 0 to tempTStrings.Count -1 do         begin           if tempTStrings[temploop1] <> '' then           begin             new(temppoint);             temppoint.fidlecount := temploop2;             temppoint.fidlename := tempTStrings[temploop1];             if temptable.FieldValues[tempTStrings[temploop1]] = null then             temppoint.fidlevalue := ' '             else             temppoint.fidlevalue := temptable.FieldValues[tempTStrings[temploop1]];             ValueTlist.Add(temppoint);           end;         end;         temptable.Next;       end;     end;   finally     temptable.Free;   end; end; //上面程序里的TLIST就是下面函数的需要的ValueTlist //QRCOLcount 就是用户决定一页打印的列数 function TForm1.WriteQRTempDBF(ValueTlist: Tlist;   QRCOLcount: integer): integer; var   templist: Tlist;   tempint: integer;   temptable: TTable;   temploop1,temploop2,temploop3: integer;   temppoint: pNowPrintvalue;   tempvalue: array of string;   modint,endint:integer; const   tempdbname = 'temprint.DBF';   FieldNames = 'TEMPFD'; begin   result := 0;   if QRCOLcount <= 0 then exit;   if ValueTlist = nil then exit;   if ValueTlist.Count <= 0 then exit;   temploop3 := QRCOLcount;   temploop1 := QRCOLcount;   temploop2 := ValueTlist.Count div temploop3;  if ValueTlist.Count mod temploop3 <> 0 then   begin     temploop2 := temploop2 +1;     modint := ValueTlist.Count mod temploop3;   end;   endint := temploop2;   templist := Tlist.Create;   temptable := TTable.Create(nil);   try     tempint := CreateTempQRFieldList(QRCOLcount,templist); //这里是建立有效数据的数据库文件的命令     if tempint >0 then     begin      tempint := CreateDatebases(temptable,BDEName,tempdbname,ttDBase,templist,false);//这里是建立空数据库的命令      if tempint >0 then      begin        temptable.Close;        temptable.DatabaseName := BDEName;  //这里是一个全局的数据库别名,大家可以自己定义        temptable.TableName := tempdbname;        temptable.Open;//下面就是把带入的有效数据，填入数据库的工作        with temptable do        begin          Append;          for temploop2 := 0 to temploop2-1 do          begin            if (temploop2 <> endint-1) then            begin            Insert;            tempvalue := nil;            setlength(tempvalue,QRCOLcount);            for temploop3 := 0 to temploop3-1 do            begin              temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];              FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;              tempvalue[temploop3] := temppoint.fidlevalue;              if temploop3 = QRCOLcount-1 then              begin                Post;                inc(result);                Insert;                for temploop1 := 0 to temploop1-1 do                FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];                Post;                inc(result);              end;            end;            end            else            begin              if (modint > 0) then              begin              Insert;              tempvalue := nil;              setlength(tempvalue,modint);              for temploop3 := 0 to modint-1 do              begin                temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];                FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;                tempvalue[temploop3] := temppoint.fidlevalue;                if temploop3 = modint-1 then                begin                  Post;                  inc(result);                  Insert;                  for temploop1 := 0 to modint-1 do                  FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];                  Post;                  inc(result);                end;              end;              end              else              begin                Insert;                tempvalue := nil;                setlength(tempvalue,QRCOLcount);                for temploop3 := 0 to temploop3-1 do                begin                  temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3];                  FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename;                  tempvalue[temploop3] := temppoint.fidlevalue;                  if temploop3 = QRCOLcount-1 then                  begin                    Post;                    inc(result);                    Insert;                    for temploop1 := 0 to temploop1-1 do                    FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1];                    Post;                    inc(result);                  end;                end;              end;            end;          end;  //for temploop2 := 0 to temploop2-1 do        end;      end;     end;   finally     templist.Free;     temptable.Free;   end; end; //接着就是动态建立TQRDBTEXT控件 //SenderParent: TGSQuickReport  只是一个普通的TQuickRep //TGSQuickReport = class(TQuickRep) 只是程序建立时不要让它自动建立 //Cols是用户定义的列数 procedure TForm1.FormatQRFormWithDataset(NowDataset: TDataset; Cols: integer; SenderParent: TGSQuickReport); var   tempqredit: TQRDBText;   temploop1: integer;   nowtop,nowleft: integer; //当前的起点   nowDetailWidth: extended;   everylabwidth:extended;  //每个Lable的宽度和高度   nowcol: integer; const   FieldNames = 'tempfd'; begin   if SenderParent = nil then exit;   nowcol := Cols;   nowtop := 0;   nowleft := 0;   nowDetailWidth := trunc(SenderParent.DetailBand1.Size.Width);   everylabwidth := trunc(nowDetailWidth / nowcol);   for temploop1 := 0 to nowcol -1 do   begin     tempqredit := TQRDBText.Create(self);     tempqredit.AutoSize := false;     tempqredit.AutoStretch := false;     tempqredit.Color := clskyblue;//clmoneygreen     tempqredit.Parent := SenderParent.DetailBand1;     tempqredit.Top := nowtop;     tempqredit.Left := nowleft;     tempqredit.Size.Width := everylabwidth;     tempqredit.DataSet := NowDataset;     tempqredit.DataField := FieldNames + inttostr(temploop1);     nowleft:= nowleft + tempqredit.Width;   end; end; //当以上三个步骤作完之后就基本成功了 下面一个是一个Button下的命令过程 procedure TForm1.BitBtn11Click(Sender: TObject); var   temptlist: Tlist;   tempcount: integer;   temppoint: pNowPrintvalue;   tempQR: TGSQuickReport;   temptable: TTable; const   tempdbname = 'temprint.DBF'; begin   temptlist := Tlist.Create;   temptable := TTable.Create(nil);   tempQR := TGSQuickReport.Create(nil);   try     self.OpenDialog1.InitialDir := projectpath;     self.OpenDialog1.Title := '';     self.OpenDialog1.Filter := '';     if self.OpenDialog1.Execute then     begin       CreateQRTlistByTTable(self.OpenDialog1.FileName,temptlist);       if temptlist.Count <= 0 then exit;       tempcount := WriteQRTempDBF(temptlist,4);       if tempcount > 0 then       begin         temptable.Close;         temptable.DatabaseName := BDEName;         temptable.TableName := tempdbname;         temptable.Open;         tempQR.DataSet := temptable;         FormatQRFormWithDataset(temptable,4,tempQR);       end;       tempQR.PreviewModal;     end;   finally     temptable.Close;     temptable.Free;     temptlist.Free;   end; end; //这里再补充两个函数,一个是建立数据库字段信息的函数，一个是动态建立数据库的函数 Function CreateTempQRFieldList(cols: integer;var resultlist: Tlist): integer; //建立打印数据库文件列表 var   FieldNames: array of string;   FieldDatas: pFieldDatas;   Temploop: integer; const   FieldSize = 40;   FieldType = ftString;   tempfieldname = 'tempfd'; begin   resultlist.Clear;   result := 0;   if cols <= 0 then exit;   setlength(FieldNames,cols);   for Temploop := 0 to cols-1 do   begin     New(FieldDatas);     FieldDatas.DataFieldName := tempfieldname + inttostr(temploop);     FieldDatas.DataFieldType := FieldType;     FieldDatas.DataFieldSize := FieldSize;     resultList.Add(FieldDatas);   end;   result := resultList.Count; end; Function CreateDatebases ( Tabless : TTable; //table控件名                             DBNames : string;  //数据库别名                             TNames : string;   //数据库名                             TTypes : TTableType; //数据库类型                             CreateDBFList: Tlist;    //数据库内容的列表                             CreateIt: boolean): integer; var   TempDatas: pFieldDatas;   TempCounts: integer; begin   result := 0;   TempCounts := CreateDBFList.Count;   if TempCounts <= 0 then exit;   Tabless.Close;   with Tabless do   begin      DatabaseName := DBNames;      TableName := TNames;      TableType := TTypes;        with FieldDefs do        begin          //if Createit then Clear;          clear;          for TempCounts := 0 to TempCounts - 1 do          begin          TempDatas := CreateDBFList.Items[TempCounts];          Add(TempDatas.DataFieldName,TempDatas.DataFieldType,TempDatas.DataFieldSize,false);          inc(result);          end;        end;      CreateTable;   end;   Tabless.Close; end; 此前已经有转载。感谢作者提供学习的资料。 <div class="bline" align="right"> </div> 2004-4-6 11:48:29    如何根据名字来动态创建对象 [问题的提出]:     我希望根据一个字符串，来创建该类的对象，例如我给定'TButton'，那么能在运行的时候，动态创建Button出来？不要告诉我用if来判断或者用case来判断等等~，那样的话，有几百个控件的话，岂不是晕倒？ [解决方案]:     请参考下面的代码，下面的代码演示了三种控件的动态创建，若需要动态创建其他的，请修改那个数组常量即可： function DynCreateControlByName(AClassName: string; AOwner: TWinControl = nil): TControl; const /// You can add any class if you want!   ControlClass : array[0..2] of TPersistentClass = (TButton, TEdit, TLabel); var   Cls : TControlClass; begin   Result := nil;   RegisterClasses(ControlClass);   Cls := TControlClass(GetClass(AClassName));   if Cls = nil then exit;     Result := Cls.Create(AOwner); end; procedure TForm1.Button1Click(Sender: TObject); var   Control : TControl; begin   Control := DynCreateControlByName(Edit1.Text);   if Control <> nil then     with Control do     begin       Parent := Self;       Left := Random(Self.Width) - Width;       Top := Random(Self.Width) - Height;       Perform(WM_SETTEXT,Length(Edit1.Text),integer(pchar(Edit1.Text)));       Show;     end; end; --------------------------------------- procedure TForm1.Button2Click(Sender: TObject); begin   TWinControlClass(FindClass('TQRDBText')).Create(Self); end; initialization RegisterClasses([TQRDBText]); finalization   UnregisterClasses([TQRDBText]); end.

一、Delphi中生成控件的两种方法 ---- 1、 Form(表单)设计中生成控件 ---- 在进行Form设计时，直接在控件工具箱选择所需控件，再设置其属性与响应事件，这种方法比较常见。 ---- 2、 程序中动态生成控件 ---- 有时候，我们需要在程序运行时动态生成控件，这样做有两大优点：一是可以增加程序的灵活性；二是如果生成控件的多少与程序中间运行结果相关，显然方法一是无法的实现的，必须用程序中动态生成方法。 ---- 程序中动态生成控件的方法分为三步，首先，定义生成的控件类型，再用Create函数生成控件，最后对控件的相关属性赋值。以TButton控件为例，步骤如下： ---- (1) 定义控件类型 &nbsp; var &nbsp; &nbsp; &nbsp;Button1:TButton; ---- (2) 生成控件 &nbsp; Button1:=TButton. Create(self); &nbsp; Button1.Parent:=Self; &nbsp; &nbsp;//一般将其父控件设置为Self,如果不设置Parent的值，则控件不会在屏幕显示出来 ---- (3) 设置其它属性及定义相关事件响应函数，如Caption, Left, Top, Height, Width, Visible, Enabled, Hint和onClick事件响应函数等。 二、动态生成控件方法的应用 ---- 在开发生产调度与管理系统中，需要动态生成排产计划图，以甘特图表示，应用Shape控件来显示零件的加工状况(每道工序的加工开始时间与结束时间)是非常适合的。应用Chart控件，对加工设备利用率以三维直方图显示，非常直观。现分别将在程序中动态生成Shape控件和Chart控件的过程加以说明。 ---- 1、动态生成Shape控件显示排产计划图(甘特图) &nbsp; &nbsp; procedure TCreateMultiCharts.ProcCreateCharts; &nbsp; &nbsp; var &nbsp; &nbsp; &nbsp; i,j,Rows,Columns,RowSpace,ChartsHeight:Integer; &nbsp; &nbsp; &nbsp; ShapeChart:array of array of TShape; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; Rows:=16; &nbsp; &nbsp; &nbsp; &nbsp;//Shape控件数组行数 &nbsp; &nbsp; &nbsp; Columns:=8; &nbsp; &nbsp; &nbsp;// Shape控件数组列数 &nbsp; &nbsp; &nbsp; RowSpace:=20; &nbsp; // Shape控件行间距 &nbsp; &nbsp; &nbsp; ChartsHeight:=20; // Shape控件高度 &nbsp; &nbsp; &nbsp; SetLength(ShapeChart,Rows,Columns); &nbsp; &nbsp; &nbsp; //设置ShapeChart数组大小 &nbsp; &nbsp; &nbsp; for i:=0 to Rows do &nbsp; &nbsp; &nbsp; &nbsp; for j:=0 to Columns do &nbsp; &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; ShapeChart[i][j]:=TShape.Create(self); &nbsp; &nbsp; &nbsp; with ShapeChart[i,j] do &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; &nbsp; Parent:=Self; &nbsp;//此行必不可少,否则Shape控件在屏幕显示不出 &nbsp; &nbsp; &nbsp; &nbsp; Shape:=stRectangle; // Shape控件形状为矩形 &nbsp; &nbsp; &nbsp; &nbsp; Top:=45+i*(RowSpace+ChartsHeight); &nbsp; &nbsp; &nbsp; &nbsp; Left:=Round(180+Q[i,j].StartTime); //因Q[i,j].StartTime为实数,故需进行四舍五入取整 &nbsp; &nbsp; &nbsp; &nbsp; Width:=Round(Q[i,j].Value) &nbsp; &nbsp; &nbsp; &nbsp; Height:=ChartsHeight; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Brush.Color:=RandomColor; //自定义函数，说明附后 &nbsp; &nbsp; &nbsp; &nbsp; Brush.Style:=bsSolid; //设置填充方式 &nbsp; &nbsp; &nbsp; &nbsp; Enabled:=True; &nbsp; &nbsp; &nbsp; end; &nbsp; &nbsp; end; end; 　 ---- 注: ---- (1)Q为一记录型二维数组,定义如下: &nbsp; type &nbsp; &nbsp; &nbsp;TempData=Record &nbsp; &nbsp; &nbsp;Value:Real; &nbsp; &nbsp; &nbsp;StartTime:Real; &nbsp; &nbsp;end; &nbsp; &nbsp;Q:array of array of TempData ---- 并且在另一过程已对Q的分量进行赋值。 ---- (2)为了区分不同的零件，Shape以不同颜色显示，此时，调用了函数RandomColor。该函数为： &nbsp; &nbsp;function TCreateMultiCharts.RandomColor; &nbsp; &nbsp;var &nbsp; &nbsp; &nbsp;red,green,blue:byte; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp;red:=random(255); &nbsp; &nbsp; &nbsp;green:=random(255); &nbsp; &nbsp; &nbsp;blue:=random(255); &nbsp; &nbsp; &nbsp;result:=red or (green shl 8) or (blue shl 16); &nbsp; &nbsp;end; ---- 2、动态生成Charts控件的ChartSeries组件，显示设备利用率 &nbsp; &nbsp;procedure TFormMultiMachinesBurthen. &nbsp; &nbsp;ShowMachineBurthenCharts; &nbsp; &nbsp;var &nbsp; &nbsp; i:Integer; &nbsp; &nbsp; Burthen:Real; &nbsp; &nbsp; SeriesClass:TChartSeriesClass; &nbsp; &nbsp; NewSeries:array of TChartSeries; &nbsp; begin &nbsp; &nbsp; SetLength(NewSeries,CreateMultiCharts.Rows); &nbsp; &nbsp; MachinesBurthenCharts.height:=200; &nbsp; &nbsp; MachinesBurthenCharts.Width:=550; &nbsp; &nbsp; for i:=0 to CreateMultiCharts.Rows do &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; SeriesClass:=TBarSeries; &nbsp;//设置形状为三维条形图 &nbsp; &nbsp; &nbsp; NewSeries[i]:=SeriesClass.Create(Self); &nbsp; &nbsp; &nbsp; NewSeries[i].ParentChart:=MachinesBurthenCharts; &nbsp; &nbsp; &nbsp; NewSeries[i].Clear; &nbsp; &nbsp; &nbsp; Burthen:=MachineBurthen[i]; &nbsp; &nbsp; &nbsp; Burthen:=Round(Burthen*100)/100; &nbsp;//只取小数点后两位数字 &nbsp; &nbsp; &nbsp; NewSeries[i].add(Burthen,'',NewSeries[i].SeriesColor); &nbsp; &nbsp; end; &nbsp; end; 　 ---- 注： ---- (1) MachineBurthen[i]为一实型数组，其值为对应设备的利用率，已在另一函数中计算得到； ---- (2) MachinesBurthenCharts为TChart控件，在type段说明。 &nbsp;<div style="BORDER-BOTTOM: #8ca6de 1px solid" align="right">2004-4-6 10:59:32&nbsp; &nbsp; </div><div class="inputcaption" style="BORDER-BOTTOM: #8ca6de 1px solid"><table cellspacing="0" cellpadding="3" width="100%" border="0"> <tbody> <tr> <td>&nbsp;</td> <td align="right"><a class="no-external-link" href="http://www.delphibbs.com/keylife/iblog_comment.asp?xid=6917" target="_blank">查看评语&raquo;&raquo;&raquo;</a>&nbsp; &nbsp; </td> </tr> </tbody></table></div>&nbsp;2004-4-6 11:29:16&nbsp; &nbsp; 动态创建菜单全接触 [基本认识]： &nbsp; &nbsp; &nbsp; 在Delphi的程序开发环境中，封装的VCL减化了我们许多的开发工作，由在界面的设计上使开发的进度很快，但在很多的时候，我们需要自己来设计可视化的用户界面，而且是在程序的运行中，这时我们就得利用Delphi给我们提供的类来完成我们需要的工作了，下面笔者就和朋友们浅入的讨论一下动态创建&quot;菜单&quot;的基本知识，希望本文给那些刚入门的朋友来个抛砖引玉的作用。 &nbsp; &nbsp; &nbsp; &nbsp; 在delphi的菜单设计中，有两个Delphi的菜单控件： &nbsp; &nbsp; &nbsp; 1：Tmainmenu; &nbsp; &nbsp; &nbsp; 2：Tpopupmenu; &nbsp; &nbsp; &nbsp; 前者是创建窗口的菜单，后者是创建右键弹出式菜单的控件，但在Delphi庞大的类库中有一个类与这两个控件密切相关，它就是：TMenuItem，窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。此TMenuItem类不出现在控件板上，在程序中用代码可创建其实例。 [基本知识]： &nbsp; &nbsp; &nbsp; 在tmainmenu,tpopupmenu控件中有一个属性是items，此属性是数组型，里面的参数为菜单项的索引值。 文件　编辑　查看　插入　格式　帮助 ---- ---- ---- ---- ---- ---- 新建　撤消　标尺　对象　字体　关于 打开　拷贝　源码　公式　颜色　 &nbsp; &nbsp; &nbsp; 相信您看过上面的菜单简单表示之后是非常熟悉的，在此菜单中菜单头的索引值代表如下： &nbsp; &nbsp; &nbsp; &quot;文件&quot;的菜单的items值为0； &nbsp; &nbsp; &nbsp; &quot;编辑&quot;的菜单的items值为1；以此类推。 &nbsp; &nbsp; &nbsp; items属性是tmenuitem类型，而在此类型中还有一个属性,是items，如果您略懂&quot;类&quot;的关系，您就不难明白此类似&quot;嵌套&quot;的关系。&quot;新建&quot;菜单选项是&quot;文件&quot;菜单选项的子类，用代码表示为tmainmenu.items[0].items[0]，&quot;打开&quot;菜单选项为tmainmenu.items[0].items[1]，以此类推，而代表&quot;编辑&quot;菜单中的&quot;拷贝&quot;菜单选项的代码为tmainmenu.items[1].items[1]，其它菜单代码表示以此类推。 [基本实例]： &nbsp; &nbsp; &nbsp; 知道了菜单的items结构之后，我们就可以进一步大胆的创建自己有序的菜单了。 &nbsp; &nbsp; &nbsp; 上面讨论到窗口的菜单和右键弹出式菜单的每个条目都是TMenuItem类的一个对象。那么我们就可以create它的一个实例，来添加自己想要的菜单了。 [示例过程]： 1：新建一个工程。 2：添加一个tmainmenu控件。 3：添加一个button控件，并在button的onclick事件中写入如下代码： procedure TForm1.Button1Click(Sender: TObject); var &nbsp; &nbsp; files,edit:tmenuitem;{要有实例的声明} begin &nbsp; &nbsp; files:=tmenuitem.Create(self); &nbsp; &nbsp; edit:=tmenuitem.create(self); &nbsp; &nbsp; files.Caption:='文件'; &nbsp; &nbsp; edit.caption:='编辑'; &nbsp; &nbsp; mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键} &nbsp; &nbsp; form1.MainMenu1.Items.Add(files); &nbsp; &nbsp; form1.mainmenu1.items.add(edit); end;　　 &nbsp; &nbsp; &nbsp; 运行后，出现如上面例举的菜单的部分结构，如此看来动态创建菜单项的方法是非常简单的，这无疑于Delphi把系统的函数进行了封装。菜单头我们创建完了，接下来就该创建菜单里的菜单项了，由&quot;items属性是tmenuitem类型，而在此类型中还有一个属性,是items&quot;此句话的意思我们可以创建菜单项，代码如下： 1：新建一个工程。 2：添加一个tmainmenu控件。 3：添加一个button控件，并在button的onclick事件中写入如下代码： procedure TForm1.Button1Click(Sender: TObject); var &nbsp; &nbsp;files,edit:tmenuitem; &nbsp; &nbsp;new,copy:tmenuitem; begin &nbsp; &nbsp;files:=tmenuitem.Create(self); &nbsp; &nbsp;edit:=tmenuitem.create(self); &nbsp; &nbsp;files.Caption:='文件'; &nbsp; &nbsp;edit.caption:='编辑'; &nbsp; &nbsp;mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键} &nbsp; &nbsp;form1.MainMenu1.Items.Add(files); &nbsp; &nbsp;form1.mainmenu1.items.add(edit); &nbsp; &nbsp;{上部代码为创建菜单头} &nbsp; &nbsp;new:=tmenuitem.create(self); &nbsp; &nbsp;copy:=tmenuitem.create(self); &nbsp; &nbsp;new.Caption:='新建'; &nbsp; &nbsp;copy.caption:='拷贝'; &nbsp; &nbsp;files.Add(new); &nbsp; &nbsp;edit.add(copy); &nbsp; {上部代码为创建菜单项} end; &nbsp; &nbsp; &nbsp; 运行效果和上面菜单结构表中基本一样，但此时点击菜单项时不出现任何的事件，显然这样的软件出售量不算理想，我们可以略改代码加个事件上去。 代码如下： 1：新建一个工程。 2：添加一个tmainmenu控件。 3: private &nbsp; procedure abc(sender:tobject); &nbsp; { Private declarations } var &nbsp; Form1: TForm1; implementation {$R *.DFM} procedure tform1.abc(sender:tobject); begin &nbsp; &nbsp;showmessage('welcome you click me!! :) xixi'); end; procedure TForm1.Button1Click(Sender: TObject); var &nbsp; &nbsp;files,edit:tmenuitem; &nbsp; &nbsp;new,copy:tmenuitem; begin &nbsp; &nbsp;files:=tmenuitem.Create(self); &nbsp; &nbsp;edit:=tmenuitem.create(self); &nbsp; &nbsp;files.Caption:='文件'; &nbsp; &nbsp;edit.caption:='编辑'; &nbsp; &nbsp;mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键} &nbsp; &nbsp;form1.MainMenu1.Items.Add(files); &nbsp; &nbsp;form1.mainmenu1.items.add(edit); &nbsp; &nbsp;{上部代码为创建菜单头} &nbsp; &nbsp;new:=tmenuitem.create(self); &nbsp; &nbsp;copy:=tmenuitem.create(self); &nbsp; &nbsp;new.Caption:='新建'; &nbsp; &nbsp;copy.caption:='拷贝'; &nbsp; &nbsp;copy.onClick:=abc; &nbsp; &nbsp;new.onClick:=abc; &nbsp; &nbsp;files.Add(new); &nbsp; &nbsp;edit.add(copy); &nbsp; &nbsp;{上部代码为创建菜单项} end; &nbsp; &nbsp; &nbsp; 这时这个软件就有了交互的功能。 &nbsp; &nbsp; &nbsp; 有时菜单项中出现一个横的条线和出现一个子的菜单，那么这样的效果怎么用代码实现的呢，下面就是此效果的代码示例： 1：新建一个工程。 2：添加一个tmainmenu控件。 3： procedure TForm1.Button1Click(Sender: TObject); var &nbsp; &nbsp;files,edit:tmenuitem; &nbsp; &nbsp;new,copy:tmenuitem; &nbsp; &nbsp;sub1,sub2,sub3,lines:tmenuitem; begin &nbsp; &nbsp;files:=tmenuitem.Create(self); &nbsp; &nbsp;edit:=tmenuitem.create(self); &nbsp; &nbsp;files.Caption:='文件'; &nbsp; &nbsp;edit.caption:='编辑'; &nbsp; &nbsp;mainmenu1.AutoHotkeys:=mamanual;{此句代码为不让系统自动设置快捷键} &nbsp; &nbsp;form1.MainMenu1.Items.Add(files); &nbsp; &nbsp;form1.mainmenu1.items.add(edit); &nbsp; {上部代码为创建菜单头} &nbsp; &nbsp;new:=tmenuitem.create(self); &nbsp; &nbsp;copy:=tmenuitem.create(self); &nbsp; &nbsp;new.Caption:='新建'; &nbsp; &nbsp;copy.caption:='拷贝'; &nbsp; &nbsp;files.Add(new); &nbsp; &nbsp;edit.add(copy); &nbsp; {上部代码为创建菜单项} &nbsp; &nbsp;sub1:=tmenuitem.create(self); &nbsp; &nbsp;sub2:=tmenuitem.create(self); &nbsp; &nbsp;sub3:=tmenuitem.create(self); &nbsp; &nbsp;lines:=tmenuitem.create(self); &nbsp; &nbsp;lines.caption:='-'; &nbsp; &nbsp;sub1.caption:='子菜单1'; &nbsp; &nbsp;sub2.caption:='子菜单2'; &nbsp; &nbsp;sub3.caption:='子菜单3'; &nbsp; &nbsp;new.Add(sub1); &nbsp; &nbsp;new.add(lines); &nbsp; &nbsp;new.add(sub3); &nbsp; &nbsp;copy.Add(sub2); &nbsp; {上面代码出现多项子菜单和横线的效果} end; &nbsp; &nbsp; &nbsp; 到此讨论的内容就要结束，菜单的创建在Delphi中是非常简单的事，在tmenuitem类中还有许多的事件和方法及属性，如Add, Clear, Click, Create, Delete, Destroy, Find, IndexOf, Insert, Remove等方法的使用都是非常简单的. <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:30:34&nbsp; &nbsp; TPagecontrol TTablesheet 动态创建 动态创建TPagecontrol, TTablesheet var &nbsp; T : TTabSheet; &nbsp; P : TPageControl; begin &nbsp; &nbsp;// Create the PageControl &nbsp; &nbsp;// need to reference the page control so we need a reference to it. &nbsp; P := TPageControl.Create(application); &nbsp; with P do begin &nbsp; &nbsp; Parent := Form1; &nbsp;// set how controls it. &nbsp; &nbsp; Top := 30; &nbsp; &nbsp; Left := 30; &nbsp; &nbsp; Width := 200; &nbsp; &nbsp; Height := 150; &nbsp; &nbsp; end; &nbsp;// with TPageControl &nbsp; &nbsp; // Create 3 pages &nbsp; T := TTabSheet.Create(P); &nbsp; with T do begin &nbsp; &nbsp; Visible := True; &nbsp; // This is necessary or form does not repaint &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;// correctly &nbsp; &nbsp; Caption := 'Page 1'; &nbsp; &nbsp; PageControl := P; &nbsp;// Assign Tab to Page Control &nbsp; &nbsp; end; &nbsp;// with &nbsp; T := TTabSheet.Create(P); &nbsp; with T do begin &nbsp; &nbsp; Visible := True; &nbsp; // This is necessary or form does not repaint &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;// correctly &nbsp; &nbsp; Caption := 'Page 2'; &nbsp; &nbsp; PageControl := P; &nbsp;// Assign Tab to Page Control &nbsp; &nbsp; end; &nbsp;// with &nbsp; T := TTabSheet.Create(P); &nbsp; with T do begin &nbsp; &nbsp; Visible := True; &nbsp; // This is necessary or form does not repaint &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;// correctly &nbsp; &nbsp; Caption := 'Page 3'; &nbsp; &nbsp; PageControl := P; &nbsp;// Assign Tab to Page Control &nbsp; &nbsp; end; &nbsp;// with &nbsp; &nbsp; // Create 3 buttons, 1 per page &nbsp; with tbutton.create(application) do begin &nbsp; &nbsp; Parent := P.Pages[0]; &nbsp;// Tell which page owns the Button &nbsp; &nbsp; Caption := 'Hello Page 1'; &nbsp; &nbsp; Left := 0; &nbsp; &nbsp; Top := 0; &nbsp; &nbsp; end; // with &nbsp; with tbutton.create(application) do begin &nbsp; &nbsp; Parent := P.Pages[1]; &nbsp;// Tell which page owns the Button &nbsp; &nbsp; Caption := 'Hello Page 2'; &nbsp; &nbsp; Left := 50; &nbsp; &nbsp; Top := 50; &nbsp; &nbsp; end; // with &nbsp; with tbutton.create(application) do begin &nbsp; &nbsp; Parent := P.Pages[2]; &nbsp;// Tell which page owns the Button &nbsp; &nbsp; Caption := 'Hello Page 3'; &nbsp; &nbsp; Left := 100; &nbsp; &nbsp; Top := &nbsp;90; &nbsp; &nbsp; end; // with &nbsp; &nbsp; // This needs to be done or the Tab does not sync to the &nbsp; &nbsp; // correct page, initially. &nbsp;Only if you have more then &nbsp; &nbsp; // one page. &nbsp; P.ActivePage := P.Pages[1]; &nbsp; P.ActivePage := P.Pages[0]; &nbsp;// page to really show end; &nbsp; <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:32:23&nbsp; &nbsp; 动态创建控件依次显示数据库值 var &nbsp; Edit1: TEdit; &nbsp; i: integer; begin &nbsp; table1.First; &nbsp; for i := 0 to table1.RecordCount - 1 do begin &nbsp; &nbsp; Edit1 := TEdit.Create(Self); &nbsp; &nbsp; Edit1.Parent := aForm; &nbsp; &nbsp; Edit1.Left := 20; &nbsp; &nbsp; Edit1.Top := 20 * i; &nbsp; &nbsp; Edit1.Text := table1.fieldbyname('姓名').asString; &nbsp; &nbsp; table1.next; &nbsp; end; &nbsp; edit1.Destroy; end; <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:40:25&nbsp; &nbsp; 动态加减pagecontrol的页数 --- 配合《TPagecontrol TTablesheet 动态创建》使用 动态添加： &nbsp; tabsheet2:=ttabsheet.Create(self); &nbsp; tabsheet2.Caption:='fkjsd'; &nbsp; tabsheet2.PageControl:=pagecontrol1; 删除： &nbsp; tabsheet1.PageControl:=nil; <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:43:25&nbsp; &nbsp; 快速动态创建MenuItem --- 配合《动态创建菜单全接触》使用 在设计程序时,有时我们需要动态地创建菜单, 通常我们使用以下的语句 &nbsp; PopupMenu1 := TPopupMenu.Create(Self); &nbsp; Item := TMenuItem.Create(PopupMenu1); &nbsp; Item.Caption := 'First Menu'; &nbsp; Item.onClick := MenuItem1Click; &nbsp; PopupMenu1.Items.Add(Item); &nbsp; Item := TMenuItem.Create(PopupMenu1); &nbsp; Item.Caption := 'Second Menu'; &nbsp; Item.onClick := MenuItem2Click; &nbsp; PopupMenu1.Items.Add(Item); &nbsp; Item := TMenuItem.Create(PopupMenu1); &nbsp; Item.Caption := 'Third Menu'; &nbsp; Item.onClick := MenuItem3Click; &nbsp; PopupMenu1.Items.Add(Item); &nbsp; Item := TMenuItem.Create(PopupMenu1); &nbsp; Item.Caption := '-'; &nbsp; PopupMenu1.Items.Add(Item); &nbsp; Item := TMenuItem.Create(PopupMenu1); &nbsp; Item.Caption := 'Fourth Menu'; &nbsp; Item.onClick := MenuItem4Click; &nbsp; PopupMenu1.Items.Add(Item); 其实我们可以使用一种更快的方法达到同样的功能, 但使用很少的代码, 那就是用NewLine和NewItem, 看看下面的例子, 是不是很简单? PopupMenu1 := TPopupMenu.Create(Self); with PopUpMenu1.Items do begin &nbsp; Add(NewItem('First Menu',0,False,True,MenuItem1Click,0,'MenuItem1')); &nbsp; Add(NewItem('Second Menu',0,False,True,MenuItem2Click,0,'MenuItem2')); &nbsp; Add(NewItem('Third Menu',0,False,True,MenuItem3Click,0,'MenuItem3')); &nbsp; Add(NewLine); // 增加一个分割棒 &nbsp; Add(NewItem('Fourth Menu',0,False,True,MenuItem4Click,0,'MenuItem4')); &nbsp; ... end; <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:45:54&nbsp; &nbsp; [作者：guosoong]在QuickRep上面的动态报表建立 相信每一个到这里的人，都在100多页中寻找过帮助，或多或少都会感到痛苦的，如果你看到本文之后，如果有一丝快乐，就是我最大的快乐了。 话归正题! [项目要求]:一个字段动态建立的数据库文件(.dbf),用户要求查询打印或者把整个数据库都打印出来。 [解决方法]: 1.首先把当前Table或Query中的数据提取出来。 2.用户决定一页报表打印多少列，把提取的数据建立数据库文件。 3.建立一个QuickQep窗体，在程序运行时动态建立，并动态建立TQRDBText。 下面提供每个工作的源码。望大家修改并通知我谢谢。 1.首先把当前Table或Query中的数据提取出来。 首先定义数据库内有效数据的数据结构 type &nbsp; printvalue = record &nbsp; fidlecount: integer; &nbsp;//当前数据库的行号(从0开始,完全是个人习惯) &nbsp; fidlename: string; &nbsp; //字段名称 &nbsp; fidlevalue: string; &nbsp;//字段内容 &nbsp; end; pNowPrintvalue = ^printvalue; &nbsp;//定义指针 这个结构大家可以随意修改 //这个命令是TTable的，用于把一个数据库文件全部提取出来 &nbsp;TQuery就留给大家自己做吧 procedure TForm1.CreateQRTlistByTTable(filename: string; ValueTlist: Tlist); var &nbsp; temppoint: pNowPrintvalue; &nbsp; tempTStrings: Tstrings; &nbsp; temploop1,temploop2: integer; &nbsp; temptable: TTable; &nbsp; tempTString: Tstrings; begin &nbsp; if filename = '' then exit; &nbsp; if ValueTlist = nil then ValueTlist := Tlist.Create; &nbsp; ValueTlist.Clear; &nbsp; temptable := TTable.Create(nil); &nbsp; tempTStrings := Tstringlist.Create; &nbsp; try &nbsp; &nbsp; if sysutils.FileExists(filename) then &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; temptable.Close; &nbsp; &nbsp; &nbsp; temptable.DatabaseName := sysutils.ExtractFilePath(filename); &nbsp; &nbsp; &nbsp; temptable.TableName := sysutils.ExtractFileName(filename); &nbsp; &nbsp; &nbsp; temptable.Open; &nbsp; &nbsp; &nbsp; temptable.First; &nbsp; &nbsp; &nbsp; tempTStrings := temptable.FieldList; &nbsp; &nbsp; &nbsp; if tempTStrings.Count &lt;= 0 then exit; &nbsp; &nbsp; &nbsp; for temploop2 := 0 to temptable.RecordCount -1 do &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; &nbsp; for temploop1 := 0 to tempTStrings.Count -1 do &nbsp; &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; if tempTStrings[temploop1] &lt;&gt; '' then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; new(temppoint); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; temppoint.fidlecount := temploop2; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; temppoint.fidlename := tempTStrings[temploop1]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; if temptable.FieldValues[tempTStrings[temploop1]] = null then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; temppoint.fidlevalue := ' ' &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; else &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; temppoint.fidlevalue := temptable.FieldValues[tempTStrings[temploop1]]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ValueTlist.Add(temppoint); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; end; &nbsp; &nbsp; &nbsp; &nbsp; end; &nbsp; &nbsp; &nbsp; &nbsp; temptable.Next; &nbsp; &nbsp; &nbsp; end; &nbsp; &nbsp; end; &nbsp; finally &nbsp; &nbsp; temptable.Free; &nbsp; end; end; //上面程序里的TLIST就是下面函数的需要的ValueTlist //QRCOLcount 就是用户决定一页打印的列数 function TForm1.WriteQRTempDBF(ValueTlist: Tlist; &nbsp; QRCOLcount: integer): integer; var &nbsp; templist: Tlist; &nbsp; tempint: integer; &nbsp; temptable: TTable; &nbsp; temploop1,temploop2,temploop3: integer; &nbsp; temppoint: pNowPrintvalue; &nbsp; tempvalue: array of string; &nbsp; modint,endint:integer; const &nbsp; tempdbname = 'temprint.DBF'; &nbsp; FieldNames = 'TEMPFD'; begin &nbsp; result := 0; &nbsp; if QRCOLcount &lt;= 0 then exit; &nbsp; if ValueTlist = nil then exit; &nbsp; if ValueTlist.Count &lt;= 0 then exit; &nbsp; temploop3 := QRCOLcount; &nbsp; temploop1 := QRCOLcount; &nbsp; temploop2 := ValueTlist.Count div temploop3; &nbsp;if ValueTlist.Count mod temploop3 &lt;&gt; 0 then &nbsp; begin &nbsp; &nbsp; temploop2 := temploop2 +1; &nbsp; &nbsp; modint := ValueTlist.Count mod temploop3; &nbsp; end; &nbsp; endint := temploop2; &nbsp; templist := Tlist.Create; &nbsp; temptable := TTable.Create(nil); &nbsp; try &nbsp; &nbsp; tempint := CreateTempQRFieldList(QRCOLcount,templist); //这里是建立有效数据的数据库文件的命令 &nbsp; &nbsp; if tempint &gt;0 then &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp;tempint := CreateDatebases(temptable,BDEName,tempdbname,ttDBase,templist,false);//这里是建立空数据库的命令 &nbsp; &nbsp; &nbsp;if tempint &gt;0 then &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp;temptable.Close; &nbsp; &nbsp; &nbsp; &nbsp;temptable.DatabaseName := BDEName; &nbsp;//这里是一个全局的数据库别名,大家可以自己定义 &nbsp; &nbsp; &nbsp; &nbsp;temptable.TableName := tempdbname; &nbsp; &nbsp; &nbsp; &nbsp;temptable.Open;//下面就是把带入的有效数据，填入数据库的工作 &nbsp; &nbsp; &nbsp; &nbsp;with temptable do &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Append; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop2 := 0 to temploop2-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if (temploop2 &lt;&gt; endint-1) then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue := nil; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;setlength(tempvalue,QRCOLcount); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop3 := 0 to temploop3-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue[temploop3] := temppoint.fidlevalue; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if temploop3 = QRCOLcount-1 then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop1 := 0 to temploop1-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;else &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if (modint &gt; 0) then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue := nil; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;setlength(tempvalue,modint); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop3 := 0 to modint-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue[temploop3] := temppoint.fidlevalue; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if temploop3 = modint-1 then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop1 := 0 to modint-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;else &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue := nil; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;setlength(tempvalue,QRCOLcount); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop3 := 0 to temploop3-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;temppoint := ValueTlist.Items[temploop2*QRCOLcount+temploop3]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop3)).AsString :=temppoint.fidlename; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tempvalue[temploop3] := temppoint.fidlevalue; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if temploop3 = QRCOLcount-1 then &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Insert; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for temploop1 := 0 to temploop1-1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FieldByName(FieldNames+inttostr(temploop1)).AsString :=tempvalue[temploop1]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Post; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp;//for temploop2 := 0 to temploop2-1 do &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; end; &nbsp; finally &nbsp; &nbsp; templist.Free; &nbsp; &nbsp; temptable.Free; &nbsp; end; end; //接着就是动态建立TQRDBTEXT控件 //SenderParent: TGSQuickReport &nbsp;只是一个普通的TQuickRep //TGSQuickReport = class(TQuickRep) 只是程序建立时不要让它自动建立 //Cols是用户定义的列数 procedure TForm1.FormatQRFormWithDataset(NowDataset: TDataset; Cols: integer; SenderParent: TGSQuickReport); var &nbsp; tempqredit: TQRDBText; &nbsp; temploop1: integer; &nbsp; nowtop,nowleft: integer; //当前的起点 &nbsp; nowDetailWidth: extended; &nbsp; everylabwidth:extended; &nbsp;//每个Lable的宽度和高度 &nbsp; nowcol: integer; const &nbsp; FieldNames = 'tempfd'; begin &nbsp; if SenderParent = nil then exit; &nbsp; nowcol := Cols; &nbsp; nowtop := 0; &nbsp; nowleft := 0; &nbsp; nowDetailWidth := trunc(SenderParent.DetailBand1.Size.Width); &nbsp; everylabwidth := trunc(nowDetailWidth / nowcol); &nbsp; for temploop1 := 0 to nowcol -1 do &nbsp; begin &nbsp; &nbsp; tempqredit := TQRDBText.Create(self); &nbsp; &nbsp; tempqredit.AutoSize := false; &nbsp; &nbsp; tempqredit.AutoStretch := false; &nbsp; &nbsp; tempqredit.Color := clskyblue;//clmoneygreen &nbsp; &nbsp; tempqredit.Parent := SenderParent.DetailBand1; &nbsp; &nbsp; tempqredit.Top := nowtop; &nbsp; &nbsp; tempqredit.Left := nowleft; &nbsp; &nbsp; tempqredit.Size.Width := everylabwidth; &nbsp; &nbsp; tempqredit.DataSet := NowDataset; &nbsp; &nbsp; tempqredit.DataField := FieldNames + inttostr(temploop1); &nbsp; &nbsp; nowleft:= nowleft + tempqredit.Width; &nbsp; end; end; //当以上三个步骤作完之后就基本成功了 下面一个是一个Button下的命令过程 procedure TForm1.BitBtn11Click(Sender: TObject); var &nbsp; temptlist: Tlist; &nbsp; tempcount: integer; &nbsp; temppoint: pNowPrintvalue; &nbsp; tempQR: TGSQuickReport; &nbsp; temptable: TTable; const &nbsp; tempdbname = 'temprint.DBF'; begin &nbsp; temptlist := Tlist.Create; &nbsp; temptable := TTable.Create(nil); &nbsp; tempQR := TGSQuickReport.Create(nil); &nbsp; try &nbsp; &nbsp; self.OpenDialog1.InitialDir := projectpath; &nbsp; &nbsp; self.OpenDialog1.Title := ''; &nbsp; &nbsp; self.OpenDialog1.Filter := ''; &nbsp; &nbsp; if self.OpenDialog1.Execute then &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; CreateQRTlistByTTable(self.OpenDialog1.FileName,temptlist); &nbsp; &nbsp; &nbsp; if temptlist.Count &lt;= 0 then exit; &nbsp; &nbsp; &nbsp; tempcount := WriteQRTempDBF(temptlist,4); &nbsp; &nbsp; &nbsp; if tempcount &gt; 0 then &nbsp; &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; &nbsp; temptable.Close; &nbsp; &nbsp; &nbsp; &nbsp; temptable.DatabaseName := BDEName; &nbsp; &nbsp; &nbsp; &nbsp; temptable.TableName := tempdbname; &nbsp; &nbsp; &nbsp; &nbsp; temptable.Open; &nbsp; &nbsp; &nbsp; &nbsp; tempQR.DataSet := temptable; &nbsp; &nbsp; &nbsp; &nbsp; FormatQRFormWithDataset(temptable,4,tempQR); &nbsp; &nbsp; &nbsp; end; &nbsp; &nbsp; &nbsp; tempQR.PreviewModal; &nbsp; &nbsp; end; &nbsp; finally &nbsp; &nbsp; temptable.Close; &nbsp; &nbsp; temptable.Free; &nbsp; &nbsp; temptlist.Free; &nbsp; end; end; //这里再补充两个函数,一个是建立数据库字段信息的函数，一个是动态建立数据库的函数 Function CreateTempQRFieldList(cols: integer;var resultlist: Tlist): integer; //建立打印数据库文件列表 var &nbsp; FieldNames: array of string; &nbsp; FieldDatas: pFieldDatas; &nbsp; Temploop: integer; const &nbsp; FieldSize = 40; &nbsp; FieldType = ftString; &nbsp; tempfieldname = 'tempfd'; begin &nbsp; resultlist.Clear; &nbsp; result := 0; &nbsp; if cols &lt;= 0 then exit; &nbsp; setlength(FieldNames,cols); &nbsp; for Temploop := 0 to cols-1 do &nbsp; begin &nbsp; &nbsp; New(FieldDatas); &nbsp; &nbsp; FieldDatas.DataFieldName := tempfieldname + inttostr(temploop); &nbsp; &nbsp; FieldDatas.DataFieldType := FieldType; &nbsp; &nbsp; FieldDatas.DataFieldSize := FieldSize; &nbsp; &nbsp; resultList.Add(FieldDatas); &nbsp; end; &nbsp; result := resultList.Count; end; Function CreateDatebases ( Tabless : TTable; //table控件名 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; DBNames : string; &nbsp;//数据库别名 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; TNames : string; &nbsp; //数据库名 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; TTypes : TTableType; //数据库类型 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; CreateDBFList: Tlist; &nbsp; &nbsp;//数据库内容的列表 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; CreateIt: boolean): integer; var &nbsp; TempDatas: pFieldDatas; &nbsp; TempCounts: integer; begin &nbsp; result := 0; &nbsp; TempCounts := CreateDBFList.Count; &nbsp; if TempCounts &lt;= 0 then exit; &nbsp; Tabless.Close; &nbsp; with Tabless do &nbsp; begin &nbsp; &nbsp; &nbsp;DatabaseName := DBNames; &nbsp; &nbsp; &nbsp;TableName := TNames; &nbsp; &nbsp; &nbsp;TableType := TTypes; &nbsp; &nbsp; &nbsp; &nbsp;with FieldDefs do &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;//if Createit then Clear; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;clear; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;for TempCounts := 0 to TempCounts - 1 do &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TempDatas := CreateDBFList.Items[TempCounts]; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Add(TempDatas.DataFieldName,TempDatas.DataFieldType,TempDatas.DataFieldSize,false); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;inc(result); &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp; &nbsp;end; &nbsp; &nbsp; &nbsp;CreateTable; &nbsp; end; &nbsp; Tabless.Close; end; 此前已经有转载。感谢作者提供学习的资料。 <div class="bline" align="right">&nbsp;</div>&nbsp;2004-4-6 11:48:29&nbsp; &nbsp; 如何根据名字来动态创建对象 [问题的提出]: &nbsp; &nbsp; 我希望根据一个字符串，来创建该类的对象，例如我给定'TButton'，那么能在运行的时候，动态创建Button出来？不要告诉我用if来判断或者用case来判断等等~，那样的话，有几百个控件的话，岂不是晕倒？ [解决方案]: &nbsp; &nbsp; 请参考下面的代码，下面的代码演示了三种控件的动态创建，若需要动态创建其他的，请修改那个数组常量即可： function DynCreateControlByName(AClassName: string; AOwner: TWinControl = nil): TControl; const /// You can add any class if you want! &nbsp; ControlClass : array[0..2] of TPersistentClass = (TButton, TEdit, TLabel); var &nbsp; Cls : TControlClass; begin &nbsp; Result := nil; &nbsp; RegisterClasses(ControlClass); &nbsp; Cls := TControlClass(GetClass(AClassName)); &nbsp; if Cls = nil then exit; &nbsp; &nbsp; Result := Cls.Create(AOwner); end; procedure TForm1.Button1Click(Sender: TObject); var &nbsp; Control : TControl; begin &nbsp; Control := DynCreateControlByName(Edit1.Text); &nbsp; if Control &lt;&gt; nil then &nbsp; &nbsp; with Control do &nbsp; &nbsp; begin &nbsp; &nbsp; &nbsp; Parent := Self; &nbsp; &nbsp; &nbsp; Left := Random(Self.Width) - Width; &nbsp; &nbsp; &nbsp; Top := Random(Self.Width) - Height; &nbsp; &nbsp; &nbsp; Perform(WM_SETTEXT,Length(Edit1.Text),integer(pchar(Edit1.Text))); &nbsp; &nbsp; &nbsp; Show; &nbsp; &nbsp; end; end; --------------------------------------- procedure TForm1.Button2Click(Sender: TObject); begin &nbsp; TWinControlClass(FindClass('TQRDBText')).Create(Self); end; initialization RegisterClasses([TQRDBText]); finalization &nbsp; UnregisterClasses([TQRDBText]); end.