游戏引擎

开发平台：
Delphi

AppsInit.pas：源码内容
							(*
 @Abstract(Application Initialization Unit)
 (C) 2003-2007 George "Mirage" Bakhtadze
 The source code may be used under either MPL 1.1 or LGPL 2.1 license. See included license.txt file <br>
 Unit contains application initialization and maintenance classes
*)
{$Include GDefines.inc}
unit AppsInit;
interface
uses
  TextFile,
  BaseTypes, Basics, BaseMsg, OSUtils,
  Windows, Messages, ShellAPI;
const
  WM_NOTIFYTRAYICON = WM_USER + 1;
type
  // Windows message handling callback
  TWndProc = function (WHandle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  // Possible application option flags
  TStarterOption = ({ Without this option the starter will create a working directory for the application in current user's documents directory (usally within "my documents" folder")
                      If the option is included the directory with the application's .exe file will be used as working directory. Not recommended under Windows Vista. }
                    soSingleUser,
                    // If this option is included current directory will be not changed by the starter, else it will be changed to working directory
                    soPreserveDir);
  // Application option flag set
  TStarterOptions = set of TStarterOption;
  { Application starter base class
    The class manages application startup process, creates window, forwards windows messages, etc }
  TAppStarter = class                                     // ToDo: Make it independent from OS
  private
    FTerminated, FActive: Boolean;
    WindowProc: TWndProc;
  protected
    // Application window style
    FWindowStyle: Cardinal;
    // Application window handle
    FWindowHandle: Cardinal;
    // Application name
    FProgramName,
    // Application .exe file name
    FProgramExeName,
    // Application .exe directory
    FProgramExeDir,
    // Application working directory
    FProgramWorkDir: string;
    // Application version string
    FProgramVersionStr: string[16];
    // Returns <b>True</b> if the application is terminated
    function GetTerminated: Boolean; virtual;
    // Windows message handler
    function ProcessMessage(Msg: Longword; wParam: Integer; lParam: Integer): Integer; virtual;
    // This method should be overridden to do command line parameters parsing
    procedure ParseParamStr; virtual;
    // This method should be overridden for variables custom initialization
    procedure Init; virtual;
  public
    // Determines if message handling is needed. <b>True</b> by default.
    HandleMessages: Boolean;
    // Determines if a default window message handler should be called
    CallDefaultMsgHandler: Boolean;
    // A message handler to forward Window messages to
    MessageHandler: TMessageHandler;
    // Time to sleep in milliseconds when the application is not active (60 default)
    InactiveSleepAmount: Integer;
    // Create and setup an application with the given name. If <b>AWindowProc</b> is <b>nil</b> a default procedure will be used.
    constructor Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
    // Immediate termination
    destructor Destroy; override;
    // Set <b>Terminated</b> flag. Normally the application will be terminated as soon as possible.
    procedure Terminate; virtual;
    // Returns <b>True</b> if another instance of the application is already rinning. If <b>ActivateExisting</b> is <b>True</b> the other instance will be activated.
    function isAlreadyRunning(ActivateExisting: Boolean): Boolean; virtual; abstract;
    // Should be called each application cycle. Usally overridden to perform message processing. Returns negate value of @Link(Terminated) property.
    function Process: Boolean; virtual; abstract;
    // Prints an error information
    procedure PrintError(const Msg: string; ErrorType: TLogLevel); virtual; abstract;
    // Application name
    property ProgramName: string read FProgramName;
    // Application .exe file name
    property ProgramExeName: string read FProgramExeName;
    // Application .exe directory including trailing path delimiter
    property ProgramExeDir: string read FProgramExeDir;
    // Application working directory including trailing path delimiter
    property ProgramWorkDir: string read FProgramWorkDir;
    // Application window style
    property WindowStyle: Cardinal read FWindowStyle;
    // Application window handle
    property WindowHandle: Cardinal read FWindowHandle;
    // <b>True</b> if the application's window is currently active
    property Active: Boolean read FActive;
    // <b>True</b> if the application is terminated
    property Terminated: Boolean read GetTerminated write FTerminated;
  end;
  // Screen saver specific implementation of @Link(TAppStarter)
  TScreenSaverStarter = class(TAppStarter)
  private
    MutexWindowHandle: hWnd;
    Rect: TRect;
    ParamChar: Char;
    FWindowClassName: string;
    FParentWindow: hWnd;
    FPreviewMode: Boolean;
    FMoveCounter: Integer;
  protected
    // Current window class
    WindowClass: TWndClass;
    // Windows message handler
    function ProcessMessage(Msg: Longword; wParam: Integer; lParam: Integer): Integer; override;
    // This method should be overridden to do parameters parsing
    procedure ParseParamStr; override;
  public
    // Create and setup a screen saver with the given name. If <b>AWindowProc</b> is <b>nil</b> a default procedure will be used.
    constructor Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
    destructor Destroy; override;
    // Runs the screen saver. If <b>APreviewMode</b> is <b>True</b> the screen saver will run in preview window.
    procedure Run(APreviewMode: Boolean); virtual;
    // Calls system routine to request password
    procedure SetPassword; virtual;
    // Calls system routine to ask user for password and returns <b>True</b> if no password needed or user enter correct password
    function QueryPassword: Boolean; virtual;
    // Shows a configuration window. Usally called from OS screen saver setup dialog
    procedure Configure; virtual;
    // Prints an error information
    procedure PrintError(const Msg: string; ErrorType: TLogLevel); override;
    // <b>True</b> if the screen saver is running in preview mode
    property PreviewMode: Boolean read FPreviewMode;
  end;
  // Win32 implementation of @Link(TAppStarter)
  TWin32AppStarter = class(TAppStarter)
  private
    FWindowClassName: string;
  protected
    // Current window class
    WindowClass: TWndClass;
    // Windows message handler
    function ProcessMessage(Msg: Longword; wParam: Integer; lParam: Integer): Integer; override;
    // Should be override for custom window settings
    procedure InitWindowSettings(var AWindowClass: TWndClass; var ARect: BaseTypes.TRect); virtual;
  public
    constructor Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
    destructor Destroy; override;
    { Returns <b>True</b> if another instance of the application (currently, an application with the same window class name) is already rinning.
      If <b>ActivateExisting</b> is <b>True</b> the other instance will be activated. }
    function isAlreadyRunning(ActivateExisting: Boolean): Boolean; override;
    // Performs win32 messages processing
    function Process: Boolean; override;
    procedure PrintError(const Msg: string; ErrorType: TLogLevel); override;
    // Application's window class name
    property WindowClassName: string read FWindowClassName;
  end;
  // Starter class for a Win32 application with an icon in system tray
  TTrayAppStarter = class(TWin32AppStarter)
  private
    TrayIcon: TNotifyIconData;
  protected
    // Windows message handler
    function ProcessMessage(Msg: Longword; wParam: Integer; lParam: Integer): Integer; override;
  public
    // Adds an icon to system tray and returns <b>True</b> if success
    function AddTrayIcon: Boolean;
    // Removes an icon to system tray
    procedure RemoveTrayIcon;
    destructor Destroy; override;
  end;
implementation
uses SysUtils;
type
  TVerifySSPassFunc = function(Parent: hWnd): Bool; StdCall;
  TChgPassAFunc = function(A: PChar; Parent: hWnd; B, C: Integer): Integer; StdCall;
var
  CurrentStarter: TAppStarter;
function StdWindowProc(WHandle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if (CurrentStarter = nil) or (CurrentStarter.WindowHandle = 0) or (CurrentStarter.FTerminated) then begin
//    Log.Log('*** <Default> Message: ' + Format('%D, %D, %D', [Msg, wParam, lParam]), lkError);
    Result := DefWindowProc(WHandle, Msg, wParam, lParam)
  end else begin
//    Log.Log('*** Message: ' + Format('%D, %D, %D', [Msg, wParam, lParam]), lkError);
    CurrentStarter.CallDefaultMsgHandler := True;
    Result := CurrentStarter.ProcessMessage(Msg, wParam, lParam);
    if CurrentStarter.CallDefaultMsgHandler then Result := DefWindowProc(WHandle, Msg, wParam, lParam);
  end;
end;
{ TAppStarter }
function TAppStarter.GetTerminated: Boolean;
begin
  Result := FTerminated;
end;
function TAppStarter.ProcessMessage(Msg: Longword; wParam, lParam: Integer): Integer;
begin
  if Assigned(MessageHandler) then MessageHandler(WMToMessage(Msg, wParam, lParam));
  Result := 1;
end;
procedure TAppStarter.ParseParamStr;
begin
end;
procedure TAppStarter.Init;
begin
end;
constructor TAppStarter.Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
var ExeExt: string;
begin
  CurrentStarter := Self;
  FProgramName := AProgramName;
  ExeExt := ExtractFileExt(ParamStr(0));
  FProgramExeName := LowerCase(ExtractFileName(ParamStr(0)));
  if ExeExt <> '' then FProgramExeName := Copy(ProgramExeName, 1, Length(ProgramExeName) - Length(ExeExt));
  FProgramExeDir := IncludeTrailingPathDelimiter(ExtractFileDir(ParamStr(0)));
  FProgramWorkDir := '';
  if not (soSingleUser in Options) then begin
    FProgramWorkDir := IncludeTrailingPathDelimiter(GetSysFolder(sfPersonal)) + ProgramExeName;
    if not DirectoryExists(ProgramWorkDir) then
      if not CreateDir(ProgramWorkDir) then begin
        Log.Log(ClassName + '.Create: Can''t create directory "' + ProgramWorkDir + '"', lkError);
        FProgramWorkDir := '';
      end;
  end;
  if ProgramWorkDir = '' then FProgramWorkDir := FProgramExeDir;
  if not (soPreserveDir in Options) then SetCurrentDir(ProgramWorkDir);
  WindowProc := AWindowProc;
  Init;
  Terminated := False;
  if isAlreadyRunning(True) then begin
    Log.Log(ClassName + '.Create: Application instance is already running', lkError);
    Terminated := True;
  end;
  InactiveSleepAmount := 60;
  FActive := GetActiveWindow = WindowHandle;
end;
destructor TAppStarter.Destroy;
begin
  Terminate;
  inherited;
end;
procedure TAppStarter.Terminate;
begin
  FTerminated := True;
end;
{ TWin32AppStarter }
function TWin32AppStarter.ProcessMessage(Msg: Longword; wParam, lParam: Integer): Integer;
begin
  Result := inherited ProcessMessage(Msg, wParam, lParam);
  case Msg of
    WM_CLOSE: begin
      Result := 0; Terminated := True;
    end;
    WM_ACTIVATEAPP: begin
      if (wParam and 65535 = WA_ACTIVE) or (wParam and 65535 = WA_CLICKACTIVE) then FActive := True;
      if wParam and 65535 = WA_INACTIVE then FActive := False;
    end;
  end;
end;
procedure TWin32AppStarter.InitWindowSettings(var AWindowClass: TWndClass; var ARect: BaseTypes.TRect);
begin
end;
constructor TWin32AppStarter.Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
const SizePercent = 50;
var
  ScreenX, ScreenY: Integer;
  WinRect: BaseTypes.TRect;
begin
  inherited;
  FWindowStyle := WS_OVERLAPPED or WS_CAPTION or WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX or WS_SYSMENU;
//  WindowStyle := WS_OVERLAPPEDWINDOW{ or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX};
  WindowClass.style := 0;//CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
  if @AWindowProc = nil then
    WindowClass.lpfnWndProc := @StdWindowProc else
      WindowClass.lpfnWndProc := {$IFNDEF FPC}@{$ENDIF}AWindowProc;
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hIcon := LoadIcon(hInstance, 'MAINICON');
  WindowClass.hCursor := LoadCursor(WindowClass.hInstance*0, IDC_ARROW);
  WindowClass.hInstance := HInstance;
  WindowClass.hbrBackground := 0;//GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  FWindowClassName := 'TAWindowClass(' + AProgramName + ')';
  WindowClass.lpszClassName := PChar(FWindowClassName);
  if RegisterClass(WindowClass) = 0 then begin
    Log.Log('TWin32AppStarter.Create: Window class registration failed', lkFatalError);
    Exit;
  end;
  ScreenX := GetSystemMetrics(SM_CXSCREEN);
  ScreenY := GetSystemMetrics(SM_CYSCREEN);
  if ScreenX = 0 then ScreenX := 640;
  if ScreenY = 0 then ScreenY := 480;
  WinRect := GetRectWH((ScreenX - ScreenX * SizePercent div 100) div 2, (ScreenY - ScreenY * SizePercent div 100) div 2,
                       ScreenX * SizePercent div 100, ScreenY * SizePercent div 100);
  InitWindowSettings(WindowClass, WinRect);
  FWindowHandle := Windows.CreateWindow(WindowClass.lpszClassName, PChar(AProgramName), FWindowStyle,
                                        WinRect.Left, WinRect.Top, WinRect.Right-WinRect.Left, WinRect.Bottom-WinRect.Top,
                                        0, 0, HInstance, nil);
  if FWindowHandle = 0 then begin
    Log.Log('TWin32AppStarter.Create: Window creation failed', lkFatalError);
    Exit;
  end;
  ShowWindow(FWindowHandle, SW_NORMAL);
  HandleMessages := True;
end;
procedure TWin32AppStarter.PrintError(const Msg: string; ErrorType: TLogLevel);
begin
  case ErrorType of
    lkInfo:       MessageBox(WindowHandle, PChar(Msg), 'Information', MB_ICONINFORMATION);
    lkWarning:    MessageBox(WindowHandle, PChar(Msg), 'Warning',     MB_ICONWARNING);
    lkError:      MessageBox(WindowHandle, PChar(Msg), 'Error',       MB_ICONERROR);
    lkFatalError: MessageBox(WindowHandle, PChar(Msg), 'Fatal error', MB_ICONSTOP);
  end;
  Log.Log(Msg, ErrorType);
end;
destructor TWin32AppStarter.Destroy;
begin
  if WindowHandle <> 0 then DestroyWindow(WindowHandle);
  if not UnRegisterClass(PChar(WindowClassName), hInstance) then
  if Log <> nil then Log.Log('Error unregistering window class: ' + GetOSErrorStr(GetLastError), lkError);
  inherited;
end;
function TWin32AppStarter.isAlreadyRunning(ActivateExisting: Boolean): Boolean;
var h: HWND;
begin
  h := FindWindow(PChar(WindowClassName), nil);
  Result := h <> 0;
  if Result and ActivateExisting then begin
//    SetActiveWindow(h);
    SetForegroundWindow(h);
    PostMessage(h, WM_NOTIFYTRAYICON, 0, WM_LBUTTONDOWN);
  end;
  {$IFDEF DEBUGMODE}
  if Result and ActivateExisting then PostMessage(h, WM_NOTIFYTRAYICON, 0, WM_LBUTTONDOWN);
  SetWindowPos(h, HWND_TOP, GetSystemMetrics(SM_CXSCREEN) div 2, 0, GetSystemMetrics(SM_CXSCREEN) div 2, GetSystemMetrics(SM_CYSCREEN)*2 div 3, SWP_NOACTIVATE{ or SWP_NOSIZE});
  Result := False;
  {$ENDIF}
end;
function TWin32AppStarter.Process: Boolean;
var Msg: tagMSG;
begin
  if HandleMessages then begin
    if (PeekMessage(Msg, WindowHandle, 0, 0, PM_REMOVE)) then begin
      repeat
        with Msg do begin
          if message = WM_QUIT then Terminated := True;
          if (message = WM_KEYDOWN) or (message = WM_KEYUP) or (message = WM_SYSKEYDOWN) or (message = WM_SYSKEYUP) then TranslateMessage(Msg);
        end;
        DispatchMessage(Msg);
      until not PeekMessage(Msg, WindowHandle, 0, 0, PM_REMOVE);
    end else if not Active then begin
      if InactiveSleepAmount >= 0 then begin
        Sleep(InactiveSleepAmount);
  //      Log.Log('sleeping...');
      end;
      FActive := GetActiveWindow = WindowHandle;
    end;
  end;
  Result := not Terminated;
end;
{ TTrayAppStarter }
function TTrayAppStarter.AddTrayIcon: Boolean;
const
  TrayMsg = 'Click to restore ';
  MsgMaxLength = 64;
var i, len: Integer; Title: PChar;
begin
  with TrayIcon do begin
    cbSize := SizeOf(TNotifyIconData);
    {$IFDEF FPC} HWnd := WindowHandle; {$ELSE} Wnd := WindowHandle; {$ENDIF}
    uID := 1;
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
    uCallBackMessage := WM_NOTIFYTRAYICON;
    hIcon := WindowClass.hIcon;
    szTip := TrayMsg;
    Getmem(Title, MsgMaxLength*4);       // Reserve memory for a unicode string
    if GetWindowText(WindowHandle, Title, MsgMaxLength-1) = 0 then begin
      FreeMem(Title);
      Title := PChar(WindowClassName);
    end;
    if Length(Title) + Length(TrayMsg) < MsgMaxLength then
      Len := Length(Title) else
        Len := MsgMaxLength-Length(TrayMsg);
    for i := 1 to Len do szTip[i+Length(TrayMsg)-1] := Title[i-1];
    FreeMem(Title);
  end;
  Result := Shell_NotifyIcon(NIM_ADD, PNotifyIconData(@TrayIcon));
end;
procedure TTrayAppStarter.RemoveTrayIcon;
begin
  Shell_NotifyIcon(NIM_DELETE, PNotifyIconData(@TrayIcon));
end;
function TTrayAppStarter.ProcessMessage(Msg: Longword; wParam, lParam: Integer): Integer;
begin
  Result := inherited ProcessMessage(Msg, wParam, lParam);
  case Msg of
    WM_NOTIFYTRAYICON: if lParam = WM_LBUTTONDOWN then begin
      RemoveTrayIcon;
      ShowWindow(WindowHandle, SW_SHOW);
      ShowWindow(WindowHandle, SW_RESTORE);
    end;
//    WM_ERASEBKGND, WM_PAINT: Result := 1;//DefWindowProc(WHandle, Msg, WParam, LParam);
    WM_SIZE{, WM_CANCELMODE}: begin
      if wParam = SIZE_MINIMIZED then begin
        if AddTrayIcon then ShowWindow(WindowHandle, SW_HIDE);
        FActive := False;
      end;
    end;
  end;
end;
destructor TTrayAppStarter.Destroy;
begin
  RemoveTrayIcon;
  inherited;
end;
{ TScreenSaverStarter }
function PreviewThreadProc(Data : Integer) : Integer; StdCall;
begin
  Sleep(1000);
  Result := 0; Randomize;
  ShowWindow(CurrentStarter.WindowHandle, SW_SHOW); UpdateWindow(CurrentStarter.WindowHandle);
  repeat
    InvalidateRect(CurrentStarter.WindowHandle, nil, False);
    Sleep(30);
  until CurrentStarter.Terminated;
  PostMessage(CurrentStarter.WindowHandle, wm_Destroy, 0, 0);
end;
constructor TScreenSaverStarter.Create(const AProgramName: string; AWindowProc: TWndProc; Options: TStarterOptions);
begin
  inherited;
  GetWindowRect(GetDesktopWindow, Rect);
  ParseParamStr;
  Run(FParentWindow <> 0);
{  if (cc = 'C') Then RunSettings
  Else If (cc = 'P') Then RunPreview
       Else If (cc = 'A') Then RunSetPassword
            Else RunFullScreen;}
end;
procedure TScreenSaverStarter.ParseParamStr;
var s: string;
begin
  s := ParamStr(1);
  if (Length(s) > 1) then begin
    Delete(s, 1, 1); { delete first char - usally "/" or "-" }
//    S[1] := UpCase(S[1]);
    ParamChar := UpCase(s[1]);
  end;
  if (ParamChar = 'P') then begin
    FParentWindow := StrToIntDef(ParamStr(2), 0);
    GetWindowRect(FParentWindow, Rect);
  end else FParentWindow := 0;
  if (ParamChar = 'C') then Configure;
end;
procedure TScreenSaverStarter.Run(APreviewMode: Boolean);
var Dummy: Cardinal;
begin
  FPreviewMode := APreviewMode;
  FMoveCounter := 10;
  WindowClass.style := 0; //CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
  WindowClass.lpfnWndProc := {$IFNDEF FPC}@{$ENDIF}WindowProc;
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hIcon := LoadIcon(hInstance, 'MAINICON');
  WindowClass.hCursor := LoadCursor(WindowClass.hInstance*0, IDC_ARROW);
  WindowClass.hInstance := HInstance;
  WindowClass.hbrBackground := 0;//GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  FWindowClassName := 'TAWindowClass(' + ProgramName + ')';
  WindowClass.lpszClassName := PChar(FWindowClassName);
  if RegisterClass(WindowClass) = 0 then begin
    Log.Log('TScreenSaverStarter.Create: Window class registration failed', lkFatalError); 
    Exit;
  end;
  if (FParentWindow <> 0) then begin
    FWindowStyle  := WS_CHILD or WS_VISIBLE or WS_DISABLED;
    FWindowHandle := CreateWindow(WindowClass.lpszClassName, WindowClass.lpszClassName, FWindowStyle, 0, 0, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, FParentWindow, 0, hInstance, nil);
    MutexWindowHandle := 0;//CreateWindow(WindowClass.lpszClassName, 'Mutex', WS_DISABLED, -10, -10, 1, 1, 0, 0, hInstance, nil);
//    SetWindowPos(MutexWindowHandle, 0, -10, -10, 1, 1, SWP_HIDEWINDOW or SWP_NOACTIVATE);
  end else begin
//    WindowStyle := WS_OVERLAPPED or WS_CAPTION or WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX or WS_SYSMENU;
    FWindowStyle  := Cardinal(WS_VISIBLE or WS_POPUP);
    FWindowHandle := CreateWindow(WindowClass.lpszClassName, nil{WindowClass.lpszClassName},
                                 FWindowStyle, 0, 0,
                                 Rect.Right-Rect.Left, Rect.Bottom-Rect.Top, 0, 0, hInstance, nil);
    {$IFNDEF DEBUGMODE}
    SetWindowPos(WindowHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOREDRAW);
    {$ENDIF}    
  end;
// ShowWindow(CurrentStarter.WindowHandle, SW_SHOW); UpdateWindow(CurrentStarter.WindowHandle);
  if FPreviewMode then OSUtils.ShowCursor;
//  if PreviewMode then CreateThread(nil, 0, @PreviewThreadProc, nil, 0, Dummy);
  if not FPreviewMode then SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
end;
procedure TScreenSaverStarter.SetPassword;
var
  Lib: THandle;
  ChgPassAFunc: TChgPassAFunc;
begin
  Lib := LoadLibrary('MPR.DLL');
  if Lib > 0 Then begin
    ChgPassAFunc := TChgPassAFunc(GetProcAddress(Lib,'PwdChangePasswordA'));
    if (@ChgPassAFunc <> nil) then ChgPassAFunc('SCRSAVE', StrToInt(ParamStr(2)), 0, 0);
    FreeLibrary(Lib);
  end;
end;
function TScreenSaverStarter.QueryPassword: Boolean;
var
  Key: hKey;
  D1, D2: Integer; { two dummies }
  Value: Integer;
  Lib: THandle;
  VerifySSPassFunc: TVerifySSPassFunc;
begin
  Result := True;
  if RegOpenKeyEx(HKEY_CURRENT_USER, 'Control PanelDesktop', 0, KEY_READ,Key) = ERROR_SUCCESS then begin
    D2 := SizeOf(Value);
    if RegQueryValueEx(Key, 'ScreenSaveUsePassword', nil, @D1, @Value, @D2) = ERROR_SUCCESS then begin
      if Value <> 0 then begin
        Lib := LoadLibrary('PASSWORD.CPL');
        if Lib > 0 then begin
          VerifySSPassFunc := TVerifySSPassFunc(GetProcAddress(Lib,'VerifyScreenSavePwd'));
          AdjustCursorVisibility(True);
          if @VerifySSPassFunc <> nil then Result := VerifySSPassFunc(FParentWindow);
          AdjustCursorVisibility(False);
          FMoveCounter := 10; { reset again if password was wrong }
          FreeLibrary(Lib);
        end;
      end;
    end;
    RegCloseKey(Key);
  end;
end;
procedure TScreenSaverStarter.Configure;
begin
  MessageBox(WindowHandle, 'There is no settings yet.'#13#10#13#10'You can use Q/W/E/S/Z/C keys to control view angle', 'Info', MB_OK);
  Terminated := True;
end;
procedure DrawSingleBox;
{var
  PaintDC  : hDC;
  Info     : TPaintStruct;
  OldBrush : hBrush;
  X,Y      : Integer;
  Color    : LongInt;
  WndRect: TRect;}
begin
{  PaintDC := beginPaint(CurrentStarter.WindowHandle, Info);
  GetWindowRect(CurrentStarter.WindowHandle, WndRect);
  X := Random(WndRect.Right); Y := Random(WndRect.Bottom);
  Color := RGB(Random(255),Random(255),Random(255));
  OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));
  RoundRect(PaintDC,X,Y,X+Random(WndRect.Right-X),Y+Random(WndRect.Bottom-Y),20,20);
  DeleteObject(SelectObject(PaintDC,OldBrush));
  EndPaint(CurrentStarter.WindowHandle, Info);}
end;
function TScreenSaverStarter.ProcessMessage(Msg: Longword; wParam, lParam: Integer): Integer;
begin
  Result := inherited ProcessMessage(Msg, wParam, lParam);
  case Msg of
    WM_NCCREATE: begin Result := 1; Exit; end;
    WM_DESTROY: begin Result := 1; PostQuitMessage(0); Terminated := True; end;
//    WM_PAINT: DrawSingleBox; { paint something }
    WM_KEYDOWN: ;//if not PreviewMode then Finished := True;//AskPassword;
    WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN, WM_MOUSEMOVE: begin
      if (not FPreviewMode) then begin
        Dec(FMoveCounter);
       if (FMoveCounter <= 0) then Terminated := True;//AskPassword;
      end;
    end;
    WM_CLOSE: begin Result := 1; Terminated := True; end;
    WM_SHOWWINDOW: if wParam = 0 then Terminated := True;
    WM_ACTIVATEAPP, WM_ACTIVATE, WM_NCACTIVATE: if not FPreviewMode then begin
      if wParam and 65535 = WA_INACTIVE then Terminated := True;
    end;
    WM_SYSCOMMAND: begin
      CallDefaultMsgHandler := False;
      case wParam and $FFF0 of
        SC_CLOSE: ;//Finished := True;
        SC_SCREENSAVE: ;
        else CallDefaultMsgHandler := True;
      end;
    end;
  end;
end;
procedure TScreenSaverStarter.PrintError(const Msg: string; ErrorType: TLogLevel);
begin
  Log.Log(Msg, ErrorType);
end;
destructor TScreenSaverStarter.Destroy;
var Dummy: Cardinal;
begin
//  if not PreviewMode then
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @Dummy, 0);
  AdjustCursorVisibility(True);
  if MutexWindowHandle <> 0 then DestroyWindow(MutexWindowHandle);
  if WindowHandle <> 0 then DestroyWindow(WindowHandle);
  UnRegisterClass(PChar(FWindowClassName), hInstance);
  inherited;
end;
end.

						