program glThreads;
uses Windows, Messages, OpenGL;
const
WND_TITLE = 'stars';
FPS_TIMER = 1; // Timer to calculate FPS
FPS_INTERVAL = 500; // Calculate FPS every 1000 ms
Const
ThreadLength = 100;
MaxThreads = 127;
StarCount = 500;
type TVertex = Record
X, Y, Z : glFloat;
end;
var
h_Wnd : HWND; // Global window handle
h_DC : HDC; // Global device context
h_RC : HGLRC; // OpenGL rendering context
keys : Array[0..255] of Boolean; // Holds keystrokes
FPSCount : Integer = 0; // Counter for FPS
ElapsedTime : Integer; // Elapsed time between frames
Xcoord, Ycoord : Integer; // mouse coordinates
Smoothing : Boolean;
RndVal : glFloat;
ThreadCount : Integer = 5;
Stars : Array[0..StarCount, 0..1] of TVertex;
Rnd : Array[0..MaxThreads] of TVertex;
SSP : Array[0..StarCount] of glFloat;
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
function IntToStr(Num : Integer) : String;
begin
Str(Num, result);
end;
procedure glDraw();
var I : Integer;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer
glLoadIdentity(); // Reset The View
glTranslate(0, 0, -7);
glRotatef(90, 1,0,0);
// Draw the stars
For I := 0 to StarCount do
begin
glBegin(GL_LINE_STRIP);
glColor3f((Stars[I,0].Y/5), (Stars[I, 0].Y/5), (Stars[I, 0].Y/5));
glVertex3fv(@Stars[I, 0]);
glColor3f(0,0,0);
glVertex3fv(@Stars[I, 1]);
Stars[I,1] := Stars[I,0];
Stars[I,0].Y := Stars[I,0].Y + SSP[I];
if Stars[I,0].Y >= 10 then
begin
SSP[I] := Random(80)/1000; // ################# star speed
Stars[I,0].X := (Random(200)-100)/100;
Stars[I,0].Y := 0;
Stars[I,0].Z := (Random(200)-100)/100;
Stars[I,1] := Stars[I,0];
end;
glEnd;
end;
end;
procedure glInit();
var I : Integer;
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Black Background
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
glClearDepth(1.0); // Depth Buffer Setup
glDisable(GL_DEPTH_TEST);
glBlendFunc(GL_ONE, GL_ONE);
glEnable(GL_BLEND);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
glLineWidth(2);
Smoothing :=FALSE;
RndVal :=0.07;
For I := 0 to StarCount do
SSP[I] := Random(1000)/1000;
end;
procedure glResizeWnd(Width, Height : Integer);
begin
if (Height = 0) then // prevent divide by zero exception
Height := 1;
glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window
glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection
glLoadIdentity(); // Reset View
gluPerspective(45.0, Width/Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth
glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
glLoadIdentity(); // Reset View
end;
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case (Msg) of
WM_CREATE:
begin
// Insert stuff you want executed when the program starts
end;
WM_CLOSE:
begin
PostQuitMessage(0);
Result := 0
end;
WM_KEYDOWN: // Set the pressed key (wparam) to equal true so we can check if its pressed
begin
keys[wParam] := True;
Result := 0;
end;
WM_KEYUP: // Set the released key (wparam) to equal false so we can check if its pressed
begin
keys[wParam] := False;
Result := 0;
end;
WM_SIZE: // Resize the window with the new width and height
begin
glResizeWnd(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end;
WM_MOUSEMOVE:
begin
Xcoord := LOWORD(lParam);
Ycoord := HIWORD(lParam);
Result := 0;
end;
WM_TIMER :
begin
if wParam = FPS_TIMER then
begin
FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL); // calculate to get per Second incase intercal is less or greater than 1 second
SetWindowText(h_Wnd, PChar(WND_TITLE + ' [' + intToStr(FPSCount) + ' FPS] Threads=' + intToStr(ThreadCount+1)));
FPSCount := 0;
Result := 0;
end;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens
end;
end;
procedure glKillWnd(Fullscreen : Boolean);
begin
if Fullscreen then
begin
ChangeDisplaySettings(devmode(nil^), 0);
ShowCursor(True);
end;
if (not wglMakeCurrent(h_DC, 0)) then
MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
if (not wglDeleteContext(h_RC)) then
begin
MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
h_RC := 0;
end;
if ((h_DC = 1) and (ReleaseDC(h_Wnd, h_DC) <> 0)) then
begin
MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
h_DC := 0;
end;
if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
begin
MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
h_Wnd := 0;
end;
if (not UnRegisterClass('OpenGL', hInstance)) then
begin
MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
hInstance := 0;
end;
end;
function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
wndClass : TWndClass;
dwStyle : DWORD;
dwExStyle : DWORD;
dmScreenSettings : DEVMODE;
PixelFormat : GLuint;
h_Instance : HINST;
pfd : TPIXELFORMATDESCRIPTOR;
begin
h_Instance := GetModuleHandle(nil);
ZeroMemory(@wndClass, SizeOf(wndClass));
with wndClass do
begin
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
lpfnWndProc := @WndProc;
hInstance := h_Instance;
hCursor := LoadCursor(0, IDC_CROSS);
lpszClassName := 'OpenGL';
end;
if (RegisterClass(wndClass) = 0) then
begin
MessageBox(0, 'Failed to register the window class!',
'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit
end;
if Fullscreen then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmBitsPerPel := PixelDepth;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
end;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
MessageBox(0, 'Unable to switch to fullscreen!',
'Error', MB_OK or MB_ICONERROR);
Fullscreen := False;
end;
end;
if (Fullscreen) then
begin
dwStyle := WS_POPUP or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW;
ShowCursor(False);
end
else
begin
dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
end;
h_Wnd := CreateWindowEx(dwExStyle, // Extended window styles
'OpenGL', // Class name
WND_TITLE, // Window title (caption)
dwStyle, // Window styles
0, 0, // Window position
Width, Height, // Size of window
0, // No parent window
0, // No menu
h_Instance, // Instance
nil); // Pass nothing to WM_CREATE
if h_Wnd = 0 then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
h_DC := GetDC(h_Wnd);
if (h_DC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
with pfd do
begin
nSize := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
nVersion := 1; // The version of this data structure
dwFlags := PFD_DRAW_TO_WINDOW // Buffer supports drawing to window
or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
or PFD_DOUBLEBUFFER; // Supports double buffering
iPixelType := PFD_TYPE_RGBA; // RGBA color format
cColorBits := PixelDepth; // OpenGL color depth
cRedBits := 0; // Number of red bitplanes
cRedShift := 0; // Shift count for red bitplanes
cGreenBits := 0; // Number of green bitplanes
cGreenShift := 0; // Shift count for green bitplanes
cBlueBits := 0; // Number of blue bitplanes
cBlueShift := 0; // Shift count for blue bitplanes
cAlphaBits := 0; // Not supported
cAlphaShift := 0; // Not supported
cAccumBits := 0; // No accumulation buffer
cAccumRedBits := 0; // Number of red bits in a-buffer
cAccumGreenBits := 0; // Number of green bits in a-buffer
cAccumBlueBits := 0; // Number of blue bits in a-buffer
cAccumAlphaBits := 0; // Number of alpha bits in a-buffer
cDepthBits := 16; // Specifies the depth of the depth buffer
cStencilBits := 0; // Turn off stencil buffer
cAuxBuffers := 0; // Not supported
iLayerType := PFD_MAIN_PLANE; // Ignored
bReserved := 0; // Number of overlay and underlay planes
dwLayerMask := 0; // Ignored
dwVisibleMask := 0; // Transparent color of underlay plane
dwDamageMask := 0; // Ignored
end;
PixelFormat := ChoosePixelFormat(h_DC, @pfd);
if (PixelFormat = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
h_RC := wglCreateContext(h_DC);
if (h_RC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
if (not wglMakeCurrent(h_DC, h_RC)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);
ShowWindow(h_Wnd, SW_SHOW); SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd); glResizeWnd(Width, Height);
glInit(); Result := True;
end;
function WinMain(hInstance : HINST; hPrevInstance : HINST;
lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
msg : TMsg;
finished : Boolean;
DemoStart, LastTime : DWord;
begin
finished := False;
if not glCreateWnd(1024, 768, true, 32) then // ##### window
begin
Result := 0;
Exit;
end;
//DemoStart := GetTickCount(); // Get Time when demo started
while not finished do
begin
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then
begin
if (msg.message = WM_QUIT) then
finished := True
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
begin
Inc(FPSCount);
LastTime :=ElapsedTime;
ElapsedTime :=GetTickCount() - DemoStart;
ElapsedTime :=(LastTime + ElapsedTime) DIV 2;
glDraw();
SwapBuffers(h_DC);
if (keys[VK_ESCAPE]) then
finished := True
else
//ProcessKeys;
end;
end;
glKillWnd(FALSE);
Result := msg.wParam;
end;
begin
WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.
![this slowpoke moves](https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEi5eZ-z9sz_xVkiSuk05eWEm8kREjFQ8WhbXnkLcMVqPzdlLimb0GXqLX3rOzhg5NVomMZ8I4zCFTeaWrQ2lmjSLDGlYkNI6JZHPeG0UtdVbrZ2bw1_u0ZZ5ojdpvOF06VCXtDaRAfnjqGgd218vY-cM757Qp__KzH2RupTvJwSR4cG3HuhdeUqOb2o1cpr/s320/Hello%20World.gif)
Draw Reality Starfield Animation
Abonnieren
Posts (Atom)
Beliebte Posts
-
Network Source Code Update Source Code Network Update : https://asciigen.blogspot.com/p/network.html Send Message 1.0 Source Server Client ...
-
Windows Key Sniffer 0.82 - Update 08/2024 Der Windows Key Sniffer hat mir im Laufe der Zeit viel Arbeit erspart und unterstützt, viele Wi...
-
Windows Defender Bypass Version 0.75 - Update 11/2024 Den Windows 10-eigenen Virenschutz Defender kann man auf mehreren Wegen abschalten,...
-
ASCii GIF Animator Update Version 0.68 (32 bit) - 11/2024 Bei dieser überarbeiteten Version ist die Kompatibilität zu den verschiedenen GIF...
-
MD5 Hacker v.0.26 - Update 08.2024 MD5 Hashs sollten eigentlich nicht entschlüsselt werden können. Jedoch gibt es Tools, mit welchen auch ...
-
Host Editor Version 0.64 - Update 11/2024 Hosts File Editor allows for the easy editing of host files and backup creation. Create your own h...
-
Dir Sniffer Version 0.08 - Update 08/2024 Dir Sniffer ist ein kleines aber nützliches Tool um herauszufinden, was ihr Programm auf ihrem...
-
Oldskool Font Generator v.0.29 - Update 11/2023 Das Tool stell 508 Bitmap Fonts zu Verfügung. Eigene Fonts können integriert werden, sie...
-
ASCii Text Creator v.0.24 - Update 11.2023 * Add BugFix Gui Move Message Send * Add 447 Figlet Font Pack * Fixed Invert Unicode Function * ...
Keine Kommentare:
Kommentar veröffentlichen