Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
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);
