Gemme objekter

Du kan gemme et Object\'s Published property\'es ( dette er hvad delphi gør med dinne form\'s ) dvs fra TPersistent til TComponent osv. kan du gemme propertyes med de indbyggede funtioner WriteComponent, WriteComponentRes dem kan du finde i hjælpen, det virker fint, jeg lavede en gang en \"ren\" obj. base ( et lille tlf kartotek ), som tilpassede sig DataObj. så hvis jeg skulle bruge et nyt felt lavede jeg bare en ny property på min dataobj så virkede det.

/Martin

Kan du give et kort eksempel på hvordan den kunne gøres, for jeg tror det er det jeg har brug for.

Men kræver det du siger ikke at dit objekt nedarver fra Tcomponent, for jeg ville gerne \"starte\" min egen, hvis du forstår

TPersistent er den du skal nedarve fra, det kan du også godt uden problemmer ( her er to unit du kan se nogle af principerne i ):

unit SmartCardClassU1;

interface

uses
  Windows, Messages, SysUtils, Classes;

type
  TCardData = class(TComponent)
  private
    FMrk: Boolean;
    FFax: String;
    FMobil: String;
    FArbTlf: String;
    FZip: String;
    FName: String;
    FTlf: String;
    FAdr: String;
    FCity1: String;
    FCity2: String;
    FCity3: String;
    FInfo: String;
    FGrp: String;
    FEMail1: String;
    FEMail2: String;
    procedure SetAdr(const Value: String);
    procedure SetArbTlf(const Value: String);
    procedure SetFax(const Value: String);
    procedure SetMobil(const Value: String);
    procedure SetMrk(const Value: Boolean);
    procedure SetFName(const Value: String);
    procedure SetTlf(const Value: String);
    procedure SetZip(const Value: String);
    procedure SetCity1(const Value: String);
    procedure SetCity2(const Value: String);
    procedure SetCity3(const Value: String);
    procedure SetEMail1(const Value: String);
    procedure SetEMail2(const Value: String);
    procedure SetGrp(const Value: String);
    procedure SetInfo(const Value: String);
  protected
  public
    constructor CreateEx( AOwner : TComponent; AID : Integer );
  published
    property Grp : String read FGrp write SetGrp;
    property City1 : String read FCity1 write SetCity1;
    property City2 : String read FCity2 write SetCity2;
    property City3 : String read FCity3 write SetCity3;
    property EMail1 : String read FEMail1 write SetEMail1;
    property EMail2 : String read FEMail2 write SetEMail2;
    property Info : String read FInfo write SetInfo;
    property Name : String read FName write SetFName;
    property Adr : String read FAdr write SetAdr;
    property Zip : String read FZip write SetZip;
    property Tlf : String read FTlf write SetTlf;
    property Mobil : String read FMobil write SetMobil;
    property Fax : String read FFax write SetFax;
    property ArbTlf : String read FArbTlf write SetArbTlf;
    property Mrk : Boolean read FMrk write SetMrk;
  end;

implementation

{ TCardData }

constructor TCardData.CreateEx(AOwner: TComponent; AID: Integer);
begin
  inherited Create(AOwner);
  Tag := AID;
end;

procedure TCardData.SetAdr(const Value: String);
begin
  FAdr := Value;
end;

procedure TCardData.SetArbTlf(const Value: String);
begin
  FArbTlf := Value;
end;

procedure TCardData.SetFax(const Value: String);
begin
  FFax := Value;
end;

procedure TCardData.SetGrp(const Value: String);
begin
  FGrp := Value;
end;

procedure TCardData.SetInfo(const Value: String);
begin
  FInfo := Value;
end;

procedure TCardData.SetMobil(const Value: String);
begin
  FMobil := Value;
end;

procedure TCardData.SetMrk(const Value: Boolean);
begin
  FMrk := Value;
end;

procedure TCardData.SetFName(const Value: String);
begin
  FName := Value;
end;

procedure TCardData.SetTlf(const Value: String);
begin
  FTlf := Value;
end;

procedure TCardData.SetZip(const Value: String);
begin
  FZip := Value;
end;

procedure TCardData.SetCity1(const Value: String);
begin
  FCity1 := Value;
end;

procedure TCardData.SetCity2(const Value: String);
begin
  FCity2 := Value;
end;

procedure TCardData.SetCity3(const Value: String);
begin
  FCity3 := Value;
end;

procedure TCardData.SetEMail1(const Value: String);
begin
  FEMail1 := Value;
