"Виртуальная библиотека Delphi" - читать интересную книгу автора

Система

1. В файл проекта (*.DPR) добавить строку {$D SCRNSAVE lt;название хранителяgt;} после строки подключения модулей (Uses...).

2. У окна формы убрать системное меню, кнопки и придать свойству WindowState значение wsMaximize.

3. Предусмотреть выход из хранителя при нажатии на клавиши клавиатуры, мыши и при перемещении курсора мыши.

4. Проверить параметры с которым был вызван хранитель и если это /c — показать окно настройки хранителя, а иначе (можно проверять на /s, а можно и не проверять) сам хранитель. /p — для отображения в окне установок хранителя экрана.

5. Скомпилировать хранитель экрана.

6. Переименовать *.EXE файл в файл *.SCR и скопировать его в каталог WINDOWS\SYSTEM\.

7. Установить новый хранитель в настройках системы!

Название хранителя может состоять из нескольких слов с пробелами, на любом языке.

При работе хранителя необходимо прятать курсор мыши, только не забывайте восстанавливать его после выхода.

Все параметры и настройки храните в файле .INI, так как хранитель и окно настройки не связаны друг с другом напрямую.

Старайтесь сделать свой хранитель как можно меньше и быстрее. Иначе ваши долго работающие (в фоновом режиме) приложения будут работать еше дольше!

{в файле *.DPR}

{$D SCRNSAVE Пример хранителя экрана}

{проверить переданные параметры}

IF (ParamStr(1) = '/c') OR (ParamStr(1) = '/C') THEN

 {скрыть курсор мыши}

 ShowCursor(False);

{восстановить курсор мыши}

ShowCursor(True);

Более подробно о создании хранителя экрана "по всем правилам"

Screen Saver in Win95

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

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

Procedure RunScreenSaver;

Var S : String;

Begin

 S := ParamStr(1);

 If (Length(S) gt; 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) gt; 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 lt;= 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 gt; 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 amp;Color:", 3, 2, 30, 39, 9

COMBOBOX 4, 4, 40, 104, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS

CTEXT "Box amp;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#228;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 Begin

   RoundedRectangles := Value;

  End;

  If (RegQueryValueEx(Key,'SolidColors',nil,@D1, @Value,@D2) = Error_Success) Then  Begin

   SolidColors := Value;

  End;

  RegCloseKey(Key);

 End;

End;

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

Procedure RunSetPassword;

Var

 Lib : THandle;

 F : TPCPAFunc;

Begin

 Lib := LoadLibrary('MPR.DLL');

 If (Lib gt; 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 программу.

Конец.

Use Val... ;-)

перевод: Владимиров А.М.

Иногда может возникнуть необходимость в выключении на время устройств ввода — клавиатуры и мыши. Например, это неплохо сделать на время выполнения кода системы защиты от копирования, в играх, или в качестве "наказания" при запуске программы по истечению срока ее бесплатного использования… Однако наилучшее ее применение — отключение клавиатуры и мыши на время работы демонстрационки, основанной на воспроизведении записанных заранее перемещений мышки и клавиатурного ввода (см. об этом отдельный раздел этой книги). Это элементарно сделать при помощи API:

EnableHadwareInput(Enable:boolean): boolean;

Enable — требуемое состояние устройств ввода (True — включены, false — выключены). Если ввод заблокирован, то его можно разблокировать вручную — нажать Ctrl+Alt+Del, при появлении меню "Завершение работы программы" ввод разблокируется.

А вот еще интересный прикол.

Включение/выключение монитора программным способом.

Предупреждаю сразу! После того, как вы отключите монитор, просто так вы его уже не включите (хотя это может быть зависит от монитора, я, во всяком случае, не смог). Только после перезагрузки компьютера.

Отключить :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

Включить :

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1); 

Для переключения языка применяется вызов LoadKeyboardLayout:

var russian, latin: HKL;

russian:=LoadKeyboardLayout('00000419', 0);

latin:=LoadKeyboardLayout('00000409', 0); 

-- -- -- -- -- где то в программе --- --- ---

SetActiveKeyboardLayout(russian);

Вот, может поможет:

gt;1. Setup.bat

=== Cut ===

@echo off

copy HookAgnt.dll %windir%\system

copy kbdhook.exe %windir%\system

start HookAgnt.reg

=== Cut ===

gt;2.HookAgnt.reg

=== Cut ===

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]

