Delphi GFX - Профессиональное создание хранителей экрана


Главная - Документация - 2D Графика	Мастера Delphi \| Corba

Профессиональное создание хранителей экрана

Вместо введения ...

Данная статья, до некоторого времени путешествовала по просторам сайтов русской документации в совершенно первобытном виде - в ней были множественные ошибки, у неё часто менялись авторы-переводчики, но что самое главное - у нее не было рабочего примера! Количество ошибок при переписывании статьи достигло такого количества, что при компиляции проект на 100% не работал. Я переписал пример, добавил в него некоторые улучшения и сделал после статьи послесловие, которое возможно интереснее самой статьи. Итак читайте бестселлер всех серверов документации по Delphi, статью скрывавшуюся под различными названиями о создании ScreenSaver'а:

Главное о чем стоит упомянуть это, что ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема.

Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi (VCL), включение хотя бы одного из них приведет к увеличению размера файла свыше 200 кб, а так, описанная ниже программа, имеет размер всего ~ 20 - 30 кб, в зависимости от версии компилятора. В конце статьи я приведу ещё пару приемов, которые смогут сократить размер приложения до десятков кб.

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

Program DelphiScreenSaver;
Uses Windows, Messages;
{$R SETTINGS.RES}
Var
...
Function A1;
Function A2;
Procedure A1;
Procedure A2;
...
Begin
  LoadSettings;
  If ParamCount > 0 Then
  Begin
    If Length(ParamStr(1)) = 1 Then
    Command := ParamStr(1)[1]
    Else Command := ParamStr(1)[2];
    Case Command Of
      'C', 'c': RunSettings;
      'P', 'p': RunPreview;
      'A', 'a': RunSetPassword;
      'S', 's': RunFullScreen;
    End;
  End Else RunSettings;
End.

Поскольку нам нужно создавать небольшое окно предварительного просмотра и полноэкранное окно, их лучше объединить, используя единственный класс окна. Следуя правилам хорошего тона, нам также нужно использовать потоки. Дело в том, что, во-первых, хранитель не должен переставать работать даже если что-то "тяжелое" случилось, и во-вторых, нам не нужно использовать таймер.

Procedure RunFullScreen;
Var
  R : TRect;
  Msg : TMsg;
  Dummy : DWORD;
  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 не введя пароль). Создание окна хранителя:

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.MainInstance;
  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 в командной строке, когда это нужно. Таким образом:

Procedure RunPreview;
Var
  R : TRect;
  PreviewWindow : hWnd;
  Msg : TMsg;
  Dummy : DWord;
Begin
  IsPreview := True;
  If ParamCount > 1 Then Val(ParamStr(2), PreviewWindow, Dummy)
  Else PreviewWindow := GetForegroundWindow;
  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. Процедура нити выглядит примерно так:

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 на наше окно (но не в поток). Для того, чтобы оперировать этим сообщением, нам нужна процедура:

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;
    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;

Если мышь перемещается, кнопка нажата, мы спрашиваем у пользователя пароль:

Function AskPassword: Boolean;
  Type TVSSPFunc = Function(Parent: hWnd): Bool; StdCall;
Var
  Key : hKey;
  D1, D2 : Integer;
  Value : Integer;
  Lib : THandle;
  F : TVSSPFunc;
