VPF::Задание источника света в Delphi - Форум программистов

ДКот

Дата 27.12.2012, 21:10 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 27.12.2012

Репутация: нет
Всего: нет

Здравствуйте. Такая проблема. Нужно, чтобы на вращающейся фигуре отображались тени в зависимости от источника света. В данном случае получилось только затемнить фигуру полностью. Подскажите, в чем проблема, пожалуйста.

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    DC : HDC;
    hrc: HGLRC;
    ry : GLfloat;
    light0_position: array [0..3] of glfloat;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  CW = 8;  //количество точек объекта
  CP = 12;  //количество полигонов

type
  T3DPoint = record
    X, Y, Z: Integer;
  end;
  T2DPoint = TPoint;

var
  W: array [1..CW] of T3DPoint;  //мировые координаты
  V: array [1..CW] of T2DPoint;  //видовые координаты
  Z: array [1..CW] of Integer;   //глубина точек
  P: array [1..CP] of record     //полигоны
    A: array [1..3] of Byte;     //номера точек, из которых состоит полигон
    mZ: Integer;                 //среднее значение глубины полигона
  end;
  Sort: array [1..CP] of Byte;   //массив для сортировки
  Scale: Integer;                //масштаб
  Teta, Phi: Single;             //углы
  BufMain, BufEmpty: TBitMap;    //буферы для вывода и очистки
  MDown: Boolean;                //нажата ли кнопка мыши
  MPos: T2DPoint;                //положение курсора мыши

procedure Get2D;
var I: Integer;
begin
  //преобразование мировых координат в видовые с помощью
  //матрицы преобразований
  for I := 1 to CW do
  begin
    V[I].X := Round(Scale * (
              W[I].X*(- Sin(Teta)) +
              W[I].Y*(  Cos(Teta)))) + Form1.Width shr 1;
    V[I].Y := Round(Scale * (
              W[I].X*(  Cos(Phi) * Cos(Teta)) +
              W[I].Y*(  Cos(Phi) * Sin(Teta)) +
              W[I].Z*(- Sin(Phi)))) + Form1.Height shr 1;
    Z[I]   := Round(Scale * (
              W[I].X*(- Sin(Phi) * Cos(Teta)) +
              W[I].Y*(- Sin(Phi) * Sin(Teta)) +
              W[I].Z*(- Cos(Phi))));
  end;
  //нахождение средней глубины полигонов:
  //так как данная глубина кроме сортировки нигде не используется, то
  //можно опустить деление на 3 - это увеличит производительность
  //алгоритма, сохранив его функциональность
  for I := 1 to CP do
    P[I].mZ := Z[P[I].A[1]] + Z[P[I].A[2]] + Z[P[I].A[3]];
end;

procedure DrawTriangle(A1, A2, A3: T2DPoint);
var
  A: array [1..3] of T2DPoint;
begin
  A[1] := A1;
  A[2] := A2;
  A[3] := A3;
  BufMain.Canvas.Polygon(A);
end;

procedure DrawPolygon(A1, A2, A3: T2DPoint);
var Nz: Integer;
begin
  //сначала нужно посчитать Z-составляющую нормали, чтобы знать,
  //нужно ли вообще рисовать полигон
  Nz := A1.X * (A2.Y - A3.Y) + A2.X * (A3.Y - A1.Y) + A3.X * (A1.Y - A2.Y);
  //если полигон виден, то нарисовать его
  if Nz < 0 then
    DrawTriangle(A1, A2, A3);
end;

procedure DrawObject;
var
  B: Boolean;
  I: Integer;
begin
  //очистить буфер от старого изображения
  BufMain.Canvas.Draw(0, 0, BufEmpty);
  //сортировка граней
  B := True;
  while B do
  begin
    B := False;
    for I := 1 to (CP - 1) do
      //если глубина меньше, то переместить ближе к концу массива
      if (P[Sort[I]].mZ < P[Sort[I + 1]].mZ) then
      begin
        Sort[I] := Sort[I] + Sort[I + 1];
        Sort[I + 1] := Sort[I] - Sort[I + 1];
        Sort[I] := Sort[I] - Sort[I + 1];
        B := True;
      end;
  end;
  //нарисовать полигоны
  for I := 1 to CP do
    DrawPolygon(V[P[Sort[I]].A[1]], V[P[Sort[I]].A[2]], V[P[Sort[I]].A[3]]);

  //вывести содержимое на экран
  Form1.Canvas.Draw(0, 0, BufMain);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I,koef: Integer;
