Программы и исходники от АМХ

Есть только миг между прошлым и будущим...
ОТЛИЧНЫЙ ХОСТИНГ

Создание хранителя экрана

Добавлено: 2008-03-07 12:47:20

Создание хранителя экрана (ScreenSaver)





Автор: Перевел Владимиров А.М.
Источник: http://www.mastak.com/
Главное о чем стоит упомянуть это, что ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi, включение хотя бы одного из них приведет к увеличению размера файла свыше 200кб, а так, описанная ниже программа, имеет размер всего 20кб!!!

Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:    

Код Delphi




   
procedure RunScreenSaver;    
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]);    
  end;    
  LoadSettings; { load settings from registry }    
  if (S = 'C') then RunSettings    
  else if (S = 'P') then RunPreview    
  else if (S = 'A') then RunSetPassword    
  else RunFullScreen;    
end;    
   
Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить используя единственный класс окна.
Следуя правилам хорошего тона, нам также нужно использовать многочисленные нити. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер.    
Процедура для запуска хранителя на полном экране - приблизительно такова:    

//////////////////////////////Код Delphi




   
procedure RunFullScreen;    
Var    
  R          : TRect;    
  Msg        : TMsg;    
  Dummy      : Integer;    
  Foreground : hWnd;    
begin    
  IsPreview := False;  MoveCounter := 3;      
  Foreground := GetForegroundWindow;    
  while (ShowCursor(False) > 0) do ;    
  GetWindowRect(GetDesktopWindow,R);    
  CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,0);    
  CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);    
  SystemParametersInfo(spi_ScreenSaverRunning,1,@Dummy,0);    
  while GetMessage(Msg,0,0,0) do begin    
    TranslateMessage(Msg);    
    DispatchMessage(Msg);    
  end;    
  SystemParametersInfo(spi_ScreenSaverRunning,0,@Dummy,0);    
  ShowCursor(True);    
  SetForegroundWindow(Foreground);    
end;    
   
Во-первых, мы проинициализировали некоторые глобальные переменные (описанные далее), затем прячем курсор мыши и создаем окно хранителя экрана. Имейте в виду, что важно уведомлять Windows, что это - хранителя экрана через SystemParametersInfo (это выводит из строя Ctrl-Alt-Del чтобы нельзя было вернуться в Windows не введя пароль). Создание окна хранителя:    

//////////////////////////////Код Delphi




   
function CreateScreenSaverWindow(Width,Height : Integer;      
  ParentWindow : hWnd) : hWnd;    
var WC : TWndClass;    
begin    
  with WC do begin    
    Style := cs_ParentDC;    
    lpfnWndProc := @PreviewWndProc;    
    cbClsExtra := 0;  cbWndExtra := 0; hIcon := 0; hCursor := 0;    
    hbrBackground := 0; lpszMenuName := nil;    
    lpszClassName := 'MyDelphiScreenSaverClass';    
    hInstance := System.hInstance;    
  end;    
  RegisterClass(WC);    
  if (ParentWindow  0) Then    
    Result := CreateWindow('MyDelphiScreenSaverClass','MySaver',    
      ws_Child Or ws_Visible or ws_Disabled,0,0,    
      Width,Height,ParentWindow,0,hInstance,nil)    
  else begin    
    Result := CreateWindow('MyDelphiScreenSaverClass','MySaver',    
      ws_Visible or ws_Popup,0,0,Width,Height, 0,0,hInstance,nil);    
    SetWindowPos(Result,hwnd_TopMost,0,0,0,0,swp_NoMove or swp_NoSize or swp_NoRedraw);    
  end;    
  PreviewWindow := Result;    
end;    
   
Теперь окна созданы используя вызовы API. Я удалил проверку ошибки, но обычно все проходит хорошо, особенно в этом типе приложения.    
Теперь Вы можете погадать, как мы получим handle родительского окна предварительного просмотра ? В действительности, это совсем просто: Windows просто передает handle в командной строке, когда это нужно. Таким образом:    

