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

Вниз

Как лучше хранить координаты точек и изображения в файле?   Найти похожие ветки 

← →
Дмитрий_177   (2006-04-06 00:45) [0]

Я уже задавал этот вопрос, но тему уже удалили... Мне Джо показал пример класса по вопосу:

unit PointsUtils;

interface
uses Windows, SysUtils, Classes;

type

TPoints = class
private
  FList: TList;
  procedure SetItems(Index: Integer; const Value: TPoint);
  function GetItems(Index: Integer): TPoint;
  function GetCount: Integer;
public
  constructor Create();
  destructor Destroy; override;
  function Add (X,Y: Integer): Integer; overload;
  function Add (APoint: TPoint): Integer; overload;
  property Count: Integer read GetCount;
  property Items[Index: Integer]: TPoint read GetItems write SetItems; default;
  procedure Clear;
  procedure SaveToStream (AStream: TStream);
  procedure SaveToFile (AFileName: string);
  procedure LoadFromStream (AStream: TStream);
  procedure LoadFromFile (AFileName: string);
end;

implementation

type
PPoint = ^TPoint;

{ TPoints }

function TPoints.Add(X, Y: Integer): Integer;
var
Pt: TPoint;
begin
Pt.X := X;
Pt.Y := Y;
Result := Add (Pt)
end;

function TPoints.Add(APoint: TPoint): Integer;
var
NewPt: PPoint;
begin
GetMem (NewPt,SizeOf(TPoint));
NewPt^ := APoint;
Result := FList.Add(NewPt)
end;

procedure TPoints.Clear;
var
I: Integer;
begin
for I := Count - 1 downto 0 do
  FreeMem (FList[I]);
FList.Clear;
end;

constructor TPoints.Create;
begin
inherited;
FList := TList.Create;
end;

destructor TPoints.Destroy;
begin
Clear;
FList.Free;
inherited;
end;

function TPoints.GetCount: Integer;
begin
Result := FList.Count
end;

function TPoints.GetItems(Index: Integer): TPoint;
begin
Result := PPoint(FList[Index])^
end;

procedure TPoints.LoadFromFile(AFileName: string);
var
Fs: TFileStream;
begin
Fs := TFileStream.Create(AFileName,fmOpenRead);
try
  LoadFromStream(Fs);
finally
  Fs.Free;
end;
end;

procedure TPoints.LoadFromStream(AStream: TStream);
var
I,
Cnt: Integer;
Pt: TPoint;
begin
Clear;
AStream.Read(Cnt,SizeOf(Cnt));
for I := 0 to Cnt-1 do
begin
  AStream.Read(Pt,SizeOf(Pt));
  Add (Pt)
end;
end;

procedure TPoints.SaveToFile(AFileName: string);
var
Fs: TFileStream;
begin
Fs := TFileStream.Create(AFileName,fmCreate);
try
  SaveToStream(Fs);
finally
  Fs.Free;
end;
end;

procedure TPoints.SaveToStream(AStream: TStream);
var
I: Integer;
Pt: TPoint;
Cnt: Integer;
begin
// количество точек
Cnt := Count;
AStream.Write(Cnt,SizeOf(Cnt));

// сами точки
for I := 0 to Count - 1 do
begin
  Pt := Self[I];
  AStream.Write(Pt,SizeOf(TPoint));
end;
end;

procedure TPoints.SetItems(Index: Integer; const Value: TPoint);
begin
PPoint(FList[Index])^ := Value
end;

end.

Пример использования:
---------------------

procedure TForm18.Button1Click(Sender: TObject);
var
APoints: TPoints;
I: Integer;
begin
APoints := TPoints.Create;
try

  APoints.Add(10,20);
  APoints.Add(30,40);
  APoints.Add(50,60);

  APoints.SaveToFile("d:\points.dat");
 
  APoints.Clear;

  APoints.LoadFromFile ("d:\points.dat");
  for I := 0 to APoints.Count - 1 do
    ShowMessageFmt("%d,%d",[APoints[I].X,APoints[I].Y]);
   
finally
  APoints.Free;
end;
end;

Но у меня возникло несколько вопросов:
1. Что делает функция Clear; в LoadFromStream и Destroy?
2. Если расширить класс еще с сохранением изображений, так правильно будет?

private
  FPictureTop: TPicture;
  FPictureBottom: TPicture;
  procedure SetPictureTop(const Value: TPicture);
  procedure SetPictureBottom(const Value: TPicture);
public
  property PictureTop: TPicture read FPictureTop write SetPictureTop;
  property PictureBottom: TPicture read FPictureBottom write SetPictureBottom;
end;
...
procedure ...SetPictureTop(const Value: TPicture);
begin
FPictureTop.Assign(Value)
end;

procedure ...SetPictureBottom(const Value: TPicture);
begin
FPictureBottom.Assign(Value)
end;

procedure ...SaveToStream(AStream: TStream);
begin
...
AStream.Write(FPictureTop, SizeOf(FPictureTop));
AStream.Write(FPictureBottom, SizeOf(FPictureBottom));
end;