begin
  //задание координат объекта
  W[1].X := -5;   W[1].Y :=  -2;   W[1].Z := -5;
  W[2].X := -5;   W[2].Y :=  -2;   W[2].Z := 2;
  W[3].X := -5;   W[3].Y := 2;   W[3].Z := 5;
  W[4].X := -5;   W[4].Y := 2;   W[4].Z := -2;
  W[5].X :=  5;   W[5].Y := 2;   W[5].Z := 2;
  W[6].X := 5;   W[6].Y :=  2;   W[6].Z :=  2;
  W[7].X := 5;   W[7].Y := 2;   W[7].Z :=  2;
  W[8].X :=  5;   W[8].Y := 2;   W[8].Z :=  2;

  //задание точек, образующих полигоны
  P[1].A[1]  := 1;   P[1].A[2]  := 4;   P[1].A[3]  := 2;
  P[2].A[1]  := 2;   P[2].A[2]  := 4;   P[2].A[3]  := 3;
  P[3].A[1]  := 5;   P[3].A[2]  := 6;   P[3].A[3]  := 8;
  P[4].A[1]  := 6;   P[4].A[2]  := 7;   P[4].A[3]  := 8;
  P[5].A[1]  := 1;   P[5].A[2]  := 2;   P[5].A[3]  := 5;
  P[6].A[1]  := 2;   P[6].A[2]  := 6;   P[6].A[3]  := 5;
  P[7].A[1]  := 2;   P[7].A[2]  := 3;   P[7].A[3]  := 6;
  P[8].A[1]  := 3;   P[8].A[2]  := 7;   P[8].A[3]  := 6;
  P[9].A[1]  := 3;   P[9].A[2]  := 4;   P[9].A[3]  := 7;
  P[10].A[1] := 4;   P[10].A[2] := 8;   P[10].A[3] := 7;
  P[11].A[1] := 4;   P[11].A[2] := 1;   P[11].A[3] := 8;
  P[12].A[1] := 1;   P[12].A[2] := 5;   P[12].A[3] := 8;

  //начальная сортировка
  for I := 1 to CP do
    Sort[I] := I;
  //начальный масштаб
  Scale := 20;
  //углы обзора
  Teta := 1;
  Phi := 1;
  //создание буферов
  BufMain := TBitMap.Create;
  BufEmpty := TBitMap.Create;
  BufEmpty.Height := Form1.ClientHeight;
  BufEmpty.Width := Form1.ClientWidth;
  BufMain.Height := Form1.ClientHeight;
  BufMain.Width := Form1.ClientWidth;
  //получить видовые координаты
  Get2D;
  //цвет рисуемых линий - черный

  BufMain.Canvas.Pen.Color := RGB(100,0,0);
  BufMain.Canvas.brush.Color:=RGB(50+koef,0,0);



      light0_position[0]:= 0.0;
      light0_position[1]:= 0.0;
      light0_position[2]:= 1.0;
      light0_position[3]:= 1.0;
      DC := GetDC (Handle);
      hrc := wglCreateContext(DC);
      wglMakeCurrent(DC, hrc);
      glClearColor (0.5, 0.5, 0.75, 1.0); // цвет фона
      glEnable(GL_LIGHT0);
      glLightfv(GL_LIGHT0, GL_POSITION, @light0_position);
      ry := 0.0;

end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  //вывести начальную проекцию объекта
     DrawObject;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MDown := True;
  MPos.X := X;
  MPos.Y := Y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if MDown then
  begin
    //изменить углы
    Teta := Teta + 0.01 * (MPos.X - X);
    Phi := Phi + 0.01 * (MPos.Y - Y);
    MPos.X := X;
    MPos.Y := Y;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
  end;
end;

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

//при изменении размеров окна необходимо перерисовать изображение
procedure TForm1.FormResize(Sender: TObject);
begin
  BufEmpty.Height := Form1.ClientHeight;
  BufEmpty.Width := Form1.ClientWidth;
  BufMain.Height := Form1.ClientHeight;
  BufMain.Width := Form1.ClientWidth;
  Get2D;
  DrawObject;
end;

