Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 05.02.2011, 15:43
Ama Ama вне форума
Активный
 
Регистрация: 15.07.2008
Сообщения: 260
Репутация: 23
Восклицание OpenGL в Delphi 7

Доброе время суток, спецы!!!! Понимаю, что тема убитая, я вот тока начал покорять OpenGL. И сразу куча вопросов. Ну кое как к примеру создал форму с прорисовкой прямоугольника внутри. Но вот второй день бьюсь над проблемой, как мне на ентот прямоугольник "растянуть" картинку из файла????????
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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.
Я знаю что гугл супер, но все таки я не понимаю как мне энто сделать....Мне желательно прям на форуме объяснить, прошу не посялать по ссылкам.........
Изображения
Тип файла: jpg Безымянный.jpg (31.2 Кбайт, 13 просмотров)
__________________
APPLICATION.TERMINATOR
Ответить с цитированием
  #2  
Старый 06.02.2011, 18:37
Ama Ama вне форума
Активный
 
Регистрация: 15.07.2008
Сообщения: 260
Репутация: 23
По умолчанию

Неужели никто не знает ответа..............я уже весь гугл облазил но ничего не нашел вот что я пытаюсь сделать:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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;
__________________
APPLICATION.TERMINATOR
Ответить с цитированием
  #3  
Старый 06.02.2011, 18:39
Ama Ama вне форума
Активный
 
Регистрация: 15.07.2008
Сообщения: 260
Репутация: 23
По умолчанию

Код ошибки: ---------------------------
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.
---------------------------
__________________
APPLICATION.TERMINATOR
Ответить с цитированием
  #4  
Старый 06.02.2011, 19:15
Аватар для AND_REY
AND_REY AND_REY вне форума
Активный
 
Регистрация: 31.03.2009
Адрес: Украина, г.Днепропетровск
Сообщения: 324
Версия Delphi: Delphi7
Репутация: 3877
По умолчанию 1

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

Последний раз редактировалось AND_REY, 06.02.2011 в 19:22.
Ответить с цитированием
  #5  
Старый 07.02.2011, 00:44
Ama Ama вне форума
Активный
 
Регистрация: 15.07.2008
Сообщения: 260
Репутация: 23
По умолчанию

Спасибо, конечно AND_REY но это не совсем то что надо. Потому что размер карты для текстуры не должен быть большим, иначе ругается на переполнение стека. А вот если статический массив карты заменить на динамический то компилятор ругается при выводе карты:
Код:
1
2
3
4
....
   glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, Pic.Graphic.Width, Pic.Graphic.Height,
                0, GL_RGB, GL_UNSIGNED_BYTE, ImPointer);
.....
Почему?
__________________
APPLICATION.TERMINATOR

Последний раз редактировалось Ama, 07.02.2011 в 01:04.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:17.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025