Советы по Delphi

         

Как можно работать с DDE под Delphi, используя вызовы API?


Кстати, достаточно легко: следующий пример демонстрирует как можно научить общаться клиентскую программу с программой-сервером. Обе программы полностью созданы на Delphi. В итоге мы имеет 2 проекта, 3 формы и 3 модуля. Для работы с DDE-запросами данный пример использует методы DDE ML API.

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

  1. Клиент может "пропихивать" (POKE) данные на сервер.
  2. Сервер может автоматически передавать данные клиенту, после чего клиент обновляет свой вид на основе результатов, полученных от сервера.
  3. Данные сервера изменяются, после чего клиент делает запрос серверу для получения новых данных и обновляет свой вид.
Как работает программа.

Ниже приведены 8 файлов, сконкатенированных в единое целое. Каждый файл имеет следующую структуру:
{ *** НАЧАЛО КОДА FILENAME.EXT *** } КОД { *** КОНЕЦ КОДА FILENAME.EXT *** },
поэтому вам остается всего-лишь взять код, расположенный между маркерами { *** }, скопировать в файл с соответствующим именем, и собрать оба проекта в среде Delphi

    { *** НАЧАЛО КОДА DDEMLCLI.DPR *** }
program Ddemlcli;

uses


Forms, Ddemlclu in 'DDEMLCLU.PAS' {Form1};
{$R *.RES}

begin
Application.CreateForm(TForm1, Form1); Application.Run; end.
{ ***  КОНЕЦ КОДА DDEMLCLI.DPR *** }

{ *** НАЧАЛО КОДА DDEMLCLU.DFM *** }
object Form1: TForm1
Left = 197 Top = 95 Width = 413 Height = 287 HorzScrollBar.Visible = False VertScrollBar.Visible = False Caption = 'Демонстрация DDEML, Клиентское приложение' Font.Color = clWindowText Font.Height = -13 Font.Name = 'System' Font.Style = [] Menu = MainMenu1 PixelsPerInch = 96 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow TextHeight = 16 object PaintBox1: TPaintBox Left = 0 Top = 0 Width = 405 Height = 241 Align = alClient Color = clWhite ParentColor = False OnPaint = PaintBox1Paint end object MainMenu1: TMainMenu Top = 208 object File1: TMenuItem Caption = '&Файл' object exit1: TMenuItem Caption = 'В&ыход' OnClick = exit1Click end end object DDE1: TMenuItem Caption = '&DDE' object RequestUpdate1: TMenuItem Caption = '&Запрос на обновление' OnClick = RequestUpdate1Click end object AdviseofChanges1: TMenuItem Caption = '&Сообщение об изменениях' OnClick = AdviseofChanges1Click end object N1: TMenuItem Caption = '-' end object PokeSomeData: TMenuItem Caption = '&Пропихивание данных' OnClick = PokeSomeDataClick end end end end
{ ***  КОНЕЦ КОДА DDEMLCLU.DFM *** }

{ *** НАЧАЛО КОДА DDEMLCLU.PAS *** }
{***************************************************}
{                                                   }
{   Delphi 1.0 DDEML Демонстрационная программа     }
{   Copyright (c) 1996 by Borland International     }
{                                                   }
{***************************************************}

{ Это демонстрационное приложение, демонстрирующее использование DDEML API в клиентском приложении. Оно использует серверное приложение DataEntry, которое является частью данной демонстрации, и служит для ввода данных и отображения их на графической панели.

Сначала вы должны запустить приложение-сервер (в DDEMLSRV.PAS), а затем стартовать клиента. Если сервер не запущен, клиент при попытке соединения потерпит неудачу.

Интерфейс сервера определен списком имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся локально как целые. }

unit Ddemlclu;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, VBXCtrl, ExtCtrls, DDEML, Menus, StdCtrls;
const
NumValues = 3;
type

