Текущий архив: 2004.03.28;
Скачать: CL | DM;

Вниз

Людии помогите! Есть форма на ней две панельки?   Найти похожие ветки 

← →
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;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.021 c