DGL • Thema anzeigen - Seltsames Picking Problem

Seltsames Picking Problem

Moderator: DGL-Team

Seite 1 von 1

[ 3 Beiträge ]

Vorheriges Thema | Nächstes Thema

Autor

Nachricht

Julian

Betreff des Beitrags: Seltsames Picking Problem

Verfasst: Do Mai 17, 2007 13:06

DGL Member

Registriert: Di Mai 15, 2007 20:08
Beiträge: 1

Ich habe hier ein Problem welches ich mir überhaupt nicht erklären kann. Ich zeichne mehrere Quads, klicke eines davon an und möchte dann mit Hilfe der 'Colormethode' rausfinden, auf welches geklickt wurde. Dies klappt alles mehr oder weniger, aber hier ist auch das Problem.

Manchmal tut es, manchmal nicht. Was ich mir überhaupt nicht erklären kann, da dieser Unterschied auch vorkommt wenn ich überhaupt nichts am Code änder.

Beispiel
- Programm compilieren
- tut
- Programm schließen
- Programm neu compilieren
- tut nicht

Wie kann sowas sein?

Hier mal der vollständige Code:

Code:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DGLOpenGL, StdCtrls, ExtCtrls, glBitmap;
 
type
  TMyQuad = record
    px, py, pz  : Single;
    sx, sy, sz  : Single;
    rx, ry, rz  : Single;
    id          : Integer;
    texture     : TglBitmap2D;
  end;
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    ListBox1: TListBox;
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DC                                : HDC;  //Handle auf Zeichenfläche
    RC                                : HGLRC;//Rendering Context
    procedure SetupGL;
    procedure Init;
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
    procedure Render;
    procedure ErrorHandler;
    procedure DrawMyQuad(q: TMyQuad);
    procedure CreateMyQuad(var mq: TMyQuad; _px,_py,_pz,_sx,_sy,_sz,_rx,_ry,_rz: Single);
    procedure ID2RGB(ID: Integer; var r,g,b: Byte);
    procedure CreateTexture(ID: Integer);
    function GetNextCubeID: Integer;
    function Pick(x,y: Integer): Integer;
    procedure Interact(x, y: Integer);
 
  end;
 
const
  NearClipping = 1;
  FarClipping  = 1000;
  MaxDrawTime  = 20;
 
var
  Form1             : TForm1;
  viewangle         : Single = 45.0;
  FPS,
  StartTime,
  DrawTime,
  TimeCount,
  FrameCount        : Integer;
  myQuads           : Array[0..5] of TMyQuad;
  a                 : Integer = 0;
  up                : boolean = true;
  nextCubeID        : Integer;
  pickMode          : Boolean;
  camPos            : TGLVectorf3;
 
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Interact(x, y: Integer);
var id: Integer;
begin
 // erstmal schaun welches angeklickt wurde
 id := pick(x, y);
 // wenns ok ist, dann nach inten verschieben
 {
 if id <> -1 then
   myQuads[id].pz := myQuads[id].pz - 0.1;
 }
 // noch anzeigen auf was geklickt wurde
 ListBox1.Items.Add(IntToStr(id));
 ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
 
procedure TForm1.CreateTexture(ID: Integer);
var bmp: TBitmap;
begin
 // bitmap erstellen
 bmp              := TBitmap.Create;
 bmp.PixelFormat  := pf24bit;
 bmp.Width        := 32;
 bmp.Height       := 32;
 
 // textur auf bitmap zeichnen
 with bmp.Canvas do begin
   Brush.Style    := bsSolid;
   Brush.Color    := random(255*255*255);
   Rectangle(-1, -1, 33, 33);
   Brush.Style    := bsClear;
   TextOut(2, 2, IntToStr(id));
 end;
 
 // richtige textur erstellen
 myQuads[id].texture := TglBitmap2D.Create;
 
 // der richtigen textur den bitmap zuweisen
 if myQuads[id].texture.AssignFromBitmap(bmp) then begin
   //AddAlphaFromColorKey(255, 0, 255, 0);
   myQuads[id].texture.GenTexture();
 end else
   ShowMessage('Textur konnte nicht erzeugt werden.');
 
 bmp.Free;
 
end;
 