"kbdhook"="kbdhook.exe"

=== Cut ===

gt;3.KbdHook.dpr

=== Cut ===

program cwbhook;

uses Windows, Dialogs;

var

 hinstDLL: HINST;

 hkprcKeyboard: TFNHookProc;

 msg: TMsg;

begin

 hinstDLL := LoadLibrary('HookAgnt.dll');

 hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');

 SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);

 repeat until not GetMessage(msg, 0, 0, 0);

end.

=== Cut === 

gt;4.HookAgnt.dpr

=== Cut ===

library HookAgent;

uses Windows, KeyboardHook in 'KeyboardHook.pas';

exports KeyboardProc;

var

 hFileMappingObject: THandle;

 fInit: Boolean;

procedure DLLMain(Reason: Integer);

begin

 if Reason = DLL_PROCESS_DETACH then begin

  UnmapViewOfFile(lpvMem);

  CloseHandle(hFileMappingObject);

 end;

end;

begin

 DLLProc := @DLLMain;

 hFileMappingObject := CreateFileMapping(THandle($FFFFFFFF), // use paging file

  nil, // no security attributes

  PAGE_READWRITE, // read/write access

  0, // size: high 32 bits

  4096, // size: low 32 bits

  'HookAgentShareMem' // name of map object

 );

 if hFileMappingObject = INVALID_HANDLE_VALUE then begin

  ExitCode := 1;

  Exit;

 end;

 fInit := GetLastError() lt;gt; ERROR_ALREADY_EXISTS;

 lpvMem := MapViewOfFile(

  hFileMappingObject, // object to map view of

  FILE_MAP_WRITE, // read/write access

  0, // high offset: map from

  0, // low offset: beginning

  0); // default: map entire file

 if lpvMem = nil then begin

  CloseHandle(hFileMappingObject);

  ExitCode := 1;

  Exit;

 end;

 if fInit then FillChar(lpvMem, PASSWORDSIZE, #0);

end.

=== Cut ===

gt;5.KeyboardHook.pas

=== Cut ===

unit KeyboardHook;

interface

uses Windows;

const PASSWORDSIZE = 16;

var

 g_hhk: HHOOK;

 g_szKeyword: array[0..PASSWORDSIZE-1] of char;

 lpvMem: Pointer;

function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;

implementation

 uses SysUtils, Dialogs;

 function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT;

 var

  szModuleFileName: array[0..MAX_PATH-1] of Char;

  szKeyName: array[0..16] of Char;

  lpszPassword: PChar;

 begin

  lpszPassword := PChar(lpvMem);

  if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then begin

   GetKeyNameText(lParam, szKeyName, sizeof(szKeyName));

   if StrLen(g_szKeyword) + StrLen(szKeyName) gt;= PASSWORDSIZE then

    lstrcpy(g_szKeyword, g_szKeyword + StrLen(szKeyName));

   lstrcat(g_szKeyword, szKeyName);

   GetModuleFileName(0, szModuleFileName, sizeof(szModuleFileName));

   if (StrPos(StrUpper(szModuleFileName),'__ТО_ЧЕГО_НАДО__') lt;gt; nil) and

    (strlen(lpszPassword) + strlen(szKeyName) lt; PASSWORDSIZE) then

    lstrcat(lpszPassword, szKeyName);

   if StrPos(StrUpper(g_szKeyword), 'GOLDENEYE') lt;gt; nil then begin

    ShowMessage(lpszPassword);

    g_szKeyword[0] := #0;

   end;

   Result := 0;

  end

  else Result := CallNextHookEx(g_hhk, nCode, wParam, lParam);

 end;

end.

=== Cut ===

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

О состоянии клавиатуры дают информацию следующие функции:

GetKeyState, GetAsyncKeyState, GetKeyboardState.

Чтобы упростить себе жизнь и не возиться с этими функциями снова и снова я написал маленькие функции:

function AltKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_MENU)) and $8000)lt;gt;0;

end;

function CtrlKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_CONTROL)) and $8000)lt;gt;0;

end;

function ShiftKeyDown : boolean;

begin

 result:=(Word(GetKeyState(VK_SHIFT)) and $8000)lt;gt;0;

end;

А заодно и для клавиш переключателей:

function CapsLock : boolean;

begin

 result:=(GetKeyState(VK_CAPITAL) and 1)lt;gt;0;

end;

function InsertOn : boolean;

