发信人: lofe ()感激生活(), 信区: BorlandDev
标  题: .在Delphi中通过Win API调用DDE
发信站: 哈工大紫丁香 (Mon Sep  4 16:20:43 2000), 转信

Its fairly easy to accomplish, following is an example of how to have a
client program talk with a server program. Both are completely written in
Delphi. In total there are 2 projects, 3 forms, and 3 units. This demo
uses DDE ML API methods to handle the DDE requests.

The server must be running before the client will load. This demo program
shows 3 different ways data can be moved between a client and a server.

1. The Client can 'POKE' data to the server.
2. The Server can automaticaly pass data to the Client and the Client
will update a graph based on the results from the Server.
3. The Server's Data changes, then the Client will make a request to the
Server for the new data, then update the graph.

***** How to handle the program. *****

Following are 8 files concatenated together. Each one has a
{ *** BEGIN CODE FOR FILENAME.EXT *** } CODE { *** END CODE FOR
FILENAME.EXT *** } take each block of code BETWEEN THE { *** } lines and
place in a file of the corresponding name, then compile and have fun !!!!



{ *** BEGIN CODE FOR DDEMLCLI.DPR *** }
program Ddemlcli;

uses
Forms,
Ddemlclu in 'DDEMLCLU.PAS' {Form1};

{$R *.RES}

begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
{ *** END CODE FOR DDEMLCLI.DPR *** }


{ *** BEGIN CODE FOR DDEMLCLU.DFM *** }
object Form1: TForm1
Left = 197
Top = 95
Width = 413
Height = 287
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
Caption = 'DDEML Demo, Client Application'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
Menu = MainMenu1
PixelsPerInch = 96
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
TextHeight = 16
object PaintBox1: TPaintBox
Left = 0
Top = 0
Width = 405
Height = 241
Align = alClient
Color = clWhite
ParentColor = False
OnPaint = PaintBox1Paint
end
object MainMenu1: TMainMenu
Top = 208
object File1: TMenuItem
Caption = '&File'
object exit1: TMenuItem
Caption = 'E&xit'
OnClick = exit1Click
end
end
object DDE1: TMenuItem
Caption = '&DDE'
object RequestUpdate1: TMenuItem
Caption = '&Request an Update'
OnClick = RequestUpdate1Click
end
object AdviseofChanges1: TMenuItem
Caption = '&Advise of Changes'
OnClick = AdviseofChanges1Click
end
object N1: TMenuItem
Caption = '-'
end
object PokeSomeData: TMenuItem
Caption = '&Poke Some Data'
OnClick = PokeSomeDataClick
end
end
end
end
{ *** END CODE FOR DDEMLCLU.DFM *** }

{ *** BEGIN CODE FOR DDEMLCLU.PAS *** }
{***************************************************}
{ }
{ Delphi 1.0 DDEML Demonstration Program }
{ Copyright (c) 1996 by Borland International }
{ }
{***************************************************}

{ This is a sample application demonstrating the use of the DDEML APIs in
a client application. It uses the DataEntry server application that
is part of this demo in order to maintain a display of the entered data
as a bar graph.

You must run the server application first (in DDEMLSRV.PAS), and then
run this client. If the server is not running, this application will
fail trying to connect.

The interface to the server is defined by the list of names (Service,
Topic, and Items) in the separate unit called DataEntry (DATAENTR.TPU).
The server makes the Items available in cf_Text format; they are con-
verted and stored locally as integers.
}

unit Ddemlclu;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, VBXCtrl, ExtCtrls, DDEML, Menus, StdCtrls;

const
NumValues = 3;

type

{ Data Structure which constitutes a sample }
TDataSample = array [1..NumValues] of Integer;
TDataString = array [0..20] of Char; { Size of Item as text }

{ Main Form }
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}

{ Local Function: CallBack Procedure for DDEML }

function CallbackProc(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ;
Data: HDDEData; Data1, Data2: Longint): HDDEData; export;
begin
CallbackProc := 0; { See if proved otherwise }

