Форум: "Основная";
Текущий архив: 2004.01.29;
Скачать: [xml.tar.bz2];

Вниз

Запись / чтение компоненты из ресурса   Найти похожие ветки 

← →
Вомбат   (2004-01-16 15:56) [0]

Леди и джентельмены! Имею вопрос по subj. Не сомневаюсь, что этота тема 1000 раз обсуждена, но тем не менее:

пишу помпоненту в res

aStream.WriteComponentRes(dxdbgMain.ClassName,dxdbgMain)

читаю ее оттуда

FreeAndNil(dxdbgMain);
dxdbgMain:= TdxDBGrid.Create(Self);
dxdbgMain:= TdxDBGrid(aStream.ReadComponentRes(nil));
dxdbgMain.Parent:= Self;

Теоретически должен загрузиться TdxdbGrid с нужным мне количеством заполненных колонок, отсортированных перед сохранением. Практически загружается "лысый" TdxdbGrid без колонок и сортировок.

Моя гипотеза: функция ReadComponentRes сохраняет компоненту без подкомпонент. Т.е. сохраняет только ее размеры и проч. Все подкомпоненты нужно сохранять и загружать вручную.

Вопрос: насколько верна моя гипотеза и если он неверна то каким образом сохранить компоненту с подкомпонентами в файл?

С неизменным уважением.

---

← →
Amoeba   (2004-01-16 16:00) [1]

Сохраняет, все-таки WriteComponentRes.
Интересно, что будет видно при просмотре сохраненного ресурса утилитой типа ResourceHacker?

---

← →
Вомбат   (2004-01-16 16:04) [2]

Amoeba

> Сохраняет, все-таки WriteComponentRes.

Не понял что вы имели ввиду.

---

← →
Mystic   (2004-01-16 20:07) [3]

Попробуй:

unit StdIO;

interface

uses Classes;

procedure WritePersistent(S: TStream; Instance: TPersistent);
procedure ReadPersistent(S: TStream; Instance: TPersistent);

procedure WriteCollection(S: TStream; Instance: TCollection);
procedure ReadCollection(S: TStream; Instance: TCollection);

implementation

type
TMyWriter = class(TWriter)
public
procedure MyWriteCollection(Instance: TCollection);
procedure WritePersistent(Instance: TPersistent);
end;

procedure TMyWriter.MyWriteCollection(Instance: TCollection);
begin
WriteCollection(Instance);
end;

procedure TMyWriter.WritePersistent(Instance: TPersistent);
begin
WriteProperties(Instance);
WriteListEnd;
end;

type
TMyReader = class(TReader)
public
procedure MyReadCollection(Instance: TCollection);
procedure ReadPersistent(Instance: TPersistent);
end;

procedure TMyReader.MyReadCollection(Instance: TCollection);
var
Value: TValueType;
begin
Value := ReadValue;
if Value <> vaCollection then
raise EStreamError.Create("vaCollection excepted");
ReadCollection(Instance);
end;

procedure TMyReader.ReadPersistent(Instance: TPersistent);
begin
while not EndOfList do ReadProperty(Instance);
ReadListEnd;
end;

procedure WriteCollection(S: TStream; Instance: TCollection);
var
Writer: TMyWriter;
begin
Writer := TMyWriter.Create(S, 4096);
try
Writer.MyWriteCollection(Instance);
finally
Writer.Free;
end;
end;

procedure ReadCollection(S: TStream; Instance: TCollection);
var
Reader: TMyReader;
begin
Reader := TMyReader.Create(S, 4096);
try
Reader.MyReadCollection(Instance);
finally
Reader.Free;
end;
end;

procedure WritePersistent(S: TStream; Instance: TPersistent);
var
Writer: TMyWriter;
begin
Writer := TMyWriter.Create(S, 4096);
try
Writer.WritePersistent(Instance);
finally
Writer.Free;
end;
end;

procedure ReadPersistent(S: TStream; Instance: TPersistent);
var
Reader: TMyReader;
begin
Reader := TMyReader.Create(S, 4096);
try
Reader.ReadPersistent(Instance);
finally
Reader.Free;
end;
end;

