Поверхность Безье

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем Asya2011, 12 дек 2011.

Статус темы:
Закрыта.
  1. Asya2011

    Asya2011 Гость

    Здравствуйте, помогите, пожалуйста разобраться с заданием. Мне нужно из поверхности Безье построить какую-либо форму (ваза, сфера или полусфера).
    Вот исходный код программы (здесь рисуется сама поверхность Безье и накладывается текстура).
    Код (Delphi):
    unit Unit1;

    interface

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

    type
    TfrmGL = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    private
    DC : HDC;
    hrc: HGLRC;
    end;

    var
    frmGL: TfrmGL;
    wrkX, wrkY : Integer;
    mode : Boolean = False;
    solid : Boolean = True;
    down : Boolean = False;
    MyTexture:glUInt;
    texpts  : array[0..1, 0..1, 0..1] of GLfloat;

    implementation

    {$R *.DFM}

    const
    {двумерный массив контрольных (опорных) точек поверхности}
    ctrlpoints : Array [0..3, 0..3, 0..2] of GLFloat =
    (
    (
    (-1.5, -1.5, 4.0),
    (-0.5, -1.5, 2.0),
    (0.5, -1.5, -1.0),
    (1.5, -1.5, 2.0)),
    (
    (-1.5, -0.5, 1.0),
    (-0.5, -0.5, 3.0),
    (0.5, -0.5, 0.0),
    (1.5, -0.5, -1.0)),
    (
    (-1.5, 0.5, 4.0),
    (-0.5, 0.5, 0.0),
    (0.5, 0.5, 3.0),
    (1.5, 0.5, 4.0)),
    (
    (-1.5, 1.5, -2.0),
    (-0.5, 1.5, -2.0),
    (0.5, 1.5, 0.0),
    (1.5, 1.5, -1.0))
    );

    {=======================================================================
    Перерисовка окна}

    procedure TfrmGL.FormPaint(Sender: TObject);
    var
    i, j : Integer;
    begin
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

    glPushMatrix;
    glRotatef(85.0, 1.0, 1.0, 1.0);
    glColor3f (0.0, 1.0, 1.0);
    If solid
    then glEvalMesh2(GL_FILL, 0, 20, 0, 20)
    else glEvalMesh2(GL_LINE, 0, 20, 0, 20);

    If mode then begin
    // The following code displays the control points as dots.
    glColor3f(1.0, 1.0, 0.0);
    glBegin(GL_POINTS);
    For i := 0 to 3 do
    For j := 0 to 3 do
    glVertex3fv(@ctrlpoints[i][j][0]);
    glEnd;
    end;
    glPopMatrix;

    SwapBuffers(DC);
    end;

    {=======================================================================
    Формат пикселя}

    procedure SetDCPixelFormat (hdc : HDC);
    var
    pfd : TPixelFormatDescriptor;
    nPixelFormat : Integer;
    begin
    FillChar (pfd, SizeOf (pfd), 0);
    pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    nPixelFormat := ChoosePixelFormat (hdc, @pfd);
    SetPixelFormat (hdc, nPixelFormat, @pfd);
    end;

    {=======================================================================
    Создание формы}

    procedure TfrmGL.FormCreate(Sender: TObject);
    begin

    DC := GetDC (Handle);
    SetDCPixelFormat(DC);
    hrc := wglCreateContext(DC);
    wglMakeCurrent(DC, hrc);
    glEnable(GL_DEPTH_TEST);

    glEnable(GL_AUTO_NORMAL);
    glEnable(GL_COLOR_MATERIAL);

    // источник света
    glEnable(GL_LIGHTING);
    glEnable(GL_LIGHT0);
    LoadTexture('texture.bmp', MyTexture,false);
    glEnable(GL_TEXTURE_2D);

    glPointSize(5.0);

    texpts[0][0][0] := 0.0;
    texpts[0][0][1] := 0.0;

    texpts[1][0][0] := 0.0;
    texpts[1][0][1] := 1.0;

    texpts[0][1][0] := 1.0;
    texpts[0][1][1] := 0.0;

    texpts[1][1][0] := 1.0;
    texpts[1][1][1] := 1.0;

    // поверхность
    glMap2f(GL_MAP2_TEXTURE_COORD_2, 0, 1, 2, 2, 0, 1, 4, 2, @texpts);
    glEnable(GL_MAP2_TEXTURE_COORD_2);
    glMap2f(GL_MAP2_VERTEX_3, 0, 1, 3, 4, 0, 1, 12, 4, @ctrlpoints);
    glEnable(GL_MAP2_VERTEX_3);
    glMapGrid2f(20, 0.0, 1.0, 20, 0.0, 1.0);

    end;

    {=======================================================================
    Конец работы приложения}

    procedure TfrmGL.FormDestroy(Sender: TObject);
    begin
    wglMakeCurrent(0, 0);
    wglDeleteContext(hrc);
    ReleaseDC (Handle, DC);
    DeleteDC (DC);
    end;

    procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState);
    begin
    If Key = VK_ESCAPE then Close;
    If Key = VK_SPACE then begin
    mode := not mode;
    InvalidateRect(Handle, nil, False);
    end;
    If Key = VK_RETURN then begin
    solid := not solid;
    InvalidateRect(Handle, nil, False);
    end;
    end;

    procedure TfrmGL.FormResize(Sender: TObject);
    begin
    glViewport(0, 0, ClientWidth, ClientHeight);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    If ClientWidth <= ClientHeight
    then glOrtho(-4.0, 4.0, -4.0 * ClientHeight / ClientWidth,
    4.0 * ClientHeight / ClientWidth, -4.0, 4.0)
    else glOrtho(-4.0 * ClientWidth / ClientHeight,
    4.0 * ClientWidth / ClientHeight, -4.0, 4.0, -4.0, 4.0);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;

    InvalidateRect(Handle, nil, False);
    end;


    procedure TfrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    Down := True;
    wrkX := X;
    wrkY := Y;
    end;

    procedure TfrmGL.FormMouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    Down := False;
    end;

    procedure TfrmGL.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    begin
    If Down then begin
    glRotatef (X - wrkX, 0.0, 1.0, 0.0);
    glRotatef (Y - wrkY, 1.0, 0.0, 0.0);
    InvalidateRect(Handle, nil, False);
    wrkX := X;
    wrkY := Y;
    end;
    end;

    end.
    Что нужно изменить в программе?
    Заранее спасибо
     
Загрузка...
Похожие Темы - Поверхность Безье
  1. vladius
    Ответов:
    0
    Просмотров:
    1.429
Статус темы:
Закрыта.

Поделиться этой страницей