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:

unit Mhaupt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, mdialog,mmitglied;

type
  TFHaupt = class(TForm)
    bt_dialog: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    lb_mitglied: TListBox;
    procedure bt_dialogClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  fdialog: Tfdialog;
  mitglied: tmitglied;
  mitgliedliste: Tlist;
  listbox: tlistbox;
    { Private-Deklarationen }
  public
  function getvorname: string;
  function getnachname: string;
  function getgebdatum: string;
  function getnummer: string;

    { Public-Deklarationen }
  end;

var
  FHaupt: TFHaupt;


implementation

{$R *.DFM}
function TFHaupt.getvorname;
begin
     getvorname:= fdialog.edit1.text;
end;

function TFHaupt.getnachname;
begin
     getnachname:= fdialog.edit2.text;
end;

function TFHaupt.getgebdatum;
begin
     getgebdatum:= fdialog.edit3.text;
end;

function TFHaupt.getnummer;
begin
     getnummer:= fdialog.edit4.text;
end;


procedure TFHaupt.bt_dialogClick(Sender: TObject);
begin
     fdialog:= tfdialog.create(SELF);
     fdialog.showmodal;

     edit1.text:= getvorname;
     edit2.text:= getnachname;
     edit3.text:= getgebdatum;
     edit4.text:= getnummer;

     mitglied:= tmitglied.create;
     mitglied.vorname:= getvorname;
     mitglied.nachname:= getnachname;
     mitglied.gebdatum:= getgebdatum;
     mitglied.nummer:=getnummer;
     mitgliedliste.add(mitglied);

    lb_mitglied.items.add(mitglied.nummer+' - '+mitglied.nachname+', '+mitglied.vorname+'('+mitglied.gebdatum+')');
   { mitgliedliste.items[0].savetofile('c:\schule\info\ml.dat'); }
    showmessage(mitglied.vorname+' wurde erfolgreich in die Liste aufgenommen!');

    fdialog.free;

end;

procedure TFHaupt.Button1Click(Sender: TObject);
begin
     close;
end;

procedure TFHaupt.FormCreate(Sender: TObject);
begin
     mitgliedliste:= tlist.create;
     listbox:= tlistbox.create(self);
    { mitgliedliste.items.loadfromfile('Mitgliedliste.dat');  }
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

unit mmitglied;

interface

type
  tmitglied = class(Tobject)
    vorname: string;
    nachname: string;
    gebdatum: string;
    nummer: string;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;


implementation

end.					

1:

[Fehler] Mhaupt.pas(81): Inkompatible Typen: 'String' und 'tmitglied'					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

myList:tstringList;
myList:=tstringList.create;

mitglied:= tmitglied.create; 
mitglied.vorname:= getvorname; 
mitglied.nachname:= getnachname; 
mitglied.gebdatum:= getgebdatum; 
mitglied.nummer:=getnummer;
    
myList.add(mitglied.nummer+' - '+mitglied.nachname+', '
+mitglied.vorname+'('+mitglied.gebdatum+')');
   
myList.saveToFile(...);					

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:

unit mmitglied; 

interface 

type 
  tmitglied = class(TComponent) // TComponent weil es sich mit streams speichern lässt!
    Fvorname: string; 
    Fnachname: string; 
    Fgebdatum: string; 
    Fnummer: string; 
  private 
    { Private-Deklarationen } 
   published // edit
    { Public-Deklarationen }
    SaveToFile(FileName);
    LoadFromFile(FileName);

    property Vorname : string read FVorname write FVorname;
    property Nachname : string read FNachname  write FNachname ;
    .    
    .
    .
  end; 


implementation 

procedure tmitglied.SaveToFile; 
var fs:TFileStream;
begin
  fs:=TFileStream.create(fileName,fmCreate);
  try
    fs.writeComponent(self);
  finally
    fs.free;
  end;
end;

procedure tmitglied.LoadFromFile; 
var fs:TFileStream;
begin
  if not fileExists(filename) then exit;
  fs:=TFileStream.create(fileName,fmOpenRead);
  try
    fs.ReadComponent(self);
  finally
    fs.free;
  end;
end;

end.					

1:

[Fehler] mmitglied.pas(6): Undefinierter Bezeichner: 'TComponent'					

1:
2:

Uses
  Classes;					

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:

...
function SaveCompoToFile(aCompo : TComponent; FileName: string; asBinary: Boolean = false): boolean;
var Stream1:TMemoryStream;
    Stream2:TMemoryStream;
    format : TStreamOriginalFormat;
begin
  result := false;
  format  := sofText;
  Stream1 := TMemoryStream.Create;
  Stream2 := TMemoryStream.Create;
  try
    Stream1.WriteComponent(aCompo);
    Stream1.Position := 0;
    if not asBinary then
    begin
      format := sofText;
      ObjectBinaryToText(Stream1,Stream2,format);
    end else Stream1.SaveToStream(Stream2);
    Stream2.SaveToFile(FileName);
    result := true;
  finally
    Stream1.Free;
    Stream2.Free;
  end;
end;


function LoadCompoFromFile(aCompo : TComponent; FileName: string; asBinary: Boolean = false): boolean;
var FileStream:TFileStream;
    MemoryStream:TMemoryStream;
    format:TStreamOriginalFormat;
begin
  result := false;
  if not FileExists(fileName) then exit;
  MemoryStream := TMemoryStream.Create;
  FileStream := TFileStream.Create(FileName,fmOpenRead);
  try
    if not asBinary then
    begin
      format := sofBinary;
      ObjectTextToBinary(FileStream,MemoryStream,format);
    end else MemoryStream.LoadFromStream(FileStream);
    MemoryStream.Position := 0;
    MemoryStream.ReadComponent(aCompo);
    result := true;
  finally
    FileStream.Free;
    MemoryStream.Free;
  end;
