removed lazarus dependencies

- added an implementation of AllocateHWnd/DeallocateHWnd to UCommon for 
  the Win32 only units DirWatch and Midi... (do not use AllocateHWnd somewhere else)
- added an own implementation of ShowMessage to UCommon (uses MessageBox in Windows, console-output otherwise)
- linux still needs lresources for the lrs-file (will be removed soon)
- the FPC windows version uses windows resources now (instead of lrs ones).
  compile them with windres (in FPC's "bin" dir) or delphi (a batch-file for windres will follow soon)
- changed path-separator from '\' to '/' in RC-file for windres compatibility

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

1 files changed, 300 insertions, 293 deletions

diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index 62d7df65..dce11ea0 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -1,293 +1,300 @@
-unit UCommon;
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
-  SysUtils,
-{$IFDEF LAZARUS}
-   lResources,
-{$ENDIF}
-   ULog,
-{$IFDEF DARWIN}
-  messages,
-{$ENDIF}
-{$IFDEF win32}
-   windows;
-{$ELSE}
-   lcltype,
-   messages;
-{$ENDIF}
-
-{$IFNDEF win32}
-type
-  hStream        = THandle;
-  HGLRC          = THandle;
-  TLargeInteger  = Int64;
-  TWin32FindData = LongInt;
-{$ENDIF}
-
-{$IFDEF LAZARUS}
-  function LazFindResource( const aName, aType : String ): TLResource;
-{$ENDIF}
-
-{$IFDEF DARWIN}
-  procedure ShowMessage( const msg : String );
-{$ENDIF}
-
-{$IFDEF FPC}
-
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
-
-function MaxValue(const Data: array of Double): Double;
-function MinValue(const Data: array of Double): Double;
-
-  {$IFDEF WIN32}
-  type
-    TWndMethod = procedure(var Message: TMessage) of object;
-  function  AllocateHWnd(Method: TWndMethod): HWND;
-  procedure DeallocateHWnd(Wnd: HWND);
-  {$ENDIF} // Win32
-
-{$ENDIF} // FPC Only
-
-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
-function AdaptFilePaths( const aPath : widestring ): widestring;
-
-
-{$IFNDEF win32}
-(*
-  function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
-  function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
-*)
-  procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-{$ENDIF}
-
-// eddie: FindFirstW etc are now in UPlatformWindows.pas
-
-(*
- * Character classes
- *)
-
-function IsAlphaChar(ch: WideChar): boolean;
-function IsNumericChar(ch: WideChar): boolean;
-function IsAlphaNumericChar(ch: WideChar): boolean;
-function IsPunctuationChar(ch: WideChar): boolean;
-function IsControlChar(ch: WideChar): boolean;
-
-
-implementation
-
-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
-var
-  iPos  : integer;
-//  sTemp : WideString;
-begin
-(*
-  result := text;
-  iPos   := Pos(search, result);
-  while (iPos > 0) do
-  begin
-    sTemp  := copy(result, iPos + length(search), length(result));
-    result := copy(result, 1, iPos - 1) + rep + sTEmp;
-    iPos   := Pos(search, result);
-  end;
-*)
-  result := text;
-
-  if search = rep then
-    exit;
-
-  for iPos := 0 to length( result ) - 1 do
-  begin
-    if result[ iPos ] = search then
-      result[ iPos ] := rep;
-  end;
-end;
-
-function AdaptFilePaths( const aPath : widestring ): widestring;
-begin
-  result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );
-end;
-
-
-{$IFNDEF win32}
-procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-begin
-  FillChar( Destination^, Length, 0 );
-end; //ZeroMemory
-
-(*
-function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
-
-  // From http://en.wikipedia.org/wiki/RDTSC
-  function RDTSC: Int64; register;
-  asm
-    rdtsc
-  end;
-
-begin
-  // Use clock_gettime  here maybe ... from libc
-  lpPerformanceCount := RDTSC();
-  result := true;
-end;
-
-function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
-begin
-  lpFrequency := 0;
-  result := true;
-end;
-*)
-{$ENDIF}
-
-
-{$IFDEF LAZARUS}
-
-function LazFindResource( const aName, aType : String ): TLResource;
-var
-  iCount : Integer;
-begin
-  result := nil;
-
-  for iCount := 0 to LazarusResources.count -1 do
-  begin
-    if ( LazarusResources.items[ iCount ].Name      = aName ) AND
-       ( LazarusResources.items[ iCount ].ValueType = aType ) THEN
-    begin
-      result := LazarusResources.items[ iCount ];
-      exit;
-    end;
-  end;
-end;
-{$ENDIF}
-
-{$IFDEF FPC}
-// FIXME: already exists in FPC
-function MaxValue(const Data: array of Double): Double;
-var
-  I: Integer;
-begin
-  Result := Data[Low(Data)];
-  for I := Low(Data) + 1 to High(Data) do
-    if Result < Data[I] then
-      Result := Data[I];
-end;
-
-// FIXME: already exists in FPC
-function MinValue(const Data: array of Double): Double;
-var
-  I: Integer;
-begin
-  Result := Data[Low(Data)];
-  for I := Low(Data) + 1 to High(Data) do
-    if Result > Data[I] then
-      Result := Data[I];
-end;
-
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
-begin
-RandomRange := Random(aMax-aMin) + aMin ;
-end;
-
-
-// NOTE !!!!!!!!!!
-// AllocateHWnd is in lclintfh.inc
-
-{$IFDEF MSWINDOWS}
-// TODO : JB this is dodgey and bad... find a REAL solution !
-function AllocateHWnd(Method: TWndMethod): HWND;
-var
-  TempClass: TWndClass;
-  ClassRegistered: Boolean;
-begin
-  Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil);
-end;
-
-procedure DeallocateHWnd(Wnd: HWND);
-var
-  Instance: Pointer;
-begin
-  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
-  DestroyWindow(Wnd);
-end;
-{$ENDIF}
-{$IFDEF DARWIN}
-// TODO : Situation for the mac isn't better !
-function AllocateHWnd(Method: TWndMethod): HWND;
-begin
-end;
-
-procedure DeallocateHWnd(Wnd: HWND);
-begin
-end;
-{$ENDIF} // IFDEF DARWIN
-
-{$ENDIF} // IFDEF FPC
-
-{$IFDEF DARWIN}
-procedure ShowMessage( const msg : String );
-begin
-	//eddie: what to do here?
-end;
-{$ENDIF}
-
-
-function IsAlphaChar(ch: WideChar): boolean;
-begin
-  // TODO: add chars > 255 when unicode-fonts work?
-  case ch of
-    'A'..'Z',  // A-Z
-    'a'..'z',  // a-z
-    #170,#181,#186,
-    #192..#214,
-    #216..#246,
-    #248..#255:
-      Result := true;
-    else
-      Result := false;
-  end;
-end;
-
-function IsNumericChar(ch: WideChar): boolean;
-begin
-  case ch of
-    '0'..'9':
-      Result := true;
-    else
-      Result := false;
-  end;
-end;
-
-function IsAlphaNumericChar(ch: WideChar): boolean;
-begin
-  Result := (IsAlphaChar(ch) or IsNumericChar(ch));
-end;
-
-function IsPunctuationChar(ch: WideChar): boolean;
-begin
-  // TODO: add chars outside of Latin1 basic (0..127)?
-  case ch of
-    ' '..'/',':'..'@','['..'`','{'..'~':
-      Result := true;
-    else
-      Result := false;
-  end;
-end;
-
-function IsControlChar(ch: WideChar): boolean;
-begin
-  case ch of
-    #0..#31,
-    #127..#159:
-      Result := true;
-    else
-      Result := false;
-  end;
-end;
-
-end.
+unit UCommon;