procedure ...LoadFromStream(AStream: TStream);
begin
...
AStream.Read(FPictureTop, SizeOf(FPictureTop));
AStream.Read(FPictureBottom, SizeOf(FPictureBottom));
end;


---

← →
Джо ©   (2006-04-06 00:53) [1]

> 1. Что делает функция Clear; в LoadFromStream и Destroy?

Метод Clear освобождает динамически выделенную под данные память для каждого элемента массива и затем очищает сам список FList (ссылки на данные, хранящиеся в нем, уже неактуальны).
В LoadFromStream он нужен затем, чтобы перед загрузкой из потока удалить старые данные. В Destroy нужен для того, чтобы освободить всю память, выделенную нами при разрушении объекта.

По второму вопросу посмотрю чуть позже, сейчас нет времени.

---

← →
Дмитрий_177   (2006-04-06 01:01) [2]

Джо, ок, только ответь пожалуйста...

---

← →
Джо ©   (2006-04-06 04:04) [3]

Вначале несколько замечаний "глобального характера".

1. Первоначально мы имели сущность "список точек" (TPoints), умеющую сохраняться/восстанавливаться. Добавление в этот
класс сущности "картинка" нарушает первоначальную абстракцию — графическое изображение не имеет никакого отношения
к "списку точек" и им не является.
Поэтому, вместо добавления в класс TPoints свойства "изображение" мы создадим другую сущность, вмещающую в себя как
массив точек так и изображения. Я назвал этот класс TGraphicData из-за незнания предметной области твоей программы.
Переименуй его, если это требуется.

2. Есть принципиально ошибочный подход в твоем коде.
AStream.Read(FPictureTop, SizeOf(FPictureTop));
Размер переменной экземпляра любого класса — 4 байта, сама переменная содержит всего лишь обычный указатель на
область памяти, в которой собственно располагается экземпляр в данный конкретный момент выполнения. Поэтому такой код
совершенно не подходит для записи данных самого объекта с его последующим восстановлением.
К счастью, у TPicture.Graphic имеются методы SaveToStream/LoadFromStream, их-то и нужно использовать в этом случае.
По этой (и по нескольким другим) причинам для хранения изображений я решил использовать абстрактный класс TGraphic
вместо TPicture. Наследники TGraphic — это TBitmap, TIcon, TJpeg и другие классы (в VCL существует механизм,
позволяющий добавлять и регистрировать собственный классы-наследники TGraphic).
В приведенном коде реализована возможность задания картинки в форматах TBitmap, TIcon, TJpegImage и TMetafile.
Добавить поддержку других форматов несложно, достаточно отредактировать соответствующим образом массив-константу
GraphicSignatures.

3. В связи с использованием TGraphic.SaveToStream/LoadFromStream связана одна проблема неприятного характера. Дело в
том, что если подряд записать в поток несколько изображений, а затем (переместившись в начало потока) выполнить
LoadFromStream, то первый же метод LoadFromStream прочитает все даннные от текущей позиции до конца
стрима. Т.е, прочитается только первая картинка (возможно, став при этом "дефективной"), а последующие попытки чтения
будут приводить к ошибке чтения за пределами потока.
Поэтому, следует явно разграничивать картинки в файле, указывая для каждой размер данных. Я использовал временный
поток в памяти для выполнения этой задачи. Это одно из самых некрасивых мест в коде :)

4. Есть еще одна проблема, связанная с тем, что TGraphic это абстрактный класс, и в переменной его типа должен храниться
экземпляр его конкретного наследника. В применении к нашему случаю это приводит к тому, что на момент чтения данных из
файла у нас нет возможности узнать, ЧТО именно записано в файле — метафайл, джейпег или битмэп. Поэтому приходится
хранить и эту информацию в файле. То, как я это реализовал — тоже достаточно неизящно :) Но пусть Борланду будет
стыдно, что он предпочел спрятать экземпляр (и даже объявление класса) TFileFormatsList в секции implementation (кто знает,
о чем я, тот да вознегодует вместе со мной ;)).

---

← →
Джо ©   (2006-04-06 04:05) [4]


unit PointsUtils;

interface
uses Windows, SysUtils, Classes, Graphics, Jpeg;

