diff options
| -rw-r--r-- | Game/Code/Classes/UCommon.pas | 89 | ||||
| -rw-r--r-- | Game/Code/UltraStar.dpr | 40 | ||||
| -rw-r--r-- | Game/Code/lib/midi/MidiFile.pas | 8 | ||||
| -rw-r--r-- | Game/Code/lib/midi/Midiin.pas | 4 | ||||
| -rw-r--r-- | Game/Code/lib/midi/Midiout.pas | 4 | ||||
| -rw-r--r-- | Game/Code/lib/other/DirWatch.pas | 8 | ||||
| -rw-r--r-- | Game/Code/lib/other/WinAllocation.pas | 97 |
7 files changed, 135 insertions, 115 deletions
diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas index 4f7f7f1b..a8f2f028 100644 --- a/Game/Code/Classes/UCommon.pas +++ b/Game/Code/Classes/UCommon.pas @@ -13,21 +13,11 @@ uses Classes, {$IFDEF MSWINDOWS} Windows, - Messages, {$ENDIF} sdl, UConfig, ULog; -{$IFNDEF DARWIN} -// FIXME: remove this if it is not needed anymore -type - hStream = THandle; - HGLRC = THandle; - TLargeInteger = Int64; - TWin32FindData = LongInt; -{$ENDIF} - type TMessageType = ( mtInfo, mtError ); @@ -42,11 +32,6 @@ function RWopsFromStream(Stream: TStream): PSDL_RWops; function RandomRange(aMin: Integer; aMax: Integer) : Integer; {$ENDIF} -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWnd(Method: TWndMethod): HWND; -procedure DeallocateHWnd(hWnd: HWND); -{$IFEND} - function StringReplaceW(text : WideString; search, rep: WideChar):WideString; function AdaptFilePaths( const aPath : widestring ): widestring; @@ -444,80 +429,6 @@ begin end; {$ENDIF} -{$IF Defined(MSWINDOWS) and Defined(FPC)} -function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -var - Msg: TMessage; - MethodPtr: ^TWndMethod; -begin - FillChar(Msg, SizeOf(Msg), 0); - Msg.msg := uMsg; - Msg.wParam := wParam; - Msg.lParam := lParam; - - MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); - if Assigned(MethodPtr) then - MethodPtr^(Msg); - - Result := DefWindowProc(hwnd, uMsg, wParam, lParam); -end; - -function AllocateHWnd(Method: TWndMethod): HWND; -var - ClassExists: Boolean; - WndClass, OldClass: TWndClass; - MethodPtr: ^TMethod; -begin - Result := 0; - - // setup class-info - FillChar(WndClass, SizeOf(TWndClass), 0); - WndClass.hInstance := HInstance; - // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, - // otherwise race-conditions might occur - WndClass.lpfnWndProc := @DefWindowProc; - WndClass.lpszClassName:= 'USDXUtilWindowClass'; - - // check if class is already registered - ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); - // create window-class shared by all windows created by AllocateHWnd() - if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then - begin - if ClassExists then - UnregisterClass(WndClass.lpszClassName, HInstance); - if (RegisterClass(WndClass) = 0) then - Exit; - end; - // create window - Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', - DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil); - if (Result = 0) then - Exit; - // assign individual callback procedure to the window - if Assigned(Method) then - begin - // TMethod contains two pointers but we can pass just one as USERDATA - GetMem(MethodPtr, SizeOf(TMethod)); - MethodPtr^ := TMethod(Method); - SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); - end; - // now enable AllocateHWndCallback for this window - SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); -end; - -procedure DeallocateHWnd(hWnd: HWND); -var - MethodPtr: ^TMethod; -begin - if (hWnd <> 0) then - begin - MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); - DestroyWindow(hWnd); - if Assigned(MethodPtr) then - FreeMem(MethodPtr); - end; -end; -{$IFEND} {$IFDEF FPC} var diff --git a/Game/Code/UltraStar.dpr b/Game/Code/UltraStar.dpr index bcee540d..c71a9300 100644 --- a/Game/Code/UltraStar.dpr +++ b/Game/Code/UltraStar.dpr @@ -46,7 +46,7 @@ uses glext in 'lib\JEDI-SDL\OpenGL\Pas\glext.pas', sdl in 'lib\JEDI-SDL\SDL\Pas\sdl.pas', sdl_image in 'lib\JEDI-SDL\SDL_Image\Pas\sdl_image.pas', -// sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas', + //sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas', sdlutils in 'lib\JEDI-SDL\SDL\Pas\sdlutils.pas', UMediaCore_SDL in 'Classes\UMediaCore_SDL.pas', @@ -57,9 +57,6 @@ uses bass in 'lib\bass\delphi\bass.pas', UAudioCore_Bass in 'Classes\UAudioCore_Bass.pas', {$ENDIF} - {$IFDEF DARWIN} - PseudoThread in 'MacOSX/Wrapper/PseudoThread.pas', - {$ENDIF} {$IFDEF UsePortaudio} portaudio in 'lib\portaudio\delphi\portaudio.pas', UAudioCore_Portaudio in 'Classes\UAudioCore_Portaudio.pas', @@ -68,20 +65,6 @@ uses portmixer in 'lib\portmixer\delphi\portmixer.pas', {$ENDIF} - {$IFDEF MSWINDOWS} - midiout in 'lib\midi\midiout.pas', - CIRCBUF in 'lib\midi\CIRCBUF.PAS', - MidiType in 'lib\midi\MidiType.PAS', - MidiDefs in 'lib\midi\MidiDefs.PAS', - MidiCons in 'lib\midi\MidiCons.PAS', - MidiFile in 'lib\midi\MidiFile.PAS', - Delphmcb in 'lib\midi\Delphmcb.PAS', - {$ENDIF} - - {$IFDEF MSWINDOWS} - DirWatch in 'lib\other\DirWatch.pas', - {$ENDIF} - {$IFDEF UseFFMpeg} avcodec in 'lib\ffmpeg\avcodec.pas', avformat in 'lib\ffmpeg\avformat.pas', @@ -104,6 +87,27 @@ uses projectM in 'lib\projectM\projectM.pas', {$ENDIF} + {$IFDEF MSWINDOWS} + {$IFDEF FPC} + // FPC compatibility file for Allocate/DeallocateHWnd + WinAllocation in 'lib\other\WinAllocation.pas', + {$ENDIF} + + midiout in 'lib\midi\midiout.pas', + CIRCBUF in 'lib\midi\CIRCBUF.PAS', + MidiType in 'lib\midi\MidiType.PAS', + MidiDefs in 'lib\midi\MidiDefs.PAS', + MidiCons in 'lib\midi\MidiCons.PAS', + MidiFile in 'lib\midi\MidiFile.PAS', + Delphmcb in 'lib\midi\Delphmcb.PAS', + + DirWatch in 'lib\other\DirWatch.pas', + {$ENDIF} + + {$IFDEF DARWIN} + PseudoThread in 'MacOSX/Wrapper/PseudoThread.pas', + {$ENDIF} + SQLiteTable3 in 'lib\SQLite\SQLiteTable3.pas', SQLite3 in 'lib\SQLite\SQLite3.pas', diff --git a/Game/Code/lib/midi/MidiFile.pas b/Game/Code/lib/midi/MidiFile.pas index 4279d305..57c9a161 100644 --- a/Game/Code/lib/midi/MidiFile.pas +++ b/Game/Code/lib/midi/MidiFile.pas @@ -99,9 +99,11 @@ uses Windows, //Forms, Messages, - SysUtils, - UCommon, - Classes; + Classes, + {$IFDEF FPC} + WinAllocation, + {$ENDIF} + SysUtils; type TChunkType = (illegal, header, track); diff --git a/Game/Code/lib/midi/Midiin.pas b/Game/Code/lib/midi/Midiin.pas index 3688d5c9..21db0298 100644 --- a/Game/Code/lib/midi/Midiin.pas +++ b/Game/Code/lib/midi/Midiin.pas @@ -112,7 +112,9 @@ uses Messages, Windows, MMSystem, - UCommon, + {$IFDEF FPC} + WinAllocation, + {$ENDIF} MidiDefs, MidiType, MidiCons, diff --git a/Game/Code/lib/midi/Midiout.pas b/Game/Code/lib/midi/Midiout.pas index 2463ae8a..606d0dae 100644 --- a/Game/Code/lib/midi/Midiout.pas +++ b/Game/Code/lib/midi/Midiout.pas @@ -107,7 +107,9 @@ uses Messages, Classes, MMSystem, - UCommon, + {$IFDEF FPC} + WinAllocation, + {$ENDIF} Circbuf, MidiType, MidiDefs, diff --git a/Game/Code/lib/other/DirWatch.pas b/Game/Code/lib/other/DirWatch.pas index d302cade..9d395840 100644 --- a/Game/Code/lib/other/DirWatch.pas +++ b/Game/Code/lib/other/DirWatch.pas @@ -31,9 +31,11 @@ interface uses Windows, Messages, - SysUtils, - UCommon, - Classes; + Classes, + {$IFDEF FPC} + WinAllocation, + {$ENDIF} + SysUtils; type TNotifyFilters = set of (nfFilename, nfDirname, nfAttrib, diff --git a/Game/Code/lib/other/WinAllocation.pas b/Game/Code/lib/other/WinAllocation.pas new file mode 100644 index 00000000..7c26a0e5 --- /dev/null +++ b/Game/Code/lib/other/WinAllocation.pas @@ -0,0 +1,97 @@ +unit WinAllocation; + +// FPC misses AllocateHWnd and DeallocateHWnd which is used by several +// libraries such as Midi... or DirWatch. +// Since FPC 2.2.2 there are dummies in Classes that just raise RunTime exceptions. +// To avoid those exceptions, include this unit AFTER Classes. +// Maybe the dummies will be replaced by functional routines in the future.WinAllocation +// +// THESE FUNCTIONS ARE ONLY FOR COMPATIBILITY WITH SOME EXTERNAL WIN32 LIBS. +// DO NOT USE THEM IN USDX CODE. +// + +interface + +uses + Classes, + Windows; + +function AllocateHWnd(Method: TWndMethod): HWND; +procedure DeallocateHWnd(hWnd: HWND); + +implementation + +function AllocateHWndCallback(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +var + Msg: TMessage; + MethodPtr: ^TWndMethod; +begin + FillChar(Msg, SizeOf(Msg), 0); + Msg.msg := uMsg; + Msg.wParam := wParam; + Msg.lParam := lParam; + + MethodPtr := Pointer(GetWindowLongPtr(hwnd, GWL_USERDATA)); + if Assigned(MethodPtr) then + MethodPtr^(Msg); + + Result := DefWindowProc(hwnd, uMsg, wParam, lParam); +end; + +function AllocateHWnd(Method: TWndMethod): HWND; +var + ClassExists: Boolean; + WndClass, OldClass: TWndClass; + MethodPtr: ^TMethod; +begin + Result := 0; + + // setup class-info + FillChar(WndClass, SizeOf(TWndClass), 0); + WndClass.hInstance := HInstance; + // Important: do not enable AllocateHWndCallback before the msg-handler method is assigned, + // otherwise race-conditions might occur + WndClass.lpfnWndProc := @DefWindowProc; + WndClass.lpszClassName:= 'USDXUtilWindowClass'; + + // check if class is already registered + ClassExists := GetClassInfo(HInstance, WndClass.lpszClassName, OldClass); + // create window-class shared by all windows created by AllocateHWnd() + if (not ClassExists) or (@OldClass.lpfnWndProc <> @DefWindowProc) then + begin + if ClassExists then + UnregisterClass(WndClass.lpszClassName, HInstance); + if (RegisterClass(WndClass) = 0) then + Exit; + end; + // create window + Result := CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName, '', + DWORD(WS_POPUP), 0, 0, 0, 0, 0, 0, HInstance, nil); + if (Result = 0) then + Exit; + // assign individual callback procedure to the window + if Assigned(Method) then + begin + // TMethod contains two pointers but we can pass just one as USERDATA + GetMem(MethodPtr, SizeOf(TMethod)); + MethodPtr^ := TMethod(Method); + SetWindowLongPtr(Result, GWL_USERDATA, LONG_PTR(MethodPtr)); + end; + // now enable AllocateHWndCallback for this window + SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@AllocateHWndCallback)); +end; + +procedure DeallocateHWnd(hWnd: HWND); +var + MethodPtr: ^TMethod; +begin + if (hWnd <> 0) then + begin + MethodPtr := Pointer(GetWindowLongPtr(hWnd, GWL_USERDATA)); + DestroyWindow(hWnd); + if Assigned(MethodPtr) then + FreeMem(MethodPtr); + end; +end; + +end. |