case CallType of
xtyp_Register:
begin
{ Nothing ... Just return 0 }
end;
xtyp_Unregister:
begin
{ Nothing ... Just return 0 }
end;
xtyp_xAct_Complete:
begin
{ Nothing ... Just return 0 }
end;
xtyp_Request, Xtyp_AdvData:
begin
Form1.Request(Conv);
CallbackProc := dde_FAck;
end;
xtyp_Disconnect:
begin
ShowMessage('Disconnected!');
Form1.Close;
end;
end;
end;


{ Posts a DDE request to obtain cf_Text data from the server. Requests
the data for all fields of the DataSample, and invalidates the window
to cause the new data to be displayed. Obtains the data from the
Server synchronously, using 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; { Redisplay the Screen }
end; { if }
end;


procedure TForm1.FormCreate(Sender: TObject);
var
I : Integer;
{ Constructs an instance of the DDE Client Window. Constructs the
window using the inherited constructor, then initializes the instance
data.
}
begin
Inst := 0; { Must be zero for first call to DdeInitialize }
CallBackPtr:= nil; { MakeProcInstance is called in 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);
{ Destroys an instance of the Client window. Frees the DDE string
handles, and frees the callback proc instance if they exist. Also
calls DdeUninitialize to terminate the conversation. Then calls on
the ancestral destructor to finish the job.
}
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); { Ignore the return value }

if CallBackPtr <> nil then
FreeProcInstance(CallBackPtr);
end;

procedure TForm1.RequestUpdate1Click(Sender: TObject);
begin
{ Generate a DDE Request in response to the DDE | Request menu selection.}
Request(ConvHdl);
end;

procedure TForm1.FormShow(Sender: TObject);
{ Completes the initialization of the DDE Server Window. Performs those
actions which require a valid window. Initializes the use of the DDEML.
}
var
I : Integer;
InitOK: Boolean;
begin
CallBackPtr := MakeProcInstance(@CallBackProc, HInstance);

{ Initialize the DDE and setup the callback function. If server is not
present, call will fail.
}
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);
end;

if (ServiceHSz <> 0) and (TopicHSz <> 0) and InitOK then begin
ConvHdl := DdeConnect(Inst, ServiceHSz, TopicHSz, nil);
if ConvHdl = 0 then begin
ShowMessage('Can not start Conversation!');
Close;
end
end
else begin
ShowMessage('Can not create Strings!');
Close;
end
end
else begin
ShowMessage('Can not Initialie!');
Close;
end;
end;
end;

procedure TForm1.AdviseofChanges1Click(Sender: TObject);
{ Toggles the state of the DDE Advise setting in response to the
DDE | Advise menu selection. When this is selected, all three
Items are set for Advising.
}
var
I: Integer;
TransType: Word;
TempResult: Longint;
begin
with TMenuITem(Sender) do begin
Checked := not Checked;
if Checked then
TransType:= (xtyp_AdvStart or xtypf_AckReq)
else
TransType:= xtyp_AdvStop;
end; { with }

for I := Low(ItemHSz) to High(ItemHSz) do
if DdeClientTransaction(nil, 0, ConvHdl, ItemHSz[I], cf_Text,
TransType, 1000, @TempResult) = 0 then
ShowMessage('Can not perform Advise Transaction');

if TransType and xtyp_AdvStart <> 0 then Request(ConvHdl);
end;

procedure TForm1.PokeSomeDataClick(Sender: TObject);
{ Generates a DDE Poke transaction in response to the DDE | Poke
menu selection. Requests a value from the user that will be
poked into DataItem1 as an illustration of the Poke function.
}
var
DataStr: pChar;
S: String;
begin
S := '0';
if InputQuery('PokeData', 'Enter Value to Poke', S) then begin
S := S + #0;
DataStr := @S[1];
DdeClientTransaction(DataStr, StrLen(DataStr) + 1, ConvHdl,
ItemHSz[1], cf_Text, xtyp_Poke, 1000, nil);
Request(ConvHdl);
end;
end;

procedure TForm1.exit1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
{ Repaints the window on request. Plots a graph of the current sales
volume.
}
const
LMarg = 30; { Left Margin of graph }
var
I,
Norm: Integer;
Wd: Integer;
Step : Integer;

ARect: TRect;

begin
Norm := 0;
for I := Low(DataSample) to High(DataSample) do begin
if abs(DataSample[I]) > Norm then
Norm := abs(DataSample[I]);
end; { for }