type

 TPoints = class
 private
   FList: TList;
   procedure SetItems(Index: Integer; const Value: TPoint);
   function GetItems(Index: Integer): TPoint;
   function GetCount: Integer;
 public
   constructor Create();
   destructor Destroy; override;
   function Add (X,Y: Integer): Integer; overload;
   function Add (APoint: TPoint): Integer; overload;
   property Count: Integer read GetCount;
   property Items[Index: Integer]: TPoint read GetItems write SetItems; default;
   procedure Clear;
   procedure SaveToStream (AStream: TStream);
   procedure SaveToFile (AFileName: string);
   procedure LoadFromStream (AStream: TStream);
   procedure LoadFromFile (AFileName: string);
 end;

 TGraphicSignature = array [0..2] of Char;

 // Подбери подходящее название класса,
 // я не знаю твоей предметной области
 TGraphicData = class
 private
   FPoints: TPoints;
   FPictureTop,
   FPictureBottom: TGraphic;
   procedure SetPictureBottom(const Value: TGraphic);
   procedure SetPictureTop(const Value: TGraphic);
   procedure DeleteGraphics;
   function CreateActualGraphicClass (const Value: TGraphic): TGraphic;
   function CreatecActualGraphicClassFromSignature (AGraphicSignature: TGraphicSignature): TGraphic;
   function GetGraphicSignature (AGraphic: TGraphic): TGraphicSignature;
   procedure SaveGraphicToStream (AGraphic: TGraphic; AStream: TStream);
   procedure LoadGraphicFromStream (var AGraphic: TGraphic; AStream: TStream);
 public
   constructor Create;
   destructor Destroy; override;
   property Points: TPoints read FPoints;
   property PictureTop: TGraphic read FPictureTop write SetPictureTop;
   property PictureBottom: TGraphic read FPictureBottom write SetPictureBottom;
   procedure SaveToStream (AStream: TStream);
   procedure SaveToFile (AFileName: string);
   procedure LoadFromStream (AStream: TStream);
   procedure LoadFromFile (AFileName: string);
 end;

implementation

type

 TGraphicFormatRec = record
   AClass: TGraphicClass;
   ASignature: TGraphicSignature;
 end;

const

 NilGraphicSignature = "...";

 GraphicSignatures: array [0..3] of TGraphicFormatRec =
 (
   (AClass: TBitmap; ASignature: "BMP"),
   (AClass: TIcon; ASignature: "ICO"),
   (AClass: TMetafile; ASignature: "EMF"),
   (AClass: TJPEGImage; ASignature: "JPG")
 );

type
 PPoint = ^TPoint;

{ TPoints }

function TPoints.Add(X, Y: Integer): Integer;
var
 Pt: TPoint;
begin
 Pt.X := X;
 Pt.Y := Y;
 Result := Add (Pt)
end;

function TPoints.Add(APoint: TPoint): Integer;
var
 NewPt: PPoint;
begin
 GetMem (NewPt,SizeOf(TPoint));
 NewPt^ := APoint;
 Result := FList.Add(NewPt)
end;

procedure TPoints.Clear;
var
 I: Integer;
begin
 for I := Count - 1 downto 0 do
   FreeMem (FList[I]);
 FList.Clear;
end;

constructor TPoints.Create;
begin
 inherited;
 FList := TList.Create;
end;

destructor TPoints.Destroy;
begin
 Clear;
 FList.Free;
 inherited;
end;

function TPoints.GetCount: Integer;
begin
 Result := FList.Count
end;

function TPoints.GetItems(Index: Integer): TPoint;
begin
 Result := PPoint(FList[Index])^
end;

procedure TPoints.LoadFromFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName,fmOpenRead);
 try
   LoadFromStream(Fs);
 finally
   Fs.Free;
 end;
end;


---

← →
Джо ©   (2006-04-06 04:05) [5]

procedure TPoints.LoadFromStream(AStream: TStream);
var
 I,
 Cnt: Integer;
 Pt: TPoint;
begin
 Clear;
 AStream.Read(Cnt,SizeOf(Cnt));
 for I := 0 to Cnt-1 do
 begin
   AStream.Read(Pt,SizeOf(Pt));
   Add (Pt)
 end;
end;

procedure TPoints.SaveToFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName,fmCreate);
 try
   SaveToStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TPoints.SaveToStream(AStream: TStream);
var
 I: Integer;
 Pt: TPoint;
 Cnt: Integer;
begin
 // количество точек
 Cnt := Count;
 AStream.Write(Cnt,SizeOf(Cnt));

 // сами точки
 for I := 0 to Count - 1 do
 begin
   Pt := Self[I];
   AStream.Write(Pt,SizeOf(TPoint));
 end;
end;

procedure TPoints.SetItems(Index: Integer; const Value: TPoint);
begin
 PPoint(FList[Index])^ := Value
end;

{ TGraphicData }

constructor TGraphicData.Create;
begin
 FPoints := TPoints.Create;
end;

function TGraphicData.CreateActualGraphicClass(const Value: TGraphic): TGraphic;
var
 GraphicClass: TGraphicClass;
begin
 if Assigned (Value) then
   Result := TGraphic(Value.ClassType.Create)
 else
   raise Exception.Create("Nil graphic instance");
end;

function TGraphicData.CreatecActualGraphicClassFromSignature(
 AGraphicSignature: TGraphicSignature): TGraphic;
var
 I: Integer;
 Found: Boolean;
begin
 Found := False;

 for I := Low(GraphicSignatures) to High(GraphicSignatures) do
 begin
   if GraphicSignatures[I].ASignature = AGraphicSignature then
   begin
     if GraphicSignatures[I].AClass <> nil then
       Result := GraphicSignatures[I].AClass.Create
     else
       Result := nil;
       
     Found := True;
     Break
   end;
 end;

 if not Found then
   raise Exception.CreateFmt("Unsupported graphic class signature "%s"",[AGraphicSignature]);
