游戏引擎

开发平台：
Delphi

OSUtils.pas：源码内容
							(*
 @Abstract(Operating systems support unit)
 (C) 2006-2007 George "Mirage" Bakhtadze. <a href="http://www.casteng.com">www.casteng.com</a> <br>
 The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
 Unit contains basic OS-related classes
*)
{$Include GDefines.inc}
unit OSUtils;
interface
uses
  {$IFDEF FPC} FPCWindows, {$ENDIF}
  ShlObj,
  SysUtils,                // ToDo: Move to advanced unit
  Windows, Messages,
  ShellAPI,
  Basics, BaseTypes, BaseMsg;
const
  kernel = 'kernel32.dll';
type
  THandle = Cardinal;
  TKbdState = array[0..255] of Byte;
  TRect = Windows.TRect;
  // System path
  TSysFolder = (sfRecycled, sfDesktop, sfStartMenu, sfPrograms, sfStartup, sfPersonal, sfTemplates, sfRecent, sfSendTo, sfNetHood, sfAppData, sfWinRoot, sfWinSys);
// OS dependent
procedure ObtainCursorPos(var X, Y: Integer);
procedure SetCursorPos(X, Y: Integer);
function AdjustCursorVisibility(Show: Boolean): Integer;
procedure ClipCursor(Rect: TRect);
function GetClipCursor: TRect;
procedure GetWindowRect(Handle: THandle; out Rect: TRect);
procedure GetClientRect(Handle: THandle; out Rect: TRect);
procedure ScreenToClient(Handle: THandle; out X, Y: Integer);
procedure ClientToScreen(Handle: THandle; out X, Y: Integer);
procedure ShowWindow(Handle: THandle);
procedure HideWindow(Handle: THandle);
procedure MinimizeWindow(Handle: THandle);
function IsWindowVisible(Handle: THandle): Boolean;
procedure SetWindowCaption(Handle: THandle; const ACaption: string);
procedure ObtainKeyboardState(var State: TKbdState);
function GetAsyncKeyState(Key: Integer): Integer;
function GetOSErrorStr(ErrorID: Integer): string;
function ActivateWindow(hwnd: THandle): Boolean;
function GetCurrentMs: Cardinal;
procedure ObtainPerformanceFrequency;
function GetPerformanceCounter: Int64;
procedure OpenWith(ParentHandle: Cardinal; const FileName: string);
procedure OpenURL(const URL: string);
function ThreadSafeIncrement(var Addend: Integer): Integer; stdcall; external kernel name 'InterlockedIncrement';
function ThreadSafeDecrement(var Addend: Integer): Integer; stdcall; external kernel name 'InterlockedDecrement';
function WMToMessage(MsgID: Cardinal; wParam, lParam: Integer): TMessage; overload;
function WMToMessage(const Msg: Messages.TMessage): TMessage; overload;
procedure Sleep(Milliseconds: Integer);           // Not accurate (~10ms)
procedure Delay(Microseconds: Integer);           // Accurate
procedure Exec(const Command: string);
function GetActiveWindow: THandle;
function GetSysFolder(SysFolder: TSysFolder): string;
function GetTextFromClipboard: string;
// OS independent
procedure SetCursorVisibility(Counter: Integer);
procedure ShowCursor;
procedure HideCursor;
var
  PerformanceFrequency: Int64;
  OneOverPerformanceFrequency: Single;
implementation
// OS dependent
procedure ObtainCursorPos(var X, Y: Integer);
var Pnt: TPoint;
begin
  Windows.GetCursorPos(Pnt);
  X := Pnt.X; Y := Pnt.Y;
end;
procedure SetCursorPos(X, Y: Integer);
begin
  Windows.SetCursorPos(X, Y);
end;
function AdjustCursorVisibility(Show: Boolean): Integer;
begin
  Result := Windows.ShowCursor(Show);
end;
procedure ClipCursor(Rect: TRect);
begin
  Windows.ClipCursor(@Rect);