if Norm = 0 then Norm := 1; { Just in case we have all zeros }

with TPaintBox(Sender).Canvas do begin
{ Paint Background }
Brush.color := clWhite;
FillRect(ClipRect);

{ Draw Axis }
MoveTo(0, ClipRect.Bottom div 2);
LineTo(ClipRect.Right, ClipRect.Bottom div 2);

MoveTo(LMarg, 0);
LineTo(LMarg, ClipRect.Bottom);

{ Print Left MArgin Text }
TextOut(0,0, IntToStr(Norm));
TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom + Font.Height, IntToStr(-Norm));

TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom div 2, '0');
{ Print X Axis Text }

{ Now draw the bars based on that Normalized value. Compute the
width of the bars so that all will fit in the window, and
compute an inter-bar space that is approximately 20% of the
width of a bar.
}
{ SelectObject(PaintDC, CreateSolidBrush(RGB(255, 0, 0)));
SetBkMode(PaintDC, Transparent);
}
ARect := ClipRect;
Wd := (ARect.Right - LMarg) div NumValues;
Step := Wd div 5;
Wd := Wd - Step;
with ARect do begin
Left := LMarg + (Step div 2);
Top := ClipRect.Bottom div 2;
end; { with }

{ Display Bars and X-Axis Text }
For i := Low(DataSample) to High(DataSample) do begin
with ARect do begin
Right := Left + Wd;
Bottom:= Top - Round((Top-5) * (DataSample[I] / Norm));
end; { with }
{ Fill Bar }
Brush.color := clFuchsia;
FillRect(ARect);
{ Display Text - Horizontal Axis }
Brush.color := clWhite;
TextOut(ARect.Left, ClipRect.Bottom div 2 - Font.Height,
StrPas(DataItemNames[i]));
with ARect do
Left := Left + Wd + Step;
end; { for }
end; { with }
end;
end.{ *** END CODE FOR DDEMLCLU.PAS *** }



{ *** BEGIN CODE FOR DDEMLSVR.DPR *** }
program Ddemlsvr;

uses
Forms,
Ddesvru in 'DDESVRU.PAS' {Form1},
Ddedlg in '\DELPHI\BIN\DDEDLG.PAS' {DataEntry};

{$R *.RES}

begin
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDataEntry, DataEntry);
Application.Run;
end.
{ *** END CODE FOR DDEMLSVR.DPR *** }

{ *** BEGIN CODE FOR DDESVRU.DFM *** }
object Form1: TForm1
Left = 712
Top = 98
Width = 307
Height = 162
Caption = 'DDEML Demo, Serve Application'
Color = clWhite
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
Menu = MainMenu1
PixelsPerInch = 96
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
TextHeight = 16
object Label1: TLabel
Left = 0
Top = 0
Width = 99
Height = 16
Caption = 'Current Values:'
end
object Label2: TLabel
Left = 16
Top = 24
Width = 74
Height = 16
Caption = 'Data Item1:'
end
object Label3: TLabel
Left = 16
Top = 40
Width = 74
Height = 16
Caption = 'Data Item2:'
end
object Label4: TLabel
Left = 16
Top = 56
Width = 74
Height = 16
Caption = 'Data Item3:'
end
object Label5: TLabel
Left = 0
Top = 88
Width = 265
Height = 16
Caption = 'Select Data|Enter Data to change values.'
end
object Label6: TLabel
Left = 96
Top = 24
Width = 8
Height = 16
Caption = '0'
end
object Label7: TLabel
Left = 96
Top = 40
Width = 8
Height = 16
Caption = '0'
end
object Label8: TLabel
Left = 96
Top = 56
Width = 8
Height = 16
Caption = '0'
end
object MainMenu1: TMainMenu
Left = 352
Top = 24
object File1: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = '&Exit'
OnClick = Exit1Click
end
end
object Data1: TMenuItem
Caption = '&Data'
object EnterData1: TMenuItem
Caption = '&Enter Data'
OnClick = EnterData1Click
end
object Clear1: TMenuItem
Caption = '&Clear'
OnClick = Clear1Click
end
end
end
end
{ *** END CODE FOR DDESVRU.DFM *** }