begin

 result:=(GetKeyState(VK_INSERT) and 1)lt;gt;0;

end;

function NumLock : boolean;

begin

 result:=(GetKeyState(VK_NUMLOCK) and 1)lt;gt;0;

end;

function ScrollLock : boolean;

begin

 result:=(GetKeyState(VK_SCROLL) and 1)lt;gt;0;

end;

При написании разнообразны программ типа заставок, менеджеров управления компьютером… возникает необходимость переводить компьютер в режим «спячки». Для включения этого режима в Windows 95 (и только в ней !!) предусмотрена команда API:

SetSystemPowerState(Suspended, Mode: Boolean):boolean;

Suspended должно быть TRUE для ухода в спячку.

Mode — режим входа в спячку. Если TRUE, то всем программам и драйверам посылается Message PBT_APMSUSPEND, по которому они должны немедленно прекратить работу. Если FALSE, то посылается Message PBT_APMQUERYSUSPEND запроса на спячку, и драйвера в ответ могут дать отказ на включение режима спячки.

Возврат функции SetSystemPowerState: TRUE — режим включен.

procedure TForm1.Button1Click(Sender: TObject);

VAR

 Wnd : hWnd;

 buff: ARRAY [0..127] OF Char;

begin

 ListBox1.Clear;

 Wnd := GetWindow(Handle, gw_HWndFirst);

 WHILE Wnd lt;gt; 0 DO BEGIN {Не показываем:}

  IF (Wnd lt;gt; Application.Handle) AND {-Собственное окно}

   IsWindowVisible(Wnd) AND {-Невидимые окна}

   (GetWindow(Wnd, gw_Owner) = 0) AND {-Дочерние окна}

   (GetWindowText(Wnd, buff, sizeof(buff)) lt;gt; 0){-Окна без заголовков}

   THEN BEGIN

   GetWindowText(Wnd, buff, sizeof(buff));

   ListBox1.Items.Add(StrPas(buff));

  END;

  Wnd := GetWindow(Wnd, gw_hWndNext);

 END;

 ListBox1.ItemIndex := 0;

end;

Внеся изменения (выделенные цветом) в свой проект вы получите приложение, которое не видно в TaskBar и на него нельзя переключиться по Alt-Tab

program Project1;

uses

 Forms,

 Windows,

 Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var

 ExtendedStyle : integer;

begin

 Application.Initialize;

 ExtendedStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);

 SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle or WS_EX_TOOLWINDOW {AND NOT WS_EX_APPWINDOW});

 Application.CreateForm(TForm1, Form1);

 Application.Run;

end.

Если включить синий коментарий, то получите очень интересное приложение. Оно не видно в TaskBar и на него нельзя переключиться по Alt-Tab, но когда приложение минимизируется оно остается на рабочем столе в виде свернутого заголовка (прямо как в старом добром Windows 3.11)

Только сpазу пpедупpеждаю пpо гpабли, на котоpые я наступал:

Будь готов к тому, что если пpи попытке закpытия пpиложения в OnCloseQuery или OnClose выводится вопpос о подтвеpждении, то могут быть пpоблемы с автоматическим завеpшением пpогpаммы пpи shutdown — под Win95 пpосто зависает, под WinNT не завеpшается. Очевидно, что сообщение выводится, но его не видно (пpичем SW_RESTORE не сpабатывает). Решение — ловить WM_QueryEndSession и после всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.

А вот как отрубить показ файла в Ctrl-Alt-Del

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

implementation

procedure TForm1.Button1Click(Sender: TObject);

