ich habe ein Problem mit meinen Klassen.
Ich erzeuge ein Objekt der Klasse TAkte (cuakten). Hierin enthalten ist eine Objektliste Akte.Adressen aus TAktenAdressen.
Das erstmalige Einlesen funktioniert.
Wenn ich ButtonAdresseZuweisen betätige, wird eine Adressliste aufgerufen und einige Daten der Adresse (das ist eine andere Klasse!) zu Akte.Adressen geadded.
Ich habe eine Ausgabe über writeline, welche mir die neue Adresse mit anzeigt. So weit - so gut.
Sobald ich aber die procedure TAktenEditor.btnAdtresseZuweisenClick verlasse (z.B. durch InitGridAdressen) ist die neu zugewiesene Akte.Adresse aber nicht mehr da.
Anm. 1: der Quellcode ist stark gekürzt!
Anm. 2: Die Klassen funktionieren unabhängig voneinander, das Problem ist nur mit Adressen in der Akte,
Code: Alles auswählen
unit fuakteneditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, Grids, ComCtrls,
cuakte, cuaktenstatus, cudokument, cuhistorie, cuaktenadresse, cuadresse, fuadressauswahl, Types;
type
{ TAktenEditor }
TAktenEditor = class(TForm)
...
procedure btnAdtresseZuweisenClick(Sender: TObject);
... procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure Init;
procedure FillAktenStatus;
procedure InitGridAktenAdresse;
. public
procedure GetAkte;//(Akte: TAkte);
procedure SetAkte;//(Akte: TAkte);
protected
function GetHistorienIndex: integer;
function GetCellText(ACol, ARow: integer): string;
end;
var
AktenEditor: TAktenEditor;
AktenstatusListe: TAktenstatusListe;
Adresse: TAktenAdresse;
AktenAdressListe: TAktenAdressListe;
Akte: TAkte; //aus Verzweiflung hier platziert, war zuvor unter Private
function CallAktenEditor(A: TAkte): integer;
function CallNewAktenEditor: integer;
implementation
{ CallAktenEditor }
function CallAktenEditor(A: TAkte): integer; //Hier wird eine zuvor gewählte Akte übergeben. Akte.Adressen ist noch nicht mit Daten gefüllt!
var
F: TAktenEditor;
i: integer;
begin
F := TAktenEditor.Create(nil);
try
F.Position := poMainFormCenter;
Akte := TAkte.Create;
Akte := A;
Akte.FillAdressen;
F.SetAkte;//(Akte);
if F.ShowModal = mrOk then
begin
F.GetAkte;//(Akte); // Hier geht die neue Adresse verloren
// TODO: Delete this
for i := 0 to Akte.Adressen.Count - 1 do
writeln(IntToStr(Akte.Adressen.Items[i].ID) + ' get Akte ' + Akte.Adressen.Items[i].Adresszeile);
Akte.WriteAndGetID(Akte);
Akte.Adressen.WriteListData(Akte.ID);
Result := Akte.ID;
end;
finally
FreeAndNil(Akte);
F.Free;
end;
end;
...
{$R *.frm}
{ TAktenEditor }
...
procedure TAktenEditor.btnAdtresseZuweisenClick(Sender: TObject);
var
A: TAdresse;
TempObj: TAktenAdresse;
s: string;
i: integer;
begin
if ListeAdresse(A) then
begin
//TODO: Aktenadresse eintragen
TempObj := TAktenAdresse.Create;
TempObj.ID := 0;
TempObj.IDAdresse := A.iD;
TempObj.IDAdressart := A.IDAdressArt;
s := A.Anrede + ' ' + A.Vorname + ' ' + A.FirmaZuname + ' ' + A.Firma2;
TempObj.Adresszeile := s;
TempObj.Zeichen := 'Abc';
Akte.Adressen.Add(TempObj);
FreeAndNil(TempObj);
// Hier scheint alles OK, die neue Adresse ist angebunden
// TODO: Delete this
for i := 0 to Akte.Adressen.Count - 1 do
writeln(IntToStr(Akte.Adressen.Items[i].ID) + ' Adresse übernommen ' + Akte.Adressen.Items[i].Adresszeile);
InitGridAktenAdresse;
end;
end;
...
{ FormCreate }
procedure TAktenEditor.FormCreate(Sender: TObject);
begin
AktenAdressListe := TAktenAdressListe.Create();
AktenstatusListe := TAktenstatusListe.Create();
FillAktenStatus;
end;
{ FormDestroy }
procedure TAktenEditor.FormDestroy(Sender: TObject);
begin
FreeAndNil(AktenAdressListe);
FreeAndNil(AktenstatusListe);
end;
...
{ Akte aus Formular Einlesen }
procedure TAktenEditor.GetAkte;//(Akte: TAkte);
begin
if Akte <> nil then
begin
if cbSstatus.ItemIndex >= 0 then
Akte.IDAktenstatus := PtrUInt(cbSstatus.Items.Objects[cbSstatus.ItemIndex]);
Akte.Nummer := StrToInt(edNummer.Text);
...
Akte.Notiz := memAnmerkungen.Text;
end;
end;
{ Formular Daten Zuweisen }
procedure TAktenEditor.SetAkte;//(Akte: TAkte);
var
AIndex: integer;
Str: string;
begin
if Akte <> nil then
begin
AIndex := cbSstatus.Items.IndexOfObject(TObject(PtrInt(Akte.IDAktenstatus)));
if AIndex >= 0 then
cbSstatus.ItemIndex := AIndex;
edNummer.Text := IntToStr(Akte.Nummer);
...
memAnmerkungen.Text := Akte.Notiz;
//AktenAdressListe.ReadByAktenID(Akte.ID);
InitGridAktenAdresse;
end;
end;
...
end.
Code: Alles auswählen
unit cuakte;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazLogger, DBCtrls, Contnrs, dtm_basis, cuAdresse, cuaktenadresse;
type
{ TAkte }
TAkte = class(TObject)
private
fIsChanged: boolean;
fID: integer;
fIDAktenstatus: integer;
fAktenzeichen: string;
fJahr: integer;
fNummer: integer;
fSache: string;
fGrund: string;
fNotiz: string;
{ Nur lesen aus AkteStatus }
fStatus: string;
{ Nur lesen aus Color }
fIDColor: integer;
fColorn: string;
fColorh: string;
fColornfont: string;
fColorhfont: string;
{ Aktenadressen }
fAdressen: TAktenAdressListe;
public
procedure SetIDAktenstatus(const aValue: integer);
procedure SetAktenzeichen(const aValue: string);
procedure SetJahr(const aValue: integer);
procedure SetNummer(const aValue: integer);
procedure SetSache(const aValue: string);
procedure SetGrund(const aValue: string);
procedure SetNotiz(const aValue: string);
procedure FillAdressen;
procedure CopyFrom(AValue: TAkte);
function WriteAndGetID(AValue: TAkte): integer;
property IsChanged: boolean read fIsChanged write fIsChanged default False;
property ID: integer read fID write fID default -1;
property IDAktenstatus: integer read fIDAktenstatus write SetIDAktenstatus default -1;
property Aktenzeichen: string read fAktenzeichen write SetAktenzeichen;
property Jahr: integer read fJahr write SetJahr;
property Nummer: integer read fNummer write SetNummer;
property Sache: string read fSache write SetSache;
property Grund: string read fGrund write SetGrund;
property Notiz: string read fNotiz write SetNotiz;
{ Nur lesen aus AkteStatus }
property Status: string read fStatus write fStatus;
{ Nur lesen aus Color }
property IDColor: integer read fIDColor write fIDColor;
property Colorn: string read fColorn write fColorn;
property Colorh: string read fColorh write fColorh;
property Colornfont: string read fColornfont write fColornfont;
property Colorhfont: string read fColorhfont write fColorhfont;
property Adressen: TAktenAdressListe read fAdressen write fAdressen;
end;
{ TAktenListe }
TAktenListe = class(TObjectList)
private
procedure ReadListData(Query: string);
function GetItem(AIndex: integer): TAkte;
procedure SetItem(AIndex: integer; const AValue: TAkte);
public
procedure ReadAll;
procedure WriteListData;
procedure DeleteByID(aID: integer);
function IndexOf(aID: integer): integer;
property Items[AIndex: integer]: TAkte read GetItem write SetItem; default;
end;
var
AktenListe: TAktenListe;
implementation
{ TAktenListe }
function TAktenListe.GetItem(AIndex: integer): TAkte;
begin
Result := TAkte(inherited Items[AIndex]);
end;
procedure TAktenListe.SetItem(AIndex: integer; const AValue: TAkte);
begin
TAkte(inherited Items[AIndex]).CopyFrom(AValue);
end;
{ TAkte }
...
initialization
AktenListe := TAktenListe.Create;
finalization
AktenListe.Free;
end.
Code: Alles auswählen
unit cuaktenadresse;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazLogger, DBCtrls, Contnrs, dtm_basis;
type
{ TAktenAdresse }
TAktenAdresse = class(TObject)
private
fIsChanged: boolean;
fID: integer;
fIDAdressart: integer;
fIDAdresse: integer;
fIDKontakt: integer;
fIDAkte: integer;
fPosition: integer;
fZeichen: string;
{ Nur lesen }
fAdresszeile: string;
fAdressart: string;
{ Nur lesen aus Color }
fIDColor: integer;
fColorn: string;
fColorh: string;
fColornfont: string;
fColorhfont: string;
public
procedure SetIDAdressart(const aValue: integer);
procedure SetIDAdresse(const aValue: integer);
procedure SetIDKontakt(const aValue: integer);
procedure SetIDAkte(const aValue: integer);
procedure SetPosition(const aValue: integer);
procedure SetZeichen(const aValue: string);
procedure CopyFrom(AValue: TAktenAdresse);
property IsChanged: boolean read fIsChanged write fIsChanged default False;
property ID: integer read fID write fID default -1;
property IDAdressart: integer read fIDAdressart write SetIDAdressart;
property IDAdresse: integer read fIDAdresse write SetIDAdresse;
property IDKontakt: integer read fIDKontakt write SetIDKontakt;
property IDAkte: integer read fIDAkte write SetIDAkte;
property Position: integer read fPosition write SetPosition;
property Zeichen: string read fZeichen write SetZeichen;
{ Nur lesen }
property Adresszeile: string read fAdresszeile write fAdresszeile;
property Adressart: string read fAdressart write fAdressart;
{ Nur lesen aus Color }
property IDColor: integer read fIDColor write fIDColor;
property Colorn: string read fColorn write fColorn;
property Colorh: string read fColorh write fColorh;
property Colornfont: string read fColornfont write fColornfont;
property Colorhfont: string read fColorhfont write fColorhfont;
end;
{ TAktenAdressListe }
TAktenAdressListe = class(TObjectList)
private
procedure ReadListData(Query: string);
function GetItem(AIndex: integer): TAktenAdresse;
procedure SetItem(AIndex: integer; const AValue: TAktenAdresse);
public
procedure ReadAll(w: string);
procedure ReadByAktenID(IDAkte: integer);
procedure WriteListData(IDAkte: integer);
procedure DeleteByID(aID: integer);
property Items[AIndex: integer]: TAktenAdresse read GetItem write SetItem; default;
end;
var
AktenAdressListe: TAktenAdressListe;
implementation
{ TAktenAdressListe }
procedure TAktenAdressListe.ReadByAktenID(IDAkte: integer);
var
w: string;
begin
w := 'WHERE fk_akte = ' + IntToStr(IDAkte);
ReadAll(w);
end;
function TAktenAdressListe.GetItem(AIndex: integer): TAktenAdresse;
begin
Result := TAktenAdresse(inherited Items[AIndex]);
end;
procedure TAktenAdressListe.SetItem(AIndex: integer; const AValue: TAktenAdresse);
begin
TAktenAdresse(inherited Items[AIndex]).CopyFrom(AValue);
end;
{ TAktenAdresse }
...
initialization
AktenAdressListe := TAktenAdressListe.Create;
finalization
AktenAdressListe.Free;
end.