//процедура масштабрования колесом мыши
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  if (WheelDelta > 0) then
  begin
    if (Scale < 200) then
      Inc(Scale, 2);
  end else
  if (WheelDelta < 0) then
  begin
    if (Scale > 2) then
      Dec(Scale, 2);
  end;
  Get2D;
  DrawObject;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BufMain.Free;
  BufEmpty.Free;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = 40 then
 begin
    //изменить углы
//    Teta := Teta + 0.01 * (MPos.X - 10);
    Phi := Phi + 0.01 * (MPos.Y - 5);
//    MPos.X := MPos.X-10;
//    MPos.Y := MPos.Y-1;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
 end        ;
 if Key = 38 then
 begin
    //изменить углы
//    Teta := Teta + 0.01 * (MPos.X - 10);
    Phi := Phi + 0.01 * (MPos.Y + 5);
//    MPos.X := MPos.X-10;
//    MPos.Y := MPos.Y-1;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
 end        ;
 if Key = 40 then
 begin
    //изменить углы
//    Teta := Teta + 0.01 * (MPos.X - 10);
    Phi := Phi + 0.01 * (MPos.Y - 5);
//    MPos.X := MPos.X-10;
//    MPos.Y := MPos.Y-1;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
 end        ;
 if Key = 37 then
 begin
    //изменить углы
    Teta := Teta + 0.01 * (MPos.X - 10);
//    Phi := Phi + 0.01 * (MPos.Y + 5);
//    MPos.X := MPos.X-10;
//    MPos.Y := MPos.Y-1;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
 end        ;
 if Key = 39 then
 begin
    //изменить углы
    Teta := Teta + 0.01 * (MPos.X + 10);
//    Phi := Phi + 0.01 * (MPos.Y + 5);
//    MPos.X := MPos.X-10;
//    MPos.Y := MPos.Y-1;
    //получить видовые координаты
    Get2D;
    //вывести проекцию объекта
    DrawObject;
 end        ;



end;

end.

Это сообщение отредактировал(а) ДКот - 29.12.2012, 14:44

phomm

Дата 10.3.2013, 10:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 7.10.2010

Репутация: нет
Всего: 1

Начнём с того, что строки

Код


DC := GetDC (Handle);
hrc := wglCreateContext(DC);
wglMakeCurrent(DC, hrc);
glClearColor (0.5, 0.5, 0.75, 1.0); // цвет фона
glEnable(GL_LIGHT0);
glLightfv(GL_LIGHT0, GL_POSITION, @light0_position);

не делают вообще ничего, их можно тупо закомментировать. О каком источнике света вообще речь, если Вы используете только канвас.полигон ?
Далее, фигуру Вы никак не затемняли, она тупо чёрная потому, что цвет кисти по умолчанию - чёрный, а текущей кистью полигон заливается при отрисовке.
Добавляем тут установку цвета - и вуаля, фигура красная.

Код


procedure DrawTriangle(A1, A2, A3: T2DPoint);
var
  A: array [1..3] of T2DPoint;
begin
  A[1] := A1;
  A[2] := A2;
  A[3] := A3;
  BufMain.Canvas.brush.Color := clRed;
  BufMain.Canvas.Polygon(A);
end;

Итого, Вам надо решить, если Вы будете использовать опенгл - то и работайте с ним, а не с канвасом. Если же работать с канвасом - то предложение такое - вычисляете цвет грани в зависимости от "угла поворота" грани на "камеру" и передаёте цвет в функцию, я там просто красный поставил (по идее можно просто умножать некий цвет на интенсивность засветки грани, а засветку определять по произведению вектора нормали грани и вектора камеры, можно даже как-то упростить, протянув просто некий обсчет по текущим углам)

Ну и напоследок, коли этот код Ваш, то труда допилить на канвасе не составит, сам код вполне хороший, (ну, за небольшими некрасивостями, типа невыведения кода вращения в параметризованную приращениями углов функцию), и человек, который это написал, вполне справится с базовыми уравнениями вычисления освещённости.

Это сообщение отредактировал(а) phomm - 10.3.2013, 10:18

phomm

Дата 13.3.2013, 15:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 7.10.2010

Репутация: нет
Всего: 1

Кстати, вот и теорию нашлась Вам из соседней темы. Как это всё делать на канвасе - с освещением. http://www.alexeyspace.ru/articles/1

Это сообщение отредактировал(а) phomm - 13.3.2013, 15:32

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »