OpenGL: Indlæse data fra filer

Under koden:

F.Delimiter := ASeperator;

skriver den:

Undecleared Identifier 'Delimeter'.

Samt Undecleard Identifier 'DelimitedText'.

Hvilken version af delphi bruger ud?

/Michael.

D5 Standard.

D5 Standard.

Okay,

Det kan være at D5's TStringList ikke har implementeret disse 2 properties.

Jeg kigger lige på koden og laver den om så du kan bruge den i D5...

/Michael.

D5 Standard.

Okay,

Det kan være at D5's TStringList ikke har implementeret disse 2 properties.

Jeg kigger lige på koden og laver den om så du kan bruge den i D5...

/Michael.

Og her er den så:

unit Obj3d;

interface

uses
  SysUtils, Classes;

type
  PVector = ^TVector;
  TVector = record
    X, Y, Z : Single;
  end;

  PFace = ^TFace;
  TFace = record
    V1, V2, V3 : Integer;
  end;

  PPFaceArray = ^TPFaceArray;
  TPFaceArray = array[0..MaxInt div SizeOf(PFace)-1] of PFace;

  PPVectorArray = ^TPVectorArray;
  TPVectorArray = array[0..MaxInt div SizeOf(PVector)-1] of PVector;

  T3dObject = class(TObject)
  private
    FFaces    : TList;
    FVectors  : TList;
    FName     : String;
  protected
    function AllocVector(AX, AY, AZ : Single) : PVector;
    function AllocFace(AVector1, AVector2, AVector3 : Integer) : PFace;
    function GetFaces : PPFaceArray;
    function GetVectors : PPVectorArray;
    function DelimitedText(ASeperator : Char; AStr : String) : TStringList;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Load(AFileName : String);
    procedure Save(AFileName : String);

    procedure Clear;

    function AddVector(AX, AY, AZ : Single) : Integer; overload;
    function AddVector(AVector : TVector) : Integer; overload;

    function AddFace(AVector1, AVector2, AVector3 : Integer) : Integer; overload;
    function AddFace(AFace : TFace) : Integer; overload;

    function NumOfFaces : Integer;
    function NumOfVectors : Integer;

    property Faces : PPFaceArray read GetFaces;
    property Vectors : PPVectorArray read GetVectors;
    property Name : String read FName write FName;
  end;

implementation

constructor T3dObject.Create;
begin
  inherited Create;
  FFaces := TList.Create;
  FVectors := TList.Create;
  FName := 'Unused.obj';
end;

destructor T3dObject.Destroy;
begin
  Clear;
  FFaces.Free;
  FFaces := nil;
  FVectors.Free;
  FVectors := nil;
  inherited Destroy;
end;

function T3dObject.AllocVector(AX, AY, AZ : Single) : PVector;
begin
  Result := AllocMem(SizeOf(TVector));
  if Result <> nil then
  begin
    Result^.X := AX;
    Result^.Y := AY;
    Result^.Z := AZ;
  end;
end;

function T3dObject.AllocFace(AVector1, AVector2, AVector3 : Integer) : PFace;
begin
  Result := AllocMem(SizeOf(TFace));
  if Result <> nil then
  begin
    Result^.V1 := AVector1;
    Result^.V2 := AVector2;
    Result^.V3 := AVector3;
  end;
end;

function T3dObject.GetFaces : PPFaceArray;
begin
  Result := PPFaceArray(FFaces.List);
end;

function T3dObject.GetVectors : PPVectorArray;
begin
  Result := PPVectorArray(FVectors.List);
end;

function T3dObject.NumOfFaces : Integer;
begin
  Result := FFaces.Count;
end;

function T3dObject.NumOfVectors : Integer;
begin
  Result := FVectors.Count;
end;

function T3dObject.DelimitedText(ASeperator : Char; AStr : String) : TStringList;
var
  I   : Integer;
  Tmp : String;
begin
  Result := TStringList.Create;
  Tmp := '';
  for I := 1 to Length(AStr) do
  begin
    if AStr[I] <> ASeperator then
      Tmp := Tmp+AStr[I]
    else
    begin
      Result.Add(Tmp);
      Tmp := '';
    end;
  end;
  if Tmp <> '' then
    Result.Add(Tmp);
