uberlinscr.pas

Delphi实效编程百例的随书源代码 这是其中的操作系统部分

UNIT UBerlinSCR;

INTERFACE

USES
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Registry,
  Globals, ExtCtrls,
  MMSystem, UPie;

TYPE
  TFormSpecSCR = CLASS(TForm)
    TimerMain: TTimer;
    TimerDimm: TTimer;
    TimerClose: TTimer;
    PROCEDURE FormCreate(Sender: TObject); VIRTUAL;
    PROCEDURE FormCloseQuery(Sender: TObject; var CanClose: Boolean);  VIRTUAL;
    PROCEDURE FormDestroy(Sender: TObject);
    PROCEDURE TimerDimmTimer(Sender: TObject);
    PROCEDURE TimerMainTimer(Sender: TObject);
    PROCEDURE FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    PROCEDURE FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure TimerCloseTimer(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  PRIVATE
    { Private declarations }
    aBerlinUhr	: TBerlinUhr;
    aBerlinUhrRegEntries: TBerlinUhrRegEntries;
    bAllowClose	: BOOLEAN;
    FUNCTION  GetPassword: BOOLEAN;
    PROCEDURE WMSysCommand(VAR Message: TWMSysCommand); message WM_SYSCOMMAND;
  PUBLIC
    { Public declarations }
  END;

VAR
  FormSpecSCR: TFormSpecSCR;

IMPLEMENTATION

{$R *.DFM}

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormCreate(Sender: TObject);

BEGIN
TimerMain.Enabled := false;
TimerDimm.Enabled := false;
bAllowClose	:= false;
Cursor	        := crNone;
Width	 	:= Screen.Width;
Height	 	:= Screen.Height;
aBerlinUhrRegEntries := TBerlinUhrRegEntries.Create;
TRY
  aBerlinUhr	:= TBerlinUhr.Create( aBerlinUhrRegEntries.BerlinUhrColors, Width, Height, Width DIV 100 );
 EXCEPT
  aBerlinUhrRegEntries.Free;
  Halt;
  END;
aBerlinUhrRegEntries.Free;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormDestroy(Sender: TObject);

VAR
  bDummy : BOOLEAN;

BEGIN
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0, @bDummy,0);
aBerlinUhr.Free;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormShow(Sender: TObject);

BEGIN
TimerMain.Enabled := true;
TimerDimm.Enabled := true;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

BEGIN
CanClose := bAllowClose;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.WMSysCommand( VAR Message: TWMSysCommand);

BEGIN
WITH Message DO
  IF ((CmdType AND $FFF0) = SC_ScreenSave) OR
     ((CmdType AND $FFF0) = SC_Close) OR
     ((CmdType AND $FFF0) = SC_TaskList) THEN
    BEGIN
    AppendText( ' SysCommand[SC_ScreenSave OR SC_Close OR SC_Tasklist]' );
    Exit;
    END;

INHERITED;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.TimerMainTimer(Sender: TObject);

BEGIN
IF Assigned( aBerlinUhr ) THEN
  BEGIN
  IF NOT( aBerlinUhr.IsProcessing ) THEN
    BEGIN
    Canvas.CopyMode := cmSrcCopy;
    Canvas.Draw(0,0, aBerlinUhr.GetBitmap( Now ) );
    END;
  END;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.TimerDimmTimer(Sender: TObject);

BEGIN
aBerlinUhr.DimmAll( true );
TimerDimm.Enabled := false;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.TimerCloseTimer(Sender: TObject);

BEGIN
TimerMain.Enabled := false;
IF bSound THEN
  BEGIN
  bSound := false;
  PlaySound( 'BRIDGE7', hInstance, SND_Resource OR SND_sync );
  END;
bAllowClose	:= GetPassword;
Close;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

BEGIN
TimerClose.Enabled := false;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

BEGIN
IF (Shift = [ssRight]) THEN
  BEGIN
  TimerClose.Enabled := true;
  END;
END;

(*---------------------------------*)
PROCEDURE TFormSpecSCR.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

BEGIN
aBerlinUhr.DimmAll( false );
TimerDimm.Enabled := true;
END;

(*---------------------------------*)
FUNCTION TFormSpecSCR.GetPassword: BOOLEAN;

VAR
  hMod     	: THandle;
  functionPWD   : function (Parent : THandle) : Boolean; stdcall;
  strSysDir    	: String;
  iNewLen    	: Integer;
  aReg		: TRegistry;
  bOkClose	: Boolean;

BEGIN
IF (aSSMode <> ssRun) OR bTestMode THEN
  BEGIN
  Result := true;
  AppendText( ' PWD not required' );
  Exit;
  END;

bOkClose := false;
aReg := TRegistry.Create;
aReg.RootKey := HKEY_CURRENT_USER;
IF aReg.OpenKey('Control Panel\Desktop',False) THEN
  BEGIN
  TRY
   TRY
      ShowCursor(true);
      IF aReg.ReadInteger('ScreenSaveUsePassword') <> 0 THEN
	BEGIN
	SetLength( strSysDir, MAX_PATH);
	iNewLen := GetSystemDirectory(PChar(strSysDir), MAX_PATH);
	SetLength( strSysDir, iNewLen);
	IF (Length(strSysDir) > 0) AND (strSysDir[Length(strSysDir)] <> '\') THEN
	  strSysDir := strSysDir+'\';
	hMod := LoadLibrary(PChar(strSysDir+'PASSWORD.CPL'));
	IF hMod = 0 THEN
	  BEGIN
	  bOkClose := true
	  END
	 ELSE
	  BEGIN
	  FunctionPWD := GetProcAddress( hMod,'VerifyScreenSavePwd');
	  IF FunctionPWD(Handle) THEN
	    bOkClose := true;
	  FreeLibrary( hMod );
	  END;
	END {if hMod = 0}
       ELSE
	BEGIN
	bOkClose := true;
	END; {if hMod = 0}
     FINALLY
       ShowCursor(false);
      END;
    EXCEPT
     bOkClose := true;
    END;
  END
 ELSE
  BEGIN
  bOkClose := true;
  END; {aReg.OpenKey() }

aReg.Free;
Result := bOkClose;
END;

(*+++++++++++++++++++++++++++++++++*)
END.