Поддержка многоязычного интерфейса

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Программирование на С у госслужащих — как секс у подростков:

— все об этом думают;

— все об этом говорят;

— все думают, что их ближний это делает;

— почти никто этого не делает;

— тот, кто это делает, делает это плохо;

— все думают, что в следующий раз лучше получится;

— никто не принимает мер безопасности;

— любому стыдно признаться в том, что он чего-то не знает;

— если у кого-то что-то получается, от этого всегда много шума.

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

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

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

Строка на языке 1=Строка на языке 2

Строка на языке 1=Строка на языке 2

Например:

Файл=File

Выход=Exit

Отмена=Cancel

И так для всех ресурсов приложения. Словарь поместим в отдельный текстовый файл.

Далее, нам необходимо для каждого текстового свойства любого компонента приложения поискать перевод в нашем словаре. Здесь не обойтись без Delphi RTTI. Через Component.ClassInfo получим ссылку на информацию типа, а затем GetTypeData(TypeInf) даст нам указатель на структуру с его описанием.

TypeInf := Component.ClassInfo;

AName := TypeInf^.name;

TypeData := GetTypeData(TypeInf);

NumProps := TypeData^.PropCount;

Далее проходимся по всем свойствам данного (классового) типа:

GetMem(PropList, NumProps * sizeof(pointer));

try

GetPropInfos(TypeInf, PropList);

for i := 0 to NumProps-1 do

begin

PropName := PropList^[i]^.name;

PropTypeInf := PropList^[i]^.PropType^;

PropInfo := PropList^[i];

case PropTypeInf^.Kind of

tkString, tkLString: //… это то, что нам нужно

if PropName ‘Name’ then { Переводить свойство Name не следует }

begin

{ Получение значения свойства и поиск перевода в словаре }

StringPropValue := GetStrProp(Component, PropInfo);

SetStrProp(Component, PropInfo, TranslateString(StringPropValue));

end;

Отдельный случай — списки TStrings и коллекции типа TTReeNodes и TListItems. Их придется обработать персонально.

tkClass:

begin

PropObject := GetObjectProp(Component, PropInfo{, TPersistent});

if Assigned(PropObject)then

begin

{ Для дочерних свойств-классов вызов просмотра свойств }

if (PropObject is TPersistent) then

UpdateComponent(PropObject as TPersistent);

{ Индивидуальный подход к некоторым классам }

if (PropObject is TStrings) then

begin

for j := 0 to (PropObject as TStrings).Count-1 do

TStrings(PropObject)[j] := TranslateString(TStrings(PropObject)[j]);

end;

if (PropObject is TTreeNodes) then

begin

for j := 0 to (PropObject as TTreeNodes).Count-1 do

TTreeNodes(PropObject).Item[j].Text :=

TranslateString(TTreeNodes(PropObject).Item[j].Text);

end;

if (PropObject is TListItems) then

begin

for j := 0 to (PropObject as TListItems).Count-1 do

TListItems(PropObject).Item[j].Caption

:= TranslateString(TListItems(PropObject).Item[j].Caption);

end;

{ Здесь можно добавить обработку остальных классов }

end;

end;

Объединяя все написанное, получим компонент для перевода строковых ресурсов.

unit glLanguageLoader;

interface

{$I glDEF.INC}

uses

Windows, Messages, SysUtils, Classes, Graphics,

Controls, Forms, Dialogs, comctrls, grids;

type

TLanguageLoaderOptions = set of (lofTrimSpaces);

{опция удаления начальных и завершающих пробелов}

TglLanguageLoader = class(TComponent)

private

sl: TStringList;

FOptions: TLanguageLoaderOptions;

function TranslateString(sString: string): string;

protected

procedure UpdateComponent(Component: TPersistent); virtual;

public

{main function}

procedure LoadLanguage(Component: TComponent; FileName: string);

published

property Options: TLanguageLoaderOptions read FOptions write FOptions;

end;

procedure LoadLanguage(Component: TComponent; FileName: string;

Options: TLanguageLoaderOptions);

procedure register;

implementation

uses

TypInfo, dsgnintf;

procedure register;

begin

RegisterComponents(‘Gl Components’, [TglLanguageLoader]);

end;

{Ф-ия для загрузки словаря без предварительного создания компонента}

procedure LoadLanguage(Component: TComponent; FileName: string;

Options: TLanguageLoaderOptions);