end;

procedure TGraphicData.DeleteGraphics;
begin
 if Assigned(FPictureTop) then
   FreeAndNil(FPictureTop);
 if Assigned(FPictureBottom) then
   FreeAndNil(FPictureBottom);
end;

destructor TGraphicData.Destroy;
begin
 FPoints.Free;
 DeleteGraphics;
 inherited;
end;

function TGraphicData.GetGraphicSignature(
 AGraphic: TGraphic): TGraphicSignature;
var
 I: Integer;
 Found: Boolean;
begin

 if Assigned(AGraphic) then
 begin
   Found := False;

   for I := Low(GraphicSignatures) to High(GraphicSignatures) do
   begin
     if GraphicSignatures[I].AClass = AGraphic.ClassType then
     begin
       Result := GraphicSignatures[I].ASignature;
       Found := True;
       Break
     end;
   end;

   if not Found then
     raise Exception.Create("Unsupported graphic class");
 end
 else
   Result := NilGraphicSignature;
end;

procedure TGraphicData.LoadFromFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName,fmOpenRead);
 try
   LoadFromStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TGraphicData.LoadFromStream(AStream: TStream);
begin
 FPoints.LoadFromStream(AStream);
 LoadGraphicFromStream(FPictureTop,AStream);
 LoadGraphicFromStream(FPictureBottom,AStream);
end;

procedure TGraphicData.LoadGraphicFromStream(var AGraphic: TGraphic;
 AStream: TStream);
var
 GraphicSignature: TGraphicSignature;
 Cnt: Int64;
 TempStream: TMemoryStream;
begin
 if Assigned(AGraphic) then
   AGraphic.Free;

 AStream.Read(GraphicSignature,SizeOf(TGraphicSignature));

 AGraphic := CreatecActualGraphicClassFromSignature(GraphicSignature);
 if Assigned(AGraphic) then
 begin
   AStream.Read(Cnt,SizeOf(Cnt));

   TempStream := TMemoryStream.Create;
   try
     TempStream.CopyFrom(AStream,Cnt);
     TempStream.Position := 0;
     AGraphic.LoadFromStream(TempStream);
   finally
     TempStream.Free;
   end;
 end;
end;

procedure TGraphicData.SaveGraphicToStream(AGraphic: TGraphic; AStream: TStream);
var
 GraphicSignature: TGraphicSignature;
 TempStream: TMemoryStream;
 Cnt: Int64;
begin
 GraphicSignature := GetGraphicSignature(AGraphic);
 
 AStream.Write(GraphicSignature,SizeOf(GraphicSignature));

 if Assigned(AGraphic) then
 begin
   TempStream := TMemoryStream.Create;
   try
     AGraphic.SaveToStream(TempStream);
     TempStream.Position := 0;
     Cnt := TempStream.Size;

     AStream.Write(Cnt,SizeOf(Cnt));

     AStream.CopyFrom(TempStream,Cnt)

   finally
     TempStream.Free;
   end;
 end;
end;

procedure TGraphicData.SaveToFile(AFileName: string);
var
 Fs: TFileStream;
begin
 Fs := TFileStream.Create(AFileName,fmCreate);
 try
   SaveToStream(Fs);
 finally
   Fs.Free;
 end;
end;

procedure TGraphicData.SaveToStream(AStream: TStream);
begin
 Points.SaveToStream(AStream);
 SaveGraphicToStream(FPictureTop,AStream);
 SaveGraphicToStream(FPictureBottom,AStream);
end;

procedure TGraphicData.SetPictureBottom(const Value: TGraphic);
begin
 if Assigned(FPictureBottom) then
   FPictureBottom.Free;

 if Assigned (Value) then
 begin
   FPictureBottom := CreateActualGraphicClass(Value);
   FPictureBottom.Assign(Value);
 end;
end;

procedure TGraphicData.SetPictureTop(const Value: TGraphic);
begin
 if Assigned(FPictureBottom) then
   FPictureBottom.Free;

 if Assigned (Value) then
 begin
   FPictureTop := CreateActualGraphicClass(Value);
   FPictureTop.Assign(Value);
 end;
end;

end.


Пример использования.
На форме две кнопки: "Сохранить", "Загрузить", и 4 экземпляра TImage. В Image1 и Image2 загружены картинки любого
формата из перечисленных выше. Остальные два пусты.


// Кнопка "Сохранить"
procedure TForm18.Button2Click(Sender: TObject);
var
 GraphicData: TGraphicData;
begin
 GraphicData := TGraphicData.Create;
 try
   GraphicData.Points.Add(10,20);
   GraphicData.Points.Add(30,40);
   GraphicData.PictureTop := Image1.Picture.Graphic;
   GraphicData.PictureBottom := Image2.Picture.Graphic;

   GraphicData.SaveToFile("d:\test.graphics");
 finally
   GraphicData.Free;
 end;
end;

