Библиотека knigago >> Компьютеры: Языки и системы программирования >> Pascal, Delphi, Lazarus и т.п. >> Виртуальная библиотека Delphi


СЛУЧАЙНЫЙ КОММЕНТАРИЙ

# 1413, книга: Концессия
автор: Павел Леонидович Далецкий

"Концессия" Павла Далецкого — захватывающий и атмосферный роман советской эпохи. Автор мастерски воссоздает напряженную обстановку 1918 года, когда большевики пытаются восстановить страну после революции и гражданской войны. В центре сюжета — интригующая история о концессии, предоставленной итальянским бизнесменам в отдаленном уголке Сибири. Прибытие иностранцев в этот заброшенный и суровый край порождает столкновение культур и идеологий. Главный герой, большевик Иван Артемьев,...

СЛУЧАЙНАЯ КНИГА

Автор неизвестен - Виртуальная библиотека Delphi

Виртуальная библиотека Delphi
Книга - Виртуальная библиотека Delphi.  Автор неизвестен  - прочитать полностью в библиотеке КнигаГо
Название:
Виртуальная библиотека Delphi
Автор неизвестен

Жанр:

Современные российские издания, Литература ХXI века (эпоха Глобализации экономики), Программирование: прочее, Pascal, Delphi, Lazarus и т.п.

Изадано в серии:

неизвестно

Издательство:

неизвестно

Год издания:

-

ISBN:

неизвестно

Отзывы:

Комментировать

Рейтинг:

Поделись книгой с друзьями!

Помощь сайту: донат на оплату сервера

Краткое содержание книги "Виртуальная библиотека Delphi"

Аннотация к этой книге отсутствует.

Читаем онлайн "Виртуальная библиотека Delphi". [Страница - 5]

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

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;

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

Процедура для запуска хранителя на полном экране — приблизительно такова:

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 не введя пароль). Создание окна хранителя:

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

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. Процедура нити выглядит примерно так:

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

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

Function AskPassword : Boolean;

Var

 Key : hKey;

 D1,D2 : Integer; { two --">

Оставить комментарий:


Ваш e-mail является приватным и не будет опубликован в комментарии.