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

一、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段说明。


 

2004-4-6 10:59:32   

 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等方法的使用都是非常简单的.

 

 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;
 

 

 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;

 

 2004-4-6 11:40:25   动态加减pagecontrol的页数 --- 配合《TPagecontrol TTablesheet 动态创建》使用

动态添加:
  tabsheet2:=ttabsheet.Create(self);
  tabsheet2.Caption:='fkjsd';
  tabsheet2.PageControl:=pagecontrol1;

删除:
  tabsheet1.PageControl:=nil;

 

 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;

 

 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;


此前已经有转载。感谢作者提供学习的资料。

 

 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.

Posted in 软件开发 at April 18, 2006. by 傻猫 .    Views: 5748    2 Comments

delphi 7的TSeverSocket和TClientSocket组见哪里去了

Borland is deprecating the use of the TServerSocket
    and TClientSocket from the unit ScktComp. It is
    recommended that you use the Indy components for
    socket operations. The TServerSocket and
    TClientSocket will no longer be installed on the
    component palette by default. If you require the
    use of these components then you can install
    the design time package named dclsockets70.bpl,
    found in your bin directory. For deployment with
    runtime packages, you will need to deploy rtl70.bpl
    and any other required packages
偶简单翻译了一下:TClientSocket 本来是D5默认安装的,但是D7使用的Indy组件后,就没有默认安装了,如果你喜欢这个组件,可以在D7的安装目录bin文件夹找到dclsockets70.bpl组件包,安装上去就OK了.rtl70.bpl是TCientSocket和TServerSocket必需的运行包. 

Posted in 软件开发 at April 18, 2006. by 傻猫 .    Views: 4702    No Comments

最简单的方法操作ini文件

procedure TFmMain.N3Click(Sender: TObject);
var
  filename:string;
begin
  filename:=ExtractFilePath(paramstr(0))+'dbconf.ini';
  myinifile:=Tinifile.Create(filename);
  ADOConnection1.Close;
  EditConnectionString(ADOConnection1);
  myinifile.WriteString('dbconf','connectstring',adoconnection1.ConnectionString);
  myinifile.Free;
end;

Posted in 软件开发 at April 18, 2006. by 傻猫 .    Views: 5225    2 Comments