• Zaloguj się!
• Zarejestruj się!

• Kompendium wiedzy
  • Delphi
    • Delphi 7. Kompendium programisty
    • Delphi 2005. Kompendium programisty
    • Artykuły
    • Gotowce
    • FAQ
  • C/C++
    • Artykuły
    • FAQ
  • C#
    • Wprowadzenie do C#
  • PHP
    • FAQ
  • Python
  • Java
  • Turbo Pascal
  • Z pogranicza
    • FAQ
  • Assembler
  • Algorytmy
  • (X)HTML
  • CSS
• Forum
  • Newbie
  • Delphi/Pascal
  • C/C++
  • C# i .NET
  • Java
  • PHP
  • Webmastering
  • Inne
  • Bazy danych
  • Algorytmy i struktury danych
  • Inżynieria oprogramowania
  • Praca
  • Off-Topic
  • Hardware/Software
  • Edukacja
  • Społeczność
  • Flame
  • Coyote
• Nowości
• Pastebin

• Edycja
• Napisz nowy artykuł w tym dziale
• Obserwuj
• Historia i autorzy

Wygaszacze ekranu

Wstęp

Screen.Cursor := crNone;

program Project1;
 
uses
  Forms, SysUtils, Windows, Dialogs, Messages,
  pass, //procedury weryfikujace/ustawiajace haslo
  Unit1 in 'Unit1.pas' {MainForm},
  ConfigUnit in 'ConfigUnit.pas' {ConfigForm},
  PrevUnit in 'PrevUnit.pas' {PrevForm};
 
//pytanie czy jest jescze to potrzebne?? Moze win 3.11<=
  {$D SCRNSAVE : Nazwa Wygaszacza} // wymagane, aby system rozpoznał wygaszacz i umieścił go na liście
 
  {$E SCR}
 
  {$R *.res} 
  {$R STRING.RES} //dolaczamy zasob z nazwa wygaszacza
  {$R MANIFEST.RES} //dla ''pelnej'' kompatybilnosci mozemy dorzucic manifest
 
var
   Params: String;
   SS_RUN: Boolean;
   hWnd_WE: THandle;  //uchwyt okna rodzica (dla okna hasla oraz okna podgladu)
   SS_SET: Boolean = False;
 
begin
  Application.Initialize;
 
//Pozwól tylko na jedną instancję wygaszacza
//if HPrevInst <> 0 then  Halt; - metoda przestarzala dostepna w systemach win 3.11
//w systemach >= win95,NT4 powinno się stosować metody oparte o np. Mutex'ach lub RegisterWindowMessage
//Lub tez informowac system za pomocą flagi SPI_SCREENSAVERRUNNING.
 
 
//W zależności od parametrów wiersza poleceń pokaż wygaszacz lub opcje wytnij tylko dwa znaki (patrz dalej konfiguracja)!
  Params := Copy(UpperCase(ParamStr(1)), 1, 2);
//System wywołuje program z parametrem 'S' jeżeli ma być włączony wygaszacz
  if (Params = '/S') or (Params = '-S') then
    begin
       //Musimy widosowi powiedziec ze wygaszacz jest wlaczony bo inaczej bedzie nam uruchamial co chwile aplikacja az zabije system system.
 
       SystemParametersInfo(SPI_SCREENSAVERRUNNING,0, @SS_RUN,0);
       if not SS_RUN then
         begin
           SS_SET := True;
           SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, nil, 0);
           Application.Title := 'Mój wygaszacz ekranu';
           Application.CreateForm(TMainForm, MainForm);
         end;
    end
{A jeżeli wywołuje z parametrem 'C' to konfiguracja}
  else if (Params = '/C') or (Params = '-C') then
    begin
      //po dwukropku uchwyt do zakladki
      Params := ParamStr(1);
      hWnd_WE := 0;
      if Length(Params) > 3 then
        hWnd_WE := StrToIntDef(Copy(Params,4,Length(Params)-3),0);
 
 
      if (hWnd_WE = 0) or (not IsWindow(hWnd_WE)) then
        Application.CreateForm(TConfigForm, ConfigForm)
      else
      begin
        hWnd_WE := GetParent(hWnd_WE);//pobieramy uchwyt do rodzica i blokujemy
        EnableWindow(hWnd_WE,False);
        ConfigForm := TConfigForm.Create(nil);
        ConfigForm.ShowModal;
        EnableWindow(hWnd_WE,True);//po zwalniamy
      end;
    end
{Parametr 'P' wywołuje podgląd}
  else if (Params = '/P') or (Params = '-P') then
    Application.CreateForm(TPrevForm, PrevForm);
 
