program SimpleLoadFromFile; {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, Windows, SysUtils, dglOpenGL, glBitmap, Helper; var oglWindow: TOpenGLWindow; running: Boolean = true; tex: TglBitmap2D; function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin case Msg of WM_DESTROY: begin running := false; end; end; result := DefWindowProc(hWnd, Msg, wParam, lParam); end; procedure RenderLoop; begin tex.Bind(); glColor4f(1, 1, 1, 1); glBegin(GL_QUADS); glTexCoord2f(0, 0); glVertex2f(100, 100); glTexCoord2f(1, 0); glVertex2f(700, 100); glTexCoord2f(1, 1); glVertex2f(700, 500); glTexCoord2f(0, 1); glVertex2f(100, 500); glEnd; tex.Unbind(); end; { function to generate texture data } procedure GenerateTextureFunc1(var FuncRec: TglBitmapFunctionRec); var g1, g2, g3, g4: Single; begin g1 := (sin(FuncRec.Position.X / 25) + 1) / 2; // generator function 1: large sinus on x position (0.0 to 1.0) g2 := (sin(FuncRec.Position.Y / 25) + 1) / 2; // generator function 2: large sinus on y position (0.0 to 1.0) g3 := FuncRec.Position.X / FuncRec.Size.X; // generator function 3: linear fade on x position (0.0 to 1.0) g4 := FuncRec.Position.Y / FuncRec.Size.Y; // generator function 4: linear fade on y position (0.0 to 1.0) FuncRec.Dest.Data.r := Trunc(g1 * FuncRec.Dest.Range.r); FuncRec.Dest.Data.g := Trunc(g2 * FuncRec.Dest.Range.g); FuncRec.Dest.Data.b := Trunc(g3 * FuncRec.Dest.Range.b); FuncRec.Dest.Data.a := Trunc(g4 * FuncRec.Dest.Range.a); end; { function to generate texture data } procedure GenerateTextureFunc2(var FuncRec: TglBitmapFunctionRec); var x, y: Single; begin x := FuncRec.Position.X / FuncRec.Size.X; y := FuncRec.Position.Y / FuncRec.Size.Y; if (x < 0.05) or (x > 0.95) or (y < 0.05) or (y > 0.95) then begin FuncRec.Dest.Data := FuncRec.Dest.Range; end else if (y < 0.333) then begin FuncRec.Dest.Data := glBitmapRec4ui(0, 0, 0, 0); end else if (y < 0.666) then begin FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, 0, 0, 0); end else begin FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, FuncRec.Dest.Range.g, 0, 0); end; end; begin oglWindow := CreateOpenGLWindow('TextureFromFunction', 800, 600, @WindowProc); try // create texture use either GenerateTextureFunc1 or GenerateTextureFunc2 tex := TglBitmap2D.Create( glBitmapSize(512, 512), tfRGBA8ub4, @GenerateTextureFunc1 //@GenerateTextureFunc2 ); tex.GenTexture; while running and ProgressMesages do begin RenderLoop; SwapBuffers(oglWindow.DC); end; finally FreeAndNil(tex); DestroyOpenGLWindow(oglWindow); end; end.