Форум: "Потрепаться";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];
ВнизЛюдии помогите! Есть форма на ней две панельки? Найти похожие ветки
← →
Style © (2004-02-27 21:13) [0]На первой панельке находятся различные TControl?
Хочу сделать точную копию контролов на второй панельке?
Либо я пива перепил либо совсем уже ничего не понимаю.
В общем у меня AV - так, как новый объект не создается а просто переназначается Parent. Как быть???
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
Control: TObject;
begin
for i := 0 to Panel1.ControlCount-1 do
begin
Control := Panel1.Controls[i].Create(Panel2);
TControl(Control).Parent := Panel2;
TControl(Control).Visible := true;
end;
end;
← →
Style © (2004-02-27 23:58) [1]Вот так решил свою проблемму :0)
unit props;
interface
uses
TypInfo,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Button1: TButton;
CheckBox1: TCheckBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure SetPropValue(Instance: TObject; const PropName: string;
const Value: Variant);
function RangedValue(const AMin, AMax: Int64): Int64;
begin
Result := Trunc(Value);
if (Result < AMin) or (Result > AMax) then
raise ERangeError.Create("Range Error");
end;
var
PropInfo: PPropInfo;
TypeData: PTypeData;
DynArray: Pointer;
begin
// get the prop info
PropInfo := GetPropInfo(Instance, PropName);
if PropInfo = nil then
raise Exception.Create(PropName + " not found")
else
begin
TypeData := GetTypeData(PropInfo^.PropType^);
case PropInfo.PropType^^.Kind of
tkInteger, tkChar, tkWChar:
if TypeData^.MinValue < TypeData^.MaxValue then
SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
TypeData^.MaxValue))
else
// Unsigned type
SetOrdProp(Instance, PropInfo,
RangedValue(LongWord(TypeData^.MinValue),
LongWord(TypeData^.MaxValue)));
tkEnumeration:
if VarType(Value) = varString then
SetEnumProp(Instance, PropInfo, VarToStr(Value))
else if VarType(Value) = varBoolean then
// Need to map variant boolean values -1,0 to 1,0
SetOrdProp(Instance, PropInfo, Abs(Trunc(Value)))
else
SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
TypeData^.MaxValue));
tkSet:
if VarType(Value) = varInteger then
SetOrdProp(Instance, PropInfo, Value)
else
SetSetProp(Instance, PropInfo, VarToStr(Value));
tkFloat:
SetFloatProp(Instance, PropInfo, Value);
tkString, tkLString:
SetStrProp(Instance, PropInfo, VarToStr(Value));
tkWString:
SetWideStrProp(Instance, PropInfo, VarToWideStr(Value));
tkVariant:
SetVariantProp(Instance, PropInfo, Value);
tkInt64:
SetInt64Prop(Instance, PropInfo, RangedValue(TypeData^.MinInt64Value,
TypeData^.MaxInt64Value));
tkDynArray:
begin
DynArrayFromVariant(DynArray, Value, PropInfo^.PropType^);
SetOrdProp(Instance, PropInfo, Integer(DynArray));
end;
else
ShowMessage(PropName);
end;
end;
end;
procedure PropAssign(Source,Dest: TControl);
var
PropList: PPropList;
i, Count: integer;
Ptr: Pointer;
begin
PropList := AllocMem(SizeOf(PropList^));
Count := GetPropList(Source.ClassInfo, tkProperties + [tkMethod],
PropList);
for i := 0 to Count - 1 do
begin
case PropList[i].PropType^^.Kind of
tkClass:
begin
Ptr := pointer(integer(GetPropValue(Source, PropList[i].Name)));
if(Integer(Ptr) <> 0) then
begin
SetOrdProp(Dest, PropList[i].Name, integer(Ptr));
end;
end;
tkMethod:
begin
SetMethodProp( Dest, PropList[i].Name,
GetMethodProp(Source,PropList[i].Name));
end;
else
SetPropValue(Dest, PropList[i].Name, GetPropValue(Source, PropList[i].Name));
end;//case
end;
end;
procedure CreateClone(Owner: TComponent; InstanceClass: TComponentClass; var Reference);
var
Instance: TComponent;
begin
Instance := TComponent(InstanceClass.NewInstance);
TComponent(Reference) := Instance;
try
Instance.Create(Owner);
except
TComponent(Reference) := nil;
raise;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
Control: TComponent;
begin
for i := 0 to Panel1.ControlCount-1 do
begin
CreateClone(Panel2,TComponentClass(Panel1.Controls[i].ClassType),Control);
if(Control <> nil) then
begin
PropAssign(Panel1.Controls[i],TControl(Control));
TControl(Control).Parent := Panel2;
TControl(Control).Visible := true;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TButton(Sender).Caption := "ops";
end;
end.
← →
DrPass © (2004-02-28 00:28) [2]Извращенец. Что тебе мешало копировать свойства, скажем, всего парой методов TStream.WriteComponent/ReadComponent?
← →
Style © (2004-02-28 00:47) [3]У меня не получилось использовать их, может я что не так делал?
function ComponentToString(Component: TComponent): string;
var
BinStream:TMemoryStream;
StrStream: TStringStream;
s: string;
begin
BinStream := TMemoryStream.Create;
try
StrStream := TStringStream.Create(s);
try
BinStream.WriteComponent(Component);
BinStream.Seek(0, soFromBeginning);
ObjectBinaryToText(BinStream, StrStream);
StrStream.Seek(0, soFromBeginning);
Result:= StrStream.DataString;
finally
StrStream.Free;
end;
finally
BinStream.Free
end;
end;
function StringToComponent(Value: string): TComponent;
var
StrStream:TStringStream;
BinStream: TMemoryStream;
begin
StrStream := TStringStream.Create(Value);
try
BinStream := TMemoryStream.Create;
try
ObjectTextToBinary(StrStream, BinStream);
BinStream.Seek(0, soFromBeginning);
Result := BinStream.ReadComponent(nil);
finally
BinStream.Free;
end;
finally
StrStream.Free;
end;
end;
← →
DrPass © (2004-02-28 01:14) [4]Все это можно уложить в несколько строчек:
ms:=TMemoryStream.Create;
ms.WriteComponent(Control1);
Control1.Name:=TempName;//для того, чтобы при копировании свойств не создать компоненту с тем же именем
ms.Position:=0;
ms.ReadComponent(Control1Clone);
ms.Free
← →
Johnmen © (2004-02-28 03:04) [5]Главное - коду побольше надёргать...
Остальное - ерунда...
:)))
← →
Style © (2004-02-28 08:54) [6]Johnmen © :)
А вообще код DrPass © [4] не копирует методы, только что проверял.
Если я на своём label на панельке присвою событие OnClick,
то вышестоящим кодом оно не переносится, мне же нужно что бы получался полный клон. Поэтому оставлю как у меня есть.
← →
Sniper-Max © (2004-02-28 09:17) [7]Что-то кода многа... аж прям голова свернулась, а на самом деле все просто!
В цикле ищешь контролы свои по имени и создаешь новый там где нало, тут же его снова находишь и присваиваешь ему нужные параметры (расположение и т.д.).
← →
Style © (2004-02-28 09:45) [8]Sniper-Max ©
Ты вообще читал ветку?
← →
Real © (2004-03-02 10:45) [9]> Style ©
Так тебе нужна КОПИЯ контролов или ПЕРЕНЕСТИ контролы с одной панели на другую? Если копия, то креатом их и асигном свойства забрать. а если перенос - вроде как insertcomponent для этого?
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.032 c