Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
{ Принимаем и проталкиваем данные по просьбе клиента. Для демонстрации этого способа используем только значение 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 = OK
BtnBorderStyle = 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 = OK
BtnClickGlyph.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
