delphi - Kan ikke finde ud af artiklen om 3D - Udvikleren.dk

Tags: delphi

Bruger #353 @ 02.08.04 16:04

Jeg har kastet mig ud i artiklen om 3D
Måske er det for stor en mundfuld for mig, for jeg er allerede løbet ind i problemer i de første linjer.

Jeg har skrevet følgende

unit GameClass;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, Math,
ExtCtrls;

type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
procedure FormCreate(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TContext = record
RenderContext, DeviceContext : THandle;
end;

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;

var
Context : TContext;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Referere til vores funktion, der vil returnere en context til vores form
Context := SetupContext(Form1);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
//Definere farven der skal overskrive Color bufferen
glClearColor(0,0,0,0);

//Overskriver Color bufferen
glClear(gl_Color_Buffer_Bit);

//Bytter OpenGL's Color buffer med Windows (GDI'en)
SwapBuffers(Context.DeviceContext);
end;

end.[/pre]

Når jeg prøver at kompile koden (der står jo i artiklen at man skal prøve det på dette tidspunkt) kommer der en fejl om "Invalid properties"

Nogen der kan hjælpe mig med at komme videre?

3 svar postet i denne tråd vises herunder
1 indlæg har modtaget i alt 1 karma

Sorter efter stemmer Sorter efter dato

Bruger #3470 @ 02.08.04 16:38

247

Jeg har kastet mig ud i artiklen om 3D
Måske er det for stor en mundfuld for mig, for jeg er allerede løbet ind i problemer i de første linjer.

Jeg har skrevet følgende

unit GameClass;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, Math,
ExtCtrls;

type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
procedure FormCreate(Sender: TObject);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TContext = record
RenderContext, DeviceContext : THandle;
end;

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;

var
Context : TContext;
procedure TForm1.FormCreate(Sender: TObject);
begin
//Referere til vores funktion, der vil returnere en context til vores form
Context := SetupContext(Form1);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
//Definere farven der skal overskrive Color bufferen
glClearColor(0,0,0,0);

//Overskriver Color bufferen
glClear(gl_Color_Buffer_Bit);

//Bytter OpenGL's Color buffer med Windows (GDI'en)
SwapBuffers(Context.DeviceContext);
end;

end.[/pre]

Når jeg prøver at kompile koden (der står jo i artiklen at man skal prøve det på dette tidspunkt) kommer der en fejl om "Invalid properties"

Nogen der kan hjælpe mig med at komme videre?

Jepper, svaret er nemt. Du har deklareret FormCreate under Form1's private sektion. Derved har andre funktioner og klasser ikke adgang til den, da den er privat til Form1. Flyt den op til den anden (FormPaint), og slet eventuelt private og public erklæringerne hvis ikke du har brug for dem, så får du i hvert fald ikke samme fejl igen.
I øvrigt burde du deklarere TContext længere oppe, da du formentlig godt kunne få brug for en global variabel af den type senere hen.
For at gøre exe-filen mindre burde du også droppe messages, dialogs og sysutils (math bliver vist brugt senere hen i artiklen, men lige nu bruger du heller ikke den), da du ikke bruger deres funktioner (sysutils har mange gode ting, så den er nok god for de fleste at beholde). Bare råd til senere hen i udviklingen...
Har ændret det med FormCreate her (resten af rådene må du selv om, men nu virker det i hvert fald):

Kode

unit GameClass;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, Math,
  ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TContext = record
    RenderContext, DeviceContext : THandle;
  end;

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;

var
  Context : TContext;
procedure TForm1.FormCreate(Sender: TObject);
begin
  //Referere til vores funktion, der vil returnere en context til vores form
  Context := SetupContext(Form1);
end;


procedure TForm1.FormPaint(Sender: TObject);
begin
  //Definere farven der skal overskrive Color bufferen
  glClearColor(0,0,0,0);

  //Overskriver Color bufferen
  glClear(gl_Color_Buffer_Bit);

  //Bytter OpenGL's Color buffer med Windows (GDI'en)
  SwapBuffers(Context.DeviceContext);
end;


end.

n i f e
115 105 102 105
6E 69 66 69

[Redigeret d. 02/08-04 16:46:12 af Nicolai Lyster Fersner]

Bruger #6079 @ 04.08.04 10:28

Hejsa jeg har også et problem i min kode:

Kode

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, OpenGL, Math,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure Idle(Sender : TObject; var Done : Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TContext = record
    RenderContext, DeviceContext : THandle;
  end;

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 TForm1.FormResize(Sender: TObject);
begin
  //Resetter vores matrix i vores FormPaint procedure
  glLoadIdentity;
  glViewport(0, 0, ClientWidth, ClientHeight);
  glFrustum(-1.0, +1.0, -(ClientHeight/ClientWidth), ClientHeight/ClientWidth, 2, 500);
end;


function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external glu32;
procedure glGenTextures(n: GLsizei; var textures: Integer); stdcall; external opengl32;
procedure glBindTexture(Target: GLenum; Texture: GLuint); stdcall; external opengl32;

type
  TRGB = record
  Red, Green, Blue : Byte;
  end;

function LoadTexture(FileName : string; MipMap : Boolean) : Integer;
var
  Bitmap : TBitmap;
  X, Y, I : Integer;
  A : array of TRGB;
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile(FileName);

  SetLength(A,0);
  for Y := Bitmap.Height-1 downto 0 do
  for X := 0 to Bitmap.Width-1 do
  begin
    SetLength(A,High(A)+2);
    I := ColorToRGB(Bitmap.Canvas.Pixels[X,Y]);
    A[High(A)].Red   := GetRValue(I);
    A[High(A)].Green := GetGValue(I);
    A[High(A)].Blue  := GetBValue(I);
  end;

  glGenTextures(1, I);
  glBindTexture(gl_Texture_2D, I);

  glTexEnvi(gl_Texture_Env, gl_Texture_Env_Mode, gl_Modulate);
  glTexParameteri(gl_Texture_2D, GL_Texture_Wrap_S, gl_Repeat);
  glTexParameteri(gl_Texture_2D, GL_Texture_Wrap_T, gl_Repeat);

  if MipMap then
  begin
    //MipMapping
    glTexParameteri(gl_Texture_2D, gl_Texture_Mag_Filter, gl_Linear_MipMap_Nearest);
    glTexParameteri(gl_Texture_2D, gl_Texture_Min_Filter, gl_Linear_Mipmap_Linear);
    gluBuild2DMipmaps(gl_Texture_2D, 3, Bitmap.Width, Bitmap.Height, gl_RGB, gl_Unsigned_Byte, A);
  end
  else
    begin
      //Standard
      glTexParameteri(gl_Texture_2D, gl_Texture_Mag_Filter, gl_Nearest);
      glTexParameteri(gl_Texture_2D, gl_Texture_Min_Filter, gl_Nearest);
      glTexImage2D(gl_Texture_2D, 0, 3, Bitmap.Width, Bitmap.Height, 0, gl_RGB, gl_Unsigned_Byte, A);
    end;

  glEnable(gl_Texture_2D);

  Bitmap.Free;

  //Retunere ID
  Result := I;
end;


var
  Context : TContext;
  Gulv_ID, Vaeg_ID, Loft_ID : Integer;
procedure TForm1.FormCreate(Sender: TObject);
var
  B : Boolean;
begin
  Context := SetupContext(Form1);

  if MessageDlg('Anvend MipMapping?',mtCustom,[mbYes,mbNo],0) = mrYes then
  B := True
  else
    B := False;

  Gulv_ID := LoadTexture('C:\\Gulv.Bmp',B);
  Vaeg_ID := LoadTexture('C:\\Vaeg.Bmp',B);
  Loft_ID := LoadTexture('C:\\Loft.Bmp',B);

  //Skjuler cursoren
  ShowCursor(False);

  //ShowMessage(glGetString(gl_Vendor));
  Application.OnIdle := Idle;
end;



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

var
  Translation, Rotation : TVector;
procedure TForm1.FormPaint(Sender: TObject);
begin
  glClearColor(0,0,0,0);
  glClear(gl_Color_Buffer_Bit or gl_Depth_Buffer_Bit);
  glEnable(gl_Depth_Test);
  glPushMatrix;

  with Rotation do
  begin
    glRotatef(X,1,0,0);
    glRotatef(Y,0,1,0);
    glRotatef(Z,0,0,1);
  end;

  with Translation do
  glTranslatef(X,Y,Z);

  //Aktivere mit gulv texture
  glBindTexture(gl_Texture_2D, Gulv_ID);
  //Tegner mit gulv
  glBegin(gl_Quads);
  glTexCoord2f(0,4);
  glVertex3f(-50, -3, -50);
  glTexCoord2f(0,0);
  glVertex3f(-50, -3, +50);
  glTexCoord2f(4,0);
  glVertex3f(+50, -3, +50);
  glTexCoord2f(4,4);
  glVertex3f(+50 ,-3 ,-50);
  glEnd;

  //Aktivere mit væg texture
  glBindTexture(gl_Texture_2D, Vaeg_ID);

  //Tegner min væg
  glBegin(gl_Quads);
  glTexCoord2f(0,1);
  glVertex3f(-50, -3, -50);
  glTexCoord2f(0,0);
  glVertex3f(-50, +22, -50);
  glTexCoord2f(4,0);
  glVertex3f(+50, +22, -50);
  glTexCoord2f(4,1);
  glVertex3f(+50, -3, -50);
  glEnd;

  //Aktivere mit loft texture
  glBindTexture(gl_Texture_2D, Loft_ID);
  //Tegner mit loft
  glBegin(gl_Quads);
  glTexCoord2f(0,4);
  glVertex3f(-50, +22, -50);
  glTexCoord2f(0,0);
  glVertex3f(-50, +22, +50);
  glTexCoord2f(4,0);
  glVertex3f(+50, +22, +50);
  glTexCoord2f(4,4);
  glVertex3f(+50 ,+22 ,-50);
  glEnd;

  glPopMatrix;

  SwapBuffers(Context.DeviceContext);
end;

var
  FPS, I : Integer;
  Jump, MoveForward, MoveBackward : Boolean;
procedure TForm1.Idle(Sender : TObject; var Done : Boolean);
var
  P : TPoint;
begin
  Done := False;

  if Jump then
  begin
    if Translation.Y > -1 then
    Translation.Y := Translation.Y-0.1
    else
      Jump := False;
  end
  else
    if Translation.Y < 0 then
    Translation.Y := Translation.Y+0.1;

  GetCursorPos(P);
  //Beregener
  P.X := (Left+(Width div 2))-P.X;
  P.Y := (Top+(Height div 2))-P.Y;
  Rotation.Y := Rotation.Y-(P.X*0.1);
  Rotation.X := Rotation.X-(P.Y*0.1);
  SetCursorPos(Left+(Width div 2),Top+(Height div 2));

  //Gå frem
  if MoveForward then
  begin
    Translation.X := Translation.X-(Sin(DegToRad(Rotation.Y))*0.5);
    Translation.Z := Translation.Z+(Cos(DegToRad(Rotation.Y))*0.5);
  end;
  //Gå tilbage
  if MoveBackward then
  begin
    Translation.X := Translation.X+(Sin(DegToRad(Rotation.Y))*0.5);
    Translation.Z := Translation.Z-(Cos(DegToRad(Rotation.Y))*0.5);
  end;

  FormPaint(nil);
  Caption := IntToStr(FPS);
  Inc(I);
end;



procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    //Drej til venstre
    VK_Left: Rotation.Y := Rotation.Y-1;
    //Drej til højre
    VK_Right: Rotation.Y := Rotation.Y+1;
    //Gå fremad
    VK_Up: begin
             Translation.X := Translation.X-Sin(DegToRad(Rotation.Y));
             Translation.Z := Translation.Z+Cos(DegToRad(Rotation.Y));
           end;
    //Gå tilbage
    VK_Down: begin
               Translation.X := Translation.X+Sin(DegToRad(Rotation.Y));
               Translation.Z := Translation.Z-Cos(DegToRad(Rotation.Y));
             end;
    //Kig ned
    VK_Insert: Rotation.X := Rotation.X+1;
    //Kig op
    VK_Delete: Rotation.X := Rotation.X-1;
    //Hop
    VK_Space: Jump := True;
    end; //Case
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FPS := I;
  I := 0;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Når venstre knap holdes nede går vi frem ad
  if Button = mbLeft then
  MoveForward := True;

  //Når højre knap holdes nede går vi tilbage
  if Button = mbRight then
  MoveBackward := True;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  //Stopper med at gå frem ad
  if Button = mbLeft then
  MoveForward := False;

  //Stopper med at gå tilbage
  if Button = mbRight then
  MoveBackward := False;
end;

end.

Fejlen er: "stream read error"

jeg er nået ned ved det første sted med to billeder i nummer 2 artikel... håber lige på et svar

Bruger #353 @ 18.08.04 11:39

Tak for hjælpen.

Kan ikke finde ud af artiklen om 3D

Karma barometer (30 dage)

Modtaget

Givet

Favorit hos
Forum tråde
Artikler