Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

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

{ 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.}