end;					

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:
128:
129:
130:
131:
132:
133:
134:
135:

{-----------------------------------------------------------------------------
 Unit Name : mxService
 Author    : maximus (mäxeus, maxantat, muku)
 Date      : 10.02.2003
-----------------------------------------------------------------------------}
unit mxService;

interface

uses classes, sysUtils, TypInfo, dvRTTI {<-- von www.joachimDeVries.de -} ;

function SaveObjectToFile(aObject : TPersistent; FileName: string; includedProps : String = '*'; filter : TTypeKinds = tkAny): boolean;
function LoadObjectFromFile(aObject : TPersistent; FileName: string; includedProps : String = '*'; filter : TTypeKinds = tkAny): boolean;

procedure CleanSpacesVar(var s:String; inQuotes:boolean=false; QuoteChar: Char = '''');
function CleanSpaces(s:String; inQuotes:boolean=false; QuoteChar:Char = ''''):string;

implementation

function CleanSpaces(s:String; inQuotes:boolean=false; QuoteChar:Char = ''''):string;
var i:integer;
    f:boolean;
begin
  result := s;
  i := 0;
  f := false;
  while i <= length(result) do
  begin
    if not inQuotes and (result[i] = QuoteChar) then f := not f;
    if (result[i] = ' ') and not f then Delete(result,i,1) else inc(i);
  end;
end;

procedure CleanSpacesVar(var s:String; inQuotes:boolean=false; QuoteChar:Char = '''');
var i:integer;
    f:boolean;
begin
  i := 0;
  f := false;
  while i <= length(s) do
  begin
    if not inQuotes and (s[i] = QuoteChar) then f := not f;
    if (s[i] = ' ') and not f then Delete(s,i,1) else inc(i);
  end;
end;

function isWholeWordInString(aWord,s:string; delimiter:char = ','):boolean;
var n,i:integer;
    m:string;
    c1,c2:char;
begin
  result := false;
  m := delimiter+lowercase(s)+delimiter;
  n := pos(lowercase(aWord),m);
  if n <= 0 then exit;
  m := copy(m,n-1,length(m)-n+2);
  c1 := m[1];
  c2 := m[length(aWord)+2];
  if ((c1 = delimiter) or (c1 = ' '))and((c2 = delimiter) or (c2 = ' '))
  then result := true
  else begin
         delete(m,2,length(aWord));
         result := isWholeWordInString(aWord, m, delimiter);
       end;
end;


//----------------------------------------------------------------------------------------


function SaveObjectToFile(aObject : TPersistent; FileName: string; includedProps : String = '*'; filter : TTypeKinds = tkAny): boolean;
var RTTI:TdvRTTIList;
    sl:TSTringList;
    i:integer;
    s,v,name:string;
    All:boolean;
begin
  result := false;
  if aObject = nil then exit;
  All := includedProps = '*';
  RTTI := TdvRTTIList.create(aObject);
  sl := TSTringList.Create;
  try
    RTTI.Filter := filter;
    if aObject is TComponent then name := TComponent(aObject).Name+' : ' else name := '';
    sl.Add('object '+name+aObject.ClassName);
    for i := 0 to RTTI.count-1 do
    begin
      if RTTI.Items[i].PropInfo.StoredProc = nil then continue;
      if not All and not isWholeWordInString(RTTI.Items[i].Name,includedProps) then continue;
      v := RTTI.Items[i].Value;
      if v <> '' then sl.Add('  ' + RTTI.Items[i].Name+' = '+ v);
    end;
    sl.Add('end');
    sl.SaveToFile(fileName);
    result := true;
  finally
    sl.Free;
    RTTI.Free;
  end;
end;

function LoadObjectFromFile(aObject : TPersistent; FileName: string; includedProps : String = '*'; filter : TTypeKinds = tkAny): boolean;
var RTTI:TdvRTTIList;
    sl:TSTringList;
    i:integer;
    s,name:string;
    All : boolean;
begin
  result := false;
  if aObject = nil then exit;
  if not FileExists(fileName) then exit;
  All := includedProps = '*';
  RTTI := TdvRTTIList.create(aObject);
  sl := TSTringList.Create;
  try
    RTTI.Filter := filter;
    sl.LoadFromFile(fileName);
    sl.Text := CleanSpaces(sl.Text);
    for i := 0 to RTTI.count-1 do
    begin
      if RTTI.Items[i].PropInfo.SetProc = nil then continue;
      name := RTTI.Items[i].Name;
      if not All and not isWholeWordInString(name,includedProps) then continue;
      if sl.IndexOfName(name) > -1
      then RTTI[i].Value := sl.Values[name];
    end;
    result := true;
  finally
    sl.Free;
    RTTI.Free;
  end;
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

uses mxService;
...
SaveObjectToFile(self, MyDir+self.Name+'.dmx','top,left,width,height,name,windowstate');
LoadObjectFromFile(self, MyDir+self.Name+'.dmx','top,left,width,height,name,windowstate');
// oder
SaveObjectToFile(self, MyDir+self.Name+'.dmx','*');  // speichert alle
LoadObjectFromFile(self, MyDir+self.Name+'.dmx','*');  // speichert alle
// oder
uses mxService, typInfo;
...
SaveObjectToFile(self, MyDir+self.Name+'.dmx','*', tkInteger); // speichert alle integer props
LoadObjectFromFile(self, MyDir+self.Name+'.dmx','*', tkInteger);