Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

TDataSample = array[1..NumValues] ofInteger;

{type

{ Структура данных, составляющих образец }

{ TDataSample = array [1..NumValues] of Integer;

{ TDataString = array [0..20] of Char; { Размер элемента как текста }

const

DataEntryName: PChar = 'DataEntry';

DataTopicName: PChar = 'SampledData';

typeTForm1 = 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;

procedureExit1Click(Sender: TObject);

functionMatchTopicAndService(Topic, Service: HSz): Boolean;

functionMatchTopicAndItem(Topic, Item: HSz): Integer;

functionWildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData;

functionAcceptPoke(Item: HSz; ClipFmt: Word;Data: HDDEData): Boolean;

functionDataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData;

procedureFormCreate(Sender: TObject);

procedureFormDestroy(Sender: TObject);

procedureFormShow(Sender: TObject);

procedureEnterData1Click(Sender: TObject);

procedureClear1Click(Sender: TObject);

private

Inst : Longint;

CallBack : TCallback;

ServiceHSz : HSz;

TopicHSz : HSz;

ItemHSz : array[1..NumValues] ofHSz;

ConvHdl : HConv;

Advising : array[1..NumValues] ofBoolean;

DataSample : TDataSample;

public

{ Public declarations }

end;

varForm1: TForm1;

implementation

usesDDEDlg; { Форма DataEntry }

{$R *.DFM}

procedureTForm1.Exit1Click(Sender: TObject);

begin

Close;

end;

{ Глобальная инициализация }

const

DemoTitle: PChar = 'DDEML демо, серверное приложение';

MaxAdvisories = 100;

NumAdvLoops : Integer = 0;

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

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

functionCallbackProc(CallType, Fmt: Word; Conv: HConv; HSz1, HSz2: HSZ; Data: HDDEData; Data1, Data2: Longint): HDDEData; export;

var

ItemNum: Integer;

begin

CallbackProc := 0; { В противном случае смотрите доказательство }

caseCallType of

xtyp_WildConnect:

CallbackProc := Form1.WildConnect(HSz1, HSz2, Fmt);

xtyp_Connect:

ifConv = 0 then begin

ifForm1.MatchTopicAndService(HSz1, HSz2) thenCallbackProc := 1; { Связь! }

end;

{ После подтверждения установки соединения записываем дескриптор связи как родительское окно.}

xtyp_Connect_Confirm:

Form1.ConvHdl := Conv;

{ Клиент запрашивает данные, делает прямой запрос или отвечает на уведомление. Возвращаем текущее состояние данных.}

xtyp_AdvReq, xtyp_Request:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

ifItemNum > 0 thenCallbackProc := Form1.DataRequested(CallType, ItemNum, Fmt);

end;

{ Отвечаем на Poke-запрос ... данная демонстрация допускает только Pokes для DataItem1. Для подтверждения получения запроса возвращаем dde_FAck, в противном случае 0.}

xtyp_Poke:

begin

ifForm1.AcceptPoke(HSz2, Fmt, Data) thenCallbackProc := dde_FAck;

end;

{ Клиент сделал запрос для старта цикла-уведомления. Имейте в виду, что мы организуем "горячий" цикл. Устанавливаем флаг Advising для указания открытого цикла, который будет проверять данные на предмет их изменения.}

xtyp_AdvStart:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

ifItemNum > 0 then begin

ifNumAdvLoops < MaxAdvisories then begin

{ Произвольное число }

Inc(NumAdvLoops);

Form1.Advising[ItemNum] := True;

CallbackProc := 1;

end;

end;

end;

{ Клиент сделал запрос на прерывание цикла-уведомления.}

xtyp_AdvStop:

begin

ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);

ifItemNum > 0 then begin

ifNumAdvLoops > 0 then begin

Dec(NumAdvLoops);

ifNumAdvLoops = 0 thenForm1.Advising[ItemNum] := False;

CallbackProc := 1;

end;

end;

end;