如何动态创建PageControl的页并将某一现有页的内容(全部控件)复制到新页上?(200分)

  • 主题发起人 主题发起人 zfh
  • 开始时间 开始时间
我有源代码,附如下,但最好是发EMail.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons, ExtCtrls;

type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Memo1: TMemo;
BitBtn1: TBitBtn;
TabSheet3: TTabSheet;
Panel1: TPanel;
Label1: TLabel;
Memo2: TMemo;
CheckBox1: TCheckBox;
RadioGroup1: TRadioGroup;
ScrollBar1: TScrollBar;
procedure BitBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
MyPagecontrol:Tpagecontrol;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
k:integer;
begin
Mypagecontrol:=TPageControl.Create(Form1);
with MyPagecontrol do
begin
parent:=Form1;
//Align:=AlBottom;
end;

for k:=0 to pagecontrol1.PageCount-2 do
begin
with pagecontrol1.Pages[k] do
begin
PageControl:=Mypagecontrol;
parent:=Mypagecontrol;
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyPagecontrol.free;
end;

end.

以下为 unit1.dfm
object Form1: TForm1
Left = 192
Top = 107
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 328
Top = 32
Width = 321
Height = 217
ActivePage = TabSheet1
TabOrder = 0
object TabSheet1: TTabSheet
Caption = 'TabSheet1'
object Label1: TLabel
Left = 40
Top = 112
Width = 32
Height = 13
Caption = 'Label1'
end
object Panel1: TPanel
Left = 24
Top = 48
Width = 185
Height = 41
Caption = 'Panel1'
TabOrder = 0
end
object Memo2: TMemo
Left = 88
Top = 88
Width = 185
Height = 89
Lines.Strings = (
'Memo2')
TabOrder = 1
end
end
object TabSheet2: TTabSheet
Caption = 'TabSheet2'
ImageIndex = 1
object Memo1: TMemo
Left = 32
Top = 8
Width = 185
Height = 89
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object ScrollBar1: TScrollBar
Left = 104
Top = 144
Width = 121
Height = 16
PageSize = 0
TabOrder = 1
end
end
object TabSheet3: TTabSheet
Caption = 'TabSheet3'
ImageIndex = 2
object CheckBox1: TCheckBox
Left = 96
Top = 24
Width = 97
Height = 17
Caption = 'CheckBox1'
TabOrder = 0
end
object RadioGroup1: TRadioGroup
Left = 56
Top = 56
Width = 185
Height = 105
Caption = 'RadioGroup1'
TabOrder = 1
end
end
end
object BitBtn1: TBitBtn
Left = 176
Top = 344
Width = 75
Height = 25
Caption = 'BitBtn1'
TabOrder = 1
OnClick = BitBtn1Click
end
end
 
var
I: Integer;
ChildControl: TControl;
begin
for I:= TabSheet1.ControlCount -1 downto 0 do
begin
ChildControl := TabSheet1.Controls;
TabSheet1.RemoveControl(ChildControl);
TabSheet2.InsertControl(ChildControl);
end;
end;

移动到新页上了 :) 不知道行不行
 
我要的是复制,不是移动哎...
 
没错楼上的二位老兄的方法都不好像不成吧?

关注~
 
我想你肯定没必要同时使用两个相同的 PAGECONTROL ,而是想部分显示页,为何不用
TabVisible属性隐藏部分不用的页呢?
 
试一下:
var
I: Integer;
S:String;
begin
for I:= TabSheet1.ControlCount -1 downto 0 do
begin
With TControlClass(TabSheet1.Controls.ClassType).Create(Self) do
begin
Parent:=TabSheet2;
Left:=TabSheet1.Controls.Left;
Top:TabSheet1.Controls.Top;
SetLength(S,255) ;
TabSheet1.Controls.GetTextBuf(PChar(S),255);
SetTextBuf(S);
end;
end;
end;

 
最终版本:(刚刚写得有点小错误)
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
S:String;
begin
for I:= TabSheet1.ControlCount -1 downto 0 do
begin
With TControlClass(TabSheet1.Controls.ClassType).Create(Self) do
begin
Parent:=TabSheet2;
Left:=TabSheet1.Controls.Left;
Top:=TabSheet1.Controls.Top;
SetLength(S,255) ;
TabSheet1.Controls.GetTextBuf(PChar(S),255);
SetTextBuf(PChar(S));
// ^^^^^^^^^^^
end;
end;
end;
 
没搞定?
 
多人接受答案了。
 
后退
顶部