{ Структура данных, представленная в примере } TDataSample = array [1..NumValues] of Integer; TDataString = array [0..20] of Char;     { Размер элемента как текста }
{ Главная форма } TForm1 = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; exit1: TMenuItem; DDE1: TMenuItem; RequestUpdate1: TMenuItem; AdviseofChanges1: TMenuItem; PokeSomeData: TMenuItem; N1: TMenuItem; PaintBox1: TPaintBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure RequestUpdate1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure AdviseofChanges1Click(Sender: TObject); procedure PokeSomeDataClick(Sender: TObject);
procedure Request(HConversation: HConv); procedure exit1Click(Sender: TObject); procedure PaintBox1Paint(Sender: TObject);
private { Private declarations } public Inst: Longint; CallBackPtr: ^TCallback; ServiceHSz : HSz; TopicHSz  : HSz; ItemHSz    : array [1..NumValues] of HSz; ConvHdl    : HConv;
DataSample : TDataSample; end;
var Form1: TForm1;

implementation

const

DataEntryName : PChar = 'DataEntry'; DataTopicName : PChar = 'SampledData'; DataItemNames : array [1..NumValues] of pChar = ('DataItem1', 'DataItem2', 'DataItem3'); {$R *.DFM}

{ Локальная функция: Процедура обратного вызова для DDEML }

function CallbackProc(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ;
Data: HDDEData; Data1, Data2: Longint): HDDEData; export; begin
CallbackProc := 0;    { В противном случае смотрите доказательство }
case CallType of xtyp_Register: begin { Ничего ... Просто возвращаем 0 } end; xtyp_Unregister: begin { Ничего ... Просто возвращаем 0 } end; xtyp_xAct_Complete: begin { Ничего ... Просто возвращаем 0 } end; xtyp_Request, Xtyp_AdvData: begin Form1.Request(Conv); CallbackProc := dde_FAck; end; xtyp_Disconnect: begin ShowMessage('Соединение разорвано!'); Form1.Close; end; end; end;

{ Посылка DDE запроса для получения cf_Text данных с сервера. Запрашиваем данные для всех полей DataSample, и обновляем окно для их отображения. Данные с сервера получаем синхронно, используя DdeClientTransaction.}

procedure TForm1.Request(HConversation: HConv);
var
hDdeTemp : HDDEData; DataStr  : TDataString; Err, I  : Integer; begin
if
HConversation <> 0 then begin for I := Low(ItemHSz) to High(ItemHSz) do begin hDdeTemp := DdeClientTransaction(nil, 0, HConversation, ItemHSz[I], cf_Text, xtyp_Request, 0, nil); if hDdeTemp <> 0 then  begin DdeGetData(hDdeTemp, @DataStr, SizeOf(DataStr), 0); Val(DataStr, DataSample[I], Err); end; { if } end; { for } Paintbox1.Refresh; { Обновляем экран } end; { if } end;

procedure TForm1.FormCreate(Sender: TObject);
var
I : Integer; { Создаем экземпляр окна DDE-клиента. Создаем окно, используя унаследованный конструктор, инициализируем экземпляр данных.}
begin
Inst       := 0;      { Должен быть нулем для первого вызова DdeInitialize } CallBackPtr:= nil;    { MakeProcInstance вызывается из SetupWindow    } ConvHdl    := 0; ServiceHSz := 0; TopicHSz   := 0; for I := Low(DataSample) to High(DataSample) do begin ItemHSz[I]    := 0; DataSample[I] := 0; end; end;

procedure TForm1.FormDestroy(Sender: TObject);
{ Уничтожаем экземпляр клиентского окна. Освобождаем дескрипторы DDE строк, и освобождаем экземпляр функции обратного вызова, если она существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка. }
var I : Integer;
begin
if
ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz); if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz); for I := Low(ItemHSz) to High(ItemHSz) do if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]);
if Inst <> 0 then DdeUninitialize(Inst);   { Игнорируем возвращаемое значение }
if CallBackPtr <> nil then FreeProcInstance(CallBackPtr); end;

procedure TForm1.RequestUpdate1Click(Sender: TObject);
begin
{ Генерируем запрос DDE в ответ на выбор пункта меню DDE | Request.}
Request(ConvHdl); end;