// Кнопка "Загрузить"
procedure TForm18.Button3Click(Sender: TObject);
var
 I: Integer;
 GraphicData: TGraphicData;
begin
 GraphicData := TGraphicData.Create;
 try
   GraphicData.LoadFromFile("d:\test.graphics");
   Image3.Canvas.Draw (0,0,GraphicData.PictureTop);
   Image4.Canvas.Draw (0,0,GraphicData.PictureBottom);

   for I := 0 to GraphicData.Points.Count - 1 do
     ShowMessageFmt("%d,%d",[GraphicData.Points[I].X,GraphicData.Points[I].Y]);

 finally
   GraphicData.Free;
 end;
end;

Еще. Код местами небрежен — не обессудьте, писано на скорую руку поздней ночью. Возможно, в нем даже есть ошибки и
преступления против человечества :)

---

← →
Джо ©   (2006-04-06 04:07) [6]

Ну вот, с тэгами накосячил :(

---

← →
Джо ©   (2006-04-06 04:11) [7]

Исправляю один из методов:
function TGraphicData.CreatecActualGraphicClassFromSignature(
 AGraphicSignature: TGraphicSignature): TGraphic;
var
 I: Integer;
 Found: Boolean;
begin
 if AGraphicSignature <> NilGraphicSignature then
 begin
   Found := False;

   for I := Low(GraphicSignatures) to High(GraphicSignatures) do
   begin
     if GraphicSignatures[I].ASignature = AGraphicSignature then
     begin
       Result := GraphicSignatures[I].AClass.Create;
       Found := True;
       Break
     end;
   end;

   if not Found then
     raise Exception.CreateFmt("Unsupported graphic class signature "%s"",[AGraphicSignature]);
 end
 else
   Result := nil
end;


---

← →
Джо ©   (2006-04-06 04:19) [8]

И, последнее.
В связи с громоздкостью кода записи/чтения картинки, возможно, было бы целесообразнее создать класс TGraphicStreamer, по образцу:

private
 FGraphic: TGraphic;
public
 property Graphic: TGraphic read FGraphic;
 procedure SaveToStream;
 procedure LoadFromStream;
 constructor Create (ASourceGraphic: TGraphic);


и именно его использовать в классе TGraphicData. Нет времени на его реализацию. Подумай, может оказаться удобным.

---

← →
Дмитрий_177   (2006-04-06 04:52) [9]

Ого... Спасибо большое Джо! Посмотрел весь код, спасибо еще раз большое! Я тут заметил что из класса TPoints уже можно убрать процедуры SaveToFile и LoadFromFile, т.к. они уже ненужные получаются... или я ошибаюсь?

---

← →
Дмитрий_177   (2006-04-06 04:57) [10]

А еще вопросик с типом изображения... Вот если все отбросить? Какой будет быстрей всех работать тип изображения в плане загрузки из такого файла и показать на форме, например в томже Image? Мне почему-то кажется bmp, хотя jpg меньше в размере... и сам файл тогда меньше места занимать будет...

---

← →
Джо ©   (2006-04-06 05:09) [11]

> [9] Дмитрий_177   (06.04.06 04:52)

Если не нужно отдельно сохранять точки в файл, то SaveToFile/LoadFromFile можно и выбросить. SaveToStream/LoadFromStream убирать нельзя, потому, что они используются в TGraphicData. Если они не будут использоваться явно, то можешь их перенести в секцию protected. Хотя, я бы оставил.


> [10] Дмитрий_177   (06.04.06 04:57)

От картинки зависит. Иногда и Icon подойдет :) Но, конечно, Bitmap будет занимать больше места, чем JPeg. Грузиться Bitmap, наверное, будет быстрее. А если графика векторная — то тогда Metafile, конечно.

---

← →
Дмитрий_177   (2006-04-06 14:23) [12]

Я просто что просил про тип изображения, мне сейчас нужно определиться какой тип изображений хранить... Я всетаки остановлюсь на bmp... Изображения не такие уж и большие будут там храниться... Но всеравно спасибо за то, что показал как делать поддержку разных типов, на будущее буду знать =))) Но именно тут в моей задаче это не нужно... Буду записывать bmp и его же считывать...=)))

---

← →
Джо ©   (2006-04-06 15:01) [13]

> [12] Дмитрий_177   (06.04.06 14:23)
> Я просто что просил про тип изображения, мне сейчас нужно
> определиться какой тип изображений хранить... Я всетаки
> остановлюсь на bmp...

Тогда объявляй FPictureTop,FPictureBottom: TBitmap и выкидывай весь геморрой с определением актуального типа графики (+его запись/чтение).

---

← →
Дмитрий_177   (2006-04-06 21:53) [14]

Если выкинуть определение актуального типа, то некоторые функции так будут выглядеть? А остальное все вроде без изменений...

procedure TGraphicData.SetPictureBottom(const Value: TBitmap);
begin
  FPictureBottom.Assign(Value);
end;

procedure TGraphicData.SetPictureTop(const Value: TBitmap);
begin
  FPictureTop.Assign(Value);
