События, происходящие в приложениях Delphi при завершении работы Windows

Я провел небольшое исследование, и вот что я выяснил:

При закрытии приложения (используя системное меню или вызывая метод закрытия формы), возникают следующие события:

FormCloseQuery - действие по умолчанию, устанавливает переменную CanClose в значание TRUE и продолжает закрытие формы.
FormClose
FormDestroy
Если приложение активно и вы пытаетесь завершить работу Windows (Shut Down), происходят следующие события (с соблюдением последовательности):

FormCloseQuery
FormDestroy
Мы видим, что метод FormClose в этом случае не вызывается.

Теперь воспроизведем всю последовательность событий, происходящую при попытке завершить работу Windows:

Windows посылает сообщение WM_QUERYENDSESSION всем приложениям и ожидает ответ.
Каждое приложение получает сообщение и возвращает одну из величин: не равную нулю - приложение готово завершить свою работу, 0 - приложение не может завершить свою работу.
Если одно из приложений возвращает 0, Windows не завершает свою работу, а снова рассылает всем окнам сообщение, на этот раз WM_ENDSESSION.
Каждое приложение должно снова подтвердить свою готовность завершить работу, поэтому операционная система ожидает ответа TRUE, резонно предполагая, что оставшиеся приложения с момента предыдущего сообщения закрыли свои сессии и готовы завершить работу. Теперь посмотрим, как на это реагирует Delphi-приложение: приложение возвращает значение TRUE и немедленно вызывает метод FormDestroy, игнорируя при этом метод FormClose. Налицо проблема.
Завершение работы Windows.
Первое решение проблемы: приложение Delphi на сообщение WM_QUERYENDSESSION должно возвратить 0, не дав при этом Windows завершить свою работу. При этом бессмысленно пытаться воспользоваться методом FormCloseQuery, поскольку нет возможности определить виновника завершения работы приложения (это может являться как результатом сообщения WM_QUERYENDSESSION, так и просто действием пользователя при попытке закрыть приложение).

Другое решение состоит в том, чтобы при получении сообщения WM_QUERYENDSESSION самим выполнить необходимые действия, вызвав метод FormClose.

Пример:


unit Unit1;  
interface  
uses  
   
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,  
  
Dialogs;  
type  
   
TForm1 = class(TForm)  
procedure FormClose(Sender: TObject; var Action: TCloseAction);  
private  
{--------------------------------------------------------}  
{ Объявляем свой обработчик сообщения WM_QUERYENDSESSION }  
{--------------------------------------------------------}  
procedure WMQueryEndSession(  
var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;  
public  
{ Public declarations }  
end;  
  
var  
   
Form1    : TForm1;  
  
  
implementation  
{$R *.DFM}  
  
{--------------------------------------------------------------}  
{ Создаем процедуру обработки сообщения WM_QUERYENDSESSION.    }  
{ Приложение получит только это сообщение при попытке Windows  }  
{ завершить работу                                             }  
{--------------------------------------------------------------}  
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);  
begin  
   
inherited;   { сначала сообщание должен обработать наследуемый метод }  
{--------------------------------------------------------------------}  
{ в этой точке вы также можете сообщить Windows о неготовности       }  
{ приложения завершить работу...                                     }  
{ Message.Result:=0;                                                 }  
{-------------------------------------------или----------------------}  
{ вызов процедуры освобождения ресурсов, предусмотренной в FormClose }  
{ MyCleanUpProcedure;                                                }  
{--------------------------------------------------------------------}  
  
end;  
  
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
   
MyCleanUpProcedure;  
  
end;  
  
end.  

Я не тестировал этот код, но могу предположить, что он должен работать. Сообщите, если это не так!

Добавлено: 07 Августа 2018 21:36:04 Добавил: Андрей Ковальчук

Создание COM-сервера

Всем привет!

Чем отличается программист от другого типа человека разумного?
Я думаю, постоянным желанием подшутить над братом меньшим - Человеком нормальным, благо способов для этого - великое множество. В реестре Windows неограниченное количество мест для автоматического запуска программ - сейчас нас интересует расширение оболочки - контекстное меню Эксплорера. Займемся созданием +СОМ-сервера который будет запускаться при вызове контекстного меню.
Сразу оговорюсь - на компе потенциального испытуемого должна стоять звуковая карта и, желательно, антивирус Касперского, чтобы испытуемому был хорошо известен вопль AVP при обнаружении вируса.

Для начала, создадим файл ресурса содержащего нужный нам вопль.
Создаем текстовый файл, пишем в нем на одной строке:

MYWAVE RCData C:\Temp\Infected.wav


(вместо C:\Temp\Infected.wav пишете реальный путь к *.wav файлу)
Сохраняем файл с именем WAVE.RC. Далее выполняем команду:

brcc32.exe C:\Temp\Wave.rc


(вместо C:\Temp\Wave.rc пишете реальный путь к Wave.rc файлу)
У нас получился файл ресурсов Wave.res который мы будем использовать дальше.

В примерах Delphi есть почти все, что нам нужно:

..:\Program Files\Borland\Delphi7\Demos\ActiveX\ShellExt\ContextM.pas


Немножко редактируем этот файл (в смысле выбрасываем ненужное - добавляем нужное) и получаем примерно это:


unit Unit1;  
  
interface  
  
uses  
  Windows, ActiveX, ComObj, Classes,  
  Dialogs, StdCtrls,  
  ShlObj;  
  
type  
  TInitWormHook = class(TComObject, IShellExtInit, IContextMenu)  
  protected  
    { IShellExtInit }  
    function IShellExtInit.Initialize = SEIInitialize;  
    function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;  
      hKeyProgID: HKEY): HResult; stdcall;  
    { IContextMenu }  
    function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,  
      uFlags: UINT): HResult; stdcall;  
    function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;  
    function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;  
      pszName: LPSTR; cchMax: UINT): HResult; stdcall;  
  end;  
  
  function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;  
  function DllCanUnloadNow: HResult; stdcall;  
  
const  
  Class_ContextMenu: TGUID = '{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}';  
  
implementation  
  
uses ComServ, SysUtils, ShellApi, Registry, Graphics, mmSystem;  
  
//Цепляем наш ресурс  
{$R wave.res}  
  
function TInitWormHook.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;  
  hKeyProgID: HKEY): HResult;  
begin  
  Result := NOERROR;  
end;  
  
function TInitWormHook.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,  
          idCmdLast, uFlags: UINT): HResult;  
begin  
  Result := 0;  
end;  
  
function TInitWormHook.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;  
begin  
  Result := NOERROR;  
end;  
  
function TInitWormHook.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;  
  pszName: LPSTR; cchMax: UINT): HRESULT;  
begin  
  Result := NOERROR;  
end;  
  
type  
  TInitWormHookFactory = class(TComObjectFactory)  
  public  
    procedure UpdateRegistry(Register: Boolean); override;  
  end;  
    
//А это - наша процедура по извлечению звука из файла ресурса  
procedure RUNWAV;  
var  
WaveHandle: THandle;  
  WavePointer: pointer;  
  begin  
  WaveHandle:= FindResource(hInstance, 'MYWAVE', RT_RCDATA);  
  if WaveHandle <> 0 then  
    begin  
      WaveHandle := LoadResource(hInstance, WaveHandle);  
      if WaveHandle <> 0 then  
        begin;  
          WavePointer:= LockResource(WaveHandle);  
          sndPlaySound(WavePointer, snd_Memory or SND_ASYNC);  
          UnlockResource(WaveHandle);  
          FreeResource(WaveHandle);  
        end;  
    end;  
end;  
  
procedure TInitWormHookFactory.UpdateRegistry(Register: Boolean);  
var  
  ClassID: string;  
begin  
  if Register then begin  
    inherited UpdateRegistry(Register);  
    ClassID := GUIDToString(Class_ContextMenu);  
    CreateRegKey('Directory\shellex\ContextMenuHandlers\WAV', '', ClassID);  
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then  
      with TRegistry.Create do  
        try  
          RootKey := HKEY_LOCAL_MACHINE;  
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);  
          OpenKey('Approved', True);  
          WriteString(ClassID, 'FTP simple client');  
        finally  
          Free;  
        end;  
  end  
  else begin  
    DeleteRegKey('Directory\shellex\ContextMenuHandlers\WAV');  
    inherited UpdateRegistry(Register);  
  end;  
end;  
  
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult;  
begin  
  Result:=ComServ.DllGetClassObject(CLSID, IID, Obj);  
  if Result = S_OK then begin  
    try  
     RUNWAV;  
    except  
    end;  
  end;  
end;  
  
function DllCanUnloadNow: HResult;  
begin  
  Result := ComServ.DllCanUnloadNow;  
  if Result = S_OK then begin  
    try  
     RUNWAV;  
    except  
    end;  
  end;  
end;  
  
initialization  
  TInitWormHookFactory.Create(ComServer, TInitWormHook, Class_ContextMenu,  
    '', 'FTP simple client', ciMultiInstance,  
    tmApartment);  
end.  
Теперь нам нужно скомпилировать из этого модуля DLL-ку. Пишем проект ShWave.dpr:


library ShWave;  
  
uses  
  ComServ,  
  Unit1 in 'Unit1.pas';  
  
exports  
  DllGetClassObject,  
  DllCanUnloadNow,  
  DllRegisterServer,  
  DllUnregisterServer;  
begin  
end.  

После компиляции получаем ShWave.dll

Мы получили +СОМ-сервер, теперь осталось его подключить к контекстному меню. Пишем файл реестра Install.reg:

REGEDIT4

[HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]
@="ShWave.dll"
"ThreadingModel"="Apartment"

[HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]
@="{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}"

[HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]
@="{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}"

Закидываем файл ShWave.dll в %SystemRoot%\System32, запускаем Install.reg и при попытке использования контекстного меню будет звучать вопль AVP или тот, который вы сами зашили в ресурс.

Вместо \*\ можно использовать любое расширение файлов и СОМ-сервер будет активизироваться только при щелчке правой кнопкой мыши на файлах выбранного типа.

Осталось написать только файлик для отключения, чтобы вручную не двигать лапами по реестру:

REGEDIT4
[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}\InprocServer32]
[-HKEY_CLASSES_ROOT\CLSID\{1A39ADB3-5ED9-44F4-B6BA-5B3D41255033}]
[-HKEY_CLASSES_ROOT\*\shellex\ContextMenuHandlers\WAV]
[-HKEY_CLASSES_ROOT\Directory\shellex\ContextMenuHandlers\WAV]


Вот и все.

Добавлено: 07 Августа 2018 21:14:29 Добавил: Андрей Ковальчук

Русификация консольных приложений в Delphi

С периодичностью раз в месяц-полтора конференция RU.DELPHI оглашается стонами на тему “Консоль не поет по-русски”, за которыми стоит вывод текста в консольных приложениях в кодировке OEM (Delphi IDE, как и все GUI, работает в ANSI).

С точки зрения набора символов эти кодовых таблицы не совпадают: позиции символов кириллицы в них различны (отсюда и неприятные эффекты), кроме того, в ANSI присутствуют диакритические символы, которых нет в OEM, но в последней имеются символы псевдографики, незаменимые при изображении таблиц (интересно, это еще кем-то востребовано? На ум приходит только FAR). Впрочем, возможности для вывода текстовой информации у этих таблиц одинаковы, что в нашем случае позволяет говорить о взаимозаменяемости.

Рассмотрим некоторые способы, которыми можно решить возникающие проблемы (три из них встречаются в различных FAQ, последний менее тривиален, но, видимо, в наибольшей степень отвечает задаче).

Работа в OEM-редакторе. Вместо борьбы с выводом «не тех» символов можно пойти иным путем – изначально готовить текст программы (точнее те его части, которые критичны к кодовой таблице) в редакторе, работающем в кодировке OEM. Решение простенькое, но на удивление эффективное, особенно при написании каких-либо локальных утилит, в которых, тем не менее, сильно востребован вывод информации.