procedure TForm1.FormShow(Sender: TObject);
{ Завершаем инициализацию окна сервера DDE. Выполняем те действия, которые требует правильное окно. Инициализируем использование DDEML. }
var
I     : Integer; InitOK: Boolean; begin
CallBackPtr := MakeProcInstance(@CallBackProc, HInstance);
{ Инициализируем DDE и устанавливаем функцию обратного вызова. Если сервер отсутствует, вызов терпит неудачу. }
if CallBackPtr <> nil then begin if DdeInitialize(Inst, TCallback(CallBackPtr), AppCmd_ClientOnly, 0) = dmlErr_No_Error then begin ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi); TopicHSz  := DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi); InitOK := True; {     for I := Low(DataItemNames) to High(DataItemNames) do begin }
for I := 1 to NumValues do begin ItemHSz[I]:= DdeCreateStringHandle(Inst, DataItemNames[I], cp_WinAnsi); InitOK := InitOK and (ItemHSz[I] <> 0); end;
if (ServiceHSz <> 0) and (TopicHSz <> 0) and InitOK then begin ConvHdl := DdeConnect(Inst, ServiceHSz, TopicHSz, nil); if ConvHdl = 0 then begin ShowMessage('Не могу инициализировать диалог!'); Close; end end else begin ShowMessage('Не могу создать строки!'); Close; end end else begin ShowMessage('Не могу осуществить инициализацию!'); Close; end; end; end;

procedure TForm1.AdviseofChanges1Click(Sender: TObject);
{ Переключаемся на режим DDE Advise с помощью пункта меню DDE | Advise (уведомление). При выборе этого пункта меню все три элемента переключаются на уведомление. }
var
I: Integer; TransType: Word; TempResult: Longint; begin
with
TMenuITem(Sender) do begin Checked := not Checked; if Checked then TransType:= (xtyp_AdvStart or xtypf_AckReq) else TransType:= xtyp_AdvStop; end; { with }
for I := Low(ItemHSz) to High(ItemHSz) do if DdeClientTransaction(nil, 0, ConvHdl, ItemHSz[I], cf_Text, TransType, 1000, @TempResult) = 0 then ShowMessage('Не могу выполнить транзакцию-уведомление');
if TransType and xtyp_AdvStart <> 0 then Request(ConvHdl); end;

procedure TForm1.PokeSomeDataClick(Sender: TObject);
{ Генерируем DDE-Poke транзакцию в ответ на выбор пункта меню DDE | Poke. Запрашиваем значение у пользователя, которое будем "проталкивать" в DataItem1 в качестве иллюстрации Poke-функции.}
var
DataStr: pChar; S: String; begin
S := '0'; if InputQuery('PokeData', 'Задайте проталкиваемую (Poke) величину', S) then begin S := S + #0; DataStr := @S[1]; DdeClientTransaction(DataStr, StrLen(DataStr) + 1, ConvHdl, ItemHSz[1], cf_Text, xtyp_Poke, 1000, nil); Request(ConvHdl); end; end;

procedure TForm1.exit1Click(Sender: TObject);
begin
close; end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
{ После запроса обновляем окно. Рисуем график объема текущих продаж.}
const
LMarg = 30;    { Левое поле графика } var
I, Norm: Integer; Wd: Integer; Step : Integer;
ARect: TRect;
begin
Norm := 0; for I := Low(DataSample) to High(DataSample) do begin if abs(DataSample[I]) > Norm then Norm := abs(DataSample[I]); end; { for }
if Norm = 0 then Norm := 1;  { В случае если у нас все нули }
with TPaintBox(Sender).Canvas do begin { Рисуем задний фон } Brush.color  := clWhite; FillRect(ClipRect);
{ Рисуем ось } MoveTo(0, ClipRect.Bottom div 2); LineTo(ClipRect.Right, ClipRect.Bottom div 2);
MoveTo(LMarg, 0); LineTo(LMarg, ClipRect.Bottom);
{ Печатаем текст левого поля } TextOut(0,0, IntToStr(Norm)); TextOut(0, ClipRect.Bottom div 2, '0'); TextOut(0, ClipRect.Bottom + Font.Height, IntToStr(-Norm));
TextOut(0, ClipRect.Bottom div 2, '0'); TextOut(0, ClipRect.Bottom div 2, '0'); TextOut(0, ClipRect.Bottom div 2, '0'); { Печатаем текст оси X }
{ Теперь рисуем бары на основе нормализованного значения. Вычисляем ширину баров (чтобы они все вместились в окне) и ширину пробела между ними, который приблизительно равен 20% от их ширины. }
{        SelectObject(PaintDC, CreateSolidBrush(RGB(255, 0, 0)));
SetBkMode(PaintDC, Transparent); }
ARect := ClipRect; Wd  := (ARect.Right - LMarg) div NumValues; Step := Wd div 5; Wd  := Wd - Step; with ARect do begin Left := LMarg + (Step div 2); Top := ClipRect.Bottom div 2; end; { with }
{ Выводим бары и текст для оси X } For i := Low(DataSample) to High(DataSample) do begin with ARect do begin Right := Left + Wd; Bottom:= Top - Round((Top-5) * (DataSample[I] / Norm)); end; { with } { Заполняем бар } Brush.color  := clFuchsia; FillRect(ARect); { Выводим текст для горизонтальной оси } Brush.color  := clWhite; TextOut(ARect.Left, ClipRect.Bottom div 2 - Font.Height, StrPas(DataItemNames[i])); with ARect do Left := Left + Wd + Step; end; { for } end; { with } end;
end.{ ***  КОНЕЦ КОДА DDEMLCLU.PAS *** }