end;
function GetClipCursor: TRect;
begin
  Windows.GetClipCursor(Result);
end;
procedure GetWindowRect(Handle: THandle; out Rect: TRect);
begin
  Windows.GetWindowRect(Handle, Rect)
end;
procedure GetClientRect(Handle: THandle; out Rect: TRect);
begin
  Windows.GetClientRect(Handle, Rect)
end;
procedure ScreenToClient(Handle: THandle; out X, Y: Integer);
var Pnt: TPoint;
begin
  Pnt.X := X; Pnt.Y := Y;
  Windows.ScreenToClient(Handle, Pnt);
  X := Pnt.X; Y := Pnt.Y;
end;
procedure ClientToScreen(Handle: THandle; out X, Y: Integer);
var Pnt: TPoint;
begin
  Pnt.X := X; Pnt.Y := Y;
  Windows.ClientToScreen(Handle, Pnt);
  X := Pnt.X; Y := Pnt.Y;
end;
procedure ShowWindow(Handle: THandle);
begin
  Windows.ShowWindow(Handle, SW_SHOWNORMAL);
end;
procedure HideWindow(Handle: THandle);
begin
  Windows.ShowWindow(Handle, SW_HIDE);
end;
procedure MinimizeWindow(Handle: THandle);
begin
  Windows.ShowWindow(Handle, SW_MINIMIZE);
end;
function IsWindowVisible(Handle: THandle): Boolean;
begin
  Result := Windows.IsWindowVisible(Handle);
end;
procedure SetWindowCaption(Handle: THandle; const ACaption: string);
begin
  Windows.SetWindowText(Handle, PChar(ACaption));
end;
procedure ObtainKeyboardState(var State: TKbdState);
begin
  Windows.GetKeyboardState(TKeyboardState(State));
end;
function GetAsyncKeyState(Key: Integer): Integer;
begin
  Result := Windows.GetAsyncKeyState(Key);
end;
function WMToMessage(MsgID: Cardinal; wParam, lParam: Integer): TMessage; overload;
begin
  case MsgID of
    WM_ACTIVATEAPP: begin
      if wParam = 0 then Result := TWindowDeactivateMsg.Create else Result := TWindowActivateMsg.Create;
    end;  
//    WM_EXITSIZEMOVE: 
    WM_SIZE: begin
      if wParam = SIZE_MINIMIZED then
        Result := TWindowMinimizeMsg.Create else
          Result := TWindowResizeMsg.Create(0, 0, lParam and 65535, lParam shr 16);
    end;  
    WM_MOVE:       Result := TWindowMoveMsg.Create(lParam and 65535, lParam shr 16);
    WM_CANCELMODE: Result := TCancelModeMsg.Create;
    WM_CHAR:       Result := TCharInputMsg.Create(Chr(wParam), lParam);
    WM_SYSCOMMAND: Result := TWindowMenuCommand.Create(wParam);
    else Result := TMessage.Create; 
  end;
  Result.Flags := Result.Flags + [mfCore];
end;
function WMToMessage(const Msg: Messages.TMessage): TMessage; overload;
begin
  Result := WMToMessage(Msg.Msg, Msg.WParam, Msg.LParam);
end;
function GetOSErrorStr(ErrorID: Integer): string;
var s: PChar;
begin
  GetMem(s, 2000);
  FormatMessage({FORMAT_MESSAGE_ALLOCATE_BUFFER or }FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS,
                nil, ErrorID, 0, s, 2000, nil);
  Result := s;
  FreeMem(s);
end;
function ActivateWindow(hwnd: THandle): Boolean;
var Input: TInput;
begin
  Result:= True;
  if hwnd = GetForegroundWindow then Exit;
  if IsWindow(hwnd) then begin
    Input.Itype:= Input_Mouse;
    FillChar(Input.mi, SizeOf(Input.mi), 0);
    SendInput(1, Input, SizeOf(Input));
    Result := SetForegroundWindow(hwnd);