К недостаткам можно отнести работу вне привычного IDE с его облегчающими жизнь наворотами (кодирование, компиляция и отладка в одном флаконе), а также определенные сложности при разрастании проекта, когда начинают использоваться сторонние строковые ресурсы, созданные с применением кодировки ANSI.

Если же проект не содержит hard-coded (включенных непосредственно в код) строк, то возможно организовать вынесение всех строковых ресурсов в отдельные модули с последующей их локализацией под требуемую кодировку – утилит, меняющих кодировку файлов существует предостаточно.

Использование фильтрующих процедур. Windows API содержит функции для преобразования между кодировками OEM и ANSI OemToChar, CharToOem, которые и предлагается использовать при выводе текста, заменяя фрагменты


Writeln(‘тра-ля-ля’);  

на


procedure MyWriteln(const S: string);  
var  
    NewStr: string;  
begin  
    SetLengtn(NewStr, Length(S));  
    CharToOem(PChar(S), PChar(NewStr));  
    Writeln(NewStr);  
end;  
...  
MyWriteln(‘тра-ля-ля’);  

К недостаткам можно отнести невозможность использования расширенного синтаксиса Write, а также некоторое захламление текста программы явным вызовом фильтрующих процедур. Задача становится совсем неприятной, когда предстоит «русифицировать» уже готовое приложение со многими обращениями к Write, поэтому применять его стоит с определенными оговорками.

Изменение кодовой страницы консоли. В принципе, для решения задачи есть документированный способ – изменение кодовой страницы консоли средствами Windows API. Проблема лишь в том, что в Win95/98 функция не работает. Впрочем, если приложение будет работать только в Windows NT, можно воспользоваться функцией SetConsoleOutputCP(866).

Перекрытие процедур вывода в RTL. Вывод в Pascal (еще в версиях от Borland для DOS) через Write-процедуры осуществляется посредством передачи выводимой информации в файл Output, который вполне можно подвергнуть легкой модификации с целью упростить себе жизнь.

Известно, что Write/Writeln без указания файла осуществляет вывод в файл Output. Output имеет тип TextFile, он же TTextRec, содержимое которого описано в SysUtils.pas. Есть там и поля, содержащие адреса процедур, в которые приходит на обработку поток выводимых приложением данных (в случае вывода). Не вдаваясь в подробности (желающие могут посмотреть устройство механизмов вывода в исходниках RTL), покажем, что происходит в процедуре, отвечающей за вывод (TTextRec.InOutFunc): { Реконструкция TextOut из Assign.asm }


function TextOut(var Text: TTextRec): Integer;  
var  
    Dummy: Cardinal;  
    SavePos: Integer;  
begin  
    SavePos := Text.BufPos;  
    if SavePos > 0 then  
        begin  
            Text.BufPos := 0;  
            if WriteFile(Text.Handle, Text.BufPtr^, SavePos, Dummy, nil) then  
                Result := 0 else  
                Result := GetLastError;  
        end else Result := 0;  
end;  

Теперь видно, что нужно сделать для вывода символов в нужной кодовой таблице – перед выводом в файл средствами ОС модифицировать данные в выходном буфере структуры Text, вписав следующую строку:


CharToOemBuff(Text.BufPtr, Text.BufPtr, SavePos);  

Модифицировать буфер можно, т.к. после операции записи в файл содержимое буфера фактически сбрасывается (когда в Text.BufPos записывается 0 – именно столько актуальных данных остается в буфере). Если не завязываться на эту особенность реализации, можно распределить буфер и модифицировать данные уже в нем. Впрочем, решение в любом случае достаточно сильно опирается на особенности реализации, поэтому проверить его пригодность при смене версии Delphi рекомендуется в любом случае. С другой стороны, вероятность отхода Borland от наработанного решения крайне мала.

Заметим, что кроме InOutFunc вывод в файл ОС происходит и в FlushFunc, которая в файле Output указывает на ту же функцию, что и InOutFunc. С учетом всего вышесказанного модуль, осуществляющий «русификацию» консольных приложений «на лету» будет совсем небольшим:


{ 
Модуль “русификации“ консольных приложений 
(c) Eugene Kasnerik, 1999 
e-mail: eugene1975@mail.ru 
}  
unit EsConsole;  
  
interface  
  
implementation  
  
uses  
    Windows;  
  
{ Описание структуры приведено здесь с единственной целью – 
не подключать SysUtils и, соответственно, код инициализации 
этого модуля. Консольные приложения обычно малы и 25К кода 
обработки исключений – несколько высокая плата за описание 
единственной структуры.}  
  
type  
    TTextRec = record  
        Handle: Integer;  
        Mode: Integer;  
        BufSize: Cardinal;  
        BufPos: Cardinal;  
        BufEnd: Cardinal;  
        BufPtr: PChar;  
        OpenFunc: Pointer;  
        InOutFunc: Pointer;  
        FlushFunc: Pointer;  
        CloseFunc: Pointer;  
        UserData: array[1..32] of Byte;  
        Name: array[0..259] of Char;  
        Buffer: array[0..127] of Char;  
    end;  
  
function ConOutFunc(var Text: TTextRec): Integer;  
var  
    Dummy: Cardinal;  
    SavePos: Integer;  
begin  
    SavePos := Text.BufPos;  
    if SavePos > 0 then  
        begin  
            Text.BufPos := 0;  
            CharToOemBuff(Text.BufPtr, Text.BufPtr, SavePos);  
            if WriteFile(Text.Handle, Text.BufPtr^, SavePos, Dummy, nil) then  
                Result := 0 else  
                Result := GetLastError;  
        end else Result := 0;  
end;  
  
initialization  
    Rewrite(Output); // Проводим инициализацию файла  
    { И подменяем обработчики. Есть в этом что-то от 
    хака, но цель оправдывает средства }  
    TTextRec(Output).InOutFunc := @ConOutFunc;  
    TTextRec(Output).FlushFunc := @ConOutFunc;  
end.  

Для русификации приложения достаточно лишь подключить вышеуказанный модуль в любом месте программы (как правило, в проекте), после чего вывод ANSI-символов будет осуществлен в ожидаемом виде. Однако следует иметь в виду, что не будут доступны символы псевдографики (для них нет аналогов в ANSI, т.е. в редакторе их не введешь) и часть диакритических знаков (для них нет аналогов в OEM). Впрочем, для модификации значений выводимых символов не обязательно использовать системные функции, что открывает простор для консольного вывода в самых разных кодировках.

Приведенное решение успешно использовалось в Delphi 2 и Delphi 4.

Автор: Евгений Каснерик

Добавлено: 07 Августа 2018 08:37:11 Добавил: Андрей Ковальчук

Работа с реестром и INI-файлами в Delphi

Реестр
Добавление элементов в контекстное меню "Создать"

Создать новый документ, поместить его в папку Windows/ShellNew
В редакторе реестра найти расширение этого файла, добавить новый подключ, добавить туда строку: FileName в качестве значения которой указать имя созданного файла.
Путь к файлу который открывает не зарегистрированные файлы

Найти ключ HKEY_CLASSES_ROOT\Unknown\Shell
Добавить новый ключ Open
Под этим ключом еще ключ с именем command в котором изменить значение (По умолчанию) на имя запускаемого файла, к имени нужно добавить %1. (Windows заменит этот символ на имя запускаемого файла)
В проводнике контекстное меню "Открыть в новом окне"

Найти ключ HKEY_CLASSES_ROOT\Directory\Shell
Создать подключ: opennew в котором изменить значение (По умолчанию) на: "Открыть в новом окне"
Под этим ключом создать еще подключ command (По умолчанию) = explorer %1
Использование средней кнопки мыши Logitech в качестве двойного щелчка
Подключ HKEY_LOCAL_MACHINE\SoftWare\Logitech и там найти параметр DoubleClick заменить 000 на 001

Новые звуковые события
Например создает звуки на запуск и закрытие WinWord
HKEY_CURRENT_USER\AppEvents\Shemes\Apps добавить подключ WinWord и к нему подключи Open и Close.
Теперь в настройках звуков видны новые события

Путь в реестре для деинсталяции программ:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall

Работа с реестром в Delphi

В Delphi есть объект TRegistry при помощи которого очень просто работать с реестром.
Реестр предназначен для хранения системных переменных и позволяет зарегистрировать файлы программы, что обеспечивает их показ в проводнике с соответствующей иконкой, вызов программы при щелчке на этом файле, добавление ряда команд в меню, вызываемое при нажатии правой кнопки мыши над файлом. Кроме того, в реестр можно внести некую свою информацию (переменные, константы, данные о инсталлированной программы ...). Программу можно добавить в список деинсталляции, что позволит удалить ее из менеджера "Установка/Удаление программ" панели управления.
Для работы с реестром применяется ряд функций API :

RegCreateKey (Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Создать подраздел в реестре. Key указывает на "корневой" раздел реестра, в SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1\subkey2\ ...). Если такой раздел уже существует, то он открывается (в любом случае при успешном вызове Result содержит Handle на раздел). Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка.

RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;

Открыть подраздел Key\SubKey и возвращает Handle на него в переменной Result. Если раздела с таким именем нет, то он не создается. Возврат - код ошибки или ERROR_SUCCESS, если успешно.

RegCloseKey(Key: HKey): Longint;

Закрывает раздел, на который ссылается Key. Возврат - код ошибки или ERROR_SUCCESS, если успешно.
RegDeleteKey(Key: HKey; SubKey: PChar): Longint;
Удалить подраздел Key\SubKey. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

RegEnumKey(Key: HKey; index: Longint; Buffer: PChar;cb: Longint): Longint;

Получить имена всех подразделов раздела Key, где Key - Handle на открытый или созданный раздел (см. RegCreateKey и RegOpenKey), Buffer - указатель на буфер, cb - размер буфера, index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой (см. пример).

RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;

Возвращает текстовую строку, связанную с ключом Key\SubKey.Value - буфер для строки; cb- размер, на входе - размер буфера, на выходе - длина возвращаемой строки. Возврат - код ошибки.

RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;

Задать новое значение ключу Key\SubKey, ValType - тип задаваемой переменной, Value - буфер для переменной, cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ. Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Примеры:


{ Создаем список всех подразделов указанного раздела }  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  MyKey: HKey;{ Handle для работы с разделом }  
  Buffer: array[0..1000] of char; { Буфер }  
  Err, { Код ошибки }  
  index: longint; { Индекс подраздела }  
begin  
  Err:=RegOpenKey(HKEY_CLASSES_ROOT,'DelphiUnit',MyKey); { Открыли раздел }  
  if Err<> ERROR_SUCCESS then   
  begin  
    MessageDlg('Нет такого раздела !!',mtError,[mbOk],0);  
    exit;  
    end;  
  index:=0;  
  {Определили имя первого подраздела }  
  Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer));   
  while err=ERROR_SUCCESS do { Цикл, пока есть подразделы }  
  begin  
    memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }  
    inc(index); { Увеличим номер подраздела }  
    Err:=RegEnumKey(MyKey,index,Buffer,Sizeof(Buffer)); { Запрос }  
  end;  
  RegCloseKey(MyKey); { Закрыли подраздел }  
end;  

Объект INIFILES - работа с INI файлами
Почему иногда лучше использовать INI-файлы, а не реестр?