//Parametr 'A' wywoluje ustawienia hasla
//Drugi parametr zawiera uchwytokna go wywolujacy
//Pozostaje to dla kompatybilnosci ze starymi systemami z seri Windows 9x/Me
  else if (Params = '/A') or (Params = '-A') then
    begin
      hWnd_WE := StrToIntDef(ParamStr(2),0);
      SetPassword(hWnd_WE);//zmiana hasla lub jego zalozenie
    end
  else
      //najczesciej odpalenie bez parametru powoduje
      //uruchomienie konfiguracji
    Application.CreateForm(TConfigForm, ConfigForm);
 
 
  Application.Run;
  //jesli to my ustawilismy flage to i my powinnismy ja zdjac
  if SS_SET then SystemParametersInfo(SPI_SCREENSAVERRUNNING,0, nil,0);
end.

Okno główne

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, nil, 0);

Okno konfiguracji

Okno podglądu

Hasło wygaszacza

Windows 9x/Me

Windows NT

Rysowanie

Gadżety

STRINGTABLE
{
 1, "Wygaszacz ekranu w Delphi"
}

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<!-- Copyright © 1981-2001 Microsoft Corporation -->
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
    name="Microsoft.Windows.Shell.ScreenSavers"
    processorArchitecture="x86"
    version="1.0.0.0"
    type="win32"/>
<description>ScreenSaver</description>
<dependency>
    <dependentAssembly>
        <assemblyIdentity
            type="win32"
            name="Microsoft.Windows.Common-Controls"
            version="6.0.0.0"
            processorArchitecture="x86"
            publicKeyToken="6595b64144ccf1df"
            language="*"
        />
    </dependentAssembly>
</dependency>
</assembly>

TODO

1. Oszczędzanie energii, wyłączanie w przypadku odpowiednich profili

Kod

Unit1.pas

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
 