{ *** НАЧАЛО КОДА DDEMLSVR.DPR *** }
program Ddemlsvr;

uses
Forms, Ddesvru in 'DDESVRU.PAS' {Form1}, Ddedlg in '\DELPHI\BIN\DDEDLG.PAS' {DataEntry};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1); Application.CreateForm(TDataEntry, DataEntry); Application.Run; end.
{ ***  КОНЕЦ КОДА DDEMLSVR.DPR *** }

{ *** НАЧАЛО КОДА DDESVRU.DFM *** }
object Form1: TForm1
Left = 712 Top = 98 Width = 307 Height = 162 Caption = 'Демонстрация DDEML, Серверное приложение' Color = clWhite Font.Color = clWindowText Font.Height = -13 Font.Name = 'System' Font.Style = [] Menu = MainMenu1 PixelsPerInch = 96 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow TextHeight = 16 object Label1: TLabel Left = 0 Top = 0 Width = 99 Height = 16 Caption = 'Текущие значения:' end object Label2: TLabel Left = 16 Top = 24 Width = 74 Height = 16 Caption = 'Data Item1:' end object Label3: TLabel Left = 16 Top = 40 Width = 74 Height = 16 Caption = 'Data Item2:' end object Label4: TLabel Left = 16 Top = 56 Width = 74 Height = 16 Caption = 'Data Item3:' end object Label5: TLabel Left = 0 Top = 88 Width = 265 Height = 16 Caption = 'Выбор данных | Ввод данных для изменения значений.' end object Label6: TLabel Left = 96 Top = 24 Width = 8 Height = 16 Caption = '0' end object Label7: TLabel Left = 96 Top = 40 Width = 8 Height = 16 Caption = '0' end object Label8: TLabel Left = 96 Top = 56 Width = 8 Height = 16 Caption = '0' end object MainMenu1: TMainMenu Left = 352 Top = 24 object File1: TMenuItem Caption = '&Файл' object Exit1: TMenuItem Caption = '&Выход' OnClick = Exit1Click end end object Data1: TMenuItem Caption = '&Данные' object EnterData1: TMenuItem Caption = '&Ввод данных' OnClick = EnterData1Click end object Clear1: TMenuItem Caption = '&Очистить' OnClick = Clear1Click end end end end
{ ***  КОНЕЦ КОДА DDESVRU.DFM *** }

{ *** НАЧАЛО КОДА DDESVRU.PAS *** }
{***************************************************}
{                                                   }
{   Delphi 1.0 DDEML Демонстрационная программа     }
{   Copyright (c) 1996 by Borland International     }
{                                                   }
{***************************************************}