INI-файлы можно просмотреть и отредактировать в обычном блокноте.
Если INI-файл хранить в папке с программой, то при переносе папки на другой компьютер настройки сохраняются. (Я еще не написал ни одной программы, которая бы не поместилась на одну дискету :)
Новичку в реестре можно запросто запутаться или (боже упаси), чего-нибудь не то изменить.
Поэтому для хранения параметров настройки программы удобно использовать стандартные INI файлы Windows. Работа с INI файлами ведется при помощи объекта TIniFiles модуля IniFiles. Краткое описание методов объекта TIniFiles дано ниже.
Constructor Create('d:\test.INI');
Создать экземпляр объекта и связать его с файлом. Если такого файла нет, то он создается, но только тогда, когда произведете в него запись информации.

WriteBool(const Section, Ident: string; Value: Boolean);

Присвоить элементу с именем Ident раздела Section значение типа boolean

WriteInteger(const Section, Ident: string; Value: Longint);

Присвоить элементу с именем Ident раздела Section значение типа Longint

WriteString(const Section, Ident, Value: string);

Присвоить элементу с именем Ident раздела Section значение типа String

ReadSection (const Section: string; Strings: TStrings);

Прочитать имена всех корректно описанных переменных раздела Section (некорректно описанные опускаются)

ReadSectionValues(const Section: string; Strings: TStrings);

Прочитать имена и значения всех корректно описанных переменных раздела Section. Формат :
имя_переменной = значение

EraseSection(const Section: string);

Удалить раздел Section со всем содержимым

ReadBool(const Section, Ident: string; Default: Boolean): Boolean;

Прочитать значение переменной типа Boolean раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

ReadInteger(const Section, Ident: string; Default: Longint): Longint;

Прочитать значение переменной типа Longint раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

ReadString(const Section, Ident, Default: string): string;

Прочитать значение переменной типа String раздела Section с именем Ident, и если его нет, то вместо него подставить значение Default.

Free;

Закрыть и освободить ресурс. Необходимо вызвать при завершении работы с INI файлом

Property Values[const Name: string]: string;

Доступ к существующему параметру по имени Name

Пример:


procedure TForm1.FormClose(Sender: TObject);  
var  
  IniFile:TIniFile;  
begin  
  IniFile := TIniFile.Create('d:\test.INI'); { Создали экземпляр объекта }  
  IniFile.WriteBool('Options', 'Sound', True); { Секция Options: Sound:=true }  
  IniFile.WriteInteger('Options', 'Level', 3); { Секция Options: Level:=3 }  
  IniFile.WriteString('Options' , 'Secret password', Pass);   
  { Секция Options: в Secret password записать значение переменной Pass }  
  IniFile.ReadSection('Options ', memo1.lines); { Читаем имена переменных}  
  IniFile.ReadSectionValues('Options ', memo2.lines); { Читаем имена и значения }  
  IniFile.Free; { Закрыли файл, уничтожили объект и освободили память }  
end;  

Добавлено: 07 Августа 2018 08:33:04 Добавил: Андрей Ковальчук

Регистрация в реестре

Несомненно, регистр (он же реестр) Windows — очень полезная вещь. Ведь в нем можно хранить так много информации — от количества программ вашей фирмы, ранее установленных на данном PC, и информации об их регистрации до разнообразных настроек окошек этих самых программ. Но для того чтобы все это там хранить, необходимо уметь работать с реестром, причем работать корректно, без ошибок.В данной статье будут разобраны основные функции работы с регистром в Delphi (легко портируемые при необходимости на С/С++), а также рассмотрены примеры пользовательских функций для более общих действий с регистром (тоже легко переносимые на С/С++). Итак, приступим…

Рассмотрим на примере. Допустим, вы написали очень (или не слишком) навороченную софтину и теперь хотите, чтобы богатенькие юзеры ею не просто так пользовались, а за денежку. То бишь, скачал юзер вашу софтинку с официального сайта вашей же фирмы Глюкософт, запустил, а она ему: «Заплати-ка ты, дружок, сначала $99.99 фирме Глюкософт, если хочешь получить все мои возможности, получи там у них код на такой-то номер, а потом и пользуйся!» Для этого вам необходимо при первом запуске сгенерировать два значения — «Программа не зарегистрирована» и уникальный номер — и где-то их сохранить. Уникальный номер нужен затем, чтобы предотвратить попытки доморощенных хакеров продавать за $9 универсальный код к вашей софтинке.

Первое и самое главное, что вам понадобится, это какая-либо переменная типа HKey. Этот тип описан в модуле windows.pas (как и все функции, описанные ниже) и представляет собой тип дескриптора ключа регистра (кто не знает, дескриптор — это типа указателя, только круче :-)).

Затем при помощи функции RegOpenKey или RegOpenKeyEx открыть необходимый нам ключ регистра. Если при этом возникнет ошибка, значит, на 99% можно утверждать, что софтина запускается впервые, или что ваши записи в регистре были удалены.

Синтаксис у нее такой:


Function RegOpenKey(BaseKey:HKey; SubKey:PChar; dwReserved:dword; samDesired:RegSAM; var ResKey:PHKey):dword;  

Где:

BaseKey — дескриптор ранее открытого ключа или одна из мнемонических констант — HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE или HKEY_USERS, обозначающих соответствующие базовые разделы регистра. Рекомендуется использовать только первые два: HKEY_CLASSES_ROOT — информация об обрабатываемых расширениях, и HKEY_CURRENT_USER — информация о текущем пользователе;

SubKey — имя ключа, который вы хотите создать. При этом оно может содержать \ для спуска на один уровень вниз, но не должно начинаться или заканчиваться на этот самый \;

dwReserved — припасено для будущих версий, должно быть 0;

samDesired — флаг или комбинация флагов, отвечающих за способ открытия ключа; возможны следующие значения: KEY_READ — просто чтение, KEY_SET_VALUE — установить значение переменной в ключе, KEY_WRITE — перезаписать ключ полностью, при этом все старые значения будут уничтожены;

ResKey — дескриптор-приемник ключа.

В случае успешного выполнения функция возвращает значение ERROR_SUCCESS или NO_ERROR, в случае ошибки возвращается код ошибки.

Пусть мы установили, что запуск произведен впервые (открытие ключа вернуло ошибку). Значит, теперь нужно создать соответствующий вашей программе ключ. Сделать это можно при помощи функции RegCreateKeyEx.

Синтаксис у нее следующий:


Function RegCreateKeyEx(BaseKey:HKey; SubKey:PChar; dwReserved:dword; pClass:PChar; dwOptions:dword; samDesired:RegSAM; SecAttr:lpSecurity_Attributes; var ResKey:PHKey; Disposition:lpdword):dword;
Большинство параметров аналогичны RegOpenKeyEx:

samDesired — может быть также KEY_ALL_ACCESS — полный доступ с предварительным созданием; KEY_CREATE_SUB_KEY — создание вложенного ключа; pClass — совершенно бесполезный параметр, поэтому лучше ставить значение nil; dwOptions — определяет тип создаваемого ключа; может быть REG_OPTION_NON_VOLATILE (постоянный ключ, используется по умолчанию; при этом информация, записанная в ключ, сохраняется и доступна после перезагрузки) или REG_OPTION_VOLATILE (временный ключ; в Win95/98 вообще игнорируется, во всех WinNT информация записывается во временную память и теряется при перезагрузке); SecAttr — в Win95/98 вообще игнорируется, во всех WinNT отвечает за параметры политики безопасности. Лучше ставить значение nil;

Disposition — еще один совершенно ненужный параметр; лучше использовать адрес любой переменной типа integer или word со значением 0.

Ну а после того как мы создадим ключ, нам необходимо записать в него наши значения. Делается это с помощью функции RegSetValueEx со следующим синтаксисом:


Function RegSetValueEx(BaseKey:HKey; ValueName:PChar; dwReserved, dwType:dword; pData:pointer; DataSize:dword):dword;  

Где:

ValueName — имя переменной, значение которой устанавливается (если ее нет, то она будет создана);
dwType — идентификатор типа переменной: REG_BINARY — все виды двоичных типов переменных (напремер, boolean); REG_DWORD — переменная типа dword; REG_SZ — строковая переменная; REG_EXPAND_SZ — строка с мнемоническими обозначениями переменных среды (например, %PATH%\GluckoSoft); REG_NONE — неопределенный или сложный тип (например, какая-нибудь структура);
pData — указатель на записываемые данные;
DataSize — размер записываемых данных.

После всех этих операций нужно закрыть дескриптор ключа и освободить связанные с ним ресурсы системы. Делается это при помощи функции RegCloseKey с самым простым синтаксисом:


Function RegCloseKey(WhatKey:HKey):dword. 

Теперь рассмотрим пользовательскую функцию, которая все это будет делать:


…  
const {нам понадобятся некоторые константы}  
SKey = ‘Software\GluckoSoft\Someware’; {ключ для данной программы}  
SID = ‘ProductID’; {имя переменной, хранящей уникальный номер программы}  
SRg = ‘Registered’;{имя переменной, хранящей сведения о регистрации}  
…  
function Prepare:dword;  
var  
Res:dword;  
Key:HKey;  
Rgst:boolean;  
ID:dword;  
Dummy:integer;  
begin  
Prepare:=ERROR_SUCCESS;  
Dummy:=0;  
Rgst:=false;  
ID:=Random(10000);  
Res:=RegOpenKeyEx(HKEY_CURRENT_USER, SKey, 0, KEY_READ, Key);  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Res:=RegCreateKey(HKEY_CURRENT_USER, SKey, 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, Key, @Dummy);  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Prepare:=Res;  
Exit;  
end  
else  
begin  
Res:=RegSetValueEx(Key,SRg,0,REG_BINARY,@Rgst,SizeOf(Rgst));  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Prepare:=Res;  
Exit;  
end;  
Res:=RegSetValueEx(Key,SID,0,REG_DWORD,@ID,SizeOf(ID));  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Prepare:=Res;  
Exit;  
end;  
RegCloseKey(Key);  
end;  
end  
else RegCloseKey(Key);  
end;  
…  

Значит, данные вы сохранили, окошко с сообщением юзеру выдали (наверняка сами это сможете сделать), тот зарегистрировался и получил код. Теперь необходимо код этот проверить на соответствие уникальному номеру и при соответствии отметить, что софтинка ваша зарегистрирована. Для этого вам понадобится уже знакомая функция RegOpenKeyEx с типом доступа KEY_READ и функция чтения RegQueryValueEx:


Function RegQueryValueEx(BaseKey:HKey; ValueName:PChar; pdwReserved,pdwType:lpdword; pData:pointer; pDataSize:lpdword):dword;  

Почти все параметры вам уже знакомы.

pdwReserved — зарезервировано, nil;
pdwType — указатель на приемник идентификатора типа указанной переменной; заполняется по выполнении функции;
pData — указатель на структуру-приемник данных;
pDataSize — указатель (!) на размер приемника данных.

С их помощью вы считываете значение уникального номера, проверяете его на соответствие введенному коду и, при удовлетворительном результате, функцией RegSetValueEx изменяете значение переменной Registered на true.

Реализовать это можно примерно так:


…  
function Register(Code:dword):dword;  
var  
Key:HKey;  
Res,D1,D2,ID:dword;  
Rgst:boolean;  
begin  
Register:=ERROR_SUCCESS;  
Res:=RegOpenKeyEx(HKEY_CURRENT_USER, SKey, 0, KEY_READ, Key);  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Register:=Res;  
Exit;  
end  
else  
begin  
D2:=SizeOf(ID);  
Res:=RegQueryValue(Key, SID, nil, @D1, @ID, @D2);  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Register:=Res;  
Exit;  
end;  
{проверяем соответствие кода уникальному номеру например так: уникальный номер равен коду, нацело деленному на два}  
if ((Code div 2)<>ID) {при несоответствии…}  
then  
begin  
Register:=666; {…возвращаем ошибку…}  
Exit; {…и выходим!}  
end;  
RegCloseKey(Key);  
Res:=RegOpenKeyEx(HKEY_CURRENT_USER, SKey, 0, KEY_SET_VALUE, Key);  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Register:=Res;  
Exit;  
end;  
Rgst:=true;  
Res:=RegSetValueEx(Key, SRg, 0, REG_BINARY, @Rgst, SizeOf(Rgst));  
if (Res<>ERROR_SUCCESS)  
then  
begin  
Register:=Res;  
Exit;  
end;  
RegCloseKey(Key);  
end;  
end;  
…  

