Виртуальная библиотека Delphi - [16]

Пример:

program Project1;
uses
  Windows, // Обязательно
  Forms,
  Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
Const
MemFileSize = 1024;
MemFileName = 'one_inst_demo_memfile';
Var
MemHnd : HWND;
begin
  { Попытаемся создать файл в памяти }
  MemHnd := CreateFileMapping(HWND($FFFFFFFF),
                              nil,
                              PAGE_READWRITE,
                              0,
                              MemFileSize,
                              MemFileName);
  { Если файл не существовал запускаем приложение }
  if GetLastError<>ERROR_ALREADY_EXISTS then
  begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
  end;
  CloseHandle(MemHnd);
end.

Часто при работе у пользователя может быть открыто 5–20 окон и сообщение о том, что программа уже запущено приводит к тому, что он вынужден полчаса искать ранее запущенную копию. Выход из положения — найдя копию программы активировать ее, для чего в последнем примере перед HALT необходимо добавить строку :

SetForegroundWindow(Wnd);

Например так:

uses
  Windows, // !!!
  Forms,
  Unit0 in 'Unit0.pas' {Form1};
var
  Handle1 : LongInt;
  Handle2 : LongInt;
{$R *.RES}
begin
  Application.Initialize;
  Handle1 := FindWindow('TForm1',nil);
  if handle1 = 0 then
    begin
      Application.CreateForm(TForm1, Form1);
      Application.Run;
    end
  else
    begin
      Handle2 := GetWindow(Handle1,GW_OWNER);
      //Чтоб заметили :)
      ShowWindow(Handle2,SW_HIDE); ShowWindow(Handle2,SW_RESTORE);
      SetForegroundWindow(Handle1); // Активизируем
    end;
end.

Пример вывода сообщения одной командой и ввода строки тоже одной командой.

Вывод сообщения: ShowMessage('сообщение');

Ввод текста от пользователя: S:=InputBox('Заголовок', 'Сообщение', S{строка по умолчанию});

unit Unit1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('Пример простого сообщения.'+#10+
  'Данное сообщение выводится всегда в центре экрана.');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessagePos('Пример сообщения с указанием его положения на экране.',
   Form1.Left+Button2.Left, Form1.Top+Button2.Top);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
  Button3.Caption := InputBox('Delphi для всех',  'Введите строку:', Button3.Caption);
end;
end.

Перетаскивание формы за ее поле

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

const SC_DragMove = $F012; { a magic number }

begin

 ReleaseCapture;

 perform(WM_SysCommand, SC_DragMove, 0);

end;

Обработка событий от клавиатуры

I. Эмуляция нажатия клавиши.

Внутри приложения это выполняется достаточно просто с помощью вызова функции Windows API SendMessage() (можно воспользоваться и методом Perform того объекта (или формы), кому посылается сообщение о нажатой клавише).

Код

Memo1.Perform(WM_CHAR, Ord('A'), 0);

или

SendMessage(Memo1.Handle, WM_CHAR, Ord('A'), 0);

приведет к печати символа "A" в объекте Memo1.

II. Перехват нажатий клавиши внутри приложения.

Задача решается очень просто. Можно у формы установить свойство KeyPreview в True и обрабатывать событие OnKeyPress. Второй способ — перехватывать событие OnMessage для объекта Application.

III. Перехват нажатия клавиши в Windows.

Существуют приложения, которым необходимо перехватывать все нажатия клавиш в Windows, даже если в данный момент активно другое приложение. Это может быть, например, программа, переключающая раскладку клавиатуры, резидентный словарь или программа, выполняющая иные действия по нажатию "горячей" комбинации клавиш. Перехват всех событий в Windows (в том числе и событий от клавиатуры) выполняется с помощью вызова функции SetWindowsHook(). Данная функция регистрирует в системе Windows ловушку (hook) для определенного типа событий/сообщений. Ловушка — это пользовательская процедура, которая будет обрабатывать указанное событие. Основное здесь то, что эта процедура должна всегда присутствовать в памяти Windows. Поэтому ловушку помещают в DLL и загружают эту DLL из программы. Пока хоть одна программа использует DLL, та не может быть выгружена из памяти. Приведем пример такой DLL и программы, ее использующей. В примере ловушка перехватывает нажатие клавиш на клавиатуре, проверяет их и, если это клавиши "+" или "-", посылает соответствующее сообщение в конкретное приложение (окно). Окно ищется по имени его класса ("TForm1") и заголовку (caption, "XXX").

{текст библиотеки}
library SendKey;
uses
WinTypes, WinProcs, Messages;
const
{пользовательские сообщения}
wm_NextShow_Event = wm_User + 133;
wm_PrevShow_Event = wm_User + 134;
{handle для ловушки}
HookHandle: hHook = 0;
var
SaveExitProc : Pointer;
{собственно ловушка}
function Key_Hook(Code: integer; wParam: word; lParam: Longint): Longint; export;