end;

procedure TGraphicData.LoadGraphicFromStream(var ABitmap: TBitmap;
AStream: TStream);
var
Cnt: Int64;
TempStream: TMemoryStream;
begin
AStream.Read(ABitmap, SizeOf(TBitmap));

if Assigned(ABitmap) then
begin
  AStream.Read(Cnt, SizeOf(Cnt));

  TempStream := TMemoryStream.Create;
  try
    TempStream.CopyFrom(AStream, Cnt);
    TempStream.Position := 0;
    ABitmap.LoadFromStream(TempStream);
  finally
    TempStream.Free;
  end;
end;
end;

procedure TGraphicData.SaveGraphicToStream(ABitmap: TBitmap; AStream: TStream);
var
TempStream: TMemoryStream;
Cnt: Int64;
begin
AStream.Write(ABitmap, SizeOf(ABitmap));

if Assigned(ABitmap) then
begin
  TempStream := TMemoryStream.Create;
  try
    ABitmap.SaveToStream(TempStream);
    TempStream.Position := 0;
    Cnt := TempStream.Size;

    AStream.Write(Cnt, SizeOf(Cnt));

    AStream.CopyFrom(TempStream, Cnt)

  finally
    TempStream.Free;
  end;
end;
end;


---

← →
Дмитрий_177   (2006-04-08 02:19) [15]

Ой, т.е. так:


constructor TGraphicData.Create;
begin
FPictureTop := TBitmap.Create;
FPictureBottom := TBitmap.Create;
FPoints := TPoints.Create;
end;

destructor TGraphicData.Destroy;
begin
DeleteGraphics;
//FPictureTop.Free;
//FPictureBottom.Free;   -> тут я не знаю надо ли писать эти строки или нет, по идее их убивает функция "DeleteGraphics", так что я их убрал (закоментировал)
FPoints.Free;
inherited;
end;

procedure TGraphicData.DeleteGraphics;
begin
if Assigned(FPictureTop) then
  FreeAndNil(FPictureTop);
if Assigned(FPictureBottom) then
  FreeAndNil(FPictureBottom);
end;

procedure TGraphicData.LoadGraphicFromStream(var ABitmap: TBitmap;
AStream: TStream);
var
Cnt: Int64;
TempStream: TMemoryStream;
begin
// if Assigned(ABitmap) then
//   ABitmap.Free;        -> с этими строками у меня выскакивает ошибка, а без них все нормально работает

if Assigned(ABitmap) then
begin
  AStream.Read(Cnt, SizeOf(Cnt));

  TempStream := TMemoryStream.Create;
  try
    TempStream.CopyFrom(AStream, Cnt);
    TempStream.Position := 0;
    ABitmap.LoadFromStream(TempStream);
  finally
    TempStream.Free;
  end;
end;
end;

procedure TGraphicData.SaveGraphicToStream(ABitmap: TBitmap; AStream: TStream);
var
TempStream: TMemoryStream;
Cnt: Int64;
begin
if Assigned(ABitmap) then
begin
  TempStream := TMemoryStream.Create;
  try
    ABitmap.SaveToStream(TempStream);
    TempStream.Position := 0;
    Cnt := TempStream.Size;

    AStream.Write(Cnt, SizeOf(Cnt));
    AStream.CopyFrom(TempStream, Cnt)

  finally
    TempStream.Free;
  end;
end;
end;


Так у меня все работает =))) Но мне еще не понятно правильно ли я сделал эти процедуры, вроде как определять ничего не надо... присвоить и все:


procedure TGraphicData.SetPictureBottom(const Value: TBitmap);
begin
 FPictureBottom.Assign(Value);
end;

procedure TGraphicData.SetPictureTop(const Value: TBitmap);
begin
 FPictureTop.Assign(Value);
end;


---

← →
Дмитрий_177   (2006-04-09 17:48) [16]