var

LanguageLoader: TglLanguageLoader;

begin

LanguageLoader := TglLanguageLoader.Create(nil);

try

LanguageLoader.LoadLanguage(Component, FileName);

finally

LanguageLoader.Free;

end;

end;

{ TglLanguageLoader }

{ Загрузка словаря, обход указанного компонента и }

{ всех его дочерних компонентов }

procedure TglLanguageLoader.LoadLanguage(Component: TComponent; FileName: string);

procedure UpdateAllComponents(Component: TComponent);

var

i: integer;

begin

{ обработка своцств компонента }

UpdateComponent(Component);

for i := 0 to Component.ComponentCount-1 do

UpdateAllComponents(Component.Components[i]);

end;

begin

sl := TStringList.Create;

try

{ Загрузка словаря из заданного файла }

sl.LoadFromFile(FileName);

sl.Sorted := true;

UpdateAllComponents(Component);

finally

sl.Free;

end;

end;

{ Проход по всем свойствам компонента }

{ Для всех строковых свойств — загрузка перевода из сооваря }

procedure TglLanguageLoader.UpdateComponent(Component: TPersistent);

var

PropInfo: PPropInfo;

TypeInf, PropTypeInf: PTypeInfo;

TypeData: PTypeData;

i, j: integer;

AName, PropName, StringPropValue: string;

PropList: PPropList;

NumProps: word;

PropObject: TObject;

begin

{ Playing with RTTI }

TypeInf := Component.ClassInfo;

AName := TypeInf^.name;

TypeData := GetTypeData(TypeInf);

NumProps := TypeData^.PropCount;

GetMem(PropList, NumProps*sizeof(pointer));

try

GetPropInfos(TypeInf, PropList);

for i := 0 to NumProps-1 do

begin

PropName := PropList^[i]^.name;

PropTypeInf := PropList^[i]^.PropType^;

PropInfo := PropList^[i];

case PropTypeInf^.Kind of

tkString, tkLString:

if PropName ‘Name’ then { Переводить свойство Name не следует }

begin

{ Получение значения свойства и поиск перевода в словаре }

StringPropValue := GetStrProp( Component, PropInfo );

SetStrProp( Component, PropInfo, TranslateString(StringPropValue) );

end;

tkClass:

begin

PropObject := GetObjectProp(Component, PropInfo{, TPersistent});

if Assigned(PropObject)then

begin

{ Для дочерних свойств-классов вызов просмотра свойств }

if (PropObject is TPersistent) then

UpdateComponent(PropObject as TPersistent);

{ Индивидуальный подход к некоторым классам }

if (PropObject is TStrings) then

begin

for j := 0 to (PropObject as TStrings).Count-1 do

TStrings(PropObject)[j] := TranslateString(TStrings(PropObject)[j]);

end;

if (PropObject is TTreeNodes) then

begin

for j := 0 to (PropObject as TTreeNodes).Count-1 do

TTreeNodes(PropObject).Item[j].Text :=

TranslateString(TTreeNodes(PropObject).Item[j].Text);

end;

if (PropObject is TListItems) then

begin

for j := 0 to (PropObject as TListItems).Count-1 do

TListItems(PropObject).Item[j].Caption :=

TranslateString(TListItems(PropObject).Item[j].Caption);

end;

{ Здесь можно добавить обработку остальных классов }

end;

end;

end;

end;

finally

FreeMem(PropList, NumProps*sizeof(pointer));

end;

end;

{ Поиск перевода для заданной строки в словаре }

function TglLanguageLoader.TranslateString(sString: string): string;

begin

if lofTrimSpaces in Options then

sString := trim(sString);

if sString = » then

begin

Result := »;

exit;

end;

if sl.IndexOfName(sString) -1 then

Result := sl.Values[sString]

else

Result := sString;

end;

end.

{/codecitation}

Как узнать, какой язык активен в Windows

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Программиста спрашивают:

— Как вам удалось так быстро выучить английский язык?!!

— Да, ерунда какая. Они там почти все слова из Delphi взяли.

function WhichLanguage:string;

var

ID: LangID;

Language: array [0..100] of char;

begin

ID := GetSystemDefaultLangID;

VerLanguageName(ID, Language, 100);

Result := string(Language);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.Text := WhichLanguage;

end;

{/codecitation}

Как программно переключить раскладку клавиатуры

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

//На русский