{ *** BEGIN CODE FOR DDESVRU.PAS *** }
{***************************************************}
{ }
{ Delphi 1.0 DDEML Demonstration Program }
{ Copyright (c) 1996 by Borland International }
{ }
{***************************************************}

{ This sample application uses the DDEML library in the server side of a
cooperative application. This server is a simple data-entry application
which allows an operator to enter three data items, which are made
available through DDE to interested clients.

This server makes its service available under the following names:

Service: 'DataEntry'
Topic : 'SampledData'
Items : 'DataItem1', 'DataItem2', 'DataItem3'

Conceivably, other topics under this service could be defined. Things
such as historical data, information about the sampling, and so on
might make useful topics.

You must run this server BEFORE running the client (DDEMLCLI.PAS), or
the client will fail the connection.

The interface to this server is defined by the list of names (Service,
Topic, and Items) in the separate unit called DataEntry (DATAENTR.TPU).
The server makes the Items available in cf_Text format; they can be
converted and stored locally as integers by the client.
}
unit Ddesvru;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Menus,

DDEML, { DDE APi }
ShellApi;

const
NumValues = 3;
DataItemNames : array [1..NumValues] of PChar = ('DataItem1',
'DataItem2',
'DataItem3');
type
TDataString = array [0..20] of Char; { Size of Item as text }
TDataSample = array [1..NumValues] of Integer;


{type
{ Data Structure which constitutes a sample }
{ TDataSample = array [1..NumValues] of Integer;
{ TDataString = array [0..20] of Char; { Size of Item as text }

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 Form }

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
{ Initialized globals }

const
DemoTitle : PChar = 'DDEML Demo, Server Application';

MaxAdvisories = 100;
NumAdvLoops : Integer = 0;


{ Local Function: CallBack Procedure for DDEML }

{ This callback procedure responds to all transactions generated by the
DDEML. The target Window object is obtained from the stored global,
and the appropriate methods within that objects are used to respond
to the given transaction, as indicated by the CallType parameter.
}
function CallbackProc(CallType, Fmt: Word; Conv: HConv; HSz1, HSz2: HSZ;
Data: HDDEData; Data1, Data2: Longint): HDDEData; export;
var
ItemNum : Integer;
begin
CallbackProc := 0; { See if proved otherwise }


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; { Connected! }
end;
{ When a connection is confirmed, record the conversation handle as the
window's own.
}
xtyp_Connect_Confirm:
Form1.ConvHdl := Conv;

{ The client has requested data, either as a direct request or
in response to an advisory. Return the current state of the
data.
}
xtyp_AdvReq, xtyp_Request:
begin
ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);
if ItemNum > 0 then
CallbackProc := Form1.DataRequested(CallType, ItemNum, Fmt);
end;

{ Respond to Poke requests ... this demo only allows Pokes of DataItem1.
Return dde_FAck to acknowledge the receipt, 0 otherwise.
}
xtyp_Poke:
begin
if Form1.AcceptPoke(HSz2, Fmt, Data) then
CallbackProc := dde_FAck;
end;

{ The client has requested the start of an advisory loop. Note
that we assume a "hot" loop. Set the Advising flag to indicate
the open loop, which will be checked whenever the data is changed.
}
xtyp_AdvStart:
begin
ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);
if ItemNum > 0 then begin
if NumAdvLoops < MaxAdvisories then begin { Arbitrary number }
Inc(NumAdvLoops);
Form1.Advising[ItemNum] := True;
CallbackProc := 1;
end;
end;
end;

{ The client has requested the advisory loop to terminate.
}
xtyp_AdvStop:
begin
ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2);
if ItemNum > 0 then
begin
if NumAdvLoops > 0 then
begin
Dec(NumAdvLoops);
if NumAdvLoops = 0 then
Form1.Advising[ItemNum] := False;
CallbackProc := 1;
end;
end;
end;
end; { Case CallType }

end;

{ Returns True if the given Topic and Service match those supported
by this application. False otherwise.
}
function TForm1.MatchTopicAndService(Topic, Service: HSz): Boolean;
begin
Result := False;
if DdeCmpStringHandles(TopicHSz, Topic) = 0 then
if DdeCmpStringHandles(ServiceHSz, Service) = 0 then
Result := True;
end;