И еще у меня еще вопросик возник, причем из интереса... Вот правда не знаю, даже книгу почитал и всеравно плохо понимаю...=((( Почему мы destructor Destroy; перекрываем "override - ом" а constructor Create; нет? я как понял что тоже надо, вроде как потомок класса TObject... А еще если такая будет ситуация, допустим мы захотим создать новый класс родителем которого будет "TPoints" и добавить туда какое-нибудь свойство например тоже изображение типа TBitmap. Как надо определять новый класс?

TNewPoints = class(TPoints)
private
  FBmp: TBitmap;
  procedure SetBmp(const Value: TBitmap);
protected
  procedure SaveToStream (AStream: TStream); override;
  procedure LoadFromStream (AStream: TStream); override;     -> надо ли перекрывать? (у меня в TPoints эти процедуры тут, а сохранения в файл вообще нету, т.к. они в TGraphicData)
public
  constructor Create; override;     -> тут тоже, надо ли перекрывать? вот мне больше всего интересно...
  destructor Destroy; override;
  property Bmp: TBitmap read FBmp write SetBmp;
  procedure Clear; override;   -> и тут
end;

implementation
...

constructor TNewPoints.Create;
begin
inherited;
FBmp := TBitmap.Create;  // еще я не очень представляю что бы мы тут писали если добавляли свойство например типа intеger? просто inherited; и все? или вообще "Create" с "Destroy" ненужен бы был?
end;

destructor TNewPoints.Destroy;
begin
FBmp.Free;
inherited;
end;

procedure TNewPoints.SetBmp(const Value: TBitmap);
begin
FBmp.Assign(Value)
end;

procedure TNewPoints.Clear; // помоему вообще зря перекрываю... по идее ненадо...
begin
inherited;
//FBmp.Free   -> Я думаю так не правильно т.к. разрушит класс в памяти, и при последующей загрузке изображения выдаст ошибку, надо какнибудь просто очистить FBmp, а как не знаю...=((( Или надо убивать а потом создавать заново?
end;

procedure TNewPoints.SaveToStream (AStream: TStream);
var
TempStream: TMemoryStream;
Cnt: Int64;
begin
inherited; -> помоему обязательно нужно написать (чтобы точки из TPoints сохранились)

if Assigned(FBmp) then
begin
 TempStream := TMemoryStream.Create;
 try
   FBmp.SaveToStream(TempStream);
   TempStream.Position := 0;
   Cnt := TempStream.Size;

   AStream.Write(Cnt, SizeOf(Cnt));
   AStream.CopyFrom(TempStream, Cnt)

 finally
   TempStream.Free;
 end;
end;
end;

procedure TNewPoints.LoadFromStream (AStream: TStream);
var
Cnt: Int64;
TempStream: TMemoryStream;
begin
inherited; -> и тут помоему тоже обязательно нужно написать (чтобы точки считались)

if Assigned(FBmp) then
begin
 AStream.Read(Cnt, SizeOf(Cnt));

 TempStream := TMemoryStream.Create;
 try
   TempStream.CopyFrom(AStream, Cnt);
   TempStream.Position := 0;
   FBmp.LoadFromStream(TempStream);
 finally
   TempStream.Free;
 end;
end;
end;

Если что не так поправьте меня пожалуйста и подскажите по вопросам которые я задал в тесте программы...

---

← →
Джо ©   (2006-04-10 02:19) [17]

> Почему мы destructor Destroy; перекрываем "override - ом"
> а constructor Create;

Потому, что у потомка деструктор объявлен виртуальным, а деструктор — нет. См. исходный текст класса TObject:
 TObject = class
   constructor Create;
   ...
   destructor Destroy; virtual;
 end;


> -> надо ли перекрывать?

Нет, ибо у потомка (TPoints) они не виртуальные. Объяви их virtual, исходный текст тебе на что даден? :)

В общем, серьезно, почитай об основах ООП, потому, что так можно мучаться этими вопросами постоянно. :)

---

← →
Джо ©   (2006-04-10 02:20) [18]

> Потому, что у потомка деструктор

Потому, что у потомка конструктор.
Сорри за опечатку.

---

← →
Джо ©   (2006-04-10 02:21) [19]

Всё, я спать, приехали :( Короче, то, что я хотел сказать, видно из приведенного исходного текста.

---

← →
Дмитрий_177   (2006-04-11 02:28) [20]

Значит можно и без "virtual" и без "override" обойтись? как это сделано в конструкторе Create =))) Просто:

constructor TPoints.Create;
begin
inherited;
FList := TList.Create;
end;

или с конструктором особый случай?

А еще я так и не понял как мне очищать изображение =( надо разрушить его "Free" а потом заново создать? А можно например так? FBmp := nil; или какнибудь так?

---

← →
Дмитрий_177   (2006-04-11 16:07) [21]

и еще у меня маленькие вопросики, надеюсь что последние...
1: типы TFont, TRect, String как надо сохранять и считывать? нужно как в сохранении сохранять размер или нет?

2: в этих же типах TFont, TRect, String в процедуре Set... нужно ли писать "const" в скобоках перед Value: "тип"?

3: если мы создаем свой класс в котором все переменные например Integer, нужно ли конструктор писать или ненадо? или нужно хотябы так написать?

constructor TMyClass.Create;
begin
inherited;
end;

---

← →
Джо ©   (2006-04-11 16:17) [22]

> [21] Дмитрий_177   (11.04.06 16:07)

1. Для string нужно. Для TFont вообще нужно отдельное сохранение писать, у него нет SaveToStream.

2. Да, в общем, без разницы.

3. Какой смысл в пустом конструкторе?

---

← →
Джо ©   (2006-04-11 16:22) [23]

Вообще, возможно, есть смысл немного перепроектировать, раз такое большое кол-во разнородных данных приходится писать/восстанавливать. Можно сделать наследника TComponent с published-свойствами. Тогда можно будет воспользоваться стандартными возможностями TStream.WriteComponent & ReadComponent.

---

← →
Дмитрий_177   (2006-04-11 16:36) [24]

а вот так непойдет TFont сохранять и загружать? AStream.Write(FFont,SizeOf(TFont)); AStream.Read(FFont, SizeOf(FFont));

А еще что скажете по поводу Дмитрий_177   (11.04.06 02:28) [20]?

---

← →
Джо ©   (2006-04-11 16:43) [25]

> [24] Дмитрий_177   (11.04.06 16:36)
> а вот так непойдет TFont сохранять и загружать? AStream.Write(FFont,
> SizeOf(TFont)); AStream.Read(FFont, SizeOf(FFont));

Не пойдет ни в коем разе. Тебе нужно разобраться с понятиями класса, объекта и т.д. Т.е, таки почитать литературу по языку.


> А еще что скажете по поводу Дмитрий_177   (11.04.06 02:28)
> [20]?

А что тут сказать? Читай книгу, справку. На предмет ООП и его реализации в Делфи.
По поводу "надо разрушить его "Free" а потом заново создать" — не обязательно. Если класс графики не меняется, то нужно
1. В конструкторе создавать экземпляр TBitmap.
2. В деструкторе его разрушать.
3. В методе Set... делать не :=, а Assign.

---

← →
Дмитрий_177   (2006-04-11 16:51) [26]

Спасибо Джо, буду разбираться с классами и объектами... и думать как TFont сохранять =)))