end;

procedure T3dObject.Load(AFileName : String);

function FindTag(ATag : String; AList : TStringList; AStartIndex : Integer) : Integer;
var
  I : Integer;
begin
  Result := -1;
  for I := AStartIndex to AList.Count-1 do
  begin
    if Pos(ATag, AList.Strings[I]) > 0 then
    begin
      Result := I;
      break;
    end;
  end;
end;

function ReadVector(ASeperator : Char; AStr : String) : TVector;
var
  F : TStringList;
begin
  F := DelimitedText(ASeperator, AStr);
  try
    case F.Count of
      1:
        begin
          Result.X := StrToFloat(F.Strings[0]);
          Result.Y := 0;
          Result.Z := 0;
        end;
      2:
        begin
          Result.X := StrToFloat(F.Strings[0]);
          Result.X := StrToFloat(F.Strings[1]);
          Result.Z := 0;
        end;
      else
        begin
          Result.X := StrToFloat(F.Strings[0]);
          Result.Y := StrToFloat(F.Strings[1]);
          Result.Z := StrToFloat(F.Strings[2]);
        end;
    end;
  finally
    F.Free;
  end;
end;

function ReadFace(ASeperator : Char; AStr : String) : TFace;
var
  F : TStringList;
begin
  F := DelimitedText(ASeperator, AStr);
  try
    case F.Count of
      1:
        begin
          Result.V1 := StrToInt(F.Strings[0]);
          Result.V2 := 0;
          Result.V3 := 0;
        end;
      2:
        begin
          Result.V1 := StrToInt(F.Strings[0]);
          Result.V2 := StrToInt(F.Strings[1]);
          Result.V3 := 0;
        end;
      else
        begin
          Result.V1 := StrToInt(F.Strings[0]);
          Result.V2 := StrToInt(F.Strings[1]);
          Result.V3 := StrToInt(F.Strings[2]);
        end;
    end;
  finally
    F.Free;
  end;
end;

var
  F     : TStringList;
  I     : Integer;
  Start : Integer;
  Slut  : Integer;
begin
  Clear;
  F := TStringList.Create;
  try
    F.LoadFromFile(AFileName);
    I := FindTag('OBJECT ', F, 0);
    if I <> -1 then
    begin // okay vi fandt starten på vores objekt
      FName := Copy(F.Strings[I], Pos('OBJECT ', F.Strings[I])+7, Length(F.Strings[I]));
// Læs vectors
      I := FindTag('VECTORS', F, I);
      if I <> -1 then
      begin // okay vi fandt starten på vores vektorer
        Inc(I);
        Start := I;
        I := FindTag('END', F, I);
        if I <> -1 then
        begin // okay vi fandt slutningen på vores vektorer
          Slut := I;
          for I := Start to Slut-1 do
          begin // Læs vector data
            AddVector(ReadVector(',', F.Strings[I]));
          end;
// Læs faces
          I := FindTag('FACES', F, Slut+1);
          if I <> -1 then
          begin // okay vi fandt starten på vores faces
            Inc(I);
            Start := I;
            I := FindTag('END', F, I);
            if I <> -1 then
            begin // okay vi fandt slutningen på vores faces
              Slut := I;
              for I := Start to Slut-1 do
              begin // Læs vector data
                AddFace(ReadFace(',', F.Strings[I]));
              end;
            end;
          end;
        end;
      end;
    end;
  finally
    F.Free;
  end;
end;

procedure T3dObject.Save(AFileName : String);
var
  F     : TStringList;
  I     : Integer;
  Face  : PFace;
  Vec   : PVector;
begin
  F := TStringList.Create;
  try
    F.Add('OBJECT '+FName);
    F.Add('  VECTORS');
    for I := 0 to FVectors.Count-1 do
    begin
      Vec := FVectors.Items[I];
      if Vec <> nil then
        F.Add('    '+FloatToStr(Vec^.X)+','+FloatToStr(Vec^.Y)+','+FloatToStr(Vec^.Z))
    end;
    F.Add('  END');
    F.Add('  FACES');
    for I := 0 to FFaces.Count-1 do
    begin
      Face := FFaces.Items[I];
      if Face <> nil then
        F.Add('    '+IntToStr(Face^.V1)+','+IntToStr(Face^.V2)+','+IntToStr(Face^.V3))
    end;
    F.Add('  END');
    F.Add('END');
    F.SaveToFile(AFileName);
  finally
    F.Free;
  end;
