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

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

  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);