Осталось совсем чуть-чуть. Предположим, что юзер вашей несомненно великолепной софтиной попользовался, но по какой-то причине решил ее удалить (мало ли, может, лучше нашел… причем, тоже вашу :-)). Удалять при этом придется порядком всякой всячины, и конечно же, вы для этого создали специальную процедуру/программу. Нужно обязательно не забыть удалить еще и записи в реестре (желательно, только от своей программы :-)). В этом вам поможет функция RegDeleteKey: Function RegDeleteKey(BaseKey:HKey; SubKey:PChar):dword.

Тут все понятно. Выглядеть это будет приблизительно вот так:


…  
procedure UnInstall;  
…  
begin  
…  
RegDeleteKey(HKEY_CURRENT_USER, SKey);  
…  
end;  
…  

Нужно заметить, что при этом удаляется только подключ HKEY_CURRENT_USER\Software\GluckoSoft\Someware, а ключ HKEY_CURRENT_USER\Software\GluckoSoft остается. Чтобы избежать удаления информации других программ в этом ключе и, с другой стороны, захламления регистра пустыми ключами, можно, например, непосредственно в ключ HKEY_CURRENT_USER\Software\GluckoSoft добавить переменную, которая будет увеличиваться на 1 при установке новых программ вашей фирмы и уменьшаться на 1 при их удалении. Когда она станет равна нулю, смело производите удаление ключа. Заодно получится счетчик «рейтинга» вашей фирмы.

P.S. Вообще-то существует еще модуль registry.pas с описанием типа TRegistry, вроде бы призванного облегчить вам жизнь, но на практике гораздо удобнее и эффективнее использовать описанные выше функции. К тому же подключение этого модуля увеличивает размер ехе-файла.

Автор: Дмитрий НАЗАРАТИЙ

Добавлено: 07 Августа 2018 08:20:56 Добавил: Андрей Ковальчук

Создание хранителя экрана (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;  

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


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 для конфигурирования и прочего (там объем и скорость уже не критичны).

Добавлено: 07 Августа 2018 08:13:19 Добавил: Андрей Ковальчук

Секреты иконки в системном трее. Часть 1

Наверняка многие, кто начинает программировать на Delphi нередко задавались такими вопросами как:

А как можно поместить иконки приложения в системный трей Windows возле часов?
Как скрыть главную форму приложения при запуске и показывать ее по команде всплывающего меню иконки приложения в системной трее, и как затем скрыть ее обратно?
Знакомо да? Что ж, сам я тоже когда-то был начинающим программистом, и потратил уйму времени и нервов за изучение и поиска решений для всех вышеизложенных вопросов. И именно сейчас я готов изложить Вам все свои знания по части работы с иконкой приложения в системной трее.
Статью я решил разделить на две части. Что содержит каждая из них догадаться не трудно - вопросов, о решении которых я расскажу тоже две.
Итак, это часть 1: "Добавление иконки в системный трей".

В этой части мы научимся:

добавлять, изменять и удалять иконку.
отлавливать события мыши на иконке (наведение, клик, двойной клик и т.д.)
менять иконку во время работы приложения, а также текст всплывающей подсказки.
Начать статью я решил не с описания всевозможных компонентов для данной сферы программинга (которых полным полно в интернете), а с описания азов - WinAPI функций, предназначенных для работы с system tray. Хотя, "функции", как то больно громко получилось. На самом деле она всего одна:


function Shell_NotifyIcon ( dwMessage: Cardinal; lpData: PNotifyIconData ) : LongBool;  

(я привожу Вам упрощенное представление функции сделанное лично мной, т.к. если взять описание функции из WinAPI SDK - понять его будет намного труднее)
подробнее о параметрах:
dwMessage:

Параметр, а точнее команда, которая указывает этой функции что именно она должна делать. Может принимать следующие значения констант:
NIM_ADD - добавляет иконку в трей
NIM_DELETE - удаляет иконку из системного трея
NIM_MODIFY - меняет (обновляет) иконку в системном трее.
lpData:
Сей параметр есть запись, которая содержит всю информацию об добавляемой, удаляемой или изменяемой иконке. Данная запись имеет вид:

_NOTIFYICONDATAA = record
   cbSize: DWORD;
   Wnd: HWND;
   uID: UINT;
   uFlags: UINT;
   uCallbackMessage: UINT;
   hIcon: HICON;
   szTip: array [0..63] of AnsiChar;
end; 

(указатель PNotifyIconData является указателем именно на эту запись)

Давайте рассмотрим, какие именно данные содержит данная запись:
cbSize: Размер данной записи;
Wnd: Handle того окна, которое будет получать сообщения от иконки;
uID: Идентификатор иконки;
uFlags: Здесь содержатся константы, означающие, какие данные верны в записи:
NIF_ICON - hIcon содержит верную информацию.
NIF_MESSAGE - uCallbackMessage содержит верную информацию.
NIF_TIP -szTip содержит верную информацию.
(Подробнее об этом я расскажу ниже)
uCallbackMessage: Назначенный Вами идентификатор сообщения, которое будет получать приложение от иконки.
hIcon: Собственно Handle иконки (TIcon.Handle).
szTip: Текст всплывающей подсказки (не более 64 символов).
Мда, наверняка ничего не понятно, да? ..особенно новичкам. Ничего! Далее я приведу код небольшой программы, написанной лично мной. Весь код программы имеет очень богатые комментарии. С их помощью понять смысл каждого шага Вам будет нетрудно:)

Ниже привожу листинг файла main.pas (файл основной и единственной формы приложения):
Внимание!: в тексте программы прошу не путать два понятия: "иконка" - это то, что собственно находится в системно трее, и "иконка (изображение)" - это то, что содержит то само изображение иконочки.


unit main;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
  ShellApi, StdCtrls, ExtCtrls, Menus;  
  
type  
  TForm1 = class(TForm)  
    GroupBox1: TGroupBox;  
    TI_Event: TLabel;  
    GroupBox2: TGroupBox;  
    TI_DC: TLabel;  
    GroupBox3: TGroupBox;  
    Icon: TImage;  
    IconFile: TEdit;  
    Browse: TButton;  
    Exit: TButton;  
    About: TButton;  
    OpenDialog1: TOpenDialog;  
    GroupBox4: TGroupBox;  
    ToolTip: TEdit;  
    SetToolTip: TButton;  
    AboutGroupBox: TGroupBox;  
    Desk: TLabel;  
    Author: TLabel;  
    Label3: TLabel;  
    Label4: TLabel;  
    email: TLabel;  
    www: TLabel;  
    procedure FormCreate(Sender: TObject);  
    procedure FormClose(Sender: TObject; var Action: TCloseAction);  
    procedure BrowseClick(Sender: TObject);  
    procedure ExitClick(Sender: TObject);  
    procedure SetToolTipClick(Sender: TObject);  
    procedure wwwClick(Sender: TObject);  
    procedure emailClick(Sender: TObject);  
    procedure AboutClick(Sender: TObject);  
  private  
    { Private declarations }  
  public  
    { Public declarations }  
   procedure IconCallBackMessage( var Mess : TMessage ); message WM_USER + 100;  
   //Здесь мы объявлем процедуру, которая будет выполнятся каждый раз, когда  
   //на иконке будет происходит какое-либо событие (клик мышки и т.п.)  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
procedure TForm1.FormCreate(Sender: TObject);  
var nid : TNotifyIconData;  
begin  
  //Добавляем иконку в трей при старте программы:  
  with nid do  //Указываем параметры иконки, для чего используем структуру  
               //TNotifyIconData.  
  begin  
    cbSize := SizeOf( TNotifyIconData ); //Размер все структуры  
    Wnd := Form1.Handle; //Здесь мы указывает Handle нашей главной формы  
                         //которая будет получать сообщения от иконки.  
    uID := 1;            //Идентификатор иконки  
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; //Обозначаем то, что в  
                                                  //параметры входят:  
                                                  //Иконка, сообщение и текст  
                                                  //подсказки (хинта).  
    uCallbackMessage := WM_USER + 100;            //Здесь мы указываем, какое  
                                                  //сообщение должна  высылать  
                                                  //иконочка нашей главной форме,  
                                                  //в тот момент, когда на ней  
                                                  //(иконке)  происходят  
                                                  //какие-либо события  
    hIcon := Application.Icon.Handle;             //Указываем на Handle  
                                                  //иконки (изображения)  
                                                  //(в данной случае берем  
                                                  //иконку основной формы  
                                                  //приложения. Ниже Вы увидите  
                                                  //как можно ее изменить)  
    StrPCopy(szTip, ToolTip.Text);                //Указываем текст всплывающей  
                                                  //посдказки, который берем из  
                                                  //компонента ToolTip,  
                                                  //расположенного на главной  
                                                  //форме.  
  end;  
  Shell_NotifyIcon( NIM_ADD, @nid );  
  //Собственно добавляем иконку в трей:)  
  //Обратите внимание, что здесь мы исползуем константу  
  //NIM_ADD (добавление иконки).  
  IconFile.Text:=Application.ExeName;  
  //Выводим на главной форме пусть к файлу, который содержит  
  //иконку (изображение):)  
  Icon.Picture.Icon:=Application.Icon;  
  //Теперь выводим на главной форме изображение  
  //иконки (изображения) в увеличенном виде  
end;  
  
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
var nid : TNotifyIconData;  
begin  
  with nid do  
  begin  
    cbSize := SizeOf( TNotifyIconData );  
    Wnd := Form1.Handle;  
    uID := 1;  
    uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;  
    uCallbackMessage := WM_USER + 100;  
    hIcon := Application.Icon.Handle;  
    StrPCopy(szTip, ToolTip.Text);  
  end;  
  Shell_NotifyIcon( NIM_DELETE, @nid );  
  //Удаляем иконку из трея. Параметры мы вводим для того,  
  //чтобы функция точно знала, какую именно иконку надо удалять.  
  //Обратите внимание, что здесь мы исползуем константу  
  //NIM_DELETE (удаление иконки).  
end;  
  
procedure TForm1.IconCallBackMessage( var Mess : TMessage );  
var Mouse: TMouse;  
begin  
  case Mess.lParam of  
    //Здесь Вы можете обрабатывать все события, происходящие на иконке:)  
    //На главнй форме я специально расположил две метки, в которых,  
    //при возникновении какого-либо события будет писаться что именно произошло:)  
    //Но, теперь во второй части во время некоторых событий будут происходит  
    //реальные процессы.  
    WM_LBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок левой кнопкой'       ;  
    WM_LBUTTONDOWN    : TI_Event.Caption:= 'Нажатие левой кнопки мыши'          ;  
    WM_LBUTTONUP      : TI_Event.Caption:= 'Отжатие левой кнопки мыши'          ;  
    WM_MBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок средней кнопкой мыши';  
    WM_MBUTTONDOWN    : TI_Event.Caption:= 'Нажатие средней кнопки мыши'        ;  
    WM_MBUTTONUP      : TI_Event.Caption:= 'Отжатие средней кнопки мыши'        ;  
    WM_MOUSEMOVE      : TI_Event.Caption:= 'Перемещение мыши'                   ;  
    WM_MOUSEWHEEL     : TI_Event.Caption:= 'Вращение колесика мыши'             ;  
    WM_RBUTTONDBLCLK  : TI_DC.Caption   := 'Двойной щелчок правой кнопкой'      ;  
    WM_RBUTTONDOWN    : TI_Event.Caption:= 'Нажатие правой кнопки мыши'         ;  
    WM_RBUTTONUP      : TI_Event.Caption:= 'Отжатие правой кнопки мыши'         ;  
  end;  