{ Данный демонстрационный пример использует библиотеку DDEML на стороне сервера кооперативного приложения. Данный сервер является простым приложением для ввода данных и позволяет оператору осуществлять ввод трех элементов данных, которые становятся доступными через DDE "заинтересованным" клиентам.

Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами:
Service: 'DataEntry' Topic  : 'SampledData' Items  : 'DataItem1', 'DataItem2', 'DataItem3'
В-принципе, в качестве сервисов могли бы быть определены и другие темы. Полезными темами, на наш взгляд, могут быть исторические даты, информация о сэмплах и пр..
Вы должны запустить этот сервер ПЕРЕД тем как запустите клиента (DDEMLCLI.PAS), в противном случае клиент не сможет установить связь.
Интерфейс для этого сервера определен как список имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся у клиента локально как целые. }
unit Ddesvru;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus,
DDEML,     { DDE APi } ShellApi;
const
NumValues = 3; DataItemNames : array [1..NumValues] of PChar = ('DataItem1', 'DataItem2', 'DataItem3'); type
TDataString = array [0..20] of Char;      { Размер элемента как текста } TDataSample = array [1..NumValues] of Integer;

{type
{ Структура данных, составляющих образец }
{  TDataSample = array [1..NumValues] of Integer;
{  TDataString = array [0..20] of Char;     { Размер элемента как текста }
const
DataEntryName: PChar = 'DataEntry'; DataTopicName: PChar = 'SampledData';
type
TForm1 = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; Exit1: TMenuItem; Data1: TMenuItem; EnterData1: TMenuItem; Clear1: TMenuItem; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; procedure Exit1Click(Sender: TObject);
function MatchTopicAndService(Topic, Service: HSz): Boolean; function MatchTopicAndItem(Topic, Item: HSz): Integer; function WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData; function AcceptPoke(Item: HSz; ClipFmt: Word; Data: HDDEData): Boolean; function DataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure EnterData1Click(Sender: TObject); procedure Clear1Click(Sender: TObject);
private Inst       : Longint; CallBack   : TCallback; ServiceHSz : HSz; TopicHSz   : HSz; ItemHSz    : array [1..NumValues] of HSz; ConvHdl    : HConv; Advising   : array [1..NumValues] of Boolean;
DataSample : TDataSample;
public { Public declarations } end;
var
Form1: TForm1;
implementation
uses
DDEDlg; { Форма DataEntry }

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close; end;
{ Глобальная инициализация }

const
DemoTitle   : PChar = 'DDEML демо, серверное приложение';
MaxAdvisories = 100; NumAdvLoops : Integer = 0;

{ Локальная функция: Процедура обратного вызова для DDEML }

{ Данная функция обратного вызова реагирует на все транзакции, генерируемые DDEML. Объект "target Window" (окно-цель) берется из глобально хранимых, и для реагирования на данную транзакцию, тип которой указан в параметре CallType, используются подходящие методы этих объектов.}

function CallbackProc(CallType, Fmt: Word; Conv: HConv; HSz1, HSz2: HSZ;
Data: HDDEData; Data1, Data2: Longint): HDDEData; export; var
ItemNum   : Integer; begin
CallbackProc := 0;    { В противном случае смотрите доказательство }
case CallType of
xtyp_WildConnect: CallbackProc := Form1.WildConnect(HSz1, HSz2, Fmt);
xtyp_Connect: if Conv = 0 then begin if Form1.MatchTopicAndService(HSz1, HSz2) then CallbackProc := 1;   { Связь! } end; { После подтверждения установки соединения записываем дескриптор связи как родительское окно.}
xtyp_Connect_Confirm: Form1.ConvHdl := Conv;
{ Клиент запрашивает данные, делает прямой запрос или отвечает на уведомление. Возвращаем текущее состояние данных.}
xtyp_AdvReq, xtyp_Request: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then CallbackProc := Form1.DataRequested(CallType, ItemNum, Fmt); end;
{ Отвечаем на Poke-запрос ... данная демонстрация допускает только Pokes для DataItem1. Для подтверждения получения запроса возвращаем dde_FAck, в противном случае 0.}
xtyp_Poke: begin if Form1.AcceptPoke(HSz2, Fmt, Data) then CallbackProc := dde_FAck; end;
{ Клиент сделал запрос для старта цикла-уведомления. Имейте в виду, что мы организуем "горячий" цикл. Устанавливаем флаг Advising для указания открытого цикла, который будет проверять данные на предмет их изменения.}
xtyp_AdvStart: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then begin if NumAdvLoops < MaxAdvisories then begin { Произвольное число } Inc(NumAdvLoops); Form1.Advising[ItemNum] := True; CallbackProc := 1; end; end; end;
{ Клиент сделал запрос на прерывание цикла-уведомления.}
xtyp_AdvStop: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then begin if NumAdvLoops > 0 then begin Dec(NumAdvLoops); if NumAdvLoops = 0 then Form1.Advising[ItemNum] := False; CallbackProc := 1; end; end; end; end;  { Case CallType }
end;

{ Возращает True, если данные Topic и Service поддерживаются этим приложением. В противном случае возвращается False.}

function TForm1.MatchTopicAndService(Topic, Service: HSz): Boolean;
begin
Result := False; if DdeCmpStringHandles(TopicHSz, Topic) = 0 then if DdeCmpStringHandles(ServiceHSz, Service) = 0 then Result := True; end;

{ Определяем, один ли Topic и Item поддерживается этим приложением. Возвращаем номер заданного элемента (Item Number) (в пределах 1..NumValues), если он обнаружен, и ноль в противном случае.}

function TForm1.MatchTopicAndItem(Topic, Item: HSz): Integer;
var
I : Integer; begin
Result := 0; if DdeCmpStringHandles(TopicHSz, Topic) = 0 then for I := 1 to NumValues do if DdeCmpStringHandles(ItemHSz[I], Item) = 0 then Result := I; end;

{ Отвечаем на запрос wildcard-соединения (дословно - дикая карта, шаблон). Такие запросы возникают всякий раз, когда клиент пытается подключиться к серверу с сервисом или именем топика, установленного в 0. Если сервер обнаруживает использование такого рода шаблона, он возвращает дескриптор массива THSZPair, содержащего найденные по шаблону Service и Topic.}
function TForm1.WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData;
var
TempPairs: array [0..1] of THSZPair; Matched  : Boolean; begin
TempPairs[0].hszSvc  := ServiceHSz; TempPairs[0].hszTopic:= TopicHSz; TempPairs[1].hszSvc  := 0;     { 0-завершает список } TempPairs[1].hszTopic:= 0;
Matched := False;
if (Topic= 0) and (Service = 0) then Matched := True                    { Шаблон обработан, элементов не найдено } else if (Topic = 0) and (DdeCmpStringHandles(Service, ServiceHSz) = 0) then Matched := True else if (DdeCmpStringHandles(Topic, TopicHSz) = 0) and (Service = 0) then Matched := True;
if Matched then WildConnect := DdeCreateDataHandle(Inst, @TempPairs, SizeOf(TempPairs), 0, 0, ClipFmt, 0) else WildConnect := 0; end;

{ Принимаем и проталкиваем данные по просьбе клиента. Для демонстрации этого способа используем только значение DataItem1, изменяемое Poke.}
function TForm1.AcceptPoke(Item: HSz; ClipFmt: Word;
Data: HDDEData): Boolean; var
DataStr    : TDataString; Err       : Integer; TempSample: Integer; begin
if
(DdeCmpStringHandles(Item, ItemHSz[1]) = 0) and (ClipFmt = cf_Text) then begin DdeGetData(Data, @DataStr, SizeOf(DataStr), 0); Val(DataStr, TempSample, Err);
if IntToStr(TempSample) <> Label6.Caption then begin Label6.Caption := IntToStr(TempSample); DataSample[1] := TempSample; if Advising[1] then DdePostAdvise(Inst, TopicHSz, ItemHSz[1]); end; AcceptPoke := True; end else AcceptPoke := False; end;

{ Возвращаем данные, запрашиваемые значениями TransType и ClipFmt. Такое может произойти в ответ на просьбу xtyp_Request или xtyp_AdvReq. Параметр ItemNum указывает на поддерживаемый (в диапазоне 1..NumValues) и требуемый элемент (обратите внимание на то, что данный метод подразумевает, что вызывающий оператор уже установил достоверность и ID требуемого пункта с помощью MatchTopicAndItem). Соответствующие данные из переменной экземпляра DataSample преобразуются в текст и возвращаются клиенту.}

function TForm1.DataRequested(TransType: Word; ItemNum: Integer;
ClipFmt: Word): HDDEData; var ItemStr: TDataString;   { Определено в DataEntry.TPU }

begin
if
ClipFmt = cf_Text then begin Str(DataSample[ItemNum], ItemStr); DataRequested := DdeCreateDataHandle(Inst, @ItemStr, StrLen(ItemStr) + 1, 0, ItemHSz[ItemNum], ClipFmt, 0); end else DataRequested := 0; end;

{ Создаем экземпляр окна DDE сервера. Вызываем унаследованный конструктор, затем устанавливаем эти объекты родителями экземпляров данных. }

procedure TForm1.FormCreate(Sender: TObject);
var I : Integer;
begin
Inst      := 0;      { Должен быть нулем для первого вызова DdeInitialize } @CallBack := nil;    { MakeProcInstance вызывается из SetupWindow         }
for I := 1 to NumValues do begin DataSample[I] := 0; Advising[I]  := False; end; { for }
end;

{ Разрушаем экземпляр окна DDE сервера. Проверяем, был ли создан экземпляр процедуры обратного вызова, если он существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка.}

procedure TForm1.FormDestroy(Sender: TObject);
var
I : Integer; begin
if
ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz); if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz); for I := 1 to NumValues do if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]);
if Inst <> 0 then DdeUninitialize(Inst);   { Игнорируем возвращаемое значение }
if @CallBack <> nil then FreeProcInstance(@CallBack); end;