Begin
  Result := True;
  If RegOpenKeyEx(hKey_Current_User, 'Control Panel\Desktop', 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;
          FreeLibrary(Lib);
        End;
      End;
    End;
  RegCloseKey(Key);
  End;
End;

Это также демонстрирует использование registry на уровне API. Также имейте в виду как мы динамически загружаем функции пароля, используя LoadLibrary. Запомните тип функции? TVSSFunc определен как:

Type TVSSPFunc = Function(Parent : hWnd) : Bool; StdCall;

Теперь почти все готово, кроме диалога конфигурации. Это запросто:

Procedure RunSettings;
Var Result : Integer;
Begin
Result := DialogBoxParam(hInstance, 'SaverSettingsDlg', GetForegroundWindow, @SettingsDlgProc, 0);
If Result = idOK Then SaveSettings;
End;

Трудная часть - это создать диалоговый сценарий (запомните: мы не используем здесь Delphi формы). Я сделал это, используя 32-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:

SAVERSETTINGSDLG DIALOG 63, 27, 178, 156
STYLE DS_SETFONT | WS_POPUPWINDOW | WS_DLGFRAME
CAPTION "Settings for Boxes Screen Saver"
FONT 8, "MS Sans Serif"
{
DEFPUSHBUTTON "OK", 5, 123, 134, 46, 16, NOT WS_TABSTOP
PUSHBUTTON "Cancel", 6, 71, 134, 46, 16, NOT WS_TABSTOP
CTEXT "Box &Color:", 3, 13, 82, 39, 9
LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani Jarvinen.", 7, 64, 9, 109, 20
CTEXT "Box &Type:", 1, 13, 54, 36, 9
AUTOCHECKBOX "Rounded Rectangles", 2, 21, 68, 85, 10
AUTOCHECKBOX "Solid Colors", 4, 21, 98, 80, 11
}

Почти также легко сделать диалоговое меню:

Function SettingsDlgProc(Window: hWnd; Msg, WParam, LParam: Integer): Integer; Stdcall;
Var
  Rect : TRect;
  iWidth, iHeight : Integer;
Begin
  Result := 0;
  Case Msg Of
    wm_InitDialog:
    Begin
      GetWindowRect(Window, Rect);
      iWidth := Rect.right - Rect.left;
      iHeight := Rect.bottom - Rect.top;
      Rect.left := (GetSystemMetrics(SM_CXSCREEN) - iWidth) Div 2;
      Rect.top := (GetSystemMetrics(SM_CYSCREEN) - iHeight) Div 2;
      MoveWindow(Window, Rect.left, Rect.top, iWidth, iHeight, False);
      If RoundedRectangles Then CheckDlgButton(Window, 2, BST_CHECKED)
      Else CheckDlgButton(Window, 2, BST_UNCHECKED);
     If SolidColors Then CheckDlgButton(Window, 4, BST_CHECKED)
      Else CheckDlgButton(Window, 4, BST_UNCHECKED);
          Result := 0;
   End;
   wm_Command:
   Begin
     If (LoWord(WParam) = 5) Then
      Begin
        If IsDlgButtonChecked(Window, 2) = BST_CHECKED Then RoundedRectangles := TRUE Else RoundedRectangles := False;
        If IsDlgButtonChecked(Window, 4) = BST_CHECKED Then SolidColors := True Else SolidColors := False;
        EndDialog(Window, idOK);
      End Else
        If (LoWord(WParam) = 6) Then EndDialog(Window, idCancel);
   End;
   wm_Close: DestroyWindow(Window);
   wm_Destroy: PostQuitMessage(0);
   Else Result := 0;
   End;
End;

После того, как пользователь выбрал некоторые установочные параметры, нам нужно сохранить их.

Procedure SaveSettings;
Var
  Key : hKey;
  Dummy : Integer;
Begin
  If RegCreateKeyEx(hKey_Current_User, 'Software\SilverStream\SSBoxes', 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;

Загружаем параметры так:

Procedure LoadSettings;
Var
  Key : hKey;
  D1, D2 : Integer;
  Value : Boolean;
Begin
  If RegOpenKeyEx(hKey_Current_User, 'Software\SilverStream\SSBoxes', 0, Key_Read, Key) = Error_Success Then
  Begin
    D2 := SizeOf(Value);
    If RegQueryValueEx(Key, 'RoundedRectangles', Nil, @D1, @Value, @D2) = Error_Success Then RoundedRectangles := Value;
    If RegQueryValueEx(Key, 'SolidColors', Nil, @D1, @Value, @D2) = Error_Success Then SolidColors := Value;
    RegCloseKey(Key);
  End;
End;

Легко? Нам также нужно позволить пользователю, установить пароль. Я честно не знаю почему это оставлено разработчику приложений ! Тем не менее:

Procedure RunSetPassword;
Type TPCPAFunc = Function(A: PChar; Parent: hWnd; B, C: Integer): Integer; StdCall;
Var
  Lib : THandle;
  F : TPCPAFunc;
Begin
  Lib := LoadLibrary('MPR.DLL');
  If Lib <> 0 Then
  Begin
    @F := GetProcAddress(Lib, 'PwdChangePasswordA');
    If @F <> Nil Then F('SCRSAVE', Str2Int(ParamStr(2)), 0, 0);
    FreeLibrary(Lib);
  End;
End;

Мы динамически загружаем (недокументированную) библиотеку MPR.DLL, которая имеет функцию, чтобы установить пароль хранителя экрана, так что нам не нужно беспокоиться об этом.
TPCPAFund ОПРЕДЕЛЕН как:

Type TPCPAFunc = Function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; StdCall;

Теперь единственная вещь, которую нам нужно рассмотреть, - самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.

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;

И последнее - глобальные переменные:

RoundedRectangles : Boolean;
SolidColors : Boolean;
IsPreview : Boolean;
MoveCounter : Integer;
QuitSaver : Boolean;
PreviewWindow : hWnd;
MaxX, MaxY : Integer;
Command : Char;

Ох, чуть не забыл! Если, Вы используете SysUtils в вашем проекте (например функцию StrToInt) вы получите EXE-файл больше чем обещанный в 20 kб. Если Вы хотите все же иметь 20 kб, надо как-то обойтись без SysUtils, например самому написать собственную StrToInt процедуру.

Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. То есть будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).

Вот на этом месте оригинальная статья "Screen Saver in Win95" или "Создание хранителя экрана (ScreenSaver)" заканчивалась ... далее пойдут мои комментарии и размышления.

В оригинальных статьях было такое количество ошибок, начиная от простых грамматических, потом шли не точности перевода ( например потоки Thread переводились как нити ) и заканчивалось все ГРУБЕЙШИМИ ошибками в коде. Последнее наиболее критично, т.к. по такой статье не возможно было составить работающий проект. Естественно "авторы" перевода не исправили эти ошибки ( или, что наиболее вероятно, не смоги их понять ), что и привело к невозможности компиляции примера. Внешне статья выглядела просто прекрасно, и ее широко распространили русскоязычные сайты.

Итак, я довел пример до ума, создал рабочую версию примера, несколько отредактировав исходный код. В результате Вы получите прекрасный шаблон для создания собственных Screen Saver'ов.

Много комментариев я добавил в исходный код, а наиболее критичные на мой взгляд вещи объясню ниже.

Первый момент, на котором я бы хотел остановится это отладка приложения. Как Вы уже поняли, Screen Saver ведет себя по разному в зависимости от различных параметров запуска. Итак, как нам эмулировать запуск его с разными параметрами в среде Delphi? Да очень просто: меню "Run --> Parametrs --> закладка Local --> строка Parametrs". Например чтобы запустить Screen Saver в режиме настройки, нужно вписать параметр "c" и так далее. Для отладки режима PreView передавайте параметр "p 0".

Теперь перейдем к созданию ресурсов. Как было описано выше, для его создания использовался Borland Resource Workshop 4.5. Это достаточно старый продукт, по этому в его роботе есть несколько тонкостей. Самое главное, при создании ресурса выберите "File --> Preferences --> Target Windows Version --> Win32". Далее необходимо использовать только стандартные ресурсы, для этого отключите флажок "Options --> Preferences --> Generate CONTROL statements only". При включении этого флага, в файл RC будет записываться примерно такие строки:

CONTROL "Check", 10, "BorCheck", 3 ...

Компиляции ресурса пройдет нормально, но при вызове диалога результат всегда будет равен -1 ! Это происходит по тому, что данный ресурс не является стандартным Windows. Для его работы необходима библиотека Borland ( я точно не знаю какая). Я установил это следующим образом: если загружен Resource Workshop диалог показывается нормально, при его отсутствие выдается сообщение о ошибке. Т.е. нужно использовать только те стандартные контролы, которые описаны в справке Windows SDK (LTEXT, RTEXT, COMBOBOX и т.д.). Справку об этих элементах можно получить в разделе меню "Help --> Windows SDK", например выбрав указатель LTEXT.

Возможно у Вас не окажется под рукой Resource Workshop, тогда воспользуйтесь программой Restorator http://www.bome.com/ . Она позволяет просматривать ресурсы из готовых RES файлов, создавать свои ресурсы и изменять их. Редактирование возможно только в текстовом режиме, с последующей визуализацией при нажатии на клавишу F7, что конечно не совсем удобно, но это лучше чем ничего. Кстати, с помощью этой замечательной программы выполняют большинство русификаций программ т.к. она позволяет создавать так называемые Path фалы.

Итак в результате работы с перечисленными программами Вы получите RC файл. Его нужно скомпилировать в RES файл. Делается это всего одной командой:

brcc32.exe filename.rc

файл brcc32.exe находится в директории X:\DelphiX\Bin, по этому для вызова необходимо прописать путь к каталогу DelphiX\Bin в PATH.

Так же хочется сказать несколько слов о работе с контролами диалогов. Каждому контролу присваивается универсальный идентификатор, число. Оно задается в RC файле, например из нашего файла Settings.rc:

DEFPUSHBUTTON "OK", 5, 123, 134, 46, 16, NOT WS_TABSTOP
PUSHBUTTON "Cancel", 6, 71, 134, 46, 16, NOT WS_TABSTOP

у кнопки "OK" идентификатор равен 5. ( Если Вы точно уверены, что какой то элемент меняться не будет, например статичный текст с названием программы присвойте ему ID=-1)

Теперь в обработчике сообщений диалога:

   wm_Command:
   Begin
     If (LoWord(WParam) = 5) Then
      Begin
      ....

мы знаем что если параметр сообщения 5, это нажата клавиша Ok. Все очень просто. Теперь посмотри как изменить состояние элементов диалога, например состояние CheckBox'а. Для этого существуют парные функции:

Установка:
CheckDlgButton(HWind, ID, BST_UNCHECKED) или
CheckDlgButton(HWind, ID, BST_CHECKED)
Проверка:
IsDlgButtonChecked(HWind, ID)

Подробную информацию по флагам Вы можете получить из справки Windows SDK Help на соответствующие функции ( CheckDlgButton и IsDlgButtonChecked ). Для управления другими элементами диалога существуют другие функции, например CheckRadioButton, GetDlgItemInt, GetDlgItemText, SetDlgItemText и т.д. Напомню, что все эти функции реализуются посредствам передачи соответствующих сообщений элементу диалога.

Несколько слов по поводу графического исполнения программы ... его практически нет, хотя разноцветные прямоугольники конечно и занимательно, но все же. Если Вы захотите создать хороший ScreenSaver, то он должен быть завораживающем, красивым. Итак как это сделать ? Все ваши фантазии будут происходить в обработчике сообщения WM_PAINT.

Procedure DrawSingleBox;
Var
  PaintDC : hDC;
  Info : TPaintStruct;
Begin
  PaintDC := BeginPaint(PreviewWindow, Info);
  { далее пойдут Ваши графические изыски }
  EndPaint(PreviewWindow, Info);
End;

Настоятельно рекомендую использовать библиотеку FastDIB и ее быстрые функции для работы с графикой. Так же Вам никто не запрещает воспользоваться DirectX или OpenGL.

Напоследок расскажу, как же можно получить эти настоящие 20 кб, а то и меньше.

Ну во первых, мы избавились от модуля SysUtils - выигрыш составил ~ 25 кб, а это уже ощутимо. Функцию str2int я позаимствовал из свободно распространяемой библиотеки KOL.
Хотите еще, пожалуйста. На сервере http://xcl.cjb.net находится замена стандартных модулей system, sysinit и т.д. Прописываем их в Seach Path и получаем выигрыш ~ 12 кб (накладываются некоторые ограничения на код, более подробно читайте в файле помощи).

Итак стандартный проект в 43 кб сократился до 11 кб, не плохо. Но мне было интересно что можно выжать еще. Про компрессоры исполняемых файлов Вы наверное слышали - ASPack, UPX и т.д. Воспользуемся бесплатной программой UPX 1.02 и получим размер exe файла в ~7 кб. В два раза меньше чем обещал автор в начале статьи. Но эти 7 кб берутся не из воздуха, размер занимаемой оперативной памяти увеличился. Так что компрессия исполняемых файлов, а тем более динамических библиотек (что вообще не допустимо), палка о двух концах - уменьшаем место на диске - увеличиваем расход памяти. Мой совет - не сжимайте файлы.

Список ссылок

Адрес переводчика, корректора
Исходный код
Сервер проекта KOL
Сервер копрессора UPX
Сервер программы Restorator
ScreenSaver. Полностью написан на WinApi, комментарии на русском, пример является "скелетом" для создания собственных программ. Автор создал все необходимые классы и процедуры для написания профессионального приложения. Автор Николай Мазуркин. Для компиляции необходим DirectX 7.0