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

    • 一、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.

    • 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必需的运行包. 

    • 最简单的方法操作ini文件

    • ```pascal
      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;
      ```

Powered by Typecho)))   ICP:蜀ICP备05009250号