//    SetActiveWindow(hwnd);
    if IsIconic(hwnd) then OpenIcon(hwnd);
    Exit;
  end;
  Result:= False;
end;
function GetCurrentMs: Cardinal;
begin
  Result := GetTickCount;
end;
procedure ObtainPerformanceFrequency;
begin
  if QueryPerformanceFrequency(PerformanceFrequency) then begin
    if PerformanceFrequency <> 0 then OneOverPerformanceFrequency := 1 / PerformanceFrequency else OneOverPerformanceFrequency := 0;
  end else PerformanceFrequency := 0;
end;
function GetPerformanceCounter: Int64;
begin
  QueryPerformanceCounter(Result);
end;
procedure OpenWith(ParentHandle: Cardinal; const FileName: string);
begin
  ShellExecute(ParentHandle, 'open', PChar('rundll32.exe'),
    PChar('shell32.dll,OpenAs_RunDLL ' + FileName), nil, SW_SHOWNORMAL);
end;
procedure OpenURL(const URL: string);
begin
  ShellExecute(0, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL);
  Sleep(500);                                                    // To eliminate some bugs with timer
end;
// OS independent
procedure SetCursorVisibility(Counter: Integer);
var i, Cur: Integer;
begin
  Cur := AdjustCursorVisibility(True);
  for i := 0 to Abs(Cur-Counter)-1 do AdjustCursorVisibility(Cur < Counter);
end;
procedure ShowCursor;
begin
  SetCursorVisibility(0);
end;
procedure HideCursor;
begin
  SetCursorVisibility(-1);
end;
procedure Sleep(Milliseconds: Integer);
begin
  Windows.Sleep(Milliseconds);
end;
procedure Delay(Microseconds: Integer);
var Cnt, Dest: Int64;
begin
  Cnt := GetPerformanceCounter;
  Dest := Cnt + Microseconds * PerformanceFrequency div 1000000;
  while GetPerformanceCounter < Dest do;
end;
procedure Exec(const Command: string);
begin
  ShellExecute({Starter.WindowHandle}0, 'open', PChar(Command), nil, nil, SW_SHOWNORMAL);
  Sleep(500);
end;
function GetActiveWindow: THandle;
begin
  Result := Windows.GetActiveWindow;
end;
function GetSysFolder(SysFolder: TSysFolder): string;
var
 s: PChar;
 p: PItemIDList;
 Folder: Integer;
begin
   Result := '';
   p := nil;
   case SysFolder of
     sfRecycled:  Folder := CSIDL_BITBUCKET;
     sfDesktop:   Folder := CSIDL_DESKTOPDIRECTORY;
     sfStartMenu: Folder := CSIDL_STARTMENU;
     sfPrograms:  Folder := CSIDL_PROGRAMS;
     sfStartup:   Folder := CSIDL_STARTUP;
     sfPersonal:  Folder := CSIDL_PERSONAL;
     sfRecent:    Folder := CSIDL_RECENT;
     sfNetHood:   Folder := CSIDL_NETHOOD;
     sfSendTo:    Folder := CSIDL_SENDTO;
     sfTemplates: Folder := CSIDL_TEMPLATES;
     sfAppData:   Folder := CSIDL_APPDATA;
//     sfWinRoot:   Folder :=
//     sfWinSys:    Folder :=
     else begin
       Assert(False);
       Exit;
     end;
   end;
   if (SHGetSpecialFolderLocation(0 ,Folder, p) <> NOERROR) or (p = nil) then Exit;
   s := StrAlloc(MAX_PATH+1);
   if SHGetPathFromIDList(p, s) then Result := s;
   StrDispose(s);
end;
function GetTextFromClipboard: string;
var hg: THandle; P: PChar;
begin
  OpenClipboard(0);
  hg := GetClipboardData(CF_TEXT);
  CloseClipboard;
  P := GlobalLock(hg);
  Result := Copy(P, 0, Length(P));
  GlobalUnlock(hg);
end;
begin
  ObtainPerformanceFrequency;
end.

						