{ Determines if the given Topic and Item match one supported by this
application. Returns the Item Number of the supported item (in the
range 1..NumValues) if one is found, and zero if no match.
}
function TForm1.MatchTopicAndItem(Topic, Item: HSz): Integer;
var
I : Integer;
begin
Result := 0;
if DdeCmpStringHandles(TopicHSz, Topic) = 0 then
for I := 1 to NumValues do
if DdeCmpStringHandles(ItemHSz[I], Item) = 0 then
Result := I;
end;

{ Responds to wildcard connect requests. These requests are generated
whenever a client tries to connect to a server with either service or
topic name set to 0. If a server detects a wild card match, it
returns a handle to an array of THSZPair's containing the matching
supported Service and Topic.
}
function TForm1.WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData;
var
TempPairs: array [0..1] of THSZPair;
Matched : Boolean;
begin
TempPairs[0].hszSvc := ServiceHSz;
TempPairs[0].hszTopic:= TopicHSz;
TempPairs[1].hszSvc := 0; { 0-terminate the list }
TempPairs[1].hszTopic:= 0;

Matched := False;

if (Topic= 0) and (Service = 0) then
Matched := True { Complete wildcard }
else
if (Topic = 0) and (DdeCmpStringHandles(Service, ServiceHSz) = 0) then
Matched := True
else
if (DdeCmpStringHandles(Topic, TopicHSz) = 0) and (Service = 0) then
Matched := True;

if Matched then
WildConnect := DdeCreateDataHandle(Inst, @TempPairs, SizeOf(TempPairs),
0, 0, ClipFmt, 0)
else
WildConnect := 0;
end;

{ Accepts and acts upon Poke requests from the Client. For this
demonstration, allows only the value of DataItem1 to be changed by a
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;

{ Returns the data requested by the given TransType and ClipFmt values.
This could happen either in response to either an xtyp_Request or an
xtyp_AdvReq. The ItemNum parameter indicates which of the supported
items (in the range 1..NumValues) was requested (note that this method
assumes that the caller has already established validity and ID of the
requested item using MatchTopicAndItem). The corresponding data from
the DataSample instance variable is converted to text and returned.
}
function TForm1.DataRequested(TransType: Word; ItemNum: Integer;
ClipFmt: Word): HDDEData;
var ItemStr: TDataString; { Defined in 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;


{ Constructs an instance of the DDE Server Window. Calls on the
inherited constructor, then sets up this objects own instandce
data.
}
procedure TForm1.FormCreate(Sender: TObject);
var I : Integer;
begin
Inst := 0; { Must be zero for first call to DdeInitialize }
@CallBack := nil; { MakeProcInstance is called in SetupWindow }

for I := 1 to NumValues do begin
DataSample[I] := 0;
Advising[I] := False;
end; { for }

end;



{ Destroys an instance of the DDE Server Window. Checks to see if the
Callback Proc Instance had been created, and frees it if so. Also
calls DdeUninitialize to terminate the conversation. Then just calls
on the ancestral destructor to finish.
}
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); { Ignore the return value }

if @CallBack <> nil then
FreeProcInstance(@CallBack);
end;

procedure TForm1.FormShow(Sender: TObject);
var
I : Integer;
{ Completes the initialization of the DDE Server Window. Initializes
the use of the DDEML by registering the services provided by this
application. Recall that the actual names used to register are
defined in a separate unit (DataEntry), so that they can be used
by the client as well.
}
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('Registration failed.');
end;
end;

procedure TForm1.EnterData1Click(Sender: TObject);
{ Activates the data-entry dialog, and updates the stored
data when complete.
}
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);
{ Clears the current data.
}
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.
{ *** END CODE FOR DDESVRU.PAS *** }

{ *** BEGIN CODE FOR DDEDLG.DFM *** }
object DataEntry: TDataEntry
Left = 488
Top = 132
ActiveControl = OKBtn
BorderStyle = bsDialog
Caption = 'Data Entry'
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

--
※ 修改:．haojs 于 Sep  4 16:11:16 修改本文．[FROM: bbs.hit.edu.cn]
--
※ 转寄:．武汉白云黄鹤站 bbs.whnet.edu.cn．[FROM: bbs.hit.edu.cn]

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: haojs.bbs@bbs.whnet.]