end;

procedure TCardData.SetEMail2(const Value: String);
begin
  FEMail2 := Value;
end;

end.

-----------------------------------
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SmartCardClassU1;


type
  TCryptMode = (cmNormal,cmCrypt);

  TCardCollection = class(TComponent)
  private
    FCards : TList;
    FFileMode : TCryptMode;
    FCrypt: TCryptMode;
    function  GetCards(Index: Integer): TCardData;
    procedure SetCards(Index: Integer; const Value: TCardData);
    procedure SetCrypt(const Value: TCryptMode);
    function  GetCardsCount: Integer;
  protected
  public
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;

    function  AddCard( ACardData : TCardData ) : Integer;
    procedure DelCard( ACardID : Integer );

    procedure LoadFromFile( AFileName : String );
    procedure SaveToFile( AFileName : String );
    function  IndexOf( ID : Integer ) : Integer;
    property  Cards[ Index : Integer ] : TCardData read GetCards write SetCards; default;
    property  CardsCount : Integer read GetCardsCount;
    property  Crypt : TCryptMode read FCrypt write SetCrypt;
  published
  end;

implementation

{ TCardCollection }

function TCardCollection.AddCard(ACardData: TCardData): Integer;
begin
  Result := FCards.Add(ACardData);
end;

constructor TCardCollection.Create(AOwner: TComponent);
begin
  FCards := TList.Create;
end;

procedure TCardCollection.DelCard( ACardID : Integer );
begin
  ACardID := IndexOf(ACardID);
  if ACardID <> -1 then FCards.Delete(ACardID);
end;

destructor TCardCollection.Destroy;
begin
  FCards.Free;
end;

function TCardCollection.GetCards(Index: Integer): TCardData;
begin
  Result := TCardData(FCards[Index]);
end;

function TCardCollection.GetCardsCount: Integer;
begin
  Result := FCards.Count;
end;

function TCardCollection.IndexOf( ID : Integer ) : Integer;
begin
  if FCards.Count > 0 then
  begin
      Result := 0;
      while ( Result < FCards.Count-1 ) and ( TCardData(FCards[Result]).Tag <> ID ) do Inc(Result);
      if TCardData(FCards[Result]).Tag <> ID then Result := -1;
  end else Result := -1;
end;

procedure TCardCollection.LoadFromFile(AFileName: String);
VAR
  F  : TFileStream;
  Cnt : Integer;
  B  : TCardData;
begin
  if not FileExists(AFileName) then EXIT;
  F := TFileStream.Create(AFileName,fmOpenReadWrite + fmShareExclusive);
  F.Read(Cnt,SizeOf(Cnt));
  FCards.Capacity := Cnt;
  while Cnt > 0 do
  begin
      B := TCardData.Create(Self);
      FCards.Add(B);
      F.ReadComponentRes(B);
      Dec(Cnt);
  end;
  F.Free;
end;

procedure TCardCollection.SaveToFile(AFileName: String);
VAR
  F  : TFileStream;
  Cnt : Integer;
begin
  F := TFileStream.Create(AFileName,fmCreate);
  Cnt := FCards.Count;
  F.Write(Cnt,SizeOf(Cnt));
  for Cnt := 0 to FCards.Count-1 do F.WriteComponentRes(IntToStr(Cnt),TCardData(FCards[Cnt]));
  F.Free;
end;

procedure TCardCollection.SetCards(Index: Integer; const Value: TCardData);
begin
  FCards[Index] := Value;
end;

procedure TCardCollection.SetCrypt(const Value: TCryptMode);
begin
  if FCrypt <> Value then
  begin
      FCrypt := Value;
      if FCrypt <> FFileMode then
      begin
        case FCrypt of
          cmNormal : ;//Decrypt the DataList and Datafile
          cmCrypt  : ;//Crypt the DataList and Datafile
        end;(* case *)
      end;
  end;
end;

end.
---------------------------------------

/Martin

I dag ville jeg nok vælge at lave TCardCollection som en TCollection i stedet for en TComponent, med ellers er det ok.

Du kan også bruge en TList til formålet det plejer jeg at gøre ...

Jens B

borrisholt >>

Her du fanget at det er til en fil jeg vil gemme, for det kan man da ikke direkte fra en TList

poull >> det var nok min komentar til TCollection han mente, men jeg har faktisk gjort som han skriver i mit eks. hvis du kigger efter har jeg også brugt en TList.

