Kamera (1): Unterschied zwischen den Versionen

unit Example;

interface

uses
  Windows, ...

type
  TFExample = class(TForm)
    .
    .
    .
  private
    FCamera: TCamera;

    FglDC: HDC;               // device context der aktuellen komponente
    FglRC: HGLRC;             // rendering kontext der aktuellen komponente

    ClearAlpha: GLclampd;     // alpha wert der hintergrundfarbe
    ClearRed: GLclampd;       // rotanteil der hintergrundfarbe
    ClearGreen: GLclampd;     // grünanteil der hintergrundfarbe
    ClearBlue: GLclampd;      // blauanteil der hintergrundfarbe
  public
    .
    .
    .
  published
    .
    .
    .

var
  FExample: TFExample;

  FxStart,                     // berechnung der mausbewegungen.
  FxDelta,                     // delta = aktuelle position minus start
  FyStart,                     // start wird erfasst sobald eine maustaste
  FyDelta:integer;             // gedrückt wird.

  FxRot,                       // umrechnung von delta in rotation wenn
  FyRot:double;                // drehung gewünscht ist (je nach taste)

  FMousePressX,                // aktuelle mausposition, wenn maustaste gedrückt wird
  FMousePressY: integer;
  FMousePosX,                  // aktuelle mausposition
  FMousePosY: integer;

  //mausaktivität überprüfen
  FRightMousePressed:boolean;  // ist die rechte maustaste gedrückt?
  FLeftMousePressed:boolean;   // ist die linke maustaste gedrückt?

const
  crCursorMove = 1;
  crCursorRotate = 2;
  crCursorSelect = 3;

implementation

uses ...

{$R *.dfm}
{$R cursors.res}

procedure TFExample.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  // mausposition merken
  FMousePosX := X;
  FMousePosY := Y;

   //das Ziehen der Szene kann nur bei gedrückter Maustaste passieren
  if not (FRightMousePressed or FLeftMousePressed) then exit;

   //ausrechenen um wieviel der Mauszeiger bewegt wurde
   FxDelta := FxStart-X;
   FyDelta := FyStart-Y;

   //Rotation anpassen, damit es nicht zu schnell wird
   FxRot := FxRot - FyDelta/20;
   Fyrot := FyRot - FxDelta/20;

   //das naechste mal ist das hier unser startpunkt:
   FxStart := X;
   FyStart := Y;

   if FRightMousePressed then
   begin
     if FxRot <> 0 then FCamera.RotateCamera (FxRot, 0, 0);
     if FyRot <> 0 then FCamera.RotateCamera (0, FyRot, 0);
   end;
   if FLeftMousePressed then
   begin
     if FxRot <> 0 then FCamera.TranslateCamera (FxRot, 0, 0);
     if FyRot <> 0 then FCamera.TranslateCamera (0, FyRot, 0);
   end;
   Paint;

   FxRot := 0;
   FyRot := 0;
end;

procedure TFExample.FormMouseDown(Sender: TObject; Button: TMouseButton;
                                 Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
  begin
    //rechte maustaste gedrückt
    FRightMousePressed:=true;
    //Startposition merken
    FxStart:=X;
    FyStart:=Y;
    Screen.Cursor := crCursorRotate;
  end
  else if Button = mbLeft then
  begin
    //rechte maustaste gedrückt
    FLeftMousePressed:=true;
    //Startposition merken
    FxStart:=X;
    FyStart:=Y;
    Screen.Cursor := crCursorMove;
  end;
  // aktuelle Mouseposition festhalten. so kann z.B. überprüft werden 
  // welches Objekt an der aktuellen Mausposition liegt
  FMousePressX := X;
  FMousePressY := Y;
end;

procedure TFExample.FormMouseUp(Sender: TObject; Button: TMouseButton;
                               Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then
  begin
    FRightMousePressed:=false;
  end;
  if Button = mbLeft then
  begin
    FLeftMousePressed:=false;
  end;
  if not (FRightMousePressed or FLeftMousePressed) then
    Screen.Cursor := crCursorSelect;
end;

procedure TFExample.FormCreate(Sender: TObject);
resourcestring
  ResStrRCfailed = 'CreateRenderingContext failed ';
  ResStrWGLfailed = 'wglMakeCurrent failed ';
begin
  inherited;

  // wenn das grafiksystem von OpenGL nicht aktiviert werden kann,
  // müssen wir das programm beenden
  if not InitOpenGL then
  begin
    raise Exception.Create('InitOpenGL failed '+IntToStr(GetLastError));
    halt (100);
  end;

  FglDC := getDC(self.WindowHandle);
  FglRC := CreateRenderingContext(FglDC,
                                  [opDoubleBuffered],
                                  32, 24, 0,0,0,0);

  if FglRC=0 then
  begin
    raise Exception.Create(ResStrRCfailed + IntToStr(GetLastError));
    halt (100);
  end;

  if not wglMakeCurrent(FglDC, FglRC) then
    raise Exception.Create(ResStrWGLfailed + IntToStr(GetLastError));

  FxRot:=0;
  FyRot:=0;

  FRightMousePressed := false;
  FLeftMousePressed := false;

  Screen.Cursors[crCursorMove]   := LoadCursor(HInstance,'MOVE');
  Screen.Cursors[crCursorRotate] := LoadCursor(HInstance,'ROTATE');
  Screen.Cursors[crCursorSelect] := LoadCursor(HInstance,'SELECT');
  Screen.Cursor                  := crCursorSelect;

  ClearAlpha := 1;         // bildschirm immer mit weiß löschen
  ClearRed:= 1;            // bildschirm immer mit weiß löschen
  ClearGreen:= 1;          // bildschirm immer mit weiß löschen
  ClearBlue:= 1;           // bildschirm immer mit weiß löschen

  FCamera := TCamera.Create;
end;

procedure TFExample.Render;  // wird aus der Methode Paint aufgerufen
resourcestring
  RestStrWGLfailed = 'TFExample.Render: wglMakeCurrent failed with ';
begin
  // da mehrere fenster möglich sind, muss immer der aktuelle
  // ausgabekontext ausgewählt werden
  if wglMakeCurrent(FglDC,FglRC) then
  begin
    glMatrixMode (GL_MODELVIEW);

    glClearColor(ClearRed, ClearGreen, ClearBlue, ClearAlpha);
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

    // View setzen

    Camera1.Apply;

    // Szene jetzt zeichnen

    glFlush;              // bearbeitung der GL-befehle beginnen
    glFinish;             // warten bis alle befehle ausgeführt sind

    SwapBuffers(FglDC);   // flackern verhindern
  end
  else
  begin
    raise Exception.Create(RestStrWGLfailed + IntToStr(GetLastError));
  end;
end;