//////////////////////////////Код Delphi




   
procedure RunPreview;    
Var    
  R             : TRect;    
  PreviewWindow : hWnd;    
  Msg           : TMsg;    
  Dummy         : Integer;    
begin    
  IsPreview := True;    
  PreviewWindow := StrToInt(ParamStr(2));    
  GetWindowRect(PreviewWindow,R);    
  CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,PreviewWindow);    
  CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);    
  while GetMessage(Msg,0,0,0) do begin    
    TranslateMessage(Msg); DispatchMessage(Msg);    
  end;    
end;    
   
Как Вы видите, window handle является вторым параметром (после "-p").    
Чтобы "выполнять" хранителя экрана - нам нужна нить. Это создается с вышеуказанным CreateThread. Процедура нити выглядит примерно так:    

//////////////////////////////Код Delphi




   
function PreviewThreadProc(Data : Integer) : Integer; stdcall;    
var R : TRect;    
begin    
  Result := 0; Randomize;    
  GetWindowRect(PreviewWindow,R);    
  MaxX := R.Right-R.Left;  MaxY := R.Bottom-R.Top;    
  ShowWindow(PreviewWindow,sw_Show); UpdateWindow(PreviewWindow);    
  Repeat    
    InvalidateRect(PreviewWindow,nil,False);    
    Sleep(30);    
  until QuitSaver;    
  PostMessage(PreviewWindow,wm_Destroy,0,0);    
end;    
   
Нить просто заставляет обновляться изображения в нашем окне, спит на некоторое время, и обновляет изображения снова. А Windows будет посылать сообщение WM_PAINT на наше окно (не в нить !). Для того, чтобы оперировать этим сообщением, нам нужна процедура:    

//////////////////////////////Код Delphi




   
function PreviewWndProc(Window : hWnd; Msg,WParam,    
  LParam : Integer): Integer; stdcall;    
begin    
  Result := 0;    
  case Msg of    
    wm_NCCreate  : Result := 1;    
    wm_Destroy   : PostQuitMessage(0);    
    wm_Paint     : DrawSingleBox; { paint something }    
    wm_Keydown   : QuitSaver := AskPassword;    
    wm_LButtondown, wm_MButtondown, wm_RButtondown, wm_MouseMove :    
                   begin    
                     if (Not IsPreview) then begin    
                       Dec(MoveCounter);    
                       if (MoveCounter <= 0) then QuitSaver := AskPassword;    
                     end;    
                   end;    
     else Result := DefWindowProc(Window,Msg,WParam,LParam);    
  end;    
end;    
   
Если мышь перемещается, кнопка нажала, мы спрашиваем у пользователя пароль:    

//////////////////////////////Код Delphi




   
function AskPassword : Boolean;    
Var    
  Key   : hKey;    
  D1,D2 : Integer; { two dummies }    
  Value : Integer;    
  Lib   : THandle;    
  F     : TVSSPFunc;    
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 > 32) then begin    
          @F := GetProcAddress(Lib,'VerifyScreenSavePwd');    
          ShowCursor(True);    
          if (@F  nil) then Result := F(PreviewWindow);    
          ShowCursor(False);    
          MoveCounter := 3; { reset again if password was wrong }    
          FreeLibrary(Lib);    
        end;    
      end;    
    end;    
    RegCloseKey(Key);    
  end;    
end;    
   
Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используюя LoadLibrary. Запомните тип функции?    
TVSSFunc ОПРЕДЕЛЕН как:    

///Код Delphi

   
Type    
TVSSPFunc = function(Parent : hWnd) : Bool; stdcall;    
   
Теперь почти все готово, кроме диалога конфигурации. Это запросто:    

