Prozedurzeiger in Record nicht erkannt?

[thosch]

Hallo,

ich habe einen Record:

Code: Alles auswählen

 
type
  TMemberProc = function(a,b,c,d: integer): Integer;
  TProcRec = record
     ProcName: LPCTSTR;
     ProcPtr: TMemberProc;
  end;
  TProcs = Array of TProcRec;
 
  TProcRecClass = class(TObject)
  private   
     FRec: TProcRec;
  public
     constructor Create(Rec: TProcRec);
     property Rec: TProcRec read FRec write FRec;
  end;
 
  TProcList = class(TObject)
  private
      FCount: Integer;   
      FCapacity: Integer;
     FProcedures: TProcs;
  public
     constructor Create;
      function Add(ARec: TProcRec): Integer;
      Count: integer read FCount;
      Capacity: Integer read FCapacity write FCapacity;
      property Procedures[Index: Integer]: TProcRec read FProcedures write FProcedures;
  end;
 
constructor TProcRecClass.Create(Rec);
begin
   inherited Create;
   FRec:=Rec;
end;
 
constructor TProcList.Create;
begin
   inherited Create;
   SetLength(FProcedures, 2);
   FCapacity := 4;
end;
 
function TProcList.Add(ARec: TProcRecClass): Integer;
begin
   inc(FCount);
   if FCount > FCapacity then SetCapacity(FCount);
   FProcedures[FCount-1] :=ARec.Rec;
end;
 

Wenn ich dann später in einer Schleife die vorher zugewisenen Prozeduren aufrufen will schlägt das fehl, Prozedurzeiger ist NIL. Warum kann ich das nicht so machen und wie kann ich Records mit einem Prozedurzeiger speichern?

Code: Alles auswählen

 
var
  r: TProcRec;
  c: TProcRecClass;
  l: TProcList;
  i: Integer;
  a,b,c,d: Integer;
 
function Addfunc(a,b,c,d: Integer): Integer; stdcall;
begin
   Result := a+b+c+d;
end;
 
function SubFunc(a,b,c,d: Integer): Integer; stdcall;
begin
   Result := (a+b) - (c+d);
end;
 
begin
   r.ProcName := 'Addiere';
   r.ProcPtr := @Addfunc;
   c := TProcRecClass.Create(r);
   l := TProcList.Create;
   l.Add(c);
 
   r.ProcName := 'Subtrahiere';
   r.ProcPtr := @SubFunc;
 
   c := TProcRecClass.Create(r);
   l.Add(c);
 
   while i < l.Count do
   begin
      l.Procedures[i].ProcPtr(a,b,c,d);  //Das funktioniert aber nicht. Warum?     
   end;
end.
 

[fliegermichl]

Da fallen mir einige Fehler auf.

TMemberProc ist nicht als StdCall deklariert, AddFunc und SubFunc aber schon.

Bei der Deklaration der Klasse TProcList fehlen bei Count und Capacity der Bezeichner "property"

Bei der property Procedures gibst du an, daß diese vom Typ TProcRec seien, die read und write Anweisungen verweisen aber auf einen ArrayTyp TProcs (was meines Wissens sowieso nicht geht)
Ich denke hier sollte TProcRecClass stehen.

Was hat i in der while Schleife für einen Wert?
Die while Schleife wird, selbst wenn i initialisiert wäre, nie beendet, da i sich nicht ändert.

[wp_xyz]

Genau! Wie von fliegermichl angedeutet, kriegt man das Beispiel nicht einmal kompiliert. Du bist aber offenbar weiter, weil du auf eine Zeile verweist, wo ein Fehler auftritt. Es wäre besser, wenn du den hochgeladenenen oder hereinkopierten Code soweit testen würdest, dass er wengistens vom Compiler akzeptiert wird (es sei denn es geht um ein Compiler-Problem).

[thosch]

Danke Euch!
Stimmt, dass der Quellcode so nicht compilierbar ist. Liegt daran dass ich das nur als Demo so hier rein geschrieben habe, ohne es getestet zu haben. Mein Original dazu ist um ein Vielfaches komplexer, das Demo hier sollte nur das Problem aufzeigen. Nun habe ich das Demo nach den Hinweisen hier korrigiert und da funktioniert es auf einmal. Also wird wohl der Fehler in meinem eigentlichen Programm, das ich hier nicht einstellen will, ähnlich gelagert sein. Falsche Typzuordnung in dem Recordwirrwarr oder nicht eindeutige Aufrufkonverntion.

Hier nun deshalb noch mal das nun funktionierende Demoprogramm:

Code: Alles auswählen

 
program Project1;
 
type
  TMemberProc = function(a,b,c,d: integer): Integer; stdcall;
  TProcRec = record
     ProcName: String;
     ProcPtr: TMemberProc;
  end;
  TProcs = Array of TProcRec;
 
  TProcRecClass = class(TObject)
  private
     FRec: TProcRec;
  public
     constructor Create(Rec: TProcRec);
     property Rec: TProcRec read FRec write FRec;
  end;
 
  { TProcList }
 
  TProcList = class(TObject)
  private
      FCount: Integer;
      FCapacity: Integer;
      FProcedures: TProcs;
      function GetProc(Index: Integer): TProcRec;
  public
     constructor Create;
      function Add(ARec: TProcRecClass): Integer;
      property Count: integer read FCount;
      property Capacity: Integer read FCapacity write FCapacity;
      property Procedures[Index: Integer]: TProcRec read GetProc;
  end;
 
constructor TProcRecClass.Create(Rec: TProcRec);
begin
   inherited Create;
   FRec:=Rec;
end;
 