---

← →
Дмитрий_177   (2006-04-11 18:07) [27]

Почитал... Если честно как сохранять TFont я так и не понял... наверно надо так: отдельно сохранять название шрифта, его размер и т.д... а потом все это считывать и присваивать TFont =))) И еще, если в string нужно и размер сохранять... а в чем ненужно? ведь строку то небольшую сохранять буду... может ShortString или Char?

---

← →
Alarm ©   (2006-04-11 18:14) [28]

Дмитрий_177 < - > Джо

Ну очень интересная переписка
И ведь какой день подряд. Можно было бы организовать это и другими способами:(

---

← →
Джо ©   (2006-04-11 18:27) [29]

> [28] Alarm ©   (11.04.06 18:14)
> Дмитрий_177 < - > Джо
>
> Ну очень интересная переписка

Рад, что вам понравилась.


> И ведь какой день подряд. Можно было бы организовать это
> и другими способами:(

Нет, нельзя. Я не даю бесплатных консультаций по e-mail (c) кто-то из здешних.

---

← →
Дмитрий_177   (2006-04-11 19:33) [30]

Ну так что насчет Дмитрий_177   (11.04.06 18:07) [27]? Мне это очень важно сейчас...

---

← →
Джо ©   (2006-04-11 19:36) [31]

> [27] Дмитрий_177   (11.04.06 18:07)
> Почитал... Если честно как сохранять TFont я так и не понял...
> наверно надо так: отдельно сохранять название шрифта, его
> размер и т.д... а потом все это считывать и присваивать
> TFont =)))

Да.


> И еще, если в string нужно и размер сохранять... а в чем
> ненужно? ведь строку то небольшую сохранять буду... может
> ShortString или Char?

Да, если ShortString, то, конечно, длину сохранять не нужно, она известна заранее.

---

← →
Дмитрий_177   (2006-04-11 19:55) [32]

спасибо большое за помощь =)))

---

← →
Дмитрий_177   (2006-04-12 00:40) [33]

У меня опять как всегда появился еще один вопрос... Со шрифтом я справился но.. есть одно но... Вдруг на компъютере пользователя не окажется такого шрифта, вот я решил еще в файл записывать сам файл шрифта:

type
 TMyFile = class
 private
   FFileFont: TMemoryStream;
   procedure SetFileFont(const Value: TFileStream);
 protected
   procedure SaveToStream (AStream: TStream);
   procedure LoadFromStream (AStream: TStream);
 public
   property FileFont: TFileStream read FFileFont write SetFileFont;
   procedure SaveToFile (AFileName: string);
   procedure LoadFromFile (AFileName: string);
 end;

implementation

constructor TMyFile.Create;
begin
 inherited;
 FFileFont := TMemoryStream.Create;
end;

destructor TMyFile.Destroy;
begin
 FFileFont.Free;
 inherited;
end;

procedure TMyFile.SetFileFont(const Value: TFileStream);
begin
 FFileFont.LoadFromStream(Value)
end;

procedure TMyFile.SaveToStream (AStream: TStream);
var
 Cnt: Int64;
begin
 FFileFont.Position := 0;
 Cnt := FFileFont.Size;

 AStream.Write(Cnt, SizeOf(Cnt));
 AStream.CopyFrom(FFileFont, Cnt);
end;

procedure TMyFile.LoadFromStream (AStream: TStream);
var
 Cnt: Int64;
begin
 AStream.Read(Cnt, SizeOf(Cnt));
 FFileFont.CopyFrom(AStream, Cnt);
end;


Вот так правильно будет? Подскажите пожалуйста еще с этим...

---

← →
Дмитрий_177   (2006-04-12 11:56) [34]

Название темы уже не соответствует разговору... Создам новую тему.

---

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

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

Наверх

Память: 0.62 MB
Время: 0.027 c