procedure TForm1.CreateMyQuad(var mq: TMyQuad; _px,_py,_pz,_sx,_sy,_sz,_rx,_ry,_rz: Single);
begin
 with mq do begin
   px := _px; py := _py; pz := _pz;
   sx := _sx; sy := _sy; sz := _sz;
   rx := _rx; ry := _ry; rz := _rz;
   id := GetNextCubeID;
 end;
 CreateTexture(mq.id);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 DC:= GetDC(Handle);
 if not InitOpenGL then begin
    ShowMessage('OpenGL kann nicht initialisiert werden. Programm wird beeendet');
    Application.Terminate;
 end;
 RC:= CreateRenderingContext(   DC,
                                [opDoubleBuffered],
                                32,
                                24,
                                0,0,0,
                                0);
  ActivateRenderingContext(DC, RC);
  Application.OnIdle := IdleHandler;
  SetupGL;
  Init;
end;
 
procedure TForm1.ID2RGB(ID: Integer; var r,g,b: Byte);
begin
  r := ID div 65025;
  ID := ID - (r*65025);
  g := ID div 255;
  ID := ID - (g*255);
  b := ID
end;
 
function TForm1.GetNextCubeID: Integer;
begin
 result := nextCubeID;
 inc(nextCubeID);
end;
 
function TForm1.Pick(x, y: Integer): Integer;
var c: TColor;
begin
 pickMode := true;
 render;
 
 glReadPixels(X, (ClientHeight - 1 - Y), 1, 1, GL_RGBA, GL_UNSIGNED_BYTE, @c);
 c := c AND $ffffff;
 result := GetRValue(c) * 65025 +
           GetGValue(c) * 255 +
           GetBValue(c);
 
 // checkt result range
 if (result > nextCubeID-1) or (result < 0) then
  result := -1;
           
 pickMode := false;
end;
 
procedure TForm1.SetupGL;
begin
  glClearColor(0.3, 0.4, 0.7, 0.0);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_TEXTURE_2D);
  //glEnable(GL_CULL_FACE);         
end;
 
procedure TForm1.Init;
begin
  randomize();
  nextCubeID  := 0;
  pickMode    := false;
  camPos[0] := 0;
  camPos[1] := 0;
  camPos[2] := -4;
  CreateMyQuad(myQuads[0], -1.5, 0, 0, 1, 1, 0, 0, 0, 0);
  CreateMyQuad(myQuads[1], 0, 0, 0, 1, 1, 0, 0, 0, 0);
  CreateMyQuad(myQuads[2], 1.5, 0, 0, 1, 1, 0, 0, 0, 0);
  CreateMyQuad(myQuads[3], 0, 1.5, 0, 1, 1, 0, 0, 0, 0);
  CreateMyQuad(myQuads[4], 0, -1.5, 0, 1, 1, 0, 0, 0, 0);
  CreateMyQuad(myQuads[5], 0, -2.5, 0, 1, 1, 0, 0, 0, 0);
end;
 
procedure TForm1.Render;
var i: Integer;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(viewangle, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
 
  // cam translations
  glTranslatef(camPos[0], camPos[1], camPos[2]);
  glRotated(a, 0, 1, 0);
 
  if pickMode then
    glShadeModel(GL_FLAT)
  else
    glShadeModel(GL_SMOOTH);
 
  // alle Zeichen wo sie sind
  for i := 0 to High(myQuads) do
   DrawMyQuad(myQuads[i]);
 
  if not pickMode then
    SwapBuffers(DC);
end;
 
procedure TForm1.DrawMyQuad(q: TMyQuad);
var r,g,b: Byte;
begin
  glPushMatrix;
 
  glTranslatef(q.px, q.py, q.pz);
 
  glRotated(q.rx, 1, 0, 0);
  glRotated(q.ry, 0, 1, 0);
  glRotated(q.rz, 0, 0, 1);
 
  if pickMode then begin
    ID2RGB(q.id, r, g, b);
    glColor3f(r/255, g/255, b/255);
    glBegin(GL_QUADS);
      glVertex3f(-(q.sx/2), -(q.sy/2), 0);
      glVertex3f( (q.sx/2), -(q.sy/2), 0);
      glVertex3f(( q.sx/2),  (q.sy/2), 0);
      glVertex3f(-(q.sx/2),  (q.sy/2), 0);
    glEnd;
  end else begin
    glColor3f(1, 1, 1);
    q.texture.Bind();
    glBegin(GL_QUADS);
      glTexCoord2f(0, 0);  glVertex3f(-(q.sx/2), -(q.sy/2), 0);
      glTexCoord2f(1, 0);  glVertex3f( (q.sx/2), -(q.sy/2), 0);
      glTexCoord2f(1, 1);  glVertex3f(( q.sx/2),  (q.sy/2), 0);
      glTexCoord2f(0, 1);  glVertex3f(-(q.sx/2),  (q.sy/2), 0);
    glEnd;
  end;
 
  glPopMatrix;
end;
 
procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  StartTime:= GetTickCount;
  Render;
  DrawTime:= GetTickCount - StartTime;
  Inc(TimeCount, DrawTime);
  Inc(FrameCount);
 
  if DrawTime < MaxDrawTime then
    Sleep(MaxDrawTime - DrawTime);
 
  if TimeCount >= 1000 then begin
    FPS:= FrameCount;
    TimeCount:= TimeCount - 1000;
    FrameCount:= 0;
    ErrorHandler;
  end;
 
  Done:= false;
end;
 
procedure TForm1.ErrorHandler;
begin
  Form1.Caption := gluErrorString(glGetError);
end;
 
procedure TForm1.FormResize(Sender: TObject);
var tmpBool : Boolean;
begin
 glViewport(0, 0, ClientWidth, ClientHeight);
 glMatrixMode(GL_PROJECTION);
 glLoadIdentity;
 gluPerspective(viewangle, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
 glMatrixMode(GL_MODELVIEW);
 glLoadIdentity;
 IdleHandler(Sender, tmpBool);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 DeactivateRenderingContext;
 DestroyRenderingContext(RC);
 ReleaseDC(Handle, DC);
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var i: Integer;
begin
 inc(a, 2);
 if a > 360 then a := a - 360;
 
 for i := 0 to High(myQuads) do
   myQuads[i].rz := a;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 InterAct(x, y);
end;
 
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;  MousePos: TPoint; var Handled: Boolean);
begin
 CamPos[2] := CamPos[2] - 0.5;
end;
 
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;  MousePos: TPoint; var Handled: Boolean);
begin
 CamPos[2] := CamPos[2] + 0.5;