procedure TForm1.Button1Click(Sender: TObject);

var

Layout: array[0.. KL_NAMELENGTH] of char;

begin

LoadKeyboardLayout( StrCopy(Layout,’00000419′),KLF_ACTIVATE);

end;

//На английский

procedure TForm1.Button2Click(Sender: TObject);

var

Layout: array[0.. KL_NAMELENGTH] of char;

begin

LoadKeyboardLayout(StrCopy(Layout,’00000409′),KLF_ACTIVATE);

end;

{/codecitation}

Как проводить локализацию своих приложений 2

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

В Delphi 3 и 4 есть специальные механизмы, позволяющие приложение «переделать» на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕHЬ просто:

берется проект, компилируется;

тут-же, не закрывая проект, вызвается New|Resource DLL Wizard, в нем указывается, какие формы и модули должны подвергнуться переводу на другой язык;

в результате работы Wizard появляется проект (sic!) с RC и DFM. Открываем формы, и переделываем все сообщения размер (соотв. длине сообщений);

Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx — название исходного проекта;

Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.

p.s. файл RUS можно подставлять и убирать по вкусу.

{/codecitation}

Как проводить локализацию своих приложений

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Dmitry Kuzmenko

Несколько перлов из жизни российских компьютерных переводчиков:

These ports are not supported — Эти порты не поддерживаются.

Assign nickname to authority — Дать кличку авторитету.

3-character resource type — Трехбуквенный тип ресурса.

В Delphi есть специальные механизмы, позволяющие приложение «переделать» на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕНЬ просто:

берется проект, компилируется

тут-же не закрывая проект вызвается New|Resource DLL Wizard в нем указывается какие формы и модули должны подвергнуться переводу на другой язык.

в результате работы Wizard появляется проект (!) с RC и DFM. Открываем формы, и переделываем все сообщения размер (соотв. длине сообщений). Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx — название исходного проекта.

Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.

p.s. файл RUS можно подставлять и убирать по вкусу.

В Delphi3. Вот, случайно набpели в хэлпе. Если нужно изменить pесуpсы какого-либо модуля, то это можно делать с помощью нехитpой опеpации:

Вынимаете pесуpсы из этого модуля.

Пеpеводите их на дpугой язык. (напpимеp pусский)

Создаете в Delphi свой пpоект Dll-ки (с именем того модуля, из котоpого вы вынули pесуpсы, напpимеp vcl30), в котоpый включаете _пеpеведенные_ pесуpсы: {$R vcl30rus.res}

Собиpаете все это.

Пеpеименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.

Если вы хотите, пpиложение «говоpило» по pусски только тогда, когда в pегиональных установках стоит Russia — то тогда это все. Если же вы хотите, чтобы ваше пpиложение _всегда_ поднимало pусские pесуpсы, то необходимо сделать следующее добавление в Registry: HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales «X:\MyProject\MyApp.exe» = «rus»

Тепеpь, когда ваше пpиложение будет поднимать pakages, то всегда будут бpаться pусские pесуpсы. Дpугие пpиложения, напpимеp Delphi — это не затpонет. Таким обpазом можно заменять даже DFM-ки из пpоекта.

Более подpобно об этом — см Help — Index — Localizing…

{/codecitation}

Как отловить изменение раскладки клавиатуры

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Александр

Клавиатура Калашникова: Del-Del-Del-Del-…..

Нужно ловить сообщение WM_INPUTLANGCHANGEREQUEST

или

procedure TForm1.Timer1Timer(Sender: TObject);

var

Layout: array [0.. KL_NAMELENGTH] of char;

begin

GetKeyboardLayoutName(Layout);

if Layout = ‘00000409’ then

label1.caption:=’en’

else

label1.caption:=’ru’;

end;

{/codecitation}

Как из программы переключать языки

var

Layout: array [0.. KL_NAMELENGTH] of char;

begin

LoadKeyboardLayout(StrCopy(Layout, ‘00000419’), KLF_ACTIVATE);

end;

procedure SetEN;

var

Layout: array [0.. KL_NAMELENGTH] of char;

begin

LoadKeyboardLayout(StrCopy(Layout, ‘00000409’), KLF_ACTIVATE);

end;

или

var

rus, lat: HKL;

rus := LoadKeyboardLayout(‘00000419’, 0);

lat := LoadKeyboardLayout(‘00000409’, 0);