Men jeg har også benyttet mig at TStream.WriteComponentRes, 
TStream.ReadComponentRes
og det virker fint, så jeg vil anbefale dig at prøve at lege lidt med det.

/Martin

poull >> Nej ikke direkte fra en TList ...  Jeg kan nemt skrive dig en Tlist der har persistens ...

Jens B

borrisholt >>
Det ville utrolig gerne have :)
Det er måske bedere at bruge persistens som udgangspunkt til sine klasser end TComponent?

alle >>
Jeg har endnu et spg: Hvis min TListe Indholder objekter der kan være to forskellige klasser, men de har begge TComponent som \"fader\", hvordan kan jeg så finde ud af om det er den ene eller anden klasse. (Er i med?)

jeg giver 10 point for det sidste lille spg

Brug IS og AS :

if MyObj IS TMyComp1 then
begin
end else
if MyObj IS TMyComp2 then
begin
end;

Men jeg vil nu stadig anbefale MIN løsning, da den selv finder ud af at gemme dine props, også hvis du tilføjer en ny, så skal du ikke ændre EN eneste line i Save og Load funktionerne, det er lidt smart efter min mening, og det kører faktisk også temmelig hurtigt, 100.000 rec tog ikke mange sek. at Loade eller Save, og du har jo faktisk fået skallen med det jeg har vist dig.

til komponenter ol er martins løsning smarter ....

Hvis du der imod har en record, fx

Tuser  = record
  Name : String;
  Age : Int64; //Folk bliver gamle nu om dage
End;

så er en TList afgjort at foretrække ....

Jens B

JB >> Både ja og nej, fordelen ved at pakke din record ind er jo automatiken hvis du udvider

/Martin

martinlind >>
Du siger IS og AS, men i det eksempel du giver bruger du IS. Kommer det ud på et hvad man bruger?

borrisholt >>
Du siger at en Tlist er at fortrække, men det er jo også det martinlind bruger eller?

alle >>
Er TComponent den ideele forfæder eller kan man lige så godt bruge TPersistent?

Kan man godt kombinere records og klasser i samme TList

TComponent skal du faktisk kun bruge hvis du gerne vil havde DesignTime faciliteter.

IS og AS er Safe TypeCast dvs. at IS spørger om det ER sådan en classe og AS \"laver om\" til sådan en class.

Du kan ikke umidelbart kombinere en record og klasse, da det er to forskellige måder at gemme data på.

/Martin

if MyObj IS TMyClass then
begin
// Safe
  (MyObj as TMyClass).MyProperty := \'Hej Du\';
// not Safe
  TMyClass(MyObj).MyProperty := \'Hej Du\';
end;

Martin >> kan og kan ..... kkan ikke er det ikke et stort ord at bruge ... Både du og jeg kunne lave et enromt grimt hack der kombinere records og klasser i samme TList  ... ikke ? Det er brud på god skik og orden men man kan !!!

Jens B

Ja man kan jo ALT, meeeen... Jeg giver dig ret. *S*

Nu jeg tænker nærmere over det vidste jeg faktisk godt det der med IS og AS, men pyt

Jeg har lavet et lille testprogram for nu at se om jeg forstod det, men det virker:(Håber ikke det er for meget kode)

unit Unit1;

interface

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

type
  TKlasse1 = class(TComponent)
  private
    TekstIndhold: String;
  end;

  TKlasse2 = class(TComponent)
  private
    talIndhold: Integer;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Liste: TList;

procedure TilfojKlasse(EnComponent: TComponent);

implementation

{$R *.DFM}

procedure TilfojKlasse(EnComponent: TComponent);
begin
  Liste := TList.Create;
  Liste.Add(EnComponent);
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  Klasse1: TKlasse1;
  Klasse2: TKlasse2;
begin
  Klasse1 := TKlasse1.Create(self);
  Klasse2 := TKlasse2.Create(self);

  Klasse1.TekstIndhold := \'Poul\';
  Klasse2.TalIndhold := 123;

  TilfojKlasse(Klasse1);
  TilfojKlasse(Klasse2);

  Button1.Caption := Klasse1.TekstIndhold + \' er \' + IntToStr(Klasse2.TalIndhold);
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
  Klasse1: TKlasse1;
  Klasse2: TKlasse2;
  I: Integer;
begin
  I := Pred(Liste.Count);
  While I >= 0 do
    begin
      if Liste[I] is TKlasse1 then
        Klasse1 := TKlasse1(Liste[I])
      else
        Klasse2 := TKlasse2(Liste[I])
    end;
  Button2.Caption := Klasse1.TekstIndhold + \' er \' + IntToStr(Klasse2.TalIndhold);
