398 lines
15 KiB
ObjectPascal
398 lines
15 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclWin32Ex.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Virgo Pärna (virgo dott parna att mail dott ee). }
|
|
{ Portions created by Virgo Pärna are Copyright (C) 2006 Virgo Pärna. All Rights Reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2006-07-25 07:56:46 +0200 (mar., 25 juil. 2006) $
|
|
|
|
unit JclWin32Ex;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows;
|
|
|
|
type
|
|
TJclWin32ExFunction = (jwfTryEnterCriticalSection, jwfSignalObjectAndWait,
|
|
jwfSetCriticalSectionSpinCount, jwfOpenWaitableTimer,
|
|
jwfInitializeCriticalSectionAndSpinCount, jwfGetFileAttributesEx,
|
|
jwfCreateWaitableTimer, jwfCancelWaitableTimer, jwfglGetString,
|
|
jwfglGetError, jwfwglCreateContext, jwfwglDeleteContext, jwfwglMakeCurrent,
|
|
jwfgluErrorString);
|
|
TJclWin32ExFunctions = set of TJclWin32ExFunction;
|
|
|
|
function JclTryEnterCriticalSection(lpCriticalSection: TRTLCriticalSection): Boolean;
|
|
function JclSignalObjectAndWait(hObjectToSignal: THandle;
|
|
hObjectToWaitOn: THandle; dwMilliseconds: Cardinal;
|
|
bAlertable: Boolean): Cardinal;
|
|
function JclSetCriticalSectionSpinCount(lpCriticalSection: TRTLCriticalSection;
|
|
dwSpinCount: Cardinal): Cardinal;
|
|
function JclOpenWaitableTimer(dwDesiredAccess: Cardinal;
|
|
bInheritHandle: Boolean; const lpTimerName: string): THandle;
|
|
function JclInitializeCriticalSectionAndSpinCount(lpCriticalSection: TRTLCriticalSection;
|
|
dwSpinCount: Cardinal): Boolean;
|
|
function JclGetFileAttributesEx(const lpFileName: string;
|
|
fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): Boolean;
|
|
function JclCreateWaitableTimer(lpTimerAttributes: PSecurityAttributes;
|
|
bManualReset: Boolean; const lpTimerName: string): THandle;
|
|
function JclCancelWaitableTimer(hTimer: THandle): Boolean;
|
|
|
|
function JclglGetString(name: Cardinal): PChar;
|
|
function JclglGetError: Cardinal;
|
|
|
|
function JclwglCreateContext(hdc: HDC): HGLRC;
|
|
function JclwglDeleteContext(hglrc: HGLRC): BOOL;
|
|
function JclwglMakeCurrent(hdc: HDC; hglrc: HGLRC): BOOL;
|
|
|
|
function JclgluErrorString(errCode: Cardinal): PChar;
|
|
|
|
function JclWin32ExFunctions: TJclWin32ExFunctions;
|
|
|
|
procedure JclCheckAndInitializeOpenGL;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net:443/svnroot/jcl/tags/JCL-1.100-Build2646/jcl/source/windows/JclWin32Ex.pas $';
|
|
Revision: '$Revision: 1695 $';
|
|
Date: '$Date: 2006-07-25 07:56:46 +0200 (mar., 25 juil. 2006) $';
|
|
LogPath: 'JCL\source\windows'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclBase, JclResources;
|
|
|
|
type
|
|
TTryEnterCriticalSectionProc = function(lpCriticalSection: TRTLCriticalSection): BOOL; stdcall;
|
|
TSignalObjectAndWaitProc = function(hObjectToSignal: THandle;
|
|
hObjectToWaitOn: THandle; dwMilliseconds: DWORD; bAlertable: BOOL): DWORD; stdcall;
|
|
TSetCriticalSectionSpinCountProc = function(lpCriticalSection: TRTLCriticalSection;
|
|
dwSpincCount: DWORD): DWORD; stdcall;
|
|
TInitializeCriticalSectionAndSpinCountProc = function(lpCriticalSection: TRTLCriticalSection;
|
|
dwSpinCount: DWORD): BOOL; stdcall;
|
|
|
|
TOpenWaitableTimerAProc = function(dwDesiredAccess: DWORD;
|
|
bInheritHandle: BOOL; lpTimerName: LPCTSTR): THandle; stdcall;
|
|
TCreateWaitableTimerAProc = function(lpTimerAttributes: PSecurityAttributes;
|
|
bManualReset: BOOL; lpTimerName: PAnsiChar): THandle; stdcall;
|
|
TCancelWaitableTimerProc = function(hTimer: THandle): BOOL; stdcall;
|
|
|
|
TGetFileAttributesExAProc = function(lpFileName: PChar;
|
|
fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): BOOL; stdcall;
|
|
|
|
TglGetStringProc = function(name: Cardinal): PChar; stdcall;
|
|
TglGetErrorProc = function: Cardinal; stdcall;
|
|
|
|
TwglCreateContextProc = function (hdc: HDC): HGLRC; stdcall;
|
|
TwglDeleteContextProc = function (hglrc: HGLRC): BOOL; stdcall;
|
|
TwglMakeCurrentProc = function (hdc: HDC; hglrc: HGLRC): BOOL; stdcall;
|
|
|
|
TgluErrorStringProc = function(errCode: Cardinal): PChar; stdcall;
|
|
|
|
var
|
|
Kernel32DllHandle: HMODULE = 0;
|
|
OpenGl32DllHandle: HMODULE = 0;
|
|
Glu32DllHandle: HMODULE = 0;
|
|
|
|
type
|
|
TDllFunctionRec = record
|
|
FunctionName: string;
|
|
FunctionAddr: Pointer;
|
|
DllName: string;
|
|
DllHandle: ^HModule;
|
|
end;
|
|
|
|
const
|
|
Glu32 = 'glu32.dll';
|
|
|
|
Win32ExFunctions: array [TJclWin32ExFunction] of TDllFunctionRec =
|
|
( // jwfTryEnterCriticalSection
|
|
(FunctionName: 'TryEnterCriticalSection'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfSignalObjectAndWait
|
|
(FunctionName: 'SignalObjectAndWait'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfSetCriticalSectionSpinCount
|
|
(FunctionName: 'SetCriticalSectionSpinCount'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfOpenWaitableTimer
|
|
(FunctionName: 'OpenWaitableTimerA'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfInitializeCriticalSectionAndSpinCount
|
|
(FunctionName: 'InitializeCriticalSectionAndSpinCount'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfGetFileAttributesEx
|
|
(FunctionName: 'GetFileAttributesExA'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfCreateWaitableTimer
|
|
(FunctionName: 'CreateWaitableTimerA'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfCancelWaitableTimer
|
|
(FunctionName: 'CancelWaitableTimer'; FunctionAddr: nil;
|
|
DllName: kernel32; DllHandle: @Kernel32DllHandle),
|
|
// jwfglGetString
|
|
(FunctionName: 'glGetString'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @OpenGl32DllHandle),
|
|
// jwfglGetError
|
|
(FunctionName: 'glGetError'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @OpenGl32DllHandle),
|
|
// jwfwglCreateContext
|
|
(FunctionName: 'wglCreateContext'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @OpenGl32DllHandle),
|
|
// jwfwglDeleteContext
|
|
(FunctionName: 'wglDeleteContext'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @OpenGl32DllHandle),
|
|
// jwfwglMakeCurrent
|
|
(FunctionName: 'wglMakeCurrent'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @OpenGl32DllHandle),
|
|
// jwfgluErrorString
|
|
(FunctionName: 'gluErrorString'; FunctionAddr: nil;
|
|
DllName: opengl32; DllHandle: @Glu32DllHandle)
|
|
);
|
|
|
|
function LoadWin32ExFunction(const Win32ExFunction: TJclWin32ExFunction): Pointer;
|
|
begin
|
|
with Win32ExFunctions[Win32ExFunction] do
|
|
begin
|
|
if not Assigned(FunctionAddr) then
|
|
begin
|
|
if DllHandle^ = 0 then
|
|
DllHandle^ := LoadLibrary(PChar(DllName));
|
|
if DllHandle^ = 0 then
|
|
raise EJclError.CreateResFmt(@RsELibraryNotFound, [DllName])
|
|
else
|
|
FunctionAddr := GetProcAddress(DllHandle^, PChar(FunctionName));
|
|
if not Assigned(FunctionAddr) then
|
|
raise EJclError.CreateResFmt(@RsEFunctionNotFound, [DllName, FunctionName]);
|
|
end;
|
|
Result := FunctionAddr;
|
|
end;
|
|
end;
|
|
|
|
function JclTryEnterCriticalSection(lpCriticalSection: TRTLCriticalSection): Boolean;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfTryEnterCriticalSection].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfTryEnterCriticalSection);
|
|
|
|
Result := TTryEnterCriticalSectionProc(FunctionAddr)(lpCriticalSection);
|
|
end;
|
|
|
|
function JclSignalObjectAndWait(hObjectToSignal: THandle; hObjectToWaitOn: THandle; dwMilliseconds: Cardinal; bAlertable: Boolean): Cardinal;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfSignalObjectAndWait].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfSignalObjectAndWait);
|
|
|
|
Result := TSignalObjectAndWaitProc(FunctionAddr)(hObjectToSignal, hObjectToSignal, dwMilliseconds, bAlertable);
|
|
end;
|
|
|
|
function JclSetCriticalSectionSpinCount(lpCriticalSection: TRTLCriticalSection; dwSpinCount: Cardinal): Cardinal;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfSetCriticalSectionSpinCount].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfSetCriticalSectionSpinCount);
|
|
|
|
Result := TSetCriticalSectionSpinCountProc(FunctionAddr)(lpCriticalSection, dwSpinCount);
|
|
end;
|
|
|
|
function JclOpenWaitableTimer(dwDesiredAccess: Cardinal; bInheritHandle: Boolean; const lpTimerName: string): THandle;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfOpenWaitableTimer].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfOpenWaitableTimer);
|
|
|
|
Result := TOpenWaitableTimerAProc(FunctionAddr)(dwDesiredAccess, bInheritHandle, PChar(lpTimerName));
|
|
end;
|
|
|
|
function JclInitializeCriticalSectionAndSpinCount(lpCriticalSection: TRTLCriticalSection; dwSpinCount: Cardinal): Boolean;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfInitializeCriticalSectionAndSpinCount].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfInitializeCriticalSectionAndSpinCount);
|
|
|
|
Result := TInitializeCriticalSectionAndSpinCountProc(FunctionAddr)(lpCriticalSection, dwSpinCount);
|
|
end;
|
|
|
|
function JclGetFileAttributesEx(const lpFileName: string; fInfoLevelId: TGetFileExInfoLevels; lpFileInformation: Pointer): Boolean;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfGetFileAttributesEx].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfGetFileAttributesEx);
|
|
|
|
Result := TGetFileAttributesExAProc(FunctionAddr)(PChar(lpFileName), fInfoLevelId, lpFileInformation);
|
|
end;
|
|
|
|
function JclCreateWaitableTimer(lpTimerAttributes: PSecurityAttributes; bManualReset: Boolean; const lpTimerName: string): THandle;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfCreateWaitableTimer].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfCreateWaitableTimer);
|
|
|
|
Result := TCreateWaitableTimerAProc(FunctionAddr)(lpTimerAttributes, bManualReset, PChar(lpTimerAttributes));
|
|
end;
|
|
|
|
function JclCancelWaitableTimer(hTimer: THandle): Boolean;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfCancelWaitableTimer].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfCancelWaitableTimer);
|
|
|
|
Result := TCancelWaitableTimerProc(FunctionAddr)(hTimer);
|
|
end;
|
|
|
|
function JclglGetString(name: Cardinal): PChar;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfglGetString].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfglGetString);
|
|
|
|
Result := TglGetStringProc(FunctionAddr)(name);
|
|
end;
|
|
|
|
function JclglGetError: Cardinal;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfglGetError].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfglGetError);
|
|
|
|
Result := TglGetErrorProc(FunctionAddr);
|
|
end;
|
|
|
|
function JclwglCreateContext(hdc: HDC): HGLRC;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfwglCreateContext].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfwglCreateContext);
|
|
|
|
Result := TwglCreateContextProc(FunctionAddr)(hdc);
|
|
end;
|
|
|
|
function JclwglDeleteContext(hglrc: HGLRC): BOOL;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfwglDeleteContext].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfwglDeleteContext);
|
|
|
|
Result := TwglDeleteContextProc(FunctionAddr)(hglrc);
|
|
end;
|
|
|
|
function JclwglMakeCurrent(hdc: HDC; hglrc: HGLRC): BOOL;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfwglMakeCurrent].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfwglMakeCurrent);
|
|
|
|
Result := TwglMakeCurrentProc(FunctionAddr)(hdc, hglrc);
|
|
end;
|
|
|
|
function JclgluErrorString(errCode: Cardinal): PChar;
|
|
var
|
|
FunctionAddr: Pointer;
|
|
begin
|
|
FunctionAddr := Win32ExFunctions[jwfgluErrorString].FunctionAddr;
|
|
if not Assigned(FunctionAddr) then
|
|
FunctionAddr := LoadWin32ExFunction(jwfgluErrorString);
|
|
|
|
Result := TgluErrorStringProc(FunctionAddr)(errCode);
|
|
end;
|
|
|
|
function JclWin32ExFunctions: TJclWin32ExFunctions;
|
|
var
|
|
Index: TJclWin32ExFunction;
|
|
begin
|
|
Result := [];
|
|
for Index := Low(TJclWin32ExFunction) to High(TJclWin32ExFunction) do
|
|
if Assigned(Win32ExFunctions[Index].FunctionAddr)
|
|
or (LoadWin32ExFunction(Index) <> nil) then
|
|
Include(Result, Index);
|
|
end;
|
|
|
|
procedure UnloadLibraries;
|
|
var
|
|
Index: TJclWin32ExFunction;
|
|
begin
|
|
for Index := Low(TJclWin32ExFunction) to High(TJclWin32ExFunction) do
|
|
with Win32ExFunctions[Index] do
|
|
begin
|
|
FunctionAddr := nil;
|
|
if DllHandle^ <> 0 then
|
|
begin
|
|
FreeLibrary(DllHandle^);
|
|
DllHandle^ := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure JclCheckAndInitializeOpenGL;
|
|
begin
|
|
if OpenGl32DllHandle = 0 then
|
|
OpenGl32DllHandle := LoadLibrary(PChar(opengl32));
|
|
if OpenGl32DllHandle = 0 then
|
|
raise EJclError.CreateResFmt(@RsELibraryNotFound, [opengl32]);
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
finalization
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
UnloadLibraries;
|
|
|
|
end.
|
|
|