- Код: Выделить всё
{$MODE objfpc}{$H+}
{$APPTYPE GUI}
program ogl_fpc_source01;
uses
{$ifdef windows}
windows,
{$endif}
gl, glu;
var
msg : TMSG; // Windows messages
hWindow : HWnd; // Windows Handle to the OGL Window
dcWindow : hDc; // Device Context for the OGL Window
rcWindow : HGLRC; // Render Context for the OGL Window
width, height, bits : longint;
fullscreen, active : boolean;
zoom : real;
w, h : integer;
wx, wy : real;
//vx, vy : integer;
cur_wx, cur_wy : real;
tmp_wx, tmp_wy : real;
{ viewport to world coordinates translation }
procedure v2w(vx, vy : integer; var wx, wy : real);
var
viewport : array[0..3] of integer;
modelview : array[0..15] of real;
projection : array[0..15] of real;
wz : real;
begin
glGetDoublev(GL_MODELVIEW_MATRIX, @modelview); //get the modelview info
glGetDoublev(GL_PROJECTION_MATRIX, @projection); //get the projection matrix info
glGetIntegerv(GL_VIEWPORT, @viewport); //get the viewport info
gluUnProject(vx, viewport[3]-vy-1, 0, @modelview, @projection, @viewport, @wx, @wy, @wz);
end;
// Simple OGL initialisation for testing. //
procedure OpenGL_Init();
begin
zoom := 1.0;
w := 1200;
h := 800;
wx := 0;
wy := 0;
glShadeModel(GL_SMOOTH);
// glEnable(GL_LINE_SMOOTH);
// glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
//glHint(GL_LINE_SMOOTH_HINT, GL_NICEST);
glEnable(GL_BLEND); // Включается смешение цветов, необходимое
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glClearColor( 0.0, 0.0, 0.0, 1.0 );
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluOrtho2D(wx, w, wy, h);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
function OpenGL_Render() : boolean;
var
i, j : real;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
{ draw here }
glClear( GL_COLOR_BUFFER_BIT );
glLoadIdentity();
glTranslatef(wx, wy, 0.0);
glScalef(zoom, zoom, 0.0);
glColor3f(1.0, 1.0, 1.0);
glBegin(GL_LINE_LOOP);
glVertex2f(1.0, 1.0);
glVertex2f(1.0, h-1);
glVertex2f(w-1, h-1);
glVertex2f(w-1, 1.0);
glEnd();
i := 0;
j := 0;
glColor3f(0.5, 0.5, 0.5);
glBegin(GL_POINTS);
while i < 1200 do begin
while j < 800 do begin
glVertex2f(i, j);
j := j + 20;
end;
j := 0;
i := i + 20;
end;
glEnd();
glColor3f(1.0, 0.0, 0.0);
glBegin(GL_LINES);
glVertex2f(0.0, 0.0);
glVertex2f(100, 100);
glEnd();
swapBuffers( dcWindow ); // put opengl stuff to screen
result := true;
end;
procedure OpenGL_Resize(width : integer; height : integer);
// ar : real;
begin
if (Height = 0) then
Height := 1;
glViewport(0, 0, width, height);
//ar := width/height;
{
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
if(width > height) then
gluOrtho2D(0, w, 0, h*ar)
else
gluOrtho2D(0, w*ar, 0, h);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity; }
end;
// Try, Throw, Catch mechanism. Simple proc to display given errors. //
procedure ThrowError(pcErrorMessage : pChar);
begin
MessageBox(0, pcErrorMessage, 'Error', MB_OK);
Halt(0);
end;
// Standard WinProc. Handles all the messages from the System. //
function GLWndProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall; export;
begin
GLWndProc := 0;
case amessage of
wm_create:
begin
active := true; // if GL Window was created correctly, then set
exit; // active-flag to "true".
end;
wm_paint:
begin
OpenGL_Render();
exit; // nothing to paint to Windows as we do all drawing with OGL
end;
wm_size:
begin
OpenGL_Resize(LOWORD(lParam), HIWORD(lParam));
OpenGL_Render();
active := true;
// exit;
end;
wm_move:
begin
//writeln('move window');
exit;
end;
wm_erasebkgnd:
begin
exit; // чтобы не перезаливалось окно и не мерцало
end;
{ --- MOUSE --- }
wm_lbuttondown:
begin
exit;
end;
wm_lbuttonup:
begin
exit;
end;
wm_mousewheel:
begin
if wparam > 0 then
//if zoom < 2 then
zoom := zoom + 0.05
else
if zoom > 0.3 then
zoom := zoom - 0.05;
opengl_render();
// exit;
end;
wm_mbuttondown:
begin
//cur_x := loword(lparam);
//cur_y := hiword(lparam);
v2w(loword(lparam), hiword(lparam), cur_wx, cur_wy);
// writeln('mouse mbutton down'); // Если раскоментить, то при нажатии средней кнопки мыши, программа зависает (
// exit;
end;
wm_mbuttonup:
begin
exit;
end;
wm_mousemove:
begin
if wparam = MK_MBUTTON then
begin
{ нажата средняя кнопка мыши, двигаем область рисования }
v2w(loword(lparam), hiword(lparam), tmp_wx, tmp_wy);
wx := wx + (tmp_wx - cur_wx);
wy := wy - (tmp_wy - cur_wy);
opengl_render();
end;
// exit;
end;
{ --- KEYBOARD --- }
wm_keydown:
begin
case wParam of
VK_ESCAPE : begin {SendMessage(hWindow,wm_destroy,0,0);} end;
VK_ADD : begin zoom := zoom + 0.25; opengl_render(); end;
VK_SUBTRACT : begin zoom := zoom - 0.25; opengl_render(); end;
VK_UP : begin wy := wy + 10; opengl_render(); end;
VK_DOWN : begin wy := wy - 10; opengl_render(); end;
VK_LEFT : begin wx := wx - 10; opengl_render(); end;
VK_RIGHT : begin wx := wx + 10; opengl_render(); end;
end;
// exit; // check for ESC key. If pressed, then send quit message
end;
wm_keyup:
begin
case wParam of
VK_F1 : begin { line } end;
VK_F2 : begin { rect } end;
VK_F3 : begin { circle } end;
VK_F4 : begin { arc } end;
VK_F5 : begin { polygon } end;
VK_F6 : begin { text } end;
end;
// exit;
end;
wm_destroy:
begin
active := false; // if quit message was sent, exit the main loop by setting
PostQuitMessage(0); // the active-flag to "false".
// exit;
end;
wm_syscommand: // system wants something..
begin
case (wParam) of
SC_SCREENSAVE : begin // ..don't start any screensavers.
GLWndProc := 0;
end;
SC_MONITORPOWER : begin // ..and don't kill monitor power.
GLWndProc := 0;
end;
end;
end;
end;
GLWndProc := DefWindowProc(Window, AMessage, WParam, LParam); // let Windows deal with the rest of the messages.
end;
// Register the Window Class. //
function WindowRegister: Boolean;
var
WindowClass: WndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@GLWndProc); // Handle to our Windows messaging interface func.
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance; // Get the Windows Instance for our app.
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
// WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := 'GLWindow'; // Name the specified Window Class
WindowRegister := RegisterClass(WindowClass) <> 0;
end;
// Create the OGL Window. //
function WindowCreate(pcApplicationName : pChar): HWnd;
var
hWindow: HWnd; // Handle to Window
// dmScreenSettings : DEVMODE; // Used for Full Screen Mode
begin
hWindow := CreateWindow('GLWindow',
pcApplicationName,
WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS,
cw_UseDefault,
cw_UseDefault,
width,
height,
0, 0,
system.MainInstance,
nil);
if hWindow <> 0 then
begin
ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
end;
WindowCreate := hWindow;
end;
// Init the Window and bind OGL to it. //
function WindowInit(hParent : HWnd): Boolean;
var
FunctionError : integer;
pfd : PIXELFORMATDESCRIPTOR;
iFormat : integer; // Pixel Format
begin
FunctionError := 0;
dcWindow := GetDC( hParent ); // Get Device Context
FillChar(pfd, sizeof(pfd), 0); // Define Pixel Format
pfd.nSize := sizeof(pfd);
pfd.nVersion := 1;
pfd.dwFlags := PFD_SUPPORT_OPENGL OR PFD_DRAW_TO_WINDOW OR PFD_DOUBLEBUFFER;
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := bits;
pfd.cDepthBits := 32;
pfd.iLayerType := PFD_MAIN_PLANE;
iFormat := ChoosePixelFormat( dcWindow, @pfd ); // Create Pixel Format
if (iFormat = 0) then
FunctionError := 1;
SetPixelFormat( dcWindow, iFormat, @pfd ); // Set Pixel Format
rcWindow := wglCreateContext( dcWindow ); // Create OpenGL Context
if (rcWindow = 0) then
FunctionError := 2;
wglMakeCurrent( dcWindow, rcWindow ); // Bind OpenGL to our Window
if FunctionError = 0 then
WindowInit := true
else
WindowInit := false;
end;
// Main function to create the Window. //
function CreateOGLWindow(pcApplicationName : pChar; iApplicationWidth, iApplicationHeight, iApplicationBits : longint; bApplicationFullscreen : boolean):Boolean;
begin
width := iApplicationWidth;
height := iApplicationHeight;
bits := iApplicationBits;
fullscreen := bApplicationFullscreen;
if not WindowRegister then begin
ThrowError('Could not register the Application Window!');
CreateOGLWindow := false;
Exit;
end;
hWindow := WindowCreate(pcApplicationName);
if longint(hWindow) = 0 then begin
ThrowError('Could not create Application Window!');
CreateOGLWindow := false;
Exit;
end;
if not WindowInit(hWindow) then begin
ThrowError('Could not initialise Application Window!');
CreateOGLWindow := false;
Exit;
end;
CreateOGLWindow := true;
end;
// Kill Application Window again. //
procedure KillOGLWindow();
begin
wglMakeCurrent( dcWindow, 0 ); // Kill Device Context
wglDeleteContext( rcWindow ); // Kill Render Context
ReleaseDC( hWindow, dcWindow ); // Release Window
DestroyWindow( hWindow ); // Kill Window itself
end;
// Main Loop. //
begin
CreateOGLWindow('tura', 1024, 768, 32, false);
OpenGL_Init(); // init opengl stuff
repeat // start main proc
if PeekMessage(@msg,0,0,0,0) = true then
begin
GetMessage(@msg,0,0,0);
TranslateMessage(msg);
DispatchMessage(msg);
end;
//OpenGL_Render();
until active = false; // end main proc
KillOGLWindow(); // kill window stuff
end.
P.S. Код самодостаточен, можно его скопироваьт в фалик и сделать fpc файлик.pas
И ещё один момент, почему в событии:
- Код: Выделить всё
wm_mousewheel:
begin
if wparam > 0 then
//if zoom < 2 then // Если я хочу ограничить максимальное увеличение, то увеличения вообще не происходит? Если закометить эту строчку то всё работает О_о
zoom := zoom + 0.05
else
if zoom > 0.3 then
zoom := zoom - 0.05;
opengl_render();
// exit;
end;
но думаю, со временем разберусь. CAD-ы я особо не использую, максимум kiCAD какой-нибудь для поделок, вечер скоротать, а так мне их больше применять негде. Была задумка сделать некий аналог kicad-а, но так как я элементарно ещё с матрицами и преобразованиями над ними плаваю(да и в целом смутно представляю, как это всё организовано в плане вывода на экран), то решил оставить эту затею. Может быть, когда-нибудь, когда ум просветлеет в этой части, вернусь к этому вопросу, а сейчас пока тесты да баловство, удовлетворения интереса для.