+

+interface

+

+{$IFDEF FPC}

+  {$MODE Delphi}

+{$ENDIF}

+

+{$I switches.inc}

+

+uses

+  SysUtils,

+  Classes,

+  Messages,

+{$IFDEF LCL}

+  lResources,

+{$ENDIF}

+{$IFDEF win32}

+  Windows,

+{$ENDIF}

+  ULog;

+

+{$IFNDEF DARWIN}

+// FIXME: remove this if it is not needed anymore

+type

+  hStream        = THandle;

+  HGLRC          = THandle;

+  TLargeInteger  = Int64;

+  TWin32FindData = LongInt;

+{$ENDIF}

+

+{$IFDEF LCL}

+  function LazFindResource( const aName, aType : String ): TLResource;

+{$ENDIF}

+

+procedure ShowMessage( const msg : String );

+

+{$IFDEF FPC}

+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;

+

+

+{$IFNDEF win32}

+  procedure ZeroMemory( Destination: Pointer; Length: DWORD );

+{$ENDIF}

+

+(*

+ * Character classes

+ *)

+

+function IsAlphaChar(ch: WideChar): boolean;

+function IsNumericChar(ch: WideChar): boolean;

+function IsAlphaNumericChar(ch: WideChar): boolean;

+function IsPunctuationChar(ch: WideChar): boolean;