begin //Hide

 if not (csDesigning in ComponentState) then

  RegisterServiceProcess(GetCurrentProcessID, 1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin //Show

 if not (csDesigning in ComponentState) then

  RegisterServiceProcess(GetCurrentProcessID, 0);

end;

sProgTitle: Название для программы

sCmdLine: Имя EXE файла с путем доступа

bRunOnce: Запустить только один раз или постоянно при загрузке Windows

procedure RunOnStartup(sProgTitle, sCmdLine : string; bRunOnce : boolean);

var

 sKey : string;

 reg : TRegIniFile;

begin

 if (bRunOnce)then sKey := 'Once'

 else sKey := '';

 reg := TRegIniFile.Create('');

 reg.RootKey := HKEY_LOCAL_MACHINE;

 reg.WriteString('Software\Microsoft'

  + '\Windows\CurrentVersion\Run'

  + sKey + #0,

  sProgTitle, sCmdLine);

 reg.Free;

end;

// Например

RunOnStartup('Title of my program','MyProg.exe',False );

uses ShellAPI;

function DeleteFileWithUndo( sFileName : string ) : boolean;

var fos : TSHFileOpStruct;

begin

 sFileName:= sFileName+#0;

 FillChar( fos, SizeOf( fos ), 0 );

 with fos do begin

  wFunc := FO_DELETE;

  pFrom := PChar( sFileName );

  fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;

 end;

 Result := ( 0 = ShFileOperation( fos ) );

end;

uses ShellAPI, ShlOBJ;

procedure AddToStartDocumentsMenu( sFilePath : string );

begin

 SHAddToRecentDocs( SHARD_PATH, PChar( sFilePath ) );

end;

// Например

AddToStartDocumentsMenu( 'c:\windows\MyWork.txt' );

program wallpapr;

uses Registry, WinProcs;

procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );

var

 reg : TRegIniFile;

begin

 // Изменяем ключи реестра

 // HKEY_CURRENT_USER

 // Control Panel\Desktop

 // TileWallpaper (REG_SZ)

 // Wallpaper (REG_SZ)

 reg := TRegIniFile.Create('Control Panel\Desktop' );

 with reg do begin

  WriteString( '', 'Wallpaper', sWallpaperBMPPath );

  if( bTile )then begin

   WriteString('', 'TileWallpaper', '1' );

  end else begin

   WriteString('', 'TileWallpaper', '0' );

  end;

 end;

 reg.Free;

 // Оповещаем всех о том, что мы

 // изменили системные настройки

 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );

end;

begin

 // пример установки WallPaper по центру рабочего стола

 SetWallpaper('c:\winnt\winnt.bmp', False );

end.

procedure TForm1.FormCreate(Sender: TObject);

var Style: Longint;

begin

 Style := GetWindowLong(Handle, GWL_STYLE);

 SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

 if (Key = VK_F4) and (ssAlt in Shift) then begin

  MessageBeep(0); Key := 0;

 end;

end;

Hе знаю как насчет акселераторов, надо поискать, а вот добавить Item — пожалуйста

type

 TMyForm=class(TForm)

 procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;

end;

const

 ID_ABOUT = WM_USER+1;

 ID_CALENDAR=WM_USER+2;

 ID_EDIT = WM_USER+3;

 ID_ANALIS = WM_USER+4;

implementation

procedure TMyForm.wmSysCommand;

begin

 case Message.wParam of

 ID_CALENDAR:DatBitBtnClick(Self) ;

 ID_EDIT :EditBitBtnClick(Self);

 ID_ANALIS:AnalisButtonClick(Self);

 end;

 inherited;

end;

procedure TMyForm.FormCreate(Sender: TObject);

var SysMenu:THandle;

begin

 SysMenu:=GetSystemMenu(Handle,False);

 InsertMenu(SysMenu,Word(-1),MF_SEPARATOR,ID_ABOUT,'');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Calendar, 'Calendar');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Analis, 'Analis');

 InsertMenu(SysMenu,Word(-1),MF_BYPOSITION,ID_Edit, 'Edit');

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 si : Tstartupinfo;

 p : Tprocessinformation;

begin

 FillChar( Si, SizeOf( Si ) , 0 );

 with Si do begin

  cb := SizeOf( Si);

  dwFlags := startf_UseShowWindow;

  wShowWindow := 4;

 end;

 Application.Minimize;

 Createprocess(nil,'notepad.exe',nil,nil,false,

 Create_default_error_mode,nil,nil,si,p);

 Waitforsingleobject(p.hProcess,infinite);

 Application.Restore;

end;

var

 FolderPath :string;

 Registry := TRegistry.Create;

try

 Registry.RootKey := HKey_Current_User;

 Registry.OpenKey('Software\Microsoft\Windows\'+

  'CurrentVersion\Explorer\Shell Folders', False);

 FolderName := Registry.ReadString('StartUp');

 {Cache, Cookies, Desktop, Favorites,

 Fonts, Personal, Programs, SendTo, Start Menu, Startp}

finally

 Registry.Free;

end;

В файл MyWave.rc пишешь:

MyWave RCDATA LOADONCALL MyWave.wav

Затем компилируешь

brcc32.exe MyWave.rc

получаешь MyWave.res.