end;  
  
procedure TForm1.BrowseClick(Sender: TObject);  
var I   : TIcon;  
    nid : TNotifyIconData;  
begin  
  //Здесь мы меням иконку приложения, для чего используем диалоговое окно  
  //(для выбора файла, который содержит изображение иконки)  
  //Итак, все потизоньку:  
  if OpenDialog1.Execute then //Запуск диаголового окна  
  begin  
    I:=TIcon.Create; //Создаем объект I типа TIcon  
    I.LoadFromFile(OpenDialog1.Filename); //Теперь загружаем в него изображение  
                                          //из того файла, который был выбран в  
                                          //окне диалогового окна  
    //Далее делаем все тоже самое, что и раньше, создаем структуру типа  
    //TNotifyIconData куда заносим все параметры иконки:)  
    with nid do  
    begin  
      cbSize := SizeOf( TNotifyIconData );  
      Wnd := Form1.Handle;  
      uID := 1;  
      uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;  
      uCallbackMessage := WM_USER + 100;  
      hIcon := I.Handle;  
      StrPCopy(szTip, ToolTip.Text);  
    end;  
    Shell_NotifyIcon( NIM_MODIFY , @nid );  
    //А вот здесь мы заносим изменения в иконку, которая находится в системном  
    //трее обратите внимание, что здесь мы исползуем константу NIM_MODIFY  
    //(изменение иконки).  
    Icon.Picture.Icon:=I;  
    IconFile.Text:=OpenDialog1.FileName;  
    I.Free;  
  end;  
end;  
  
procedure TForm1.ExitClick(Sender: TObject);  
begin  
  //Закрываем приложение.   
  Close;  
end;  
  
procedure TForm1.SetToolTipClick(Sender: TObject);  
var nid : TNotifyIconData;  
begin  
  //Здесь мы назначаем всплывающую посказу:)  
  //Здесь все тоже самое, что и в предыдущей процедуре.  
  //Только иконка (изображение) берется из компонента Icon,  
  //который назодится на главной форме:)  
  //А текст всплывающей посказки берем из  
  //компонента ToolTip (который расположен на главной форме)  
  with nid do  
  begin  
      cbSize := SizeOf( TNotifyIconData );  
      Wnd := Form1.Handle;  
      uID := 1;  
      uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;  
      uCallbackMessage := WM_USER + 100;  
      hIcon := Icon.Picture.Icon.Handle;  
      StrPCopy(szTip, ToolTip.Text);  
  end;  
  Shell_NotifyIcon( NIM_MODIFY , @nid );  
  //.. и снова меням иконку:)  
end;  
  
//Далее идут процедуры, относящие работе сведений о программе  
//Тут нет ничего сложного :-)  
procedure TForm1.wwwClick(Sender: TObject);  
begin  
  ShellExecute(Application.Handle,'open','http://delphi.hostmos.ru',nil,nil,0);  
end;  
  
procedure TForm1.emailClick(Sender: TObject);  
begin  
  ShellExecute(Application.Handle,'open','mailto:srustik@rambler.ru',nil,nil,0);  
end;  
  
procedure TForm1.AboutClick(Sender: TObject);  
begin  
  if Form1.Width=250 then  
  begin  
    Form1.Width:=430;  
    About.Caption:='О Программе <<';  
  end  
  else begin  
    Form1.Width:=250;  
    About.Caption:='О Программе >>';  
  end;  
  AboutGroupBox.Visible:=not AboutGroupBox.Visible;  
end;  
  
end.  
end.  

Вот в принципе и все:) Надеюсь данная часть помогла Вам понять азы работы с системным треем:)

Автор: Рустик

Добавлено: 07 Августа 2018 07:42:27 Добавил: Андрей Ковальчук

Монитор, разрешения экрана

Масштабирование окон в зависимости от разрешения монитора
В ранней стадии создания приложения решите для себя хотите ли вы позволить форме масштабироваться. Преимущество немасштабируемой формы в том, что ничего не меняется во время выполнения. В этом же заключается и недостаток (ваша форма может бать слишком маленькой или слишком большой в некоторых случаях).
Если вы не собираетесь делать форму масштабируемой, установите свойство Scaled=False и дальше не читайте. В противном случае Scaled=True.
Установите AutoScroll=False. AutoScroll = True означает не менять размер окна формы при выполнении что не очень хорошо выглядит, когда содержимое формы меняет размер.
Установите шрифты формы на TrueType, например Arial. Если такого шрифта не окажется на пользовательском компьютере, то Windows выберет альтернативный шрифт из того же семейства. Этот шрифт может не совпадать по размеру, что вызовет проблемы.
Установите свойство Position в любое значение, отличное от poDesigned. poDesigned оставляет форму там, где она была во время дизайна, и, например, при разрешении 1280x1024 форма окажется в левом верхнем углу и совершенно за экраном при 800x600.
Оставляйте по-крайней мере 4 точки между компонентами, чтобы при смене положения границы на одну позицию компоненты не "наезжали" друг на друга. Для однострочных меток (TLabel) с выравниванием alLeft или alRight установите AutoSize=True. Иначе AutoSize=False.
Убедитесь, что достаточно пустого места у TLabel для изменения ширины шрифта - 25% пустого места многовато, зато безопасно. При AutoSize=False убедитесь, что ширина метки правильная, при AutoSize=True убедитесь, что есть ссвободное место для роста метки.
Для многострочных меток (word-wrapped labels), оставьте хотя бы одну пустую строку снизу.
Будьте осторожны при открытии проекта в среде Delphi при разных разрешениях. Свойство PixelsPerInch меняется при открытии формы. Лучше тестировать приложения при разных разрешениях, запуская готовый скомпилированный проект, а редактировать его при одном разрешении. Иначе это вызовет проблемы с размерами.
Не изменяйте свойство PixelsPerInch!
В общем, нет необходимости тестировать приложение для каждого разрешения в отдельности, но стоит проверить его на 800x600 с маленькими и большими шрифтами и на более высоком разрешении перед продажей.
Уделите пристальное внимание принципиально однострочным компонентам типа TDBLookupCombo. Многострочные компоненты всегда показывают только целые строки, а TEdit покажет урезанную снизу строку. Каждый компонент лучше сделать на несколько точек больше.
Масштабирование размера шрифтов
Когда программы написанные в Delphi работают на системах с установленными маленькими шрифтами, получается странный вид формы. К примеру, расположенные на форме компоненты Label становятся малы для размещения указанного теста, обрезая его в правой или нижней части. StringGrid не осуществляет положенного выравнивания и т.д. Следующий код масштабирует как размер формы, так и размер шрифтов. Вызывая его в FormCreate можно добиться не плохих результатов.

Приведенная ниже программа масштабирует форму так, чтобы она выглядела одинаково внезависимости от размера экрана и пикселей на дюйм. Расположенный ниже участок кода проверяет, отличается ли размер экрана во время выполнения от размера во время проектирования. Если да, Scaled устанавливается в True и компоненты снова масштабируются так, чтобы они выводились в той же позиции экрана, что и во время проектирования.

Так же необходимо проверить, отличается ли размер шрифта во времы выполнения от размера во время проектирования. Если во время выполнения PixelsPerInch формы отличается от PixelsPerInch во время проектирования, шрифты снова масштабируются так, чтобы форма не отличалась от той, которая была во время разработки. Масштабирование производится исходя из коэффициента, получаемого путем деления значения font.height во время проектирования на font.height во время выполнения. Font.size в этом случае работать не будет, так как это может дать результат больший, чем текущие размеры компонентов, при этом текст может оказаться за границами области компонента. Например, форма создана при размерах экрана 800x600 с установленными маленькими шрифтами, имеющими размер font.size=8. Когда вы запускаете в системе с 800x600 и большими шрифтами, font.size также будет равен 8, но текст будет больше чем при работе в системе с маленькими шрифтами. Данное масштабирование позволяет иметь один и тот же размер шрифтов при различных установках системы.

ВАЖНО! : Установите в Инспекторе Объектов свойство Scaled TForm в FALSE.


interface  
uses  
 Forms, Controls;  
  procedure geAutoScale(MForm: TForm);  
implementation  
type  
  TFooClass = class(TControl); //необходимо выяснить защищенность  
procedure geAutoScale(MForm: TForm);  
const  
 cScreenWidth: integer = 800;  
 сScreenHeight: integer = 600;  
 cPixelsPerInch: integer = 96;  
 cFontHeight: integer = -11; //В режиме проектирование значение из Font.Height  
var  
 i: integer;  
begin  
 if (Screen.width <> cScreenWidth) or (Screen.PixelsPerInch <> cPixelsPerInch) then  
  begin  
   MForm.scaled:= true;  
   MForm.height:= MForm.height * screen.Height div cScreenHeight;  
   MForm.width:= MForm.width * screen.width div cScreenWidth;  
   MForm.ScaleBy(screen.width, cScreenWidth);  
  end;  
 if (Screen.PixelsPerInch <> cPixelsPerInch) then  
  begin  
   for i:= MForm.ControlCount - 1 downto 0 do  
    TFooClass(MForm.Controls[i]).Font.Height:=  
    (MForm.Font.Height div cFontHeight) *  
    TFooClass(MForm.Controls[i]).Font.Height;  
  end;  
end;  
end.  

Добавлено: 04 Августа 2018 07:49:55 Добавил: Андрей Ковальчук

Какие есть директивы компилятора?

Директивы условной компиляции
{$C+} и {$C-} - директивы проверки утверждений
{$I+} и {$I-} - директивы контроля ввода/вывода
{$M} и {$S} - директивы, определяющие размер стека
{$M+} и {$M-} - директивы информации времени выполнения о типах
{$Q+} и {$Q-} - директивы проверки переполнения целочисленных операций
{$R} - директива связывания ресурсов
{$R+} и {$R-} - директивы проверки диапазона
{$APPTYPE CONSOLE} - директива создания консольного приложения

1) Директивы компилятора, разрешающие или запрещающие проверку утверждений.

По умолчанию {$C+} или {$ASSERTIONS ON}

Область действия локальная

Описание

Директивы компилятора $C разрешают или запрещают проверку утверждений. Они влияют на работу процедуры Assert,используемой при отладке программ. По умолчанию действует
директива {$C+} и процедура Assert генерирует исключение EAssertionFailed, если проверяемое утверждение ложно.

Так как эти проверки используются только в процессе отладки программы, то перед ее окончательной компиляцией следует указать директиву {$C-}. При этом работа процедур Assert будет блокировано и генерация исключений EassertionFailed производиться не будет.

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

2) Директивы компилятора, включающие и выключающие контроль файлового ввода-вывода.

По умолчанию {$I+} или {$IOCHECKS ON}

Область действия локальная

Описание

Директивы компилятора $I включают или выключают автоматический контроль результата вызова процедур ввода-вывода Object Pascal. Если действует директива {$I+}, то при возвращении процедурой ввода-вывода ненулевого значения генерируется
исключение EInOutError и в его свойство errorcode заносится код ошибки. Таким образом, при действующей директиве {$I+} операции ввода-вывода располагаются в блоке try...except, имеющем обработчик исключения EInOutError. Если такого блока нет, то обработка производится методом TApplication.HandleException.

Если действует директива {$I-}, то исключение не генерируется. В этом случае проверить, была ли ошибка, или ее не было, можно, обратившись к функции IOResult. Эта функция очищает ошибку и возвращает ее код, который затем можно анализировать. Типичное применение директивы {$I-} и функции IOResult демонстрирует следующий пример:


