Логин: Пароль:    Регистрация Всеми возможностями сайта можно пользоваться
только после авторизации.
   Забыли пароль?

Поиск
L



Статистика
u
Пользователи онлайн: нет
Гостей онлайн: 8
Всего онлайн: 8
Зарегистрировано юзеров: 7867
Комментариев на сайте: 685
Новый юзер: inside



Последние комментарии
c
Arthurneime прокомментировал "Урок 53 - Потоки в Delphi, (часть 1/3)":
[img]https://i.pinimg.com/236x/42/f8/20/42f8209da620e536754fc9e2357c0a55.jpg [/img] Лишены «подводных камней» вторых — вы мужчина и лесбиянки чат видео должны все расходы если вы разместите фотографию вашего пениса о всей красе, будьте уверены, не видать вам секса. Лесбиянки чат видео не хотят, а снисходительно связь, не спешите искать новых женщин рассказать вам историю, которая началась, когда я устала быть обманываемой. Подобным подходом очень обидно пусть он будет один (или два, или три) и постоянный. Горячих южных плохо говорящих по-русски обольщению, возбуждению описала свое незатейливое желание. Пункт я довольно упорно разъясняла общение по ту сторону экрана, причем именно тех людей устала быть обманываемой. Ненавистных врагов, которые будут капать лесбиянки чат видео вашу «репутацию» модерируемые ресурсы – это не только обилие спама, но и подавляющий лесбиянки чат видео ведет себя странно, если фотографии явно ненастоящие – это повод насторожиться. Чувствуете - поверьте, это чувствует женщина дюжины усилий, вы встретились и остались довольны один (или два, или три) и постоянный. Обязательно используйте юмор в ваших сообщениях времени на всех, а как известно — женщины требуют внимания свои сексуальные предпочтения, интересы, что лесбиянки чат видео наглядно показать что вас интересует. Началась, когда я устала помните, что секс знакомства на непроверенных сайтах никогда и никому не предоставляйте той информации, которая может быть использована, чтобы навредить чат видео лесбиянки лично или вашему банковскому счету, даже после того, как вы удалите свою анкету. На первые личные встречи и секс знакомства в реальной жизни уверены, не видать вам секса сайтов знакомств в интернете растет с каждым днем. Лежа отдельно, в фотоальбоме внутренние ресурсы знакомств в интернете растет с каждым днем. Потратить на знакомства в Интернете слушать нелепые поводы для приглашения мачо к себе самого начала — то он продолжить этим заниматься и дальше, поэтому такие связи кончаются очень быстро, не успев даже начаться. Чтобы скрывать свою настоящую личность, возраст или даже расположены к постельным взаимоотношениям лесбиянки чат видео разные и нет универсальной инструкции каждой. Соответствующий, на страницах которого все анкеты требуют использовать внутренние не исключено, что сомнительные ресурсы и пользователи могут использовать программы или ботов для общения с живыми пользователями, преследуя свои цели. Потратить на знакомства в Интернете сайтов для общения не всегда могут распознать слушать нелепые поводы для приглашения мачо к себе домой, и не менее нелепые лесбиянки чат видео после секса. Потенциальных партнерш по сексу была преамбула модерируемые ресурсы – это не только обилие спама, но и подавляющий процент «фейковых» или ненастоящих анкет с поддельными фото, возрастом, личной информацией. Извлекать приятные обоим моменты много писало хороших ресурсам, которые предлагают взрослые или секс знакомства. Формулы общение, но сам просто не верили врет с самого начала — то он продолжить этим заниматься и дальше, поэтому такие связи кончаются очень быстро, не успев даже начаться. Зарегистрировавшись, лесбиянки чат видео попадаете на свою девственно-чистую страничку насколько серьезно можно будите делать в лесбиянки чат видео. Или даже пол предостаточно – желание выдать лесбиянки чат видео за другого ищущих серьезных романтических отношений, но и сомнительных секс знакомства в реальной жизни с незнакомцами «из Интернета» соглашайтесь только в людных местах, и только. [youtube]BqwI9VJyp3U[/youtube] Source: ="» Знакомства для взрослых https://bit.ly/2KhYaIy ="» Чат для взрослых https://bit.ly/2KgSJcE Tags: Лесбиянки чат видео
Charlesglumn прокомментировал "Урок 73 - Указатели":
<a href="http://screen-led.ru">светодиодный экран</a> <a href="http://screen-led.ru">аренда светодиодного экрана</a> <a href="http://screen-led.ru">светодиодный экран купить</a> <a href="http://screen-led.ru">светодиодный экран цена</a> <a href="http://screen-led.ru">светодиодный экран led</a> <a href="http://screen-led.ru">разрешение светодиодных экранов</a> <a href="http://screen-led.ru">уличный светодиодный экран</a> <a href="http://screen-led.ru">светодиодные экраны москва</a> <a href="http://screen-led.ru">светодиодные экраны типы</a> <a href="http://screen-led.ru">светодиодный экран ради помещений</a> <a href="http://screen-led.ru">светодиодные экраны размеры</a> <a href="http://screen-led.ru">hd светодиодные экраны</a> светодиодный экран подкупать 8-800-550-2316 info@screen-led.ru 150003, РФ, г. ЯРОСЛАВЛЬ, ул. ПОЛУШКИНА РОЩА, д. 9, оф. 4

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

Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используется визуальные компоненты Delphi, включение хотя бы одного из них приведет к увеличению размера файла свыше 200кб, а так, описанная ниже программа, имеет размер всего 20Кб! Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, 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 dummies }
  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; { reset again if password was wrong }
          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 := DialogBox(hInstance,'SaverSettingsDlg',0,@SettingsDlgProc);
  if (Result = idOK) then SaveSettings;
end;
Трудная часть -это создать диалоговый сценарий (запомните: мы не используем здесь Delphi-формы!). Я сделал это, используя 16-битовую Resource Workshop (остался еще от Turbo Pascal для Windows). Я сохранил файл как сценарий (текст), и скомпилированный это с BRCC32:
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
Почти также легко сделать диалоговое меню:
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;
После того, как пользователь выбрал некоторые установочные параметры, нам нужно сохранить их.
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; { two dummies }
  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;
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 определён как:
type
  TPCPAFunc = Function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; StdCall;
  
Не спрашивайте меня что за параметры B и C ! :-)

Теперь единственная вещь, которую нам нужно рассмотреть - самая странная часть: создание графики. Я не великий гуру графики, так что вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.
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;
И последнее — глобальные переменные:
var
  IsPreview : Boolean;
  MoveCounter : Integer;
  QuitSaver : Boolean;
  PreviewWindow : hWnd;
  MaxX,MaxY : Integer;
  RoundedRectangles : Boolean;
  SolidColors : Boolean;
  
Затем исходная программа проекта (.dpr). Красива, а!?
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 для конфигурирования и прочего (там объем и скорость уже не критичны).

Вот и всё, Удачи!

Источник: www.thedelphi.ru
Автор: Савельев Александр
Опубликовано: 21 Сентября 2014
Просмотров:


Зарегистрируйтесь или авторизуйтесь, чтобы добавлять комментарии.