[Ama]

Доброе время суток, спецы!!!! Понимаю, что тема убитая, я вот тока начал покорять OpenGL. И сразу куча вопросов. Ну кое как к примеру создал форму с прорисовкой прямоугольника внутри. Но вот второй день бьюсь над проблемой, как мне на ентот прямоугольник "растянуть" картинку из файла????????

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    OD1: TOpenDialog;
    DXDIB1: TDXDIB;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(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 FormDblClick(Sender: TObject);
  private
    { Private declarations }
    nX, nY, oX, oY, oxx, oyy: GLDouble;
    dr: boolean;
    Pic: TPicture;
  public
    { Public declarations }
    function SetPixFormat(DC: HDC): boolean;
    procedure doQuard(ListInd: integer);
    procedure doDraw;
  end;

var
  Form1: TForm1;
  DC: HDC;
  HRC: HGLRC;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.SetPixFormat(DC: HDC): boolean;
 var
  pfd: PIXELFORMATDESCRIPTOR;
  ppfd: PPIXELFORMATDESCRIPTOR;
  pixFormat: integer;
begin
 ppfd:= @pfd;
 ppfd.nSize:= SizeOf(PIXELFORMATDESCRIPTOR);
 ppfd.nVersion:= 1;
 ppfd.dwFlags:= PFD_DRAW_TO_WINDOW xor PFD_SUPPORT_OPENGL xor
                PFD_DOUBLEBUFFER;
 ppfd.dwLayerMask:= PFD_MAIN_PLANE;
 ppfd.iPixelType:= PFD_TYPE_RGBA;
 ppfd.cColorBits:= 32;
 ppfd.cDepthBits:= 32;
 ppfd.cAccumBits:= 0;
 ppfd.cStencilBits:= 0;
 pixFormat:= ChoosePixelFormat(DC, ppfd);

 if (pixFormat = 0) or not SetPixelFormat(DC, pixFormat, ppfd) then
  begin
   ShowMessage('NONONO');
   Result:= false;
   exit;
  end;
 Result:= true;
end;

procedure TForm1.FormCreate(Sender: TObject);
 var
    p: TGLArrayf4;
    d: TGLArrayf3;
begin
 DC:= GetDC(Handle);
 if not SetPixFormat(DC) then exit;
 HRC:= wglCreateContext(DC);
 wglMakeCurrent(DC, HRC);
 //ShowCursor(false);
 glClearColor(0.2, 0.2, 0.2, 1.0);
 glEnable(GL_COLOR_MATERIAL or GL_DEPTH_TEST); // GL_DEPTH_TEST GL_POINT_SMOOTH

{ p[0]:= 3; p[1]:= 3; p[2]:= 3; p[3]:= 1;
 d[0]:= -1; d[1]:= -1; d[2]:= -3;
 glLightfv(GL_LIGHT0, GL_POSITION, @p);
 glLightfv(GL_LIGHT0, GL_SPOT_DIRECTION, @d);}

// glClear(GL_COLOR_BUFFER_BIT);
// doQuard(1);
 dr:= false;
 nX:= -400.0; nY:= -400.0;
 Pic:= TPicture.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 wglMakeCurrent(0, 0);
 wglDeleteContext(HRC);
 ReleaseDC(Handle, DC);
 DeleteDC(DC);
 Pic.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 glViewPort(0, 0, ClientWidth, ClientHeight);
 glMatrixMode(GL_PROJECTION);
 glLoadIdentity;
 glOrtho(-500, 500, -500, 500, 2, 1200);
// gluPerspective(30.0, ClientWidth / ClientHeight, 0.1, 1000.0);
 gluLookAt(0, 0, 500, 0, 0, 0, 0, 1, 0);
 glMatrixMode(GL_MODELVIEW);
// glLoadIdentity;
// glClear(GL_COLOR_BUFFER_BIT or
//         GL_DEPTH_BUFFER_BIT);
 doDraw;
end;

procedure TForm1.doQuard(ListInd: integer);
begin
 glClear(GL_DEPTH_BUFFER_BIT xor GL_COLOR_BUFFER_BIT);
// glNewList(ListInd, GL_COMPILE);
 glBegin(GL_QUADS);
  glColor3f(0, 0, 1);
  glVertex3f(nX, nY, 0);

  glColor3f(0, 1, 0);
  glVertex3f(nX + 800, nY, 0);

  glColor3f(1, 0, 0);
  glVertex3f(nX + 800, nY + 800, 0);

  glColor3f(0, 1, 1);
  glVertex3f(nX, nY + 800, 0);
 glEnd;
// glEndList;
 SwapBuffers(DC);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 doDraw;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 var xx, yy: GLDouble;
begin
 oX:= nX; oY:= nY;
 xx:= 500 - (X / ClientWidth) * 1000;
 yy:= 500 - (1 - Y / ClientHeight) * 1000;
{ if (Round(xx - nX) * 1e5 > 0) and (Round(xx - (nX + 8)) * 1e5 < 0) and
    (Round(yy - nY) * 1e5 > 0) and (Round(yy - (nY + 8)) * 1e5 < 0) then}
  begin
   dr:= true;
   oxx:= xx; oyy:= yy;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
 var xx, yy: GLDouble;
begin
 if dr then
  begin
   xx:= 500 - (X / ClientWidth) * 1000;
   yy:= 500 - (1 - Y / ClientHeight) * 1000;
   nX:= oX - xx + oxx;
   nY:= oY - yy + oyy;
   doDraw;
  end;
end;

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

procedure TForm1.FormDblClick(Sender: TObject);
begin
 if OD1.Execute then
  begin
   Pic.LoadFromFile(OD1.FileName);
  end;
end;

procedure TForm1.doDraw;
begin
 doQuard(1);
// Как-то тут хотел прописать прорисовку картинки......но даже не знаю // счего начать.....
end;

end.

Я знаю что гугл супер, но все таки я не понимаю как мне энто сделать....Мне желательно прям на форуме объяснить, прошу не посялать по ссылкам.........

[Ama]

Неужели никто не знает ответа..............я уже весь гугл облазил но ничего не нашел вот что я пытаюсь сделать:

Код:

procedure TForm1.BitmapToGLBitmap(ABitmap: TBitmap; var PicData: pointer);
 type TADataC = array[0..2] of GLuByte;
      TADataW = array of TADataC;
      TAData = array of TADataW;

      TRGBArray = array[0..0] of TRGBTriple;
      PRGBArray = ^TRGBArray;

 var AData: TAData;
     x, y: integer;
     col: PRGBarray;
     r, g, b: byte;
begin
 if (ABitmap.Width = 0) or (ABitmap.Height = 0) then
  begin
   PicData:= nil;
   exit;
  end;
 SetLength(AData, ABitmap.Width);
 for x:= 0 to ABitmap.Width - 1 do
   SetLength(AData[x], ABitmap.Height);
 ABitmap.PixelFormat:= pf24bit;
 for y:= 0 to ABitmap.Height - 1 do
  begin
   col:= ABitmap.ScanLine[y];
   for x:= 0 to ABitmap.Width - 1 do
    begin
     r:= col[x].rgbtRed; g:= col[x].rgbtGreen; b:= col[x].rgbtBlue;
     AData[x][y][0]:= r;
     AData[x][y][1]:= g;
     AData[x][y][2]:= b;
    end;
  end;
 PicData:= AData;
end;

.....

procedure TForm1.FormDblClick(Sender: TObject);
begin
 if OD1.Execute then
  begin
   Pic.LoadFromFile(OD1.FileName);
   doDraw;
  end;
end;

procedure TForm1.doDraw;
 var b: TBitmap;
     ImPointer: Pointer;
begin
 doQuard(1);
 if Pic.Graphic <> nil then
  begin
   b:= TBitmap.Create;
   b.Assign(Pic.Graphic);
   BitmapToGLBitmap(b, ImPointer);

   glEnable(GL_ALPHA_TEST);

   glEnable(GL_DEPTH_TEST);
   glEnable(GL_COLOR_MATERIAL);
   glEnable(GL_LIGHTING);
   glEnable(GL_LIGHT0);
   glEnable(GL_BLEND);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

   glRasterPos2d(nX, nY);
   glPixelZoom(Abs(2 * nX / Pic.Graphic.Width), Abs(2 * nY / Pic.Graphic.Height));
   glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
   glDrawPixels(Pic.Graphic.Width, Pic.Graphic.Height, GL_RGB,
                GL_UNSIGNED_BYTE, ImPointer); //<-вот здесь сильно ругается
   SwapBuffers(DC);
   b.Free;
  end;
end;

[Ama]

Код ошибки: ---------------------------
Project D:\For Borland\Delph_project\OpenGL\Firs_project\Project1 .exe faulted with message: 'access violation at 0x0024fee9: read of address 0x0134951a'. Process Stopped. Use Step or Run to continue.
---------------------------

[AND_REY]

Вот нашёл исходник может поможет: zalil.ru/30463307

[Ama]

Спасибо, конечно AND_REY но это не совсем то что надо. Потому что размер карты для текстуры не должен быть большим, иначе ругается на переполнение стека. А вот если статический массив карты заменить на динамический то компилятор ругается при выводе карты:

Код:

....
   glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, Pic.Graphic.Width, Pic.Graphic.Height,
                0, GL_RGB, GL_UNSIGNED_BYTE, ImPointer);
.....

Почему?