procedure TForm1.FormShow(Sender: TObject);
var
I : Integer; { Завершаем инициализацию окна DDE сервера. Процедура инициализации использует DDEML для регистрации сервисов, предусмотренных данным приложением. Помните о том, что реальные имена, использованные в регистрах, определены в отдельном модуле (DataEntry), поэтому они могут быть использованы и клиентом. }

begin
@CallBack:= MakeProcInstance(@CallBackProc, HInstance);
if DdeInitialize(Inst, CallBack, 0, 0) = dmlErr_No_Error then begin ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi); TopicHSz  := DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi); for I := 1 to NumValues do ItemHSz[I] := DdeCreateStringHandle(Inst, DataItemNames[I], cp_WinAnsi);
if DdeNameService(Inst, ServiceHSz, 0, dns_Register) = 0 then ShowMessage('Ошибка в процессе регистрации.'); end; end;

procedure TForm1.EnterData1Click(Sender: TObject);
{ Активизируем диалог ввода данных и обновляем хранимые данные по окончании ввода.}
var
I: Integer;
begin
if
DataEntry.ShowModal = mrOk then begin with DataEntry do begin Label6.Caption := S1; Label7.Caption := S2; Label8.Caption := S3; DataSample[1] := StrToInt(S1); DataSample[2] := StrToInt(S2); DataSample[3] := StrToInt(S3); end; { with }
for I := 1 to NumValues do if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]); end; { if } end;