SetActiveKeyboardLayout(rus);

 

Узнать о завершении работы Windows

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

Если текст в Memo1 был изменен, то программа не разрешает завершения сеанса Windows.

private

procedure WMQueryEndSession(var Msg: TWMQueryEndSession);

message WM_QUERYENDSESSION;

procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);

begin

Msg.Result := integer(not Memo1.Modified);

end;

{/codecitation}

Сообщения Windows — введение

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вирус детям не игрушка, не товарищ и не друг!

Кто-нибудь может со мной поделиться информацией о работе в Delphi с Windows Messages (системные сообщения)? Все эти сообщения типа WM_*** вызывают у меня нервный тик, поскольку это я не могу понять как это работает.

Список всех системных сообщений Windows доступен в файлах электронной справки Delphi. (Я использую D5, но думаю в будущих версиях все останется на своих местах).

Сообщения WM_ (и другие) играют существенную роль в работе Windows. Все вы хорошо знаете, что Delphi первоначально строится на принципе *управления событиями*; наверняка не один раз вы создавали обработчики событий OnKeyPress, OnThis, OnThat и других. Если у вас есть исходный код VCL, вы легко обнаружите, что механизм работы событий в Delphi основан на обработке конкретных системных соощенияй, посылаемых вашему элементу управления (как раз здесь и заложено главное достоинство объектно-ориентированного программирования, когда вы можете создать новый компонент на основе существующего и «научить» его обрабатывать другие необходимые вам системные сообщения). Windows постоянно посылает сообщения в ответ на действия пользователя и ждет соответствующей реакции от приложений Delphi (и всех остальных приложений Windows), заключающейся в их «приеме» и соответствующей обработке. Delphi имеет оболочки для большинства системных сообщений, создав «механизм оповещения элемента управления о приеме сообщения на его адрес» — с

обытия для компонентов, как было описано выше.

Кроме приема сообщений, у вас также существует возможность их отправления. Это возможно двумя способами: SendMessage и PostMessage (обе являются Win API функциями), а также метод Delphi Perform. Первые два требуют в качестве параметра Handle указывать дескриптор компонента, которому вы шлете сообщение, тогда как Perform является методом, принадлежащим самому компоненту. Сообщения передаются в стандартную очередь системных сообщений и обрабатываются подобно другим сообщениям.

Вот тривиальный пример: я хочу (по некоторой причудливой причине) вставлять в TMemo символ ‘y’ каждый раз после набора цифры ‘4’. (Обдумайте способ автоматической вставки блока begin-end или заключительной скобки.) Я, конечно, мог бы поработать с Memo-свойством Lines, но это было бы не так красиво и достаточно громоздко. Вот как выглядит наш пример с использованием сообщений:

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

if Key = ‘4’ then

SendMessage(Memo1.Handle, WM_CHAR, Word(‘y’), 0);

end;

Другой пример демонстрирует работу с компонентом ComboBox. Мы хотим, чтобы он автоматически выпадал при нажатии пользователем какой-либо клавиши. Это поведение, к сожалению, нестандартно. Вот что мы делаем:

procedure TFormEffortRates.ComboBoxMaterialKeyDown(Sender: TObject; var

Key: Word; Shift: TShiftState);

var

iShowing: integer;

{ какой-то код, затем… }

begin

{ С помощью сообщения узнаем состояние («раскрытость») ComboBox’а }

iShowing := SendMessage((Sender as TComboBox).Handle, CB_GETDROPPEDSTATE, 0, 0);

if iShowing = 0 then

{ раскрываем ComboBox }

SendMessage((Sender as TComboBox).Handle, CB_SHOWDROPDOWN, 1,0);

end;

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

function TMDIChild.GetMemoColumn(const TheMemo : TMemo) : integer;

begin

Result := TheMemo.SelStart —

(SendMessage(TheMemo.Handle, EM_LINEINDEX,

GetMemoLine(TheMemo), 0));

end;

function TMDIChild.GetMemoLine(const TheMemo : TMemo) : integer;

begin

Result := SendMessage(TheMemo.Handle, EM_LINEFROMCHAR,

TheMemo.SelStart, 0);

end;

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

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

{/codecitation}

Переслать текст в другую программу

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

unit Readmain;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, Menus, StdCtrls;

{ The WM_COPYDATA Windows message is not defined in the 16-bit Messages }

{ unit, although it is available to 16-bit applications running under }

