Général

Accueil
News (Archives)
Articles
Liens
Programmes

Forum

Accès au forum

Conformité

Flux RSS

Flux RSS news (RSS 2.0)

Ecrire un écran de veille

<a href="http://www.darkskull.net/fichiers/tips/scrsaver.zip">sources du projet</a> (11.1 ko)

Un écran de veille s'écrit comme un simple executable, avec l'extension SCR. (un écran de veille porte un nom de type nomdefichier.scr). Pour Demander à Delphi de changer l'extension du fichier à générer, il suffit d'ajouter la directive:

{$E scr}

Ensuite, ce qu'il faut savoir, c'est qu'un écran de veille possède 5 modes d'éxecution différents, qui sont initialisés en fonction des paramètres fournis par Windows au fichier SCR :

1) Mode Configuration standard
2) Mode Configuration dans les propriétés d'affichage
3) Mode Execution
4) Mode Preview
5) Mode Changer le Mot de Passe

Les paramètres donnés au SCR pour lancer un de ces modes sont :

1) Pas de paramètres
2) /C
3) /S
4) /P HandledeFenêtre
5) /A HandledeFenêtre

Comme vous pouvez le remarquer, dans les modes "Preview" et "Changer le Mot de Passe", un Handle de Fenêtre est fourni en paramètre, de sorte à ce qu'on puisse modifier les infos de ces fenêtres dans le cas du mode Preview par exemple. Il nous faudra donc déclarer une variable pour stocker ce handle, ainsi qu'une procédure pour le récupérer à partir des paramètres, car les paramètres sont des chaines de caractère :

var
  ParamHandle: THandle;

procedure GetParamHandle;
begin
  ParamHandle := StrToInt(ParamStr(2));
end;

Il nous faut maintenant vérifier, avant la création des fiches, dans quel mode l'écran de veille est lancé, donc dans les sources du projet :

type
  TScreenSaverMode = (smConfigStd, smConfig, smExecute, smPreview, smPassWord);

var
  ScreenSaverMode: TSCreenSaverMode;

procedure GetScreenSaverMode;
var
  c: char;
begin
  Case ParamCount of
    0: ScreenSaverMode := smConfigStd;
    1: begin
         c := UpCase(ParamStr(1)[2]);
         if (c = 'C') then ScreenSaverMode := smConfigStd
         else ScreenSaverMode := smExecute;
       end;
    2: begin
         c := UpCase(ParamStr(1)[2]);
         if (c = 'P') then ScreenSaverMode := smPreview
         else ScreenSaverMode := smPassWord;
         GetParamHandle;
       end;
  end;
end;

Ensuite commence l'implémentation des 5 modes. Nous allons commencer par le plus simple, le changement de mot de passe, qui consiste en un appel à la DLL des mots de passe pour écran de veille :

procedure ExecSetPwd;
var
  hLib : THandle;
  P : function(a: PChar; ParentHandle: THandle; b, c: Integer): Integer; stdcall;
  SysDir : string;
  SysLength : integer;
begin
  SetLength(SysDir, MAX_PATH);
  SysLength := GetSystemDirectory(PChar(SysDir), MAX_PATH);
  SetLength(SysDir, SysLength);
  if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then SysDir := SysDir + '\';
  hLib := LoadLibrary(PChar(SysDir + 'MPR.DLL'));
  if hLib <> 0 then
    begin
      P := GetProcAddress (hLib, 'PwdChangePasswordA');
      if assigned (P) then P('SCRSAVE', ParamHandle, 0, 0);
      FreeLibrary (hLib);
    end;
end;

Ensuite, nous écrirons la fiche de configuration. Il nous suffit de mettre une fiche avec un TProgessBar qui nous permettra de régler la vitesse d'execution de l'écran de veille. Nous définirons 5 niveaux de vitesse, et nous sauvegarderons les informations dans la base de registre...

procedure WriteSpeed(Value: integer);
var
  R: TRegistry;