end;

procedure T3dObject.Clear;
var
  I : Integer;
  P : Pointer;
begin
  for I := 0 to FFaces.Count-1 do
  begin
    P := FFaces.Items[I];
    if P <> nil then
      FreeMem(P);
  end;
  FFaces.Clear;

  for I := 0 to FVectors.Count-1 do
  begin
    P := FVectors.Items[I];
    if P <> nil then
      FreeMem(P);
  end;
  FVectors.Clear;
  FName := 'Unused.obj';
end;

function T3dObject.AddVector(AVector : TVector) : Integer;
begin
  Result := FVectors.Add(AllocVector(AVector.X, AVector.Y, AVector.Z));
end;

function T3dObject.AddVector(AX, AY, AZ : Single) : Integer;
begin
  Result := FVectors.Add(AllocVector(AX, AY, AZ));
end;

function T3dObject.AddFace(AFace : TFace) : Integer;
begin
  Result := FFaces.Add(AllocFace(AFace.V1, AFace.V2, AFace.V3));
end;

function T3dObject.AddFace(AVector1, AVector2, AVector3 : Integer) : Integer;
begin
  Result := FFaces.Add(AllocFace(AVector1, AVector2, AVector3));
end;

end.

/Michael.

Hvordan er det helt præcist jeg bruger koden? Når jeg kører EXE-filen skriver den:

"project project1.exe raised exception class EAccessViolation with message 'Access violation at address 04F9EEF7 in module 'atioglxx.dll'. Read of address 00000012'. Process stopped. Use Step or Run to continue".

Jeg har skrevet følgende i mit project1:

unit Unit1;

interface

uses
  Windows, Messages, opengl, obj3d,SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
 TContext = record
    RenderContext, DeviceContext : THandle;
end;

var
  Form1: TForm1;
  Context : TContext;

implementation

{$R *.DFM}
function SetupContext(Sender : TObject) : TContext;
var
  PFD: PixelFormatDescriptor;
  I : Integer;
begin
  with TWinControl(Sender) do
  Result.DeviceContext := GetDC(Handle);

  ZeroMemory(@PFD,SizeOf(PFD));

  with PFD do
  begin
    nSize := Sizeof(PixelFormatDescriptor);
    nVersion := 1;
    dwFlags := pfd_Support_OpenGL or pfd_Draw_to_Window or pfd_DoubleBuffer;
    iPixelType := pfd_Type_RGBA;
    cColorBits := 24;
    cDepthBits := 32;
    iLayerType := pfd_Main_Plane;
  end;

  I := ChoosePixelFormat(Result.DeviceContext,@PFD);

  if I = 0 then
  Exit;

  if not SetPixelFormat(Result.DeviceContext, I, @PFD) then
  Exit;

  Result.RenderContext := wglCreateContext(Result.DeviceContext);

  if Result.RenderContext = 0 then
  Exit;

  if not wglMakeCurrent(Result.DeviceContext, Result.RenderContext) then
  Exit;
end;

procedure OpretNytObjekt;
var
  Obj : T3dObject;
begin
  Obj := T3dObject.Create;
  Obj.AddVector(1.0, 1.0, 1.0);
  Obj.AddVector(1.0, 2.0, 1.0);
  Obj.AddVector(2.0, 2.0, 1.0);
  Obj.AddVector(2.0, 1.0, 1.0);
  Obj.AddFace(1,2,3);
  Obj.AddFace(1,3,4);
  Obj.Name := 'Wall_1';
  Obj.Save('wall.obj');
  Obj.Free;
end;

procedure Render(AObject : T3dObject);
var
  I : Integer;
begin
  glBegin(gl_Triangles);
  for I := 0 to AObject.NumOfFaces-1 do
  begin
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V1]));
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V2]));
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V3]));
  end;
  glEnd;
end;