{$I-}  
  
AssignFile(F,s);  
Rewrite(F);  
  
{$I+}  
i:=IOResult;  
if i<>0 then  
  
case i of  
      2: ..........  
      3: ..........  
   end;   

В этом примере на время открытия файла отключается проверка ошибок ввода вывода, затем она опять включается, переменной i присваивается значение, возвращаемое функцией IOResult и, если это значение не равно нулю (есть ошибка), то предпринимаются какие-то действия в зависимости от кода ошибки. Подобный стиль программирования был типичен до введения в Object Pascal механизма обработки исключений. Однако сейчас, по-видимому, подобный стиль устарел и применение директив $I потеряло былое значение.

3) Директивы компилятора, определяющие размер стека

По умолчанию {$M 16384,1048576}

Область действия глобальная

Описание

Локальные переменные в процедурах и функциях размещаются в стеке приложения. При каждом вызове процедуры или функции ее локальные переменные помещаются в стек. При выходе из процедуры или функции эти локальные процедуры удаляются из стека.
Директивы компилятора $M задают параметры стека приложения: его минимальный и максимальный размеры. Приложение всегда гарантированно имеет размер стека, равный его минимальной величине. Если при запуске приложения Windows обнаруживает, что не может
выделить этот минимальный объем памяти, то выдается сообщение об этой ошибке.

Если во время работы выясняется, что минимального размера стека не хватает, то размер увеличивается на 4 K, но не более, чем до установленного директивой максимального размера. Если увеличение размера стека невозможно из-за нехватки памяти или из-за достижения его максимальной величины, генерируется исключение EStackOverflow. Минимальный размер стека по умолчанию равен 16384 (16K). Этот размер может изменяться параметром minstacksize
директивы {$M} или параметром number директивы {$MINSTACKSIZE}.

Максимальный размер стека по умолчанию равен 1,048,576 (1M). Этот размер может изменяться параметром maxstacksize директивы {$M} или параметром number директивы {$MAXSTACKSIZE number}. Значение минимального размера стека может задаваться целым числом в диапазоне между1024 и 2147483647. Значение максимального размера стека должно быть не менее минимального размера и не более 2147483647. Директивы задания размера стека могут включаться только в программу и не должны использоваться в библиотеках и модулях.

В Delphi 1 имеется процедура компилятора {$S}, осуществляющая переключение контроля переполнения стека. Теперь этот процесс полностью автоматизирован и директива {$S} оставлена только для обратной совместимости.

4) Директивы компилятора, включающие и выключающие генерацию информации времени выполнения о типах (runtime type information - RTTI).

По умолчанию {$M-} или {$ TYPEINFO OFF}

Область действия локальная

Описание

Директивы компилятора $I включают или выключают генерацию информации времени выполнения о типах (runtime type information - RTTI). Если класс объявляется в состоянии {$M+} или является производным от класса объявленного в этом состоянии, то компилятор генерирует RTTI о его полях, методах и свойствах, объявленных в разделе published. В противном
случае раздел published в классе не допускается. Класс TPersistent, являющийся предшественником большинства классов Delphi и все классов компонентов, объявлен в модуле Classes в состоянии {$M+}. Так что для всех классов, производных от него, заботиться о директиве {$M+}не приходится.

5) Директивы компилятора, включающие и выключающие проверку переполнения при целочисленных операциях

По умолчанию {$Q-} или {$OVERFLOWCHECKS OFF}

Область действия локальная

Описание

Директивы компилятора $Q включают или выключают проверку переполнения при целочисленных операциях. Под переполнением понимается получение результата, который не может сохраняться в регистре компьютера. При включенной директиве {$Q+} проверяется переполнение при целочисленных операциях +, -, *, Abs, Sqr, Succ, Pred, Inc и Dec. После каждой из этих операций размещается код, осуществляющий соответствующую проверку. Если обнаружено переполнение,
то генерируется исключение EIntOverflow. Если это исключение не может быть обработано, выполнение программы завершается.

Директивы $Q проверяют только результат арифметических операций. Обычно они используются совместно с директивами {$R}, проверяющими диапазон значений при присваивании.
Директива {$Q+} замедляет выполнение программы и увеличивает ее размер. Поэтому обычно она используется только во время отладки программы. Однако, надо отдавать себе отчет, что отключение этой директивы приведет к появлению ошибочных результатов расчета в случаях, если переполнение действительно произойдет во время выполнении программы. Причем сообщений о подобных ошибках не будет.

6) Директива компилятора, связывающая с выполняемым модулем файлы ресурсов

Область действия локальная

Описание

Директива компилятора {$R} указывает файлы ресурсов (.DFM, .RES), которые должны быть включены в выполняемый модуль или в библиотеку. Указанный файл должен быть файлом ресурсов Windows. По умолчанию расширение файлов ресурсов - .RES. В процессе компоновки компилированной программы или библиотеки файлы, указанные в директивах {$R}, копируются в
выполняемый модуль. Компоновщик Delphi ищет эти файлы сначала в том каталоге, в котором расположен модуль, содержащий директиву {$R}, а затем в каталогах, указанных при выполнении команды главного меню Project | Options на странице Directories/Conditionals диалогового окна в опции Search path или в опции /R командной строки DCC32.

При генерации кода модуля, содержащего форму, Delphi автоматически включает в файл .pas директиву {$R *.DFM}, обеспечивающую компоновку файлов ресурсов форм. Эту директиву нельзя удалять из текста модуля, так как в противном случае загрузочный модуль не будет создан и сгенерируется исключение EResNotFound.

7) Директивы компилятора, включающие и выключающие проверку диапазона целочисленных значений и индексов

По умолчанию {$R-} или {$RANGECHECKS OFF}

Область действия локальная

Описание

Директивы компилятора $R включают или выключают проверку диапазона целочисленных значений и индексов. Если включена директива {$R+}, то все индексы массивов и строк и все присваивания скалярным переменным и переменным с ограниченным диапазоном значений проверяются на соответствие значения допустимому диапазону. Если требования
диапазона нарушены или присваиваемое значение слишком велико, генерируется исключение ERangeError. Если оно не может быть перехвачено, выполнение программы завершается.

Проверка диапазона длинных строк типа Long strings не производится.
Директива {$R+} замедляет работу приложения и увеличивает его размер. Поэтому она обычно используется только во время отладки.

8) Директива компилятора, связывающая с выполняемым модулем файлы ресурсов

Область действия локальная

Описание

Директива компилятора {$R} указывает файлы ресурсов (.DFM, .RES), которые должны быть включены в выполняемый модуль или в библиотеку. Указанный файл должен быть файлом ресурсов Windows. По умолчанию расширение файлов ресурсов - .RES.
В процессе компоновки компилированной программы или библиотеки файлы, указанные в директивах {$R}, копируются в выполняемый модуль. Компоновщик Delphi ищет эти файлы сначала в том каталоге, в котором расположен модуль, содержащий директиву {$R}, а затем в каталогах, указанных при выполнении команды главного меню Project | Options на странице Directories/Conditionals диалогового окна в опции Search path или в опции /R командной строки DCC32.

При генерации кода модуля, содержащего форму, Delphi автоматически включает в файл .pas директиву {$R *.DFM}, обеспечивающую компоновку файлов ресурсов форм. Эту директиву нельзя удалять из текста модуля, так как в противном случае загрузочный модуль не будет создан и сгенерируется исключение EResNotFound.

Добавлено: 02 Августа 2018 08:03:06 Добавил: Андрей Ковальчук

Использование HOOK в Дельфи

Что такое НООК?
НООК - это механизм перехвата сообщений, предоставляемый системой Microsoft Windows. Программист пишет специального вида функцию (НООК-функция), которая затем при помощи функции SetWindowsHookEx вставляется на верх стека НООК-функций системы. Ваша НООК-функция сама решает, передать ли ей сообщение в следующую НООК-функцию при помощи CallNextHookEx или нет.

Какие бывает НООК'и?
НООК бывают глобальные, контролирующие всю систему, так и локальные, ориентированные на какой-либо поток (Thread). Кроме того НООК различаются по типу перехватываемых сообщений (подробнее об этом - ниже). НООК несколько подтормаживают систему, поэтому ставить их рекомендуется только при необходимости, и кактолько необходимость в них отпадает - удалять.

Как создавать НООК?
НООК устанавливается в систему при помощи функции SetWindowsHookEx, вот её заголовок: function SetWindowsHookEx(idHook: Integer; lpfn: TFNHookProc; hmod: HINST; dwThreadId: DWORD): HHOOK;

idHook
константа, определяющая тип вставляемого НООК'а, должна быть одна из нижеследующих констант:
WH_CALLWNDPROC
вставляемая НООК-функция следит за всеми сообщения перед их отпралением в соответствующую оконную функцию
WH_CALLWNDPROCRET
вставляемая НООК-функция следит за всеми сообщениями после их отправления в оконную функцию
WH_CBT
вставляемая НООК-функция следит за окнами, а именно: за созданием, активацией, уничтожением, сменой размера; перед завершением системной команды меню, перед извлечением события мыши или клавиатуры из очереди сообщений, перед установкой фокуса и т.д.
WH_DEBUG
вставляемая НООК-функция следит за другими НООК-функциями.
WH_GETMESSAGE
вставляемая НООК-функция следит за сообщениями, посылаемыми в очередь сообщений.
WH_JOURNALPLAYBACK
вставляемая НООК-функция посылает сообщения, записанные до этого WH_JOURNALRECORD НООК'ом.
WH_JOURNALRECORD
эта НООК-функция записывает все сообщения куда-либо в специальном формате, причем позже они могут быть "воспроизведены" при помощи НООК'а WH_JOURNALPLAYBACK. Это в некотором роде аналог магнитофонной записи сообщений.
WH_KEYBOARD
вставляемая НООК-функция следит за сообщениями клавиатуры
WH_MOUSE
вставляемая НООК-функция следит за сообщениями мыши
WH_MSGFILTER
WH_SHELL
WH_SYSMSGFILTER
lpfn
указатель на непосредственно функцию. Обратите внимание, что если Вы ставите глобальный НООК, то НООК-функция обязательно должна находиться в некоторой DLL!!!
hmod
описатель DLL, в которой находится код функции.
dwThreadId
идентификатор потока, в который вставляется НООК
Подробнее о НООК-функциях сотри справку по Win32API.

Как удалять НООК?
НООК удаляется при помощи функции UnHookWindowsEx.

Пример использования НООК.
Ставим НООК, следящий за мышью (WH_MOUSE). Программа следит за нажатием средней кнопки мыши, и когда она нажимается, делает окно, находящееся непосредственно под указателем, поверх всех остальных (TopMost). Код самой НООК-функции помещен в библиотеку lib2.dll, туда же помещены и функции Start - для установки НООК, и Remove - для удаления НООК.

Файл sticker.dpr

program sticker;  
  
uses windows, messages;  
  
  
var wc : TWndClassEx;  
MainWnd : THandle;  
Mesg : TMsg;  
//экспортируем две функции из библиотеки с НООК'ами  
procedure Start; external 'lib2.dll' name 'Start';  
procedure Remove; external 'lib2.dll' name 'Remove';  
  
function WindowProc(wnd:HWND; Msg : Integer; Wparam:Wparam; Lparam:Lparam):Lresult; stdcall;  
var nCode, ctrlID : word;  
Begin  
case msg of  
wm_destroy :  
Begin  
Remove;//удаляем НООК  
postquitmessage(0); exit;  
Result:=0;  
End;  
  
else Result:=DefWindowProc(wnd,msg,wparam,lparam);  
end;  
End;  
  
  
begin  
  