end.

---

← →
Mystic   (2004-01-16 20:10) [4]

По крайней мере, приведенный ниже код у меня нормально отрабатывает нормально (для DBGrid)

unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, DBGrids;

type
TMainForm = class(TForm)
TestCollection: TButton;
TestPersistent: TButton;
DBGrid: TDBGrid;
CloneComponentBtn: TButton;
procedure TestCollectionClick(Sender: TObject);
procedure TestPersistentClick(Sender: TObject);
procedure CloneComponentBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

uses StdIO;

{$R *.DFM}

type
TMyCollectionItem = class;

TMyCollection = class(TCollection)
private
function GetItem(Index: Integer): TMyCollectionItem;
procedure SetItem(Index: Integer; const Value: TMyCollectionItem);
public
constructor Create;
property Items[ Index: Integer]: TMyCollectionItem read GetItem write SetItem; default;
end;

TMyCollectionItem = class(TCollectionItem)
private
FData: Integer;
FStrData: string;
published
property Data: Integer read FData write FData;
property StrData: string read FStrData write FStrData;
end;

TMyPersistent = class(TPersistent)
private
FData: Integer;
FStrData: string;
published
property Data: Integer read FData write FData;
property StrData: string read FStrData write FStrData;
end;

{ TMyCollection }

constructor TMyCollection.Create;
begin
inherited Create(TMyCollectionItem);
end;

function TMyCollection.GetItem(Index: Integer): TMyCollectionItem;
begin
Result := inherited Items[Index] as TMyCollectionItem;
end;

procedure TMyCollection.SetItem(Index: Integer;
const Value: TMyCollectionItem);
begin
inherited Items[Index] := Value;
end;

procedure TMainForm.TestCollectionClick(Sender: TObject);
var
C1, C2: TMyCollection;
S: TStream;
SavePos: Integer;
I: Integer;
begin
C1 := nil;
C2 := nil;
S := nil;
try
C1 := TMyCollection.Create;
C2 := TMyCollection.Create;
S := TMemoryStream.Create;
with C1.Add as TmyCollectionItem do
begin
Data := 1;
StrData := "test #1";
end;
with C1.Add as TmyCollectionItem do
begin
Data := 2;
StrData := "test #2";
end;
WriteCollection(S, C1);
SavePos := S.Position;
S.Position := 0;
ReadCollection(S, C2);
Assert(S.Position = SavePos);
Assert(C1.Count = C2.Count);
for I := 0 to C1.Count-1 do
begin
Assert(C1[I].Data = C2[I].Data);
Assert(C1[I].StrData = C2[I].StrData);
end;
ShowMessage("Test successful.");
finally
C1.Free;
C2.Free;
S.Free;
end;
end;

procedure TMainForm.TestPersistentClick(Sender: TObject);
var
P1, P2: TMyPersistent;
S: TStream;
SavePos: Integer;
begin
P1 := nil;
P2 := nil;
S := nil;
try
P1 := TMyPersistent.Create;
P2 := TMyPersistent.Create;
S := TMemoryStream.Create;
P1.Data := 1;
P1.StrData := "test #1";
WritePersistent(S, P1);
SavePos := S.Position;
S.Position := 0;
ReadPersistent(S, P2);
Assert(S.Position = SavePos);
Assert(P1.Data = P2.Data);
Assert(P1.StrData = P2.StrData);
ShowMessage("Test successful.");
finally
P1.Free;
P2.Free;
S.Free;
end;
end;

procedure TMainForm.CloneComponentBtnClick(Sender: TObject);
var
NewGrid: TDBGrid;
S: TStream;
SavePos: Integer;
begin
S := TMemoryStream.Create;
try
NewGrid := TDBGrid.Create(Self);
NewGrid.Parent := Self;
WritePersistent(S, DBGrid);
SavePos := S.Position;
S.Position := 0;
ReadPersistent(S, NewGrid);
Assert(S.Position = SavePos);
NewGrid.Top := DBGrid.Top + DBGrid.Height;
NewGrid.Left := DBGrid.Left;
finally
S.Free;
end;
end;

end.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.01.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.008 c