+function IsControlChar(ch: WideChar): boolean;

+

+

+implementation

+

+uses

+{$IFDEF Delphi}

+  Dialogs,

+{$ENDIF}

+  UConfig;

+

+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;

+var

+  iPos  : integer;

+//  sTemp : WideString;

+begin

+(*

+  result := text;

+  iPos   := Pos(search, result);

+  while (iPos > 0) do

+  begin

+    sTemp  := copy(result, iPos + length(search), length(result));

+    result := copy(result, 1, iPos - 1) + rep + sTEmp;

+    iPos   := Pos(search, result);

+  end;

+*)

+  result := text;

+

+  if search = rep then

+    exit;

+

+  for iPos := 0 to length( result ) - 1 do

+  begin

+    if result[ iPos ] = search then

+      result[ iPos ] := rep;

+  end;

+end;

+

+function AdaptFilePaths( const aPath : widestring ): widestring;

+begin

+  result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );

+end;

+

+

+{$IFNDEF win32}

+procedure ZeroMemory( Destination: Pointer; Length: DWORD );

+begin

+  FillChar( Destination^, Length, 0 );

+end; //ZeroMemory

+

+(*

+function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;

+

+  // From http://en.wikipedia.org/wiki/RDTSC

+  function RDTSC: Int64; register;

+  asm

+    rdtsc

+  end;

+

+begin

+  // Use clock_gettime  here maybe ... from libc

+  lpPerformanceCount := RDTSC();

+  result := true;

+end;

+

+function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;

+begin

+  lpFrequency := 0;

+  result := true;

+end;

+*)

+{$ENDIF}

+

+

+{$IFDEF LCL}

+function LazFindResource( const aName, aType : String ): TLResource;

+var

+  iCount : Integer;

+begin

+  result := nil;

+

+  for iCount := 0 to LazarusResources.count -1 do

+  begin

+    if ( LazarusResources.items[ iCount ].Name      = aName ) AND

+       ( LazarusResources.items[ iCount ].ValueType = aType ) THEN

+    begin

+      result := LazarusResources.items[ iCount ];

+      exit;

+    end;

+  end;

+end;

+{$ENDIF}

+

+{$IFDEF FPC}

+function RandomRange(aMin: Integer; aMax: Integer) : Integer;

+begin

+  RandomRange := Random(aMax-aMin) + aMin ;

+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, '',

+    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}

+

+procedure ShowMessage( const msg : String );

+begin

+{$IF Defined(MSWINDOWS)}

+  MessageBox(0, PChar(msg), PChar(USDXVersionStr()), MB_ICONINFORMATION);

+{$ELSE}

+  debugwriteln(msg);

+{$IFEND}

+end;

+

+function IsAlphaChar(ch: WideChar): boolean;

+begin

+  // TODO: add chars > 255 when unicode-fonts work?

+  case ch of

+    'A'..'Z',  // A-Z

+    'a'..'z',  // a-z

+    #170,#181,#186,

+    #192..#214,

+    #216..#246,

+    #248..#255:

+      Result := true;

+    else

+      Result := false;

+  end;

+end;

+

+function IsNumericChar(ch: WideChar): boolean;

+begin

+  case ch of

+    '0'..'9':

+      Result := true;

+    else

+      Result := false;

+  end;

+end;

+

+function IsAlphaNumericChar(ch: WideChar): boolean;

+begin

+  Result := (IsAlphaChar(ch) or IsNumericChar(ch));

+end;

+

+function IsPunctuationChar(ch: WideChar): boolean;

+begin

+  // TODO: add chars outside of Latin1 basic (0..127)?

+  case ch of

+    ' '..'/',':'..'@','['..'`','{'..'~':

+      Result := true;

+    else

+      Result := false;

+  end;

+end;

+

+function IsControlChar(ch: WideChar): boolean;

+begin

+  case ch of

+    #0..#31,

+    #127..#159:

+      Result := true;

+    else

+      Result := false;

+  end;

+end;

+

+end.