wc.cbSize:=sizeof(wc);  
wc.style:=cs_hredraw or cs_vredraw;  
wc.lpfnWndProc:=@WindowProc;  
wc.cbClsExtra:=0;  
wc.cbWndExtra:=0;  
wc.hInstance:=HInstance;  
wc.hIcon:=LoadIcon(0,idi_application);  
wc.hCursor:=LoadCursor(0,idc_arrow);  
wc.hbrBackground:=COLOR_BTNFACE+1;  
wc.lpszMenuName:=nil;  
wc.lpszClassName:='WndClass1';  
  
RegisterClassEx(wc);  
  
  
MainWnd:=CreateWindowEx(0,'WndClass1',  
'Caption',  
ws_overlappedwindow,  
cw_usedefault,cw_usedefault,cw_usedefault,cw_usedefault,0,0,  
Hinstance,nil);  
  
  
ShowWindow(MainWnd,CmdShow);  
  
Start;//вставляем НООК  
  
While GetMessage(Mesg,0,0,0) do  
begin  
TranslateMessage(Mesg);  
DispatchMessage(Mesg);  
end;  
  
end.  

Файл lib2.dpr


library lib2;  
  
  
uses  
windows, messages;  
var  
pt : TPoint;  
theHook : THandle;  
  
function MouseHook(nCode, wParam, lParam : integer) : Lresult; stdcall;  
var  
msg : PMouseHookStruct;  
w : THandle;  
style : integer;  
  
Begin  
if nCode<0 then begin  
result := CallNextHookEx(theHook, nCode, wParam, lParam);  
exit;  
end;  
msg := PMouseHookStruct(lParam);  
  
case wParam of  
WM_MBUTTONDOWN : pt := msg^.pt;  
WM_MBUTTONUP : begin  
w := WindowFromPoint(pt);  
style := GetWindowLong(w, GWL_EXSTYLE);  
if (style and WS_EX_TOPMOST) <> 0 then begin  
//уже поверх всех - сделать обычным  
ShowWindow(w, sw_hide);  
SetWindowPos(w, HWND_NOTOPMOST, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE OR SWP_SHOWWINDOW);  
end  
else begin  
//сделать поверх остальных   
ShowWindow(w, sw_hide);  
SetWindowPos(w, HWND_TOPMOST, 0,0,0,0, SWP_NOMOVE OR SWP_NOSIZE OR SWP_SHOWWINDOW);  
end;  
  
end;  
end;  
  
  
result := CallNextHookEx(theHook, nCode, wParam, lParam);  
End;  
  
  
procedure Start;  
begin  
  
theHook := SetWindowsHookEx(wh_mouse, @mouseHook, hInstance, 0);  
if theHook = 0 then messageBox(0,'Error!','Error!',mb_ok);  
end;  
  
procedure Remove;  
begin  
UnhookWindowsHookEx(theHook);  
end;  
  
exports  
Start index 1 name 'Start',  
Remove index 2 name 'Remove';  
  
end.  

Всё.

Добавлено: 02 Августа 2018 07:53:24 Добавил: Андрей Ковальчук

Интерфейс переноса Drag-and-Drop

Интерфейс переноса и приема компонентов появился достаточно давно. Он обеспечивает взаимодействие двух элементов управления во время выполнения приложения. При этом могут выполняться любые необходимые операции. Несмотря на простоту реализации и давность разработки, многие программисты (особенно новички) считают этот механизм малопонятным и экзотическим. Тем не менее использование Drag-and-Drop может оказаться очень полезным и простым в реализации. Сейчас мы в этом убедимся.

Для того чтобы механизм заработал, требуется настроить соответствующим образом два элемента управления. Один должен быть источником (Source), второй — приемником (Target). При этом источник никуда не перемещается, а только регистрируется в качестве такового в механизме.

Примечание

Один элемент управления может быть одновременно источником и приемником.

Пользователь помещает указатель мыши на нужный элемент управления, нажимает левую кнопку мыши и, не отпуская ее, начинает перемещать курсор ко второму элементу. При достижении этого элемента пользователь отпускает кнопку мыши. В этот момент выполняются предусмотренные разработчиком действия. При этом первый элемент управления является источником, а второй — приемником.

После выполнения настройки механизм включается и реагирует на перетаскивание мышью компонента-источника в приемник. Группа методов-обработчиков обеспечивает контроль всего процесса и служит для хранения исходного кода, который разработчик сочтет нужным связать с перетаскиванием. Это может быть передача текста, значений свойств (из одного редактора в другой можно передать настройки интерфейса, шрифта и сам текст); перенос файлов и изображений; простое перемещение элемента управления с места на место и т. д. Пример реализации Drag-and-Drop в Windows — возможность переноса файлов и папок между дисками и папками.

Как видите, можно придумать множество областей применения механизма Drag-and-Drop. Его универсальность объясняется тем, что это всего лишь средство связывания двух компонентов при помощи указателя мыши. А конкретное наполнение зависит только от фантазии программиста и поставленных задач.

Весь механизм Drag-and-Drop реализован в базовом классе TControl, который является предком всех элементов управления. Рассмотрим суть механизма.

Любой элемент управления из Палитры компонентов Delphi является источником в механизме Drag-and-Drop. Его поведение на начальном этапе переноса зависит от значения свойства


type TDragMode = (dmManual, dmAutomatic);  
property DragMode: TDragMode;  

Значение dmAutomatic обеспечивает автоматическую реакцию компонента на нажатие левой кнопки мыши и начало перетаскивания — при этом механизм включается самостоятельно.

Значение dmManual (установлено по умолчанию) требует от разработчика обеспечить включение механизма вручную. Этот режим используется в том случае, если компонент должен реагировать на нажатие левой кнопки мыши как-то иначе. Для инициализации переноса используется метод


procedure BeginDrag(Immediate: Boolean;  
Threshold: Integer = -1); 

Параметр immediate = True обеспечивает немедленный старт механизма. При значении False механизм включается только при перемещении курсора на расстояние, определенное параметром Threshold.

О включении механизма сигнализирует указатель мыши — он изменяется на курсор, определенный в свойстве


property DragCursor: TCursor;   

Еще раз напомним, что источник при перемещении курсора не изменяет собственного положения, и только в случае успешного завершения переноса сможет взаимодействовать с приемником.

Приемником может стать любой компонент, в котором создан метод-обработчик


procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;  
var Accept: Boolean);  

Он вызывается при перемещении курсора в режиме Drag-and-Drop над этим компонентом. В методе-обработчике можно предусмотреть селекцию источников переноса по нужным атрибутам.

Если параметр Accept получает значение True, то данный компонент становится приемником. Источник переноса определяется параметром source. Через этот параметр разработчик получает доступ к свойствам и методам источника. Текущее положение курсора задают параметры X и Y. Параметр state возвращает информацию о характере движения мыши:


type TDragState = (dsDragEnter, dsDragLeave, dsDragMove); 

dsDragEnter — указатель появился над компонентом; dsDragLeave — указатель покинул компонент; dsDragMove — указатель перемещается по компоненту.

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


type TDragDropEvent = procedure(Sender, Source: TObject; X, Y: Integer)  
of object;  
property OnDragDrop: TDragDropEvent;  

который вызывается при отпускании левой кнопки мыши на компоненте-приемнике. Доступ к источнику и приемнику обеспечивают параметры Source и Sender соответственно. Координаты мыши возвращают параметры X и Y.

При завершении переноса элемент управления — источник — получает соответствующее сообщение, которое обрабатывается методом


type TEndDragEvent = procedure(Sender, Target: TObject; X, Y: Integer)  
of object;  
property OnEndDrag: TEndDragEvent;  

Источник и приемник определяются параметрами Sender и Target соответственно. Координаты мыши определяются параметрами X и Y.

Для программной остановки переноса можно использовать метод EndDrag источника (при обычном завершении операции пользователем он не используется):


procedure EndDrag(Drop: Boolean);   

Теперь настало время закрепить полученные знания на практике. Рассмотрим небольшой пример. В проекте DemoDragDrop на основе механизма Drag-and-Drop реализована передача текста между текстовыми редакторами и перемещение панелей по форме (рис. 27.1).

implementation  
{$R *.DFM)  
procedure TMainForm.EditlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, У: Integer);  
begin if Button = mbLeft  
then TEdit(Sender).BeginDrag(True);  
end;  
procedure TMainForm.Edit2DragOver(Sender, Source: TObject; X, Y: Integer;  
State: TDragState; var Accept: Boolean);  
begin  
if Source is TEdit  
then Accept := True  
else Accept :<= False;  
end;  
procedure TMainForm.Edit2DragDrop(Sender, Source: TObject; X, Y:  
Integer);  
begin  
TEdit(Sender).Text := TEdit(Source).Text;  
TEdit(Sender).SetFocus;  
TEdit(Sender).SelectAll;  
end;  
procedure TMainForm.EditlEndDrag(Sender, Target: TObject; X, Y: Integer);  
begin if Assigned(Target)  
then TEdit(Sender).Text := 'Текст перенесен в ' + TEdit(Target).Name;  
end;  
procedure TMainForm.FormDragOver(Sender, Source: TObject; X, Y: Integer;  
State: TDragState; var Accept: Boolean); begin if Source.ClassName = 'TPanel'  
then Accept := True  
else Accept := False;  
end;  
procedure TMainForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);  
begin  
TPanel(Source).Left := X;  
TPanel(Source).Top := Y;  
end;  
end.  

Для однострочного редактора Edit1 определены методы-обработчики источника. В методе EditiMouseDown обрабатывается нажатие левой кнопки мыши

и включается механизм переноса. Так как свойство DragMode для Edit1 имеет значение dmManual, то компонент без проблем обеспечивает получение фокуса и редактирование текста.

Метод EditiEndDrag обеспечивает отображение информации о выполнении переноса в источнике.

Для компонента Edit2 определены методы-обработчики приемника. Метод Edit2DragOver проверяет класс источника и разрешает или запрещает прием.

Метод Edit2DragDrop осуществляет перенос текста из источника в приемник.

Примечание

Обратите внимание, что оба компонента TEdit одновременно являются источниками и приемниками. Для этого каждый из них использует методы-обработчики другого. А исходный код методов настроен на обработку владельца как экземпляра класса TEdit.

Форма, как приемник Drag-and-Drop, обеспечивает перемещение панели Panel2, которая выступает в роли источника. Метод FormDragOver запрещает прием любых компонентов, кроме панелей. Метод FormDragDrop осуществляет перемещение компонента.

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

Добавлено: 02 Августа 2018 07:49:39 Добавил: Андрей Ковальчук

Отображение округленного окошка подсказок для значка приложения в System Tray

В Windows 2000 и выше, формат структуры NotifyIconData, которая используется для работы с иконками в Трее (которая, кстати, называется "The Taskbar Notification Area") значительно отличается от предыдущий версий Windows. Однако, эти изменения НЕ отражены в юните ShellAPI.pas в Delphi 5.

Итак, нам понадобится преобразованный SHELLAPI.H, в котором присутствуют все необходимые объявления:


uses Windows;  
   
type  
  NotifyIconData_50 = packed record // определённая в shellapi.h  
  cbSize: DWORD;  
  Wnd: HWND;  
  uID: UINT;  
  uFlags: UINT;  
  uCallbackMessage: UINT;  
  hIcon: HICON;  
  szTip: array[0..MAXCHAR] of AnsiChar;  
  dwState: DWORD;  
  dwStateMask: DWORD;  
  szInfo: array[0..MAXBYTE] of AnsiChar;  
  uTimeout: UINT; // union with uVersion: UINT;  
  szInfoTitle: array[0..63] of AnsiChar;  
  dwInfoFlags: DWORD;  
end{record};  
   
const  
  NIF_INFO = $00000010;  
   
  NIIF_NONE = $00000000;  
  NIIF_INFO = $00000001;  
  NIIF_WARNING = $00000002;  
  NIIF_ERROR = $00000003;  