end;

end.


Dette skulle bare gemme det i listen og så hente det igen

Ups jeg mener at det IKKE virker

procedure TForm1.Button2Click(Sender: TObject);
Var
  Klasse1: TKlasse1;
  Klasse2: TKlasse2;
  I: Integer;
begin
//  I := Pred(Liste.Count);
//  While I >= 0 do
for I := 0 to Liste.Count-1 do
    begin
      if Liste[I] is TKlasse1 then
        Klasse1 := TKlasse1(Liste[I])
      else
        Klasse2 := TKlasse2(Liste[I])
    end;
  Button2.Caption := Klasse1.TekstIndhold + \' er \' + IntToStr(Klasse2.TalIndhold);
end;

Det burde virke

Martin

Jeg tjekker lige, men så vidt jeg lige kan se er det eneste du har ændret er fra en while-lykke til en for-lykke eller?

Elles siger jeg mange tak for den hurtige og effiktive svartid.

Ja fordi du har glemt at tælle din I ned, da du kører i en løkke indtil I >= 0 men du dec ikke så den looper vel

Nå, men jeg kunne compilere det for den kom med denne fejl:
Operator not applicable to this operand type
(og det gør den også med din kode)

Så det kunen tyde på at man ikke kunne bruge is her, for hvis jeg erstatter Liste[I] med klasse1 som er den lokale variable virker det, så skal man tage hensyn til at det er en TListe?

Ja det er fordi din Liste[I] ikke er en TObject men en Pointer og IS og AS er class operatorer, det er også det den siger til dig.

/Martin

Hvorledes kan jeg jeg så bruge en TListe? Er det noget med bare at skrive Liste[I]^ eller?

Jep, hvis du tager hjælp ( F1 ) på en TList kan du se hvordan den er skruet sammen, kig på TObjectList og de andre også TStringList er meget brugt og god at kende som sin egen bukselomme :)

Du kan også godt gemme et TObject i en TList fordi en Object forekomst er lig med en pointer

Jo men selv om jeg forstår det der i hjælp er jeg aldrig helt sikker når det angår pointere.
Det kan være jeg skal bruge TObjectList istedet for TList da jeg ikke er så glad for noget med pointere ;]

Ok jeg prøver lige koden

Selv om jeg har ændret lidt i koden (til brug af AS) virker det ikke:
procedure TForm1.Button2Click(Sender: TObject);
Var
  Klasse1: TKlasse1;
  Klasse2: TKlasse2;
  I: Integer;
begin
  for I := 0 to Liste.Count-1 do
    begin
      if Liste[I]^ is TKlasse1 then
        Klasse1 := (Liste[I]^ as TKlasse1)
      else
        Klasse2 := (Liste[I]^ as TKlasse2);
    end;
  Button2.Caption := Klasse1.TekstIndhold + \' er \' + IntToStr(Klasse2.TalIndhold);
end;

begin
  for I := 0 to Liste.Count-1 do
    begin
      if TObject(Liste[I]^) is TKlasse1 then
        Klasse1 := (TObject(Liste[I]^) as TKlasse1)
      else
        Klasse2 := (TObject(Liste[I]^) as TKlasse2);
    end;
  Button2.Caption := Klasse1.TekstIndhold + \' er \' + IntToStr(Klasse2.TalIndhold);

Jeg har ikke lige delphi kørende, med det må være noget i den stil der skal til, men brug TObjectList i stedet eller TStringList, den har en Items[I] som er string og Objects[I] som er TObject, så hver Items har sin egen Object, kan bruges til mange ting, hvor man har brug for noget tekst og noget andet ( en Object ref. eller en record pointer ). Jeg prøver at få tid til et lille eks. på Delphi-kursus siden en af dagende, hvis det kan lade sig gøre.

Det kunne jeg være meget interesseret i, men hvad er det for en side.

jeg skal nok lige teste det du skriver.

Det er bedere end den tidligere kode, da jeg nu kan compilere mit program, men der kommer en af disse der access violations og man ved ikke hvad der er galt.
Selv om der ikke ville være dette problem med TObjectList (hvilket jeg så vil bruge frem over) kunne det være rart hvis du lige som den sidste ting hjalp med at få det med tList til at virke.

Nåmen pyt hvis du ikke lige ved det sidste spg, for jeg har jo fået svar på det jeg ville.

Mange tak