//////////////////////////////Код Delphi




   
procedure RunSettings;    
var Result : Integer;    
begin    
  Result := DialogBox(hInstance,'SaverSettingsDlg',0,@SettingsDlgProc);    
  if (Result = idoK) then SaveSettings;    
end;    
   
Трудная часть -это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы!). Я сделал это, используя 16-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:    

//////////////////////////////Код Delphi




   
SaverSettingsDlg DIALOG 70, 130, 166, 75    
STYLE WS_POPUP | WS_DLGFRAME | WS_SYSMENU    
CAPTION "Settings for Boxes"    
FONT 8, "MS Sans Serif"    
begin    
    DEFPUSHBUTTON "OK", 5, 115, 6, 46, 16    
    PUSHBUTTON "Cancel", 6, 115, 28, 46, 16    
CTEXT "Box &Color:", 3, 2, 30, 39, 9    
    COMBOBOX 4, 4, 40, 104, 50, CBS_DROPdoWNLIST | CBS_HASSTRINGS    
    CTEXT "Box &Type:", 1, 4, 3, 36, 9    
    COMBOBOX 2, 5, 12, 103, 50, CBS_DROPdoWNLIST | CBS_HASSTRINGS    
    LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani    
           Jдrvinen.", 7, 4, 57, 103, 16,    
           WS_CHILD | WS_VISIBLE | WS_GROUP    
END    
   
Почти также легко сделать диалоговое меню:    

//////////////////////////////Код Delphi




   
function SettingsDlgProc(Window : hWnd; Msg,WParam,LParam : Integer): Integer; stdcall;    
var S : String;    
begin    
  Result := 0;    
  case Msg of    
    wm_InitDialog : begin    
                      { initialize the dialog box }    
                      Result := 0;    
                    end;    
    wm_Command    : begin    
                      if (LoWord(WParam) = 5) then EndDialog(Window,idoK)    
                      else if (LoWord(WParam) = 6) then EndDialog(Window,idCancel);    
                    end;    
    wm_Close      : DestroyWindow(Window);    
    wm_Destroy    : PostQuitMessage(0);    
    else Result := 0;    
  end;    
end;    
   
После того, как пользователь выбрал некоторые установочные параметры, нам нужно сохранить их.    

//////////////////////////////Код Delphi




   
procedure SaveSettings;    
Var    
  Key   : hKey;    
  Dummy : Integer;    
begin    
  if (RegCreateKeyEx(hKey_Current_User,    
                     'SoftwareSilverStreamSSBoxes',    
                     0,nil,Reg_Option_Non_Volatile,    
                     Key_All_Access,nil,Key,    
                     @Dummy) = Error_Success) then begin    
    RegSetValueEx(Key,'RoundedRectangles',0,Reg_Binary,    
     @RoundedRectangles,SizeOf(Boolean));    
    RegSetValueEx(Key,'SolidColors',0,Reg_Binary, @SolidColors,SizeOf(Boolean));    
    RegCloseKey(Key);    
  end;    
end;    
   
Загружаем параметры так:    

//////////////////////////////Код Delphi




   
procedure LoadSettings;    
Var    
  Key   : hKey;    
  D1,D2 : Integer; { two dummies }    
  Value : Boolean;    
begin    
  if (RegOpenKeyEx(hKey_Current_User,    
                   'SoftwareSilverStreamSSBoxes',0,    
                   Key_Read,    
                   Key) = Error_Success) then begin    
    D2 := SizeOf(Value);    
    if (RegQueryValueEx(Key,'RoundedRectangles',nil,@D1,    
        @Value, @D2) = Error_Success) then    
    begin      
      RoundedRectangles := Value;    
    end;    
    if (RegQueryValueEx(Key,'SolidColors',nil,@D1,    
        @Value,@D2) = Error_Success) then    
    begin    
      SolidColors := Value;    
    end;    
    RegCloseKey(Key);    
  end;    
end;    
   