procedure TForm1.Clear1Click(Sender: TObject);
{ Очищаем текущую дату. }
var
I: Integer;
begin
for
I := 1 to NumValues do begin DataSample[I] := 0; if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]); end;
Label6.Caption := '0'; Label7.Caption := '0'; Label8.Caption := '0'; end;

end.
{ ***  КОНЕЦ КОДА DDESVRU.PAS *** }

{ *** НАЧАЛО КОДА DDEDLG.DFM *** }
object DataEntry: TDataEntry
Left = 488 Top = 132 ActiveControl = OKBtn BorderStyle = bsDialog Caption = 'Ввод данных' ClientHeight = 264 ClientWidth = 199 Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] PixelsPerInch = 96 Position = poScreenCenter OnShow = FormShow TextHeight = 13 object Bevel1: TBevel Left = 8 Top = 8 Width = 177 Height = 201 Shape = bsFrame IsControl = True end object OKBtn: TBitBtn Left = 16 Top = 216 Width = 69 Height = 39 Caption = '&OK' ModalResult = 1 TabOrder = 3 OnClick = OKBtnClick Glyph.Data = { BE060000424DBE06000000000000360400002800000024000000120000000100 0800000000008802000000000000000000000000000000000000000000000000 80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA A600000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000F0FBFF00A4A0A000808080000000 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00030303030303 0303030303030303030303030303030303030303030303030303030303030303 03030303030303030303030303030303030303030303FF030303030303030303 03030303030303040403030303030303030303030303030303F8F8FF03030303 03030303030303030303040202040303030303030303030303030303F80303F8 FF030303030303030303030303040202020204030303030303030303030303F8 03030303F8FF0303030303030303030304020202020202040303030303030303 0303F8030303030303F8FF030303030303030304020202FA0202020204030303 0303030303F8FF0303F8FF030303F8FF03030303030303020202FA03FA020202 040303030303030303F8FF03F803F8FF0303F8FF03030303030303FA02FA0303 03FA0202020403030303030303F8FFF8030303F8FF0303F8FF03030303030303 FA0303030303FA0202020403030303030303F80303030303F8FF0303F8FF0303 0303030303030303030303FA0202020403030303030303030303030303F8FF03 03F8FF03030303030303030303030303FA020202040303030303030303030303 0303F8FF0303F8FF03030303030303030303030303FA02020204030303030303 03030303030303F8FF0303F8FF03030303030303030303030303FA0202020403 030303030303030303030303F8FF0303F8FF03030303030303030303030303FA 0202040303030303030303030303030303F8FF03F8FF03030303030303030303 03030303FA0202030303030303030303030303030303F8FFF803030303030303 030303030303030303FA0303030303030303030303030303030303F803030303 0303030303030303030303030303030303030303030303030303030303030303 0303} Margin = 2 NumGlyphs = 2 Spacing = -1 IsControl = True end object CancelBtn: TBitBtn Left = 108 Top = 216 Width = 69 Height = 39 Caption = '&Отмена' TabOrder = 4 Kind = bkCancel Margin = 2 Spacing = -1 IsControl = True end object Panel2: TPanel Left = 16 Top = 88 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 1 object Label1: TLabel Left = 24 Top = 8 Width = 5 Height = 13 end object Label2: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 2:' end object Edit2: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end object Panel1: TPanel Left = 16 Top = 16 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 0 object Label4: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 1:' end object Edit1: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end object Panel3: TPanel Left = 16 Top = 144 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 2 object Label6: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 3:' end object Edit3: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end end
{ ***   КОНЕЦ КОДА DDEDLG.DFM *** }