begin
  R := TRegistry.Create;
  try
    R.OpenKey('\Software\Dark Skull\Screen Saver\', true);
    R.WriteInteger('Speed', Value);
  finally
    R.Free;
  end;
end;

function GetSpeed: integer;
var
  R: TRegistry;
begin
  R := TRegistry.Create;
  try
    R.OpenKey('\Software\Dark Skull\Screen Saver\', true);
    if R.ValueExists('Speed') then Result := R.ReadInteger('Speed')
    else Result := 3;
  finally
    R.Free;
  end;
end;

Ensuite, nous écrivons un Thread qui pourra être executé aussi bien en plein-écran que dans la fenêtre de preview. C'est lui qui s'occupera du dessin. Dans mon exemple, le thread affiche d'abord le bureau en fond d'écran, puis il dessine des rectangles aléatoirement sur l'écran avec des couleurs aléatoires. Pour cela, nous devons lui fournir en paramètres le canvas où il devra dessiner, ainsi que le rectangle auquel il doit se limiter (pour le mode preview par exemple).

unit UnitThread;

interface

uses
  Windows, Classes, Graphics, Forms, UnitConfig;

type
  TDrawThread = class (TThread)
  protected
    Canvas     : TCanvas;
    Left       : integer;
    Top        : integer;
    Width      : integer;
    Height     : integer;
    Background : TBitmap;
    SleepTime  : integer;
    procedure Draw;
  public
    constructor Create(ACanvas : TCanvas; DrawRect : TRect);
    procedure Execute; override;
   end;

implementation

constructor TDrawThread.Create(ACanvas: TCanvas; DrawRect: TRect);
var
  BackgroundCanvas : TCanvas;
  DC : hDC;
begin
  {définition des variables locales}
  Canvas := ACanvas;
  Left   := DrawRect.Left;
  Top    := DrawRect.Top;
  Width  := DrawRect.Right  - DrawRect.Left;
  Height := DrawRect.Bottom - DrawRect.Left;
  SleepTime := GetSpeed;

  {obtenir le bitmap de fond}
  Background := TBitmap.Create;
  Background.Width := Width;
  Background.Height := Height;
  DC := GetDC (0);
  BackgroundCanvas := TCanvas.Create;
  BackgroundCanvas.Handle := DC;
  {diminuer le fond d'écran pour qu'il tienne dans le Canvas (Preview...)}
  Background.Canvas.CopyRect(Rect(0, 0, Width, Height), BackgroundCanvas,
                             Rect(0, 0, Screen.Width, Screen.Height));
  BackgroundCanvas.Free;
  ReleaseDC(0, DC);

  {Initialiser le thread pour qu'il commence tout de suite}
  inherited Create(false);
  FreeOnTerminate := True;
end;

procedure TDrawThread.Execute;
var
  R: TRect;
begin
  try
    R := Rect(Left, Top, Left + Width, Top + Height);
    Canvas.CopyRect (R, Background.Canvas, R);
    while not Terminated do
      begin
        Synchronize(Draw);
        if SleepTime > 0 then Sleep(SleepTime);
      end;
  finally
    Background.Free;
  end;
end;

procedure TDrawThread.Draw;
begin
  Canvas.Brush.Color := rgb(random(255), random(255), random(255));
  Canvas.Rectangle(Left + Random(Width), Top + Random(Height),
                   Left + Random(Width), Top + Random(Height));
end;

end.

Maintenant que nous avons écrit notre thread, nous pouvons nous occuper de la prévisualisation. Comme la prévisualisation ne s'effectue pas dans une fenêtre du projet, mais dans une fenêtre d'un dialogue Windows, nous devons surcharger sa méthode WndProc pour pouvoir y dessiner :

function MyWndProc(Wnd: HWnd; Msg: integer; wParam: Word;
                   lParam: integer): integer; far; stdcall;
begin
  {si on reçoit un message WM_CLOSE ou WM_DESTROY, on quitte}
  if (Msg = WM_DESTROY) or (Msg = WM_CLOSE) then PostMessage(Wnd, WM_QUIT, 0, 0);
  Result := DefWindowProc(Wnd, Msg, wParam, lParam);
end;

procedure ExecPreview;
var
  PreviewCanvas : TCanvas;
  WndClass : TWndClass;
  DC       : hDC;
  MyWnd    : hWnd;
  Msg      : TMsg;
  MyThread : TDrawThread;
  PrevRect : TRect;
begin
  {créé une nouvelle classe de fenêtre}
  with WndClass do
    begin
      style := CS_PARENTDC;
      lpfnWndProc := @MyWndProc;
      cbClsExtra := 0;
      cbWndExtra := 0;
      hIcon := 0;
      hCursor := 0;
      hbrBackground := 0;
      lpszMenuName := nil;
      lpszClassName := 'DarkSkullScreenSaverPreview';
    end;
  WndClass.hInstance := hInstance;
  Windows.RegisterClass(WndClass);
  {Obtenir quelques infos}
  GetWindowRect(ParamHandle, PrevRect);
  PrevRect.Right := PrevRect.Right - PrevRect.Left;
  PrevRect.Bottom := PrevRect.Bottom - PrevRect.Top;
  PrevRect.Left := 0;
  PrevRect.Top := 0;
  {Et maintenant créér une fenêtre enfant de la preview}
  MyWnd := CreateWindow('DarkSkullScreenSaverPreview', 'Dark Skull Saver',
                        WS_CHILD or WS_DISABLED or WS_VISIBLE, 0, 0,
                        PrevRect.Right, PrevRect.Bottom,
                        ParamHandle, 0, hInstance, nil);
  {obtenir un DC sur la fiche créée}
  DC := GetDC(MyWnd);
  PreviewCanvas := TCanvas.Create;
  PreviewCanvas.Handle := DC;
  MyThread := TDrawThread.Create(PreviewCanvas, PrevRect);
  {Et maintenant la boucle principale}
  while GetMessage(Msg, 0, 0, 0) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
  MyThread.Terminate;
  PreviewCanvas.Free;
end;

Et maintenant, le plus long à écrire: l'execution normale de l'économiseur d'écran. Il faut tout d'abord faire en sorte que la fiche principale soit toujours au premier plan. Pour cela, il suffit de mettre sa propriété FormStyle sur fsStayOnTop. Ensuite, il faut que la fiche prenne tout l'écran. Pour cela, on met sa propriété Border sur bsNone, et mettre le code suivant dans le OnCreate :

Left := 0;
top := 0;
Width := Screen.Width;
Height := Screen.Height;

Ensuite, il faut empêcher les CTRL-ALT-SUPPR et ALT-TAB, et masquer le curseur. Pour cela, il faut ajouter les lignes suivantes :

 
SystemParametersInfo(97, Word(True), @Dummy, 0); {plus de alt-tab ou ctrl-alt-suppr}
ShowCursor(false);

SystemParametersInfo(97, Word(False), @Dummy, 0);
ShowCursor(true);

Ensuite, il faut empécher Windows de redessiner la fiche, en gérant l'évennement WM_ERASEBKGND :

procedure TFormMain.WMEraseBkGnd;
begin
  Msg.Result := 0;
end;

Comme vous le savez, un écran de veille se ferme automatiquement dès qu'on appuie sur une touche ou qu'on bouge la souris. Mais si un mot de passe a été configuré, il faut le gérer avant de sortir de l'écran de veille :

 
procedure TFormMain.CloseIfOk;
var
  hLib : THandle;
  P : function (Parent : THandle) : Boolean; stdcall;
  SysDir : String;
  NewLength : Integer;
  Registry : TRegistry;
begin
  {On vérifie si on doit regarder le mot de passe}
  Registry := TRegistry.Create;
  Registry.RootKey := HKEY_CURRENT_USER;
  if Registry.OpenKey('Control Panel\desktop', false) then
    begin
      if Registry.ReadInteger('ScreenSaveUsePassword') <> 0 then
        begin
          ShowCursor (True);
          SetLength(SysDir, MAX_PATH);
          NewLength := GetSystemDirectory(PChar(SysDir), MAX_PATH);
          SetLength (SysDir, NewLength);
          if (length (SysDir) > 0) and (SysDir [length (SysDir)] <> '\')
          then SysDir := SysDir + '\';
          hLib := LoadLibrary (PChar (SysDir + 'PASSWORD.CPL'));
          if hLib = 0 then Close {si on ne trouve pas la DLL, on quitte}
          else
            begin
              P := GetProcAddress(hLib, 'VerifyScreenSavePwd');
              if P (Handle) then Close;
              FreeLibrary (hLib);
            end;
          IgnoredEvents := 0;
          ShowCursor(False);
        end
      else Close;
    end
  else Close;
end;

A présent que nous avons défini notre procédure de fermeture, nous pouvons déjà réagir aux évennement Clavier. Pour cela, nous allons réagir à l'évennement OnKeyDown :

procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  CloseIfOk;
end;

Il nous faut maintenant réagir aux évennements déclenchés par la souris. Malheureusement, le moindre déplacement d'un pixel de la souris déclenche un évennement. Il nous faut donc définir une marge de réaction aux évennement souris, en déclarant 2 variables: une qui contient le nombre d'évennements à ignorer, et une autre qui compte le nombre d'évennements déjà ignorés. Quand le compte dépasse le nombre à ignorer, alors on ferme l'écran de veille. On remet le compteur à zero toutes les secondes grâce à un Timer :

var
  TickstoIgnore: integer;
  IgnoredEvents: integer;

  TickstoIgnore := 5;
  IgnoredEvents := 0;

  IgnoredEvents := 0;

  IgnoredEvents := IgnoredEvents + 1;
  if IgnoredEvents > TickstoIgnore then CloseIfOk;

Ensuite, il faut empêcher l'écran de veille de s'activer une 2° fois. Pour cela, nous gérons l'évennement WM_SYSCOMMAND :

procedure TFormMain.WMSysCommand;
begin
  {N'activer l'écran de veille qu'une seule fois}
  if Msg.cmdType = SC_SCREENSAVE then Msg.Result := 1 
  else inherited;
end;

Enfin, à présent que tous les évennements ont été définis, il ne nous reste plus qu'à créér le Thread dans le FormShow, s'il n'a pas déjà été créé :

procedure TFormMain.FormShow(Sender: TObject);
begin
  if not Assigned(MyThread) then
    MyThread := TDrawThread.Create(Canvas, Rect(0, 0, Width, Height));
end;

Puis, pour finir, il n'y a plus qu'à lancer la bonne procédure en fonction du mode d'execution dans la source de projet :

begin
  case ScreenSaverMode of
    smConfig, smConfigStd: begin
                             Application.Initialize;
                             Application.CreateForm(TFormConfig, FormConfig);
                             Application.Run;
                           end;
    smExecute:             begin
                             Application.Initialize;
                             Application.CreateForm(TFormMain, FormMain);
                             Application.Run;
                           end;
    smPassWord:            ExecSetPwd;
    smPreview:             ExecPreview;
  end;
end.

Et voilà. Je vous conseille de télécharger les <a href="http://www.darkskull.net/fichiers/tips/scrsaver.zip">sources du projet</a> (11.1 ko) pour que vous compreniez bien tous les mécanismes.

3 requête(s) SQL executée(s) en 0.001 Secs - Temps total de génération de la page : 0.006 Secs