Добавить в "Избранное" Ноябрь вт. 21 2017 г. в 10:58
Навигация
Еще полезняшки (G)

    -
Счетчики
      ОБменник E-POS
      Оплата услуг с помощью WebMoney, RBK Money, Деньги@Mail.Ru, WebCreds и Яндекс.Деньги

      Raznoe


      Openstat-

      Статьи
      Кто ищет тот всегда найдет... Самая правдивая система поиска

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

      Добавлено: 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 Создание хранителя экрана Программы от АМХ Статьи 2017-11-21 10_58_15

      Кредиты

      Статьи
      Delphi
      Вход
      Логин:

      Пароль:


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


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

      Топ загрузок за неделю
      Грузим...
      Copyright АМХ© 2003-2016Работает под управлением WebCodePortalSystem v. 4.2.2