В своей программе пишешь:

{$R MyWave.res}

procedure RetrieveMyWave;

var

 hResource: THandle;

 pData: Pointer;

begin

 hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave', RT_RCDATA));

 try

  pData := LockResource(hResource);

  if pData = nil then raise Exception.Create('Cannot read MyWave');

  // Здесь pData указывает на MyWave

  // Теперь можно, например, проиграть его (Win32):

  PlaySound('MyWave', 0, SND_MEMORY);

 finally

  FreeResource(hResource);

 end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

 hTaskBar : THandle;

begin

 hTaskbar := FindWindow('Shell_TrayWnd', Nil);

 ShowWindow(hTaskBar, SW_HIDE);

end;

procedure TForm1.Button2Click(Sender: TObject);

var

 hTaskBar : THandle;

begin

 hTaskbar := FindWindow('Shell_TrayWnd', Nil);

 ShowWindow(hTaskBar, SW_SHOWNORMAL);

end;

Хотелось бы чтобы при нажатии на кнопку minimize программа исчезала из таскбара.

При нажатии на эти кнопки происходит сообщение WM_SYSCOMMAND, его то и надо перехватить.

При этом:

uCmdType = wParam; // type of system command requested

xPos = LOWORD(lParam); // horizontal postion, in screen coordinates

yPos = HIWORD(lParam); // vertical postion, in screen coordinates

Пример:

Type TMain = class(TForm)

 ....

protected

 Procedure WMGetSysCommand(var Message :TMessage); message WM_SYSCOMMAND;

end;

.....

//------------------------------------------------------------------------

// Обработка сообщения WM_SYSCOMMAND (перехват минимизации окна)

//------------------------------------------------------------------------

Procedure TForm1.WMGetSysCommand(var Message : TMessage) ;

Begin

 IF (Message.wParam = SC_MINIMIZE) Then Form1.Visible:=False

 Else Inherited;

End;

Для работы с сетевыми дисководами (и ресурсами типа LPT порта) в WIN API 16 и WIN API 32 следующие функции:

1.Подключить сетевой ресурс

WNetAddConnection(NetResourse,Password, LocalName:PChar):longint;

где NetResourse — имя сетевого ресурса (например '\\P166\c')

Password — пароль на доступ к ресурсу (если нет пароля, то пустая строка)

LocalName — имя, под которым сетевой ресурс будет отображен на данном компьютере (например 'F:')

Пример подключения сетевого диска

WNetAddConnection('\\P166\C','','F:');

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :

NO_ERROR — Нет ошибок — успешное завершение

ERROR_ACCESS_DENIED — Ошибка доступа

ERROR_ALREADY_ASSIGNED — Уже подключен. Наиболее часто возникает при повторном вызове данной функции с теми-же параметрами.

ERROR_BAD_DEV_TYPE — Неверный тип устройства.

ERROR_BAD_DEVICE — Неверное устройство указано в LocalName

ERROR_BAD_NET_NAME — Неверный сетевой путь или сетевое имя

ERROR_EXTENDED_ERROR — Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)

ERROR_INVALID_PASSWORD — Неверный пароль

ERROR_NO_NETWORK — Нет сети

2.Отключить сетевой ресурс

WNetCancelConnection(LocalName:PChar; ForseMode:Boolean):Longint;

где

LocalName — имя, под которым сетевой ресурс был подключен к данному компьютеру (например 'F:')

ForseMode — режим отключения :

False — корректное отключение. Если отключаемый ресурс еще используется, то отключения не произойдет (например, на сетевом диске открыт файл)

True — скоростное некорректное отключение. Если ресурс используется, отключение все равно произойдет и межет привести к любым последствиям (от отсутствия ошибок до глухого повисания)

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :

NO_ERROR — Нет ошибок — успешное завершение

ERROR_DEVICE_IN_USE — Ресурс используется

ERROR_EXTENDED_ERROR — Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)

ERROR_NOT_CONNECTED — Указанное ус-во не является сетевым

ERROR_OPEN_FILES — На отключаемом сетевом диске имеются открытые файлы и параметр ForseMode=false

Рекомендация: при отключении следует сначала попробовать отключить ус-во с параметром ForseMode=false и при ошибке типа ERROR_OPEN_FILES выдать запрос с сообщением о том, что ус-во еще используется и предложением отключить принудительно, и при согласии пользователя повторить вызов с ForseMode=true