function TProcList.GetProc(Index: Integer): TProcRec;
begin
  Result := FProcedures[Index];
end;
 
constructor TProcList.Create;
begin
   inherited Create;
   SetLength(FProcedures, 2);
   FCapacity := 4;
end;
 
function TProcList.Add(ARec: TProcRecClass): Integer;
begin
   inc(FCount);
   if FCount > FCapacity then
   begin
     FCapacity := FCount;
     SetLength(FProcedures,FCapacity);
   end;
   FProcedures[FCount-1] :=ARec.Rec;
end;
 
var
  r: TProcRec;
  c: TProcRecClass;
  l: TProcList;
  i: Integer;
  a,b,e,d: Integer;
 
function Addfunc(a,b,e,d: Integer): Integer; stdcall;
begin
   Result := a+b+e+d;
end;
 
function SubFunc(a,b,e,d: Integer): Integer; stdcall;
begin
   Result := (a+b) - (e+d);
end;
 
begin
   r.ProcName := 'Addiere';
   r.ProcPtr := @Addfunc;
   c := TProcRecClass.Create(r);
   l := TProcList.Create;
   l.Add(c);
 
   r.ProcName := 'Subtrahiere';
   r.ProcPtr := @SubFunc;
 
   c := TProcRecClass.Create(r);
   l.Add(c);
 
   a:=2400; b:=400; e:=45; d:=5;
 
   while i < l.Count do
   begin
      writeln('Ergebnis: ', l.Procedures[i].ProcPtr(a,b,e,d));
      inc(i);
   end;
   writeln;
   writeln('Zurück mit <<Enter>> ... ');
   readln;
end.
 

[corpsman]

Code: Alles auswählen

constructor TProcList.Create;
begin
   inherited Create;
   SetLength(FProcedures, 2);
   FCapacity := 4;
end;

sollte das nicht

Code: Alles auswählen

constructor TProcList.Create;
begin
   inherited Create;
   SetLength(FProcedures, 2);
   FCapacity := 2;
end;

sein, sonst greift deine Add routine doch beim 3. und 4. Mal daneben..

[thosch]

Wieso das? Ich will doch einfach nur die Kapazität etwas größer machen, als aktuell gebraucht. Im Beispiel 2 Einträge mehr. Wenn die Einträge dann kommen sollen die zuerst in die Zuviel bereitgestellten Speicherplätze geschrieben werden und danach lege ich neue an, wenn die Anzahl der zusätzlich bereit gestellten Einträge für die Anzahl der neu hinzu kommenden Einträge nicht mehr ausreicht.

FCapacity zeigt an, wie viele Einträge aktuell in die Liste passen. FCount zeigt die Anzahl der bereits vorhandenen Einträge.
.

[corpsman]

Du erstelltst das Object
fCount = 0;
dann addest du 4 mal

1. Mal
fcount = 1;
FCapacity = 4;
Length(FProcedures) =2

2. Mal
fcount = 2;
FCapacity = 4;
Length(FProcedures) =2

3. Mal
fcount = 3;
FCapacity = 4;
Length(FProcedures) =2 <-- Boom (in der Zeile FProcedures[FCount-1] :=ARec.Rec; )

Wenn du es drehen würdest würde es vielleicht gehen, ich verstehe aber auch nicht warum du fcapacity überhaupt brauchst, denn das kriegst du auch via

Code: Alles auswählen

 
   FCapacity := length(FProcedures);
 

[wp_xyz]

Ich denke auch, dass da etwas falsch ist.

Code: Alles auswählen

function TProcList.Add(ARec: TProcRecClass): Integer;
begin
   inc(FCount);
   if FCount > FCapacity then
   begin
     FCapacity := FCount;
     SetLength(FProcedures,FCapacity);
   end;
   FProcedures[FCount-1] :=ARec.Rec;
end;

Wenn in Add die Kapazitätsgrenze überschritten wird, müsste eigentlich diese vergrößert werden. Stattdessen setzst du sie auf Count, also genau um 1 höher. Damit ist der ganze Kapazitätsmechanismus eigentlich sinnlos, denn mit jedem hinzugefügten Eintrag muss die Liste umkopiert werden, was du ja eigentlich vermeiden wolltest. Ich würde stattdessen eine Blockgröße definieren, um die Capacity wächst. Damit muss für diese Anzahl von neuen Einträgen nichts umkopiert werden.

Code: Alles auswählen

const
  BLOCK_SIZE = 100; // oder wie auch immer...
 
function TProcList.Add(ARec: TProcRecClass): Integer;
begin
   inc(FCount);
   if FCount > FCapacity then
   begin
     inc(FCapacity, BLOCK_SIZE);
     SetLength(FProcedures,FCapacity);
   end;
   FProcedures[FCount-1] :=ARec.Rec;
end;

[fliegermichl]

Oder noch einfacher TProcList von TList ableiten wo all das bereits implementiert ist.

Den Typ der Einträge kann man da auch ganz einfach festlegen.

Code: Alles auswählen

 
type
 TProcList = class ( TList )
  function get(Index : integer) : TProcRecClass;
  procedure Put(Index : integer; Item : TProcRecClass);
  property Items[Index : integer] : TProcRecClass read get write put; default;
 end;
 
implementation
function TProcRecList.get(Index : integer) : TProcRecClass;
begin
 Result := TProcRecClass(inherited get(Index));
end;
 
procedure TProcRecList.put(Index : integer; Item : TProcRecClass);
begin
 inherited Put(index, Item);
end;
 

Da Items als default deklariert ist, brauchst du nicht mal mehr einen Typecast. Kannst also mittels MyItem := MyList[2] direkt darauf zugreifen.