-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathstreambase.pas
More file actions
128 lines (99 loc) · 3.18 KB
/
streambase.pas
File metadata and controls
128 lines (99 loc) · 3.18 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
{
/***************************************************************************
streambase.pas
--------------
***************************************************************************/
*****************************************************************************
This file is part of the Lazarus packages by Andreas Jakobsche
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
{ |Subversion-Dokumentation
|------------------------
|$Date: 2018-01-08 15:28:51 +0100 (Mo, 08 Jan 2018) $ (letzter Aenderungszeitpunkt)
|$Revision: 2607 $ (letzter geaenderte Revision)
|$Author: andreas $ (letzter Autor)
|$HeadURL: svn://martina:3691/Lazarus/packages/streams/streambase.pas $ (Archivadresse)
|$Id: streambase.pas 2607 2018-01-08 14:28:51Z andreas $ (eindeutige Dateikennzeichnung)
}
unit StreamBase;
{$mode objfpc}{$H+}
interface
uses
Classes;
const
FilerBufferSize = 1024;
type
{ TRegisteredComponentReader }
TRegisteredComponentReader = class(TReader)
public
procedure FindComponentClass(Reader: TReader; const AClassName: string;
var ComponentClass: TComponentClass); virtual;{Klasse aus dem Klassennamen
ermitteln, z.B. aus der mit RegisterForStreaming erstellten Liste,
eventuell nicht nötig bei binärem Speichern}
end;
{ TStreamableClasses }
TStreamableClasses = class(TList)
private
function GetClasses(AClassName: string): TComponentClass;
procedure SetClasses(AClassName: string; AValue: TComponentClass);
public
destructor Destroy; override;
public
property Classes[AClassName: string]: TComponentClass read GetClasses
write SetClasses; default;
end;
var
StreamableClasses: TStreamableClasses;
implementation
type
TStreamableClass = record
Name: string;
ClassRef: TComponentClass;
end;
PStreamableClass = ^TStreamableClass;
{ TStreamableClasses }
function TStreamableClasses.GetClasses(AClassName: string): TComponentClass;
var i: Integer;
begin
for i := 0 to Count - 1 do
if AClassName = PStreamableClass(Items[i])^.Name then begin
Result := PStreamableClass(Items[i])^.ClassRef;
Exit
end;
Result := nil
end;
procedure TStreamableClasses.SetClasses(AClassName: string;
AValue: TComponentClass);
var
x: PStreamableClass;
i: Integer;
begin
for i := 0 to Count - 1 do
if PStreamableClass(Items[i])^.Name = AClassName then begin
PStreamableClass(Items[i])^.ClassRef := AValue;
Exit
end;
x := New(PStreamableClass);
x^.Name := AClassname;
x^.ClassRef := AValue;
Add(x)
end;
destructor TStreamableClasses.Destroy;
var i: Integer;
begin
for i := 0 to Count - 1 do
if Items[i] <> nil then Dispose(PStreamableClass(Items[i]));
inherited Destroy;
end;
procedure TRegisteredComponentReader.FindComponentClass(Reader: TReader;
const AClassName: string; var ComponentClass: TComponentClass);
begin
ComponentClass := StreamableClasses[AClassName]
end;
initialization
StreamableClasses := TStreamableClasses.Create;
finalization
StreamableClasses.Free;
end.