{ Windows 95 or NT. This message is discussed in the Win32 API online }

{ help. }

const

WM_COPYDATA = $004A;

type

TMainForm = class(TForm)

ReadMemo: TMemo;

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

Help1: TMenuItem;

About1: TMenuItem;

procedure Exit1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure About1Click(Sender: TObject);

private

procedure OnAppMessage(var M: TMsg; var Handled: Boolean);

procedure WMCopyData(var M: TMessage); message WM_COPYDATA;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses RegMsg, AboutU;

type

{ The TCopyDataStruct record type is not defined in WinTypes unit, }

{ although it is available in the 16-bit Windows API when running }

{ under Windows 95 and NT. The lParam of the WM_COPYDATA message }

{ points to one of these. }

PCopyDataStruct = ^TCopyDataStruct;

TCopyDataStruct = record

dwData: DWORD;

cbData: DWORD;

lpData: Pointer;

end;

procedure TMainForm.OnAppMessage(var M: TMsg; var Handled: Boolean);

{ OnMessage handler for Application object. }

begin

{ The DDGM_HandshakeMessage message is received as a broadcast to }

{ all applications. The wParam of this message contains the handle }

{ of the window which broadcasted the message. We respond by posting }

{ the same message back to the sender, with our handle in the wParam. }

if M.Message = DDGM_HandshakeMessage then

begin

PostMessage(M.wParam, DDGM_HandshakeMessage, Handle, 0);

Handled := True;

end;

end;

procedure TMainForm.WMCopyData(var M: TMessage);

{ Handler for WM_COPYDATA message }

begin

{ Check wParam to ensure we know WHO sent us the WM_COPYDATA message }

if PCopyDataStruct(M.lParam)^.dwData = DDGM_HandshakeMessage then

{ When WM_COPYDATA message is received, the lParam points to}

ReadMemo.SetTextBuf(PChar(PCopyDataStruct(M.lParam)^.lpData));

end;

procedure TMainForm.Exit1Click(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Application.OnMessage := OnAppMessage;

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

AboutBox;

end;

end.

unit CopyMain;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Menus;

type

TMainForm = class(TForm)

DataMemo: TMemo;

BottomPnl: TPanel;

BtnPnl: TPanel;

CloseBtn: TButton;

CopyBtn: TButton;

MainMenu1: TMainMenu;

File1: TMenuItem;

CopyData1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

Help1: TMenuItem;

About1: TMenuItem;

procedure CloseBtnClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure About1Click(Sender: TObject);

procedure CopyBtnClick(Sender: TObject);

private

{ Private declarations }

protected

procedure WndProc(var Message: TMessage); override;

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses AboutU, RegMsg;

// The following declaration is necessary because of an error in

// the declaration of BroadcastSystemMessage() in the Windows unit

function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;

uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;

external ‘user32.dll’;

var

Recipients: DWORD = BSM_APPLICATIONS;

procedure TMainForm.WndProc(var Message: TMessage);

var

DataBuffer: TCopyDataStruct;

Buf: PChar;

BufSize: Integer;

begin

if Message.Msg = DDGM_HandshakeMessage then

begin

{ Allocate buffer }

BufSize := DataMemo.GetTextLen (1 * SizeOf(Char));

Buf := AllocMem(BufSize);

{ Copy memo to buffer }

DataMemo.GetTextBuf(Buf, BufSize);

try

with DataBuffer do

begin

{ Fill dwData with registered message as safety check }

dwData := DDGM_HandshakeMessage;

cbData := BufSize;

lpData := Buf;

end;

{ NOTE: WM_COPYDATA message must be *sent* }

SendMessage(Message.wParam, WM_COPYDATA, Handle,

Longint(@DataBuffer));

finally

FreeMem(Buf, BufSize);

end;

end

else

inherited WndProc(Message);

end;

procedure TMainForm.CloseBtnClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormResize(Sender: TObject);

begin

BtnPnl.Left := BottomPnl.Width div 2 — BtnPnl.Width div 2;

end;

procedure TMainForm.About1Click(Sender: TObject);

begin

AboutBox;

end;

procedure TMainForm.CopyBtnClick(Sender: TObject);

begin

{ Call for any listening apps }

BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,

@Recipients, DDGM_HandshakeMessage, Handle, 0);

end;

end.

Скачать весь проект

{/codecitation}