Легко? Нам также нужно позволить пользователю, установить пароль. Я честно не знаю почему это оставлено разработчику приложений ! Тем не менее:    

//////////////////////////////Код Delphi




   
procedure RunSetPassword;    
Var    
  Lib : THandle;    
  F   : TPCPAFunc;    
begin    
  Lib := LoadLibrary('MPR.DLL');    
  if (Lib > 32) then begin    
    @F := GetProcAddress(Lib,'PwdChangePasswordA');    
    if (@F  nil) then F('SCRSAVE',StrToInt(ParamStr(2)),0,0);    
    FreeLibrary(Lib);    
  end;    
end;    
   
Мы динамически загружаем (недокументированную) библиотеку MPR.DLL, которая имеет функцию, чтобы установить пароль хранителя экрана, так что нам не нужно беспокоиться об этом.    
TPCPAFund ОПРЕДЕЛЕН как:    

//////////////////////////////Код Delphi




   
Type    
TPCPAFunc = function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; stdcall;    
   
(Не спрашивайте меня что за параметры B и C ! :-)    
Теперь единственная вещь, которую нам нужно рассмотреть, - самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.    

//////////////////////////////Код Delphi




   
procedure DrawSingleBox;    
Var    
  PaintDC  : hDC;    
  Info     : TPaintStruct;    
  OldBrush : hBrush;    
  X,Y      : Integer;    
  Color    : LongInt;    
begin    
  PaintDC := beginPaint(PreviewWindow,Info);    
  X := Random(MaxX); Y := Random(MaxY);    
  if SolidColors Then    
    Color := GetNearestColor(PaintDC,RGB(Random(255),Random(255),Random(255)))    
  else Color := RGB(Random(255),Random(255),Random(255));    
  OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));    
  if RoundedRectangles Then    
    RoundRect(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y),20,20)    
  else Rectangle(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y));    
  DeleteObject(SelectObject(PaintDC,OldBrush));    
  EndPaint(PreviewWindow,Info);    
end;    
   
И последнее -  глобальные переменные:    

//////////////////////////////Код Delphi




   
Var    
  IsPreview         : Boolean;    
  MoveCounter       : Integer;    
  QuitSaver         : Boolean;    
  PreviewWindow     : hWnd;    
  MaxX,MaxY         : Integer;    
  RoundedRectangles : Boolean;    
  SolidColors       : Boolean;    
   
Затем исходная программа проекта (.dpr). Красива, а!?    

//////////////////////////////Код Delphi




   
program MySaverIsGreat;    
uses    
   windows, messages, Utility; { defines all routines }    
{$R SETTINGS.RES}    
begin    
  RunScreenSaver;    
end.    
   
Ох, чуть не забыл! Если, Вы используете SysUtils в вашем проекте (например фуекцию StrToInt) вы получите EXE-файл больше чем обещанный в 20k. :)  Если Вы хотите все же иметь20k, надо как-то обойтись без SysUtils, например самому написать собственную StrToInt процедуру.    
   
Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. Т.о. будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).

Оглавление   |  На верх


Тема страницы:

Delphi Создание хранителя экрана Программы и исходники от АМХ Статьи 2019-05-20 01_41_35 ()

Поиск по VIN
VIN


проверь АВТО
Проверь свое авто на угон


ПРОВЕРЬ АВТО на угон

Raznoe


cy-pr.com

Анализ сайта ahmt.net
Top.Mail.Ru
Яндекс.Метрика

Обратный звонок
Нажмите зеленый кругляш и мы вам перезвоним
РЕГИСТРАЦИЯ
Бесплатная регистрация в каталогах
Топ загрузок за неделю
Вход
Логин:

Пароль:


Запомнить меня
На сайте
Гостей: 3
Пользователей: 0


Полезное от Google 2017

Счетчик сайта



Copyright (c) AMX 2003 - 2019 All rights reserved.
Design by AMX © 2019 All rights reserved.