procedure HentObjektOgRenderIt;
var
  Obj : T3dObject;
begin
  Obj := T3dObject.Create;
  Obj.Load('wall.obj');
  Render(Obj);
  Obj.Free;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   Context := SetupContext(Form1);

end;

procedure TForm1.FormPaint(Sender: TObject);
begin

  glClearColor(0,0,0,0);


  glClear(gl_Color_Buffer_Bit);

  OpretNytObjekt;
  HentObjektOgRenderIt;

  SwapBuffers(Context.DeviceContext);

end;

end.

Hvordan er det helt præcist jeg bruger koden? Når jeg kører EXE-filen skriver den:

"project project1.exe raised exception class EAccessViolation with message 'Access violation at address 04F9EEF7 in module 'atioglxx.dll'. Read of address 00000012'. Process stopped. Use Step or Run to continue".

Jeg har skrevet følgende i mit project1:

Kode 

unit Unit1;

interface

uses
  Windows, Messages, opengl, obj3d,SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
 TContext = record
    RenderContext, DeviceContext : THandle;
end;

var
  Form1: TForm1;
  Context : TContext;

implementation

{$R *.DFM}
function SetupContext(Sender : TObject) : TContext;
var
  PFD: PixelFormatDescriptor;
  I : Integer;
begin
  with TWinControl(Sender) do
  Result.DeviceContext := GetDC(Handle);

  ZeroMemory(@PFD,SizeOf(PFD));

  with PFD do
  begin
    nSize := Sizeof(PixelFormatDescriptor);
    nVersion := 1;
    dwFlags := pfd_Support_OpenGL or pfd_Draw_to_Window or pfd_DoubleBuffer;
    iPixelType := pfd_Type_RGBA;
    cColorBits := 24;
    cDepthBits := 32;
    iLayerType := pfd_Main_Plane;
  end;

  I := ChoosePixelFormat(Result.DeviceContext,@PFD);

  if I = 0 then
  Exit;

  if not SetPixelFormat(Result.DeviceContext, I, @PFD) then
  Exit;

  Result.RenderContext := wglCreateContext(Result.DeviceContext);

  if Result.RenderContext = 0 then
  Exit;

  if not wglMakeCurrent(Result.DeviceContext, Result.RenderContext) then
  Exit;
end;

procedure OpretNytObjekt;
var
  Obj : T3dObject;
begin
  Obj := T3dObject.Create;
  Obj.AddVector(1.0, 1.0, 1.0);
  Obj.AddVector(1.0, 2.0, 1.0);
  Obj.AddVector(2.0, 2.0, 1.0);
  Obj.AddVector(2.0, 1.0, 1.0);
  Obj.AddFace(1,2,3);
  Obj.AddFace(1,3,4);
  Obj.Name := 'Wall_1';
  Obj.Save('wall.obj');
  Obj.Free;
end;

procedure Render(AObject : T3dObject);
var
  I : Integer;
begin
  glBegin(gl_Triangles);
  for I := 0 to AObject.NumOfFaces-1 do
  begin
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V1]));
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V2]));
    glVertex3fv(Pointer(AObject.Vectors^[AObject.Faces^[I].V3]));
  end;
  glEnd;
end;

procedure HentObjektOgRenderIt;
var
  Obj : T3dObject;
begin
  Obj := T3dObject.Create;
  Obj.Load('wall.obj');
  Render(Obj);
  Obj.Free;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
   Context := SetupContext(Form1);

end;

procedure TForm1.FormPaint(Sender: TObject);
begin

  glClearColor(0,0,0,0);


  glClear(gl_Color_Buffer_Bit);

  OpretNytObjekt;
  HentObjektOgRenderIt;

  SwapBuffers(Context.DeviceContext);

end;

end.

Hej,

Du får en exception fordi din faces er forkerte.
Med det mener jeg at din vector liste er nul-indekseret.
Hvis du retter de 2 linier kode i OpretNytObjekt til:
Obj.AddFace(0,1,2);
Obj.AddFace(0,2,3);

Så brude det hele fungere igen :-)

PS. det var i mit kode eks. at jeg havde lavet en fejl (havde glemt at listerne selvfølgelig er nul-indekseret).

/Michael.