А это набор вспомогательных типов:

type  
  TBalloonTimeout = 10..30{seconds};  
  TBalloonIconType = (bitNone, // нет иконки  
  bitInfo, // информационная иконка (синяя)  
  bitWarning, // иконка восклицания (жёлтая)  
  bitError); // иконка ошибки (красная)  

Теперь мы готовы приступить к созданию округлённых подсказок! Для этого воспользуемся следующей функцией:

uses SysUtils, Windows, ShellAPI;  
   
function BalloonTrayIcon(const Window: HWND; const IconID: Byte;   
  
const Timeout: TBalloonTimeout; const BalloonText,  
BalloonTitle: String; const BalloonIconType: TBalloonIconType): Boolean;  
const  
  aBalloonIconTypes : array[TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);  
var  
  NID_50 : NotifyIconData_50;  
begin  
  FillChar(NID_50, SizeOf(NotifyIconData_50), 0);  
  with NID_50 do  
  begin  
    cbSize := SizeOf(NotifyIconData_50);  
    Wnd := Window;  
    uID := IconID;  
    uFlags := NIF_INFO;  
    StrPCopy(szInfo, BalloonText);  
    uTimeout := Timeout * 1000;  
    StrPCopy(szInfoTitle, BalloonTitle);  
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];  
  end{with};  
  Result := Shell_NotifyIcon(NIM_MODIFY, @NID_50);  
end;  

Вызывается она следующим образом:

BalloonTrayIcon(Form1.Handle, 1, 10, 'this is the balloon text', 'title', bitWarning);  

Иконка, должна быть предварительно добавлена с тем же дескриптором окна и IconID (в данном примере Form1.Handle и 1).

Можете попробовать все три типа иконок внутри всплывающей подсказки.

Несколько заключительных замечаний:

Нет необходимости использовать большую структуру NotifyIconData_50 для добавления или удаления иконок, старая добрая структура NotifyIconData прекрасно подойдёт для этого.
Для callback сообщения можно использовать WM_APP + что-нибудь.
Используя различные IconID, легко можно добавить несколько различных иконок из одного родительского окна и работать с ними по их IconID.

Добавлено: 02 Августа 2018 07:43:52 Добавил: Андрей Ковальчук

Секреты Delphi. Менеджер памяти

Я думаю, ни для кого не секрет, что некоторый запас свободной оперативной памяти для работы приложений влияет на производительность. Оптимизировать процесс распределения памяти между программами можно установкой специальных сервисов, которые периодически сбрасывают часть данных в своп-файл. Особенно это актуально на компьютерах с небольшим объемом оперативной памяти.

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


function BS_FreeMem(const aBuf Size: Integer):boolean;  
var  
tmpBuffer: PChar;  
begin  
result:=true;  
try  
//Выделяем буфер заданного размера  
GetMem(tmpBuffer, aBufSize);  
try  
//Заполняем буфер нулями для имитации его использования  
FillChar(tmpBuffer^, aBufSize, 0);   
finally  
FreeMem(tmpBuffer);  
end;  
except  
result:=false;  
end;  
end;  

На машинах класса Windows NT можно попробовать воспользоваться API-функцией SetProcessWorkingSetSize.
Вызов данной функции со значениями параметров dwMinimumWorkingSetSize и dwMaximumWorkingSetSize, равными $FFFFFFFF, вызывает сброс страниц памяти, занятых процессом, в своп-файл. Например:


SetProcessWorkingSetSize (GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);  

Вызывать созданную фунцию можно по таймеру, например:


procedure TfrmMain.Digital ClockMinute (Sender: TObject; DDGTime: TDateTime);  
var  
MemStat:TMemoryStatus;  
fMemPercent:Extended;  
bufSize:Variant;  
oldHint:String;  
oldCursor:TCursor;  
begin  
//Глобальная переменная, определяющая активность функции  
if gInternalMemManager then  
begin  
MemStat.dwLength := SizeOf (TMemory Status);  
GlobalMemoryStatus(Mem Stat);  
fMemPercent:=(MemStat.dw TotalPhys-MemStat.dwAvailPhys);  
fMemPercent:=fMemPercent* 100/MemStat. dwTotalPhys;  
//Вызываем функцию, при загрузке памяти более 90%  
if fMemPercent > 90 then  
try  
oldHint:=Application. Hint;  
oldCursor:=Screen. Cursor;  
Screen.Cursor:=crHour Glass;  
Application.Hint:='Освобождение оперативной памяти..';  
//вычисляем размер выделяемого буфера  
bufSize:=(MemStat.dwTo-talPhys-MemStat.dwAvailPhys)/2;  
BS_FreeMem(Integer (buf Size));  
finally  
Application.Hint:=oldHint;  
Screen.Cursor:=oldCursor;  
end;  
end;   
end; 

Следует заметить, что на 100% проблема не решается, так как на освобождение памяти требуется некоторое время, и вызов функции освобождения памяти может произойти в неподходящий момент — например, когда пользователь вводит данные и не смотрит на экран. Буду признателен за возможные идеи решения поставленной задачи.

Автор: Сергей Бердачук

Добавлено: 02 Августа 2018 07:40:57 Добавил: Андрей Ковальчук

Отлавливаем нажатие калавиш клавиатуры

В этом коротком уроке я покажу вам, как перехватывать нажатия кнопок клавиатуры. Пригодиться он для написания простенького клавиатурного шпиона, который бы отлавливал нажатия клавиш и вёл лог. Можно написать просто небольшой прикол типа если пользователь нажимает клавишу "Ф" то на экране появляется "И". Короче я думаю фантазия у вас работает нормально поэтому применение этому коду вы найдете.

Начинаем кодить, нам понадобиться: Компонент Timer с закладки System и компонент Label с закладки Standart. Выделяем Timer, создаем, обработчик событий OnTime и прописываем в нем следующий код:


if getasynckeystate($1b)<>0 then  
Label1.Caption:='Вы нажали ESC' 

Вот что должно получиться:


procedure TForm1.Timer1Timer(Sender: TObject);  
begin  
if getasynckeystate($1b)<>0 then  
Label1.Caption:='Вы нажали ESC'  
end;  

В данном примере мы перехватываем нажатие клавиши ESC во всем Windows и побарабану активна или нет наша программа. Используем мы здесь Api функцию getasynckeystate, в качестве параметра ей нужно указать виртуальный код клавиши, котрую хотим отлавливать. В нашем случае это Esc виртуальный код $1b. Все виртуальные коды клавиш приведены ниже:

Да чуть не забыл, свойство Interval у компонента Timer меняем на 1


vk_lbutton = $01;  
vk_rbutton = $02;  
vk_cancel = $03;  
vk_mbutton = $04;  
vk_back = $08;  
vk_tab = $09;  
vk_clear = $0c;  
vk_return = $0d;  
vk_shift = $10;  
vk_control = $11;  
vk_menu = $12;  
vk_pause = $13;  
vk_capital = $14;  
vk_escape = $1b;  
vk_space = $20;  
vk_prior = $21;  
vk_next = $22;  
vk_end = $23;  
vk_home = $24;  
vk_left = $25;  
vk_up = $26;  
vk_right = $27;  
vk_down = $28;  
vk_select = $29;  
vk_print = $2a;  
vk_execute = $2b;  
vk_snapshot = $2c;  
vk_insert = $2d;  
vk_delete = $2e;  
vk_help = $2f;  
>> vk_a - vk_z такие же, как и их ascii-эквиваленты: 'a' - 'z' ($41 - $5A)<<
>> vk_0 - vk_9 такие же, как и их ascii-эквиваленты: '0' - '9' ($30 - $39)}


vk_numpad0 = $60;  
vk_numpad1 = $61;  
vk_numpad2 = $62;  
vk_numpad3 = $63;  
vk_numpad4 = $64;  
vk_numpad5 = $65;  
vk_numpad6 = $66;  
vk_numpad7 = $67;  
vk_numpad8 = $68;  
vk_numpad9 = $69;  
vk_multiply = $6a;  
vk_add = $6b;  
vk_separator = $6c;  
vk_subtract = $6d;  
vk_decimal = $6e;  
vk_divide = $6f;  
vk_f1 = $70;  
vk_f2 = $71;  
vk_f3 = $72;  
vk_f4 = $73;  
vk_f5 = $74;  
vk_f6 = $75;  
vk_f7 = $76;  
vk_f8 = $77;  
vk_f9 = $78;  
vk_f10 = $79;  
vk_f11 = $7a;  
vk_f12 = $7b;  
vk_f13 = $7c;  
vk_f14 = $7d;  
vk_f15 = $7e;  
vk_f16 = $7f;  
vk_f17 = $80;  
vk_f18 = $81;  
vk_f19 = $82;  
vk_f20 = $83;  
vk_f21 = $84;  
vk_f22 = $85;  
vk_f23 = $86;  
vk_f24 = $87;  
vk_numlock = $90;  
vk_scroll = $91;  

Добавлено: 02 Августа 2018 07:37:00 Добавил: Андрей Ковальчук

Работа с буфером обмена

Каждый юзер наверняка сталкивался с помещением информации в буфер и извлечением ее оттуда. Тот же пресловутый Ворд при нажатии кнопки "копировать" помещает выделенный текст в буфер, а при нажатии "вставить" - извлекает его. Таким же образом помещаться в буфер могут изображения и данные разных форматов. Итак, буфер - это специальная область оперативной памяти в которую Windows помещает пользовательские данные для обмена между разными приложениями или внутри одного приложения.

Для того, чтобы работать с буфером обмена из Delphi, необходимо подключить к своему приложению модуль clipbrd.pas, то есть пишем в uses clipbrd.pas,...

РАБОТА С ТЕКСТОМ
Самый простой способ поместить в буфер обмена какой-либо текст - это добавить следующий код:


Clipboard.asText:='ВАШ_ТЕКСТ'; 

или


Clipboard.SetTextBuf(PChar('ВАШ_ТЕКСТ'));  

Чтобы извлечь текст из буфера, можно сделать так (поместим текст в Memo1:TMemo):


Memo1.Text:=Clipboard.asText;  

РАБОТА С ИЗОБРАЖЕНИЯМИ
Если вы работаете с компонентом Image1:Timage, то самым простым способом поместить в него изображение из буфера будет присвоение хэндла данных Clipboard'a хэндлу Tbitmap:


Image1.Picture.Bitmap.Handle:=Clipboard.GetAsHandle(CF_bitmap); 

КАК УЗНАТЬ ФОРМАТ ДАННЫХ БУФЕРА В ДАННЫЙ МОМЕНТ
Для этого существует специальная функция Clipboard.HasFormat(Format: WORD):boolean;
Функция возвращает true, если в буфере именно этот формат, в противном случает возвращает false.
Описание форматов:
CF_TEXT - Обычный текст, заканчивающийся <CR><LF>
CF_BITMAP - Битмап изображение *.bmp
CF_METAFILEPICT - Метафайл изображение *.wmf
CF_PICTURE - Объект типа TPicture
CF_COMPONENT - Компонента Delphi (Tbutton, например)
CF_OBJECT - Любой объект в Delphi типа TPersistent

ОЧИЩАЕМ БУФЕР
Чтобы очистить буфер обмена от содержащихся в нем данных, используйте процедуру Clipboard.clear;
ОТКРЫВАЕМ // ЗАКРЫВАЕМ
Если вы хотите, чтобы все приложения, кроме вашего не могли изменять содержимое буфера, используйте


Clipboard.Open;  

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

З.Ы.
Многие объекты в Delphi изначально имеют методы, позволяющие помещать данные в буфер и извлекать их оттуда, примером может служить Tpicture.

Удачного кодинга!

Добавлено: 02 Августа 2018 07:34:00 Добавил: Андрей Ковальчук