type
  TMainForm = class(TForm)
    Label1: TLabel;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    Old: TPoint;
    Czulosc: Integer;
  public
    { Public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  Pass;
 
{$R *.dfm}
 
procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  Close;
end;
 
procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Close;
end;
 
procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (Old.X = 0) and (Old.Y = 0) then Old := Point(X, Y0;
  if (Abs(Old.X - X) > Czulosc) or (Abs(Old.Y - Y) > Czulosc)  then
    Close;      
end;
 
procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   Close;
end;
 
procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Close;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  Old := Point(0, 0);
  Czulosc := 5; //czulosc wygaszacza na ruch myszka, waro ustalic wieksza niz 1 (np. przejezdzajacy pociag ...)
 
  //ustawiamy okno
  //TODO - wiele monitorow
  Top := 0;
  Left := 0;
  Width := GetSystemMetrics(SM_CXSCREEN);
  Height := GetSystemMetrics(SM_CYSCREEN);
  Screen.Cursor := crNone;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Screen.Cursor := crDefault;  //dobry zwyczaj
end;
 
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  //Dla kompatybilnosci z windowsami 9x/Me
  //mozna sprawdzic haslo CheckPassword(handle);
  //Jesli bledne to CanCLose = false
end;
 
end.

Unit1.dfm

object MainForm: TMainForm
  Left = 192
  Top = 107
  BorderStyle = bsNone
  Caption = 'MainForm'
  ClientHeight = 723
  ClientWidth = 1080
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnKeyPress = FormKeyPress
  OnMouseDown = FormMouseDown
  OnMouseMove = FormMouseMove
  OnMouseUp = FormMouseUp
  OnMouseWheel = FormMouseWheel
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 40
    Top = 48
    Width = 71
    Height = 13
    Caption = 'Okono g'#322#243'wne'
  end
end

ConfigUnit.pas

unit ConfigUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TConfigForm = class(TForm)
    Label1: TLabel;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  ConfigForm: TConfigForm;
 
implementation
 
{$R *.dfm}
 
end.

ConfigUnit.dfm

object ConfigForm: TConfigForm
  Left = 174
  Top = 249
  Width = 379
  Height = 196
  Caption = 'ConfigForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 56
    Top = 64
    Width = 59
    Height = 13
    Caption = 'Konfiguracja'
  end
end

PrevUnit.pas

unit PrevUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TPrevForm = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  PrevForm: TPrevForm;
 
implementation
 
{$R *.dfm}
 
procedure TPrevForm.FormCreate(Sender: TObject);
var Preview: hWnd;
    R:TRect;
begin
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST);
  Preview := StrToIntDef(ParamStr(2), 0);//uchwyt okna podgladu
  if (IsWindow(Preview)) then Close(); //jak nie okno to konczymy
  //teoretycznie powinno sie sprawdzic nazwe klasy, mozna pominac .... patrz stale wygaszacza
  SetWindowLong(self.handle, GWL_STYLE, GetWindowLong(Preview, GWL_STYLE) or WS_DISABLED or WS_CHILD);
  SetWindowLong(self.handle, GWL_EXSTYLE, GetWindowLong((Preview), GWL_EXSTYLE));
  Windows.SetParent(self.handle, Preview);
  Top:= 0;
  Left:= 0;
  //nie jest powiedziane jaki standardowy rozmiar ma okno podgladu, powinnismy sie dopasowac.
  GetWindowRect(Preview, R);
  Width := R.right - R.left;
  Height := R.bottom - R.top;
end;
 
end.

PrevUnit.dfm

object PrevForm: TPrevForm
  Left = 478
  Top = 256
  Width = 1088
  Height = 750
  Caption = 'PrevForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 40
    Top = 48
    Width = 39
    Height = 13
    Caption = 'Podgl'#261'd'
  end
end

Pass.pas

unit Pass;
{***********************************
 Screen Saver Password management for 9x/ME
 Reichel Bartosz
 1999-2001
 ***********************************}
 
interface
 
uses 
  Windows, SysUtils;
 
  procedure SetPassword(Arg:Integer);
  function CheckPassword(w:HWND):Boolean;
 
implementation
 
procedure SetPassword(Arg: Integer);
var
 functionPwd : function (a : PChar; ParentHandle : THandle; b, c : Integer): Integer; stdcall;
 hMod:THandle;
begin
  hMod := LoadLibrary('MPR.DLL');
  if hMod <> 0 then
  begin
    @functionPwd := GetProcAddress(hMod,'PwdChangePasswordA');//funkcja zakladajaca haslo
    if @functionPwd <> nil then
      functionPwd('SCRSAVE',Arg,0,0);
    FreeLibrary(hMod);
  end;
end;
 
function CheckPassword(w:HWND):Boolean;
var
 hMod: THandle;
 functionCPwd: function(H:HWND) :Boolean; stdcall;
 Rez: HKEY;
 DW: DWORD;
 SIZ, TYP: DWORD;
begin
  //sprawdzamy czy haselo jest uzywane
  Result := True;
  DW := 0;
  //licze na to, ze w win 2000 (jako jedyny system, rozni sie od innych) tez tak jest
  if RegOpenKey(HKEY_CURRENT_USER,'Control Panel\Desktop',Rez) = ERROR_SUCCESS then
    begin
      TYP := REG_DWORD;
      SIZ := SizeOF(DW);
      RegQueryValueEx(Rez,'ScreenSaveUsepassword',nil,@TYP,@DW,@SIZ);
      RegCloseKey(Rez);
    end;
 
  if DW = 0 then Exit; //jak nie to nic nie robimy
  //a jak jest to pytamy sie jakie
  //funkcja do hasla jestw cpl patrz nizej
  ShowCursor(True);
  hMod := LoadLibrary('password.cpl');
  if hMod <> 0 then
  begin
    @functionCPwd := GetProcAddress(hMod,'VerifyScreenSavePwd');
    if @functionCPwd <> nil then
         Result := functionCPwd(W);
    FreeLibrary(hMod);
  end;
  ShowCursor(False);
end;
 
end.

ScrConst.pas

unit ScrConst;
{***********************************
 Screen Saver constants
 reichel.pl
 1999-2001 (2007)
 ***********************************}
interface
 
uses Windows;
{*************************PARAMETRY************************
 /p [hWnd] - Parametr podawany dla podglądu w małym okienku
             po za tym podawany uchwyt małego okienka
             (w telewizorku) - okienko podglądu(malego)
             powinno być jego "dzieckiem"(właściwość CHILD)
 /c - Ustawienia, po dwukropku dostajemy uchwyt do zakladki Screen Savers (nie wiem czy wszedzie)
 /s - Podgląd
 /a [hWnd] - Ochrona chasłem (Uchwyt okna właściwości) - 9x/Me
***********************************************************}
const
   ParentPrevClass = 'SSDemoParent'; //Okno rodzic okienka demonstracyjnego jego uchwyt jest podawany w lini komenndy
   PrevClass       = 'WindowsScreenSaverClass'; //Klasa okna podglądu i okna głównego wygaszacza
   PrevWinName     = 'Preview';//okno podglądu przyjmuje nazwe "Preview"
   SS              = 'Screen Saver';//Nazwa okna głównego wygaszacza
   //Wygaszacz ekranu --- REJESTR
   RegScrPath      = 'Control Panel\Desktop';
   ScrDat          = 'ScreenSave_Data';//Hex Zakodowane chasło
   ScrUsePas       = 'ScreenSaveUsePassword';//DWORD
 
 
//Tu
//HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\Control Panel\Desktop\ScreenSaverIsSecure
//zapisana jest informacja czy haslo jest wlaczone (dla systemow z serii NT)
//mozna samemu user32.dll,LockWorkStation
 
{ Elementy ''policyjne'' w systemie dotyczace wygaszaczy (rejestr)
 
   ScreenSaveActive
   ScreenSaveLowPowerActive
   ScreenSaveLowPowerTimeout
   ScreenSavePowerOffActive
   ScreenSavePowerOffTimeout
   ScreenSaveTimeOut
 
}
 
   // Rozmiary okienka PREVIEW
   PrevX = 152;
   PrevY = 112;
 
  {
  Funkcje zwiazane ze zmiana hasla oraz jego sprawdzeniem dla systemow 9x/Me
  PASSWORD.CPL
  VerifyScreenSavePwd
 
  MPR.DLL (SCRSAVE)?
  PwdChangePasswordA}
 
//Numery standardowe dla zasobów  wygaszacza
   Dlg_id = 2003;  //DIALOG
   Ico_id = 100;   //ICON
   Str_id = 100;   //STRING
   NameStr_id = 1; //ID dla opisu nazwy wygaszacza, ktora pojawia sie w oknie konfiguracji
 
 
implementation
 
end.

src to skrót od source anie screen, użyj *.scr

cz
niemgoe zmienić format nieda się
biore prawym przyciskem na plik zmień nazwe i zmieniam na dziki.src i pokazuje dziki.exe a nie dziki.src

moim zdaniem zdecydowanie szybciej i lepiej i łatwiej się robi takie wygaszacze w programie The Games Factory po co się tyle męczyć?

no ten art to ci sie nie udal :P

ojojoj, coś mi się ten artykuł nie podoba... w ogóle nic nie tłumaczysz!

A jak zrobić aby mieć mozliwość konfiguracji wygaszacza tak ma to mejsce w windowsie??