{ *** НАЧАЛО КОДА DDEDLG.PAS *** }
{***************************************************}
{                                                   }
{   Delphi 1.0 DDEML Демонстрационная программа     }
{   Copyright (c) 1996 by Borland International     }
{                                                   }
{***************************************************}

{ Данный модуль определяет интерфейс сервера DataEntry DDE
(DDEMLSRV.PAS). Здесь определены имена Service, Topic, и Item, поддерживаемые сервером, и также определена структура данных, которая может использоваться клиентом для локального хранения "показательных" данных.
Сервер Data Entry Server делает свои "показательные" данные доступными в текстовом виде (cf_Text) сформированными в виде трех различных топика (Topics). Клиент может их преобразовывать в целое для использования со структурой данных, которая здесь определена. }
unit Ddedlg;

interface

uses
WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, Mask, ExtCtrls;
type
TDataEntry = class(TForm) OKBtn: TBitBtn; CancelBtn: TBitBtn; Bevel1: TBevel; Panel2: TPanel; Label1: TLabel; Label2: TLabel; Panel1: TPanel; Label4: TLabel; Panel3: TPanel; Label6: TLabel; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure OKBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public S1, S2, S3: String; { Public declarations } end;
var
DataEntry: TDataEntry;
implementation

{$R *.DFM}

procedure TDataEntry.OKBtnClick(Sender: TObject);
begin
S1 := Edit1.Text; S2 := Edit2.Text; S3 := Edit3.Text; end;

procedure TDataEntry.FormShow(Sender: TObject);
begin
Edit1.Text := '0'; Edit2.Text := '0'; Edit3.Text := '0'; Edit1.SetFocus; end;

end.
{ ***  КОНЕЦ КОДА DDEDLG.PAS *** }

[001424]



Содержание раздела