moved AllocateHWnd/DeallocateHWnd from UCommon.pas to WinAllocation.pas. Do NOT use them in USDX code. They are just by the DirWatch and Midi... libs in FPC (Windows).

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1224 b956fd51-792f-4845-bead-9b4dfca2ff2c

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.