C-Funktion mit Pointern in Delphi nachbilden

[oXmoX]

Ok, ich komme nicht weiter

Darum hier nochmal mein Code in größerer Ausführlichkeit:

Code:

unit CxCore;

interface

const
  CV_32FC1         = 4;
  CV_64FC1         = 5;

  CV_MAT_TYPE_MASK = 31;

type
  PDoubleArray = ^TDoubleArray;
  TDoubleArray = array [Word] of Double;

  PSingleArray = ^TSingleArray;
  TSingleArray = array [Word] of Single;

  P_CvMat = ^CvMat;
  CvMat = record
    type_:        Integer;
    step:         Integer;

    //for internal use only
    refcount:     PInteger;

    data:         record
      case Integer of
        0: (ptr:  PByte);
        1: (s:    PSmallInt);
        2: (i:    PInteger);
        3: (fl:   PSingle);
        4: (db:   PDouble)
    end;
    case Integer of
      0: (rows:   Integer);
      1: (height: Integer;
    case Integer of
      0: (cols:   Integer);
      1: (width:  Integer))
  end;

function cvCreateMat(rows:  Integer;
                     cols:  Integer;
                     type_: Integer): P_CvMat; cdecl;

function cvmGet(const mat: P_CvMat;
                row: Integer;
                col: Integer): Double; cdecl;
procedure cvmSet(mat: P_CvMat;
                 row: Integer;
                 col: Integer;
                 value: Double); cdecl;

function CV_MAT_TYPE(flags: Cardinal):  Cardinal;


implementation

function cvCreateMat(rows:  Integer;
                     cols:  Integer;
                     type_: Integer): P_CvMat; external 'cxcore096.dll';

function cvmGet(const mat: P_CvMat; row: Integer; col: Integer): Double;
//    external 'cxcore096.dll';
var
  type_:      Integer;
begin
  type_ := CV_MAT_TYPE(mat.type_);
  assert((row < mat.rows) and (col < mat.cols));

  if(type_ = CV_32FC1) then
    Result :=
        PSingleArray(Cardinal(mat.data.ptr) + Cardinal(mat.step) * row)[col]
  else
  begin
    assert(type_ = CV_64FC1);
    Result :=
        PDoubleArray(Cardinal(mat.data.ptr) + Cardinal(mat.step) * row)[col];
  end;
end;

procedure cvmSet(mat: P_CvMat; row: Integer; col: Integer; value: Double);
//    external 'cxcore096.dll';
var
  type_:      Integer;
begin
  type_ := CV_MAT_TYPE(mat.type_);
  assert((row < mat.rows) and (col < mat.cols));

  if(type_ = CV_32FC1) then
    PSingleArray(Cardinal(mat.data.ptr) + Cardinal(mat.step) * row)[col] :=
        value
  else
  begin
    assert(type_ = CV_64FC1);
    PDoubleArray(Cardinal(mat.data.ptr) + Cardinal(mat.step) * row)[col] :=
        value;
  end;
end;

// #define CV_MAT_TYPE(flags)      ((flags) & CV_MAT_TYPE_MASK)
function CV_MAT_TYPE(flags: Cardinal): Cardinal;
begin
  Result := flags and CV_MAT_TYPE_MASK;
end;

end.

Die in der Unit verwendete dll gibt es im Anhang. Sie ist Teil der Open-Source-Bibliothek OpenCV (Beta 4). Sollte das mit der dll alleine nicht funktionieren (aufgrund fehlender Abhängigkeiten etc.), dann lässt sich wohl eine komplette Installation der OpenCV Bibliothek nicht vermeiden (kommt aber mit einer einfachen Setup-Datei). Sollte jemand diesen Aufwand tatsächlich treiben: DANKE dafür.

Die Werte für die Konstanten und die Getter und Setter-Funktion habe ich übrigens aus diesem C-Header-File übernommen.

Jetzt die Test-Unit:

Code:

unit TestMatrix;

interface

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

type
  TForm1 = class(TForm)
    ButtonTest64: TButton;
    ButtonTest32: TButton;
    procedure ButtonTest64Click(Sender: TObject);
    procedure ButtonTest32Click(Sender: TObject);
  private
    procedure TestMat(Mat: P_CvMat);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ButtonTest64Click(Sender: TObject);
var
  Mat:      P_CvMat;
begin
  Mat := cvCreateMat(3, 3, CV_64FC1);
  Self.TestMat(Mat);
end;

procedure TForm1.ButtonTest32Click(Sender: TObject);
var
  Mat:      P_CvMat;
begin
  Mat := cvCreateMat(3, 3, CV_32FC1);
  Self.TestMat(Mat);
end;

procedure TForm1.TestMat(Mat: P_CvMat);
var
  Row, Col: Integer;
  Val:      Integer;
begin
  // Matrixwerte belegen
  Val := 0;
  for Row := 0 to 2 do
    for Col := 0 to 2 do
    begin
      cvmSet(Mat, Row, Col, Val);
      Inc(Val);
    end;

  // Matrixwerte auslesen
  for Row := 0 to 2 do
    for Col := 0 to 2 do
    begin
      ShowMessage(FloatToStr(cvmGet(Mat, Row, Col)));
    end;
end;

end.

Bei mir funktioniert der Test nur mit den 32-Bit-Matrizen, nicht aber mit den 64-Bit-Matrizen ...kommen dann beim Auslesen falsche Werte heraus.

Also ...wo ist der Fehler?