end;
 
end.

Nach oben

gucky

Betreff des Beitrags:

Verfasst: Do Mai 17, 2007 13:20

DGL Member

Registriert: Di Sep 19, 2006 13:24
Beiträge: 173

Schonmal nen Stoppunkt in die pick Funktion gesetzt und Step by Step kontrolliert was in den Variablen steht?

Nach oben

Lord Horazont

Betreff des Beitrags:

Verfasst: Do Mai 17, 2007 14:03

DGL Member

Registriert: Do Sep 02, 2004 19:42
Beiträge: 4158
Programmiersprache: FreePascal, C++

Also was du schilderst klingt nach nicht initialisierten Variabeln, prüf dazu mal die Kompilerausgabe.

Was ich aber auch noch festgestellt habe ist, dass du mehrfach 65025 verwendest. Dieser Wert scheint mir im Zusammenhang etwas ungünstig gewählt.
Aus

Code:

 
glReadPixels(X, (ClientHeight - 1 - Y), 1, 1, GL_RGBA, GL_UNSIGNED_BYTE, @c);
c := c AND $ffffff;
result := GetRValue(c) * 65025 +
  GetGValue(c) * 255 +
  GetBValue(c);

würde ich

Code:

 
glReadPixels(X, (ClientHeight - 1 - Y), 1, 1, GL_RGBA, GL_UNSIGNED_BYTE, @c);
c := c AND $ffffff;
result := c;
 

machen, während

Code:

 
procedure TForm1.ID2RGB(ID: Integer; var r,g,b: Byte);
begin
  r := ID div 65025;
  ID := ID - (r*65025);
  g := ID div 255;
  ID := ID - (g*255);
  b := ID
end;
 

so aussehen sollte:

Code:

 
procedure TForm1.ID2RGB(ID: Integer; var r,g,b: Byte);
begin
  r := (ID and $FF0000) shr 16;
  g := (ID and $00FF00) shr 8;
  b := (ID and $0000FF);
end;
 

Das ist ein wenig eleganter gelöst und spart auch ein wenig rechenzeit. Was bei der ColorMethode aber auch wichtig ist, dass du im moment fest davon ausgehst, dass du deinen 32 bzw. 24 Bit Rendering Context bekommst. Auf einem System, welches nur 16 Bit unterstützt würde jede zweite ID den gleichen Farbwert haben. Das solltest du nicht außer acht lassen.

Gruß Lord Horazont

_________________
If you find any deadlinks, please send me a notification – Wenn du tote Links findest, sende mir eine Benachrichtigung.
current projects: ManiacLab; aioxmpp
zombofant network • my photostream
„Writing code is like writing poetry“ - source unknown

„Give a man a fish, and you feed him for a day. Teach a man to fish and you feed him for a lifetime. “ ~ A Chinese Proverb

Nach oben

Seite 1 von 1

[ 3 Beiträge ]

Foren-Übersicht » Programmierung » Allgemein

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 12 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.