delphi opengl

[qwazarkent]

есть такой код, реализующий цветные вертикальные полосы. Как сделать например окружность красного цвета? Построение цветных вертикальных полос происходит в процедуре procedure LoadTexture; вот код реализующий полосы:

      if j mod 2=0 then//если j четная то
        bits[i,j,0]:=255//красная составляющая максимальная
      else//иначе
        bits[i,j,0]:=0; 
        bits[i,j,1]:=255;
        bits[i,j,2]:=0;

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure WmCreate(var msg : TWMCreate); message WM_CREATE;
    procedure WmPaint(var msg : TWMPaint); message WM_PAINT;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  Context : HGLRC;
implementation

{$R *.dfm}

procedure LoadTexture;
var i,j : integer;
    tex : TBitmap;
    bits : array[0..7,0..7,0..2] of Byte;
begin
tex:=TBitmap.Create;
for i := 0 to 7 do
  begin
  for j := 0 to 7 do
    begin
      if j mod 2=0 then
        bits[i,j,0]:=255
      else
        bits[i,j,0]:=0; 
        bits[i,j,1]:=255;
        bits[i,j,2]:=0;
    end;
  end;
  tex.Free;

  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,GL_RGB,8,8,0,GL_RGB,GL_UNSIGNED_BYTE,@bits);
  glEnable(GL_TEXTURE_2D);
end;

procedure TForm1.WmCreate(var msg : TWMCreate);
var npf : integer;
    pfd : PIXELFORMATDESCRIPTOR;
begin
  FillChar(pfd,SizeOf(pfd),0);
  npf:=ChoosePixelFormat(Canvas.Handle,@pfd);
  SetPixelFormat(Canvas.Handle,npf,@pfd);
  Context:=wglCreateContext(Canvas.Handle);
end;

procedure TForm1.WmPaint(var msg : TWMPaint);
begin
  wglMakeCurrent(Canvas.Handle,Context);
  glClearColor(0,0,0,0);
  glClear(GL_COLOR_BUFFER_BIT);
  LoadTexture;
  glBegin(GL_QUADS);
     glTexCoord2d(0,0); glVertex3f(0.5,0.5,0);
     glTexCoord2d(1,0); glVertex3f(-0.5,0.5,0);
     glTexCoord2d(1,1); glVertex3f(-0.5,-0.5,0);
     glTexCoord2d(0,1); glVertex3f(0.5,-0.5,0);
  glEnd;

end;
end.

[Develop]

окружность можно сделать примерно так:

cX:= 3;
cY:= 3;
cR:= 3;
cR2:= cR*cR;
for i := 0 to 7 do
for j := 0 to 7 do
begin
  tmp:= sqr(i-cX) + sqr(j-cY);
  if tmp <= cR2 then
  begin
     bits[i,j,0]:=255; 
     bits[i,j,1]:=0;
     bits[i,j,2]:=0;
  end
  else
  begin
     bits[i,j,0]:=0;
     bits[i,j,1]:=255;
     bits[i,j,2]:=0;
  end;
end;

и да, это - "tex:=TBitmap.Create;" там тоже не нужно.

P.S. Не надо грузить текстуру каждый кадр)) LoadTexture лучше перенести из WmPaint в WmCreate.

Удачи !!

[qwazarkent]

ок спасибо. но вместо окружности получилась фигура похожая на квадрат

[Develop]

Сделай размер рисунка побольше, например 128x128 текселей и будет тебе счастье))

[qwazarkent]

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure WmCreate(var msg : TWMCreate); message WM_CREATE;
    procedure WmPaint(var msg : TWMPaint); message WM_PAINT;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  Context : HGLRC;
implementation

{$R *.dfm}

procedure LoadTexture;
var i,j,cX,cY,cR,cR2 : integer;
    tmp : real;
    tex : TBitmap;
    bits : array[0..7,0..7,0..2] of Byte;
begin
cX:=3;
cY:=3;
cR:=3;
cR2:= cR*cR;
for i:=0 to 7 do
for j:=0 to 7 do
begin
  tmp:= sqr(i-cX) + sqr(j-cY);
  if tmp <= cR2 then
  begin
     bits[i,j,0]:=255; 
     bits[i,j,1]:=0;
     bits[i,j,2]:=0;
  end
  else
  begin
     bits[i,j,0]:=0;
     bits[i,j,1]:=255;
     bits[i,j,2]:=0;
  end;
end;
    

  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,GL_RGB,8,8,0,GL_RGB,GL_UNSIGNED_BYTE,@bits);
  glEnable(GL_TEXTURE_2D);
end;

procedure TForm1.WmCreate(var msg : TWMCreate);
var npf : integer;
    pfd : PIXELFORMATDESCRIPTOR;
begin
  FillChar(pfd,SizeOf(pfd),0);
  npf:=ChoosePixelFormat(Canvas.Handle,@pfd);
  SetPixelFormat(Canvas.Handle,npf,@pfd);
  Context:=wglCreateContext(Canvas.Handle);
end;

procedure TForm1.WmPaint(var msg : TWMPaint);
begin
  wglMakeCurrent(Canvas.Handle,Context);
  glClearColor(0,0,0,0);
  glClear(GL_COLOR_BUFFER_BIT);
  LoadTexture;
  glBegin(GL_QUADS);
     glTexCoord2d(0,0); glVertex3f(0.5,0.5,0);
     glTexCoord2d(1,0); glVertex3f(-0.5,0.5,0);
     glTexCoord2d(1,1); glVertex3f(-0.5,-0.5,0);
     glTexCoord2d(0,1); glVertex3f(0.5,-0.5,0);
  glEnd;
end;
end.

[Develop]

Эх молодежь))

procedure LoadTexture;
const 
  cX = 64;
  cY = 64;
  cR = 32;
var i,j : integer;
    cR2, tmp : double;
    bits : array[0..127,0..127,0..2] of Byte;
begin
  cR2:= cR*cR;
  for i:=0 to 127 do
  for j:=0 to 127 do
  begin
    tmp:= sqr(i-cX) + sqr(j-cY);
    if tmp <= cR2 then
    begin
       bits[i,j,0]:=255; 
       bits[i,j,1]:=0;
       bits[i,j,2]:=0;
    end
    else
    begin
      bits[i,j,0]:=0;
      bits[i,j,1]:=255;
      bits[i,j,2]:=0;
    end;
  end;
    
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
  glTexImage2D(GL_TEXTURE_2D,0,GL_RGB,128,128,0,GL_RGB,GL_UNSIGNED_BYTE,@bits);
  glEnable(GL_TEXTURE_2D);
end;

[qwazarkent]

=) спасибо

[qwazarkent]

и еще последние 2 вопроса:
1. Как например реализовать мишень для дротиков? типа там кольца
2. Как сделать внутри Quada квадрат развернутый на 45 градусов, и внутри развернутого квадрата еще один квадрат

п.с. кажется наглею, но если не сложно посмотрите. оочень нужно
п.с.с. не очень понимаю реализацию нескольких геометрических объектов одновременно (например, внутри квадрата треугольник)

[Develop]

Вообще то это уже тянет на фриланс =) ну да ладно ...

по поводу мишени - то можно рисовать несколько окружностей разного радиуса и цвета, а на счет пункта 2 то сходу так не соображу, надо подумать.

[qwazarkent]

"по поводу мишени - то можно рисовать несколько окружностей разного радиуса и цвета" вот именно я незнаю как реализовать одновременно несколько объектов, например внутри Quada квадрат развернутый на 45 градусов, а внутри него окружность