Source file: /~heha/messtech/motor.zip/SRC/SMSDDE.PAS

unit SMSDDE;
{Schrittmotor-DDE-Objekt}
interface

uses
 WinProcs, WinTypes,
 Win31, ODDE, DDEML, Strings, SMSH, SMSP;

const
 DdeLastSystem=5;

 DdeSystemS: array[0..DdeLastSystem]of PChar=
 ('System','Topics','Formats','Help','TopicItemList','SysItems');

 DdeStrings:array[0..5]of PChar=(nil,DdeTopic+' %s','CF_TEXT',
  'MPK3 Schrittmotor-Ansteuerung'#13#10+
  'Topics: '+DdeTopic+' und %s (Alias)'#13#10+
  'Items: '+DdeItem1+' (enthaelt Position),'#13#10+
  '       '+DdeItem2+' (<>0 solange sich Motor bewegt),'#13#10+
  '       '+DdeItem3+' (<>0 wenn Referenzfahrt ausgefuehrt wurde)'#13#10+
  'Execs: Move xxx, Stop, Free, Sync, Init'#13#10,
{  'Execs: Move xxx (Position nach xxx setzen),'#13#10+
  '       Stop (Motor anhalten), Free (Spulen stromfrei schalten),'#13#10+
  '       Sync (nur Referenzfahrt), Init (vollst. mit Benutzermeldung)'#13#10,}
  DdeItem1+' '+DdeItem2+' '+DdeItem3,
  'Topics Formats Help TopicItemList SysItems');

type
 PMyDDE=^TMyDDE;
 TMyDDE=object(TDDE)
  MainWnd: HWnd;		{zum Versenden von Messages}
  ServiceHsz: Hsz;		{Stringhandles}
  DataHsz: array[0..DdeLastData]of Hsz;	{Index Null ist immer das Topic}
  SysHsz: array[0..DdeLastSystem]of Hsz;
  Alias: PChar; AliasHsz: Hsz;
  Connections: Integer;
  Advising: array[1..DdeLastData]of Byte;	{<>0 bedeutet autom. Info}
  constructor Init(SendMsgToWindow:HWnd);
  destructor Done; virtual;
  function _Connect(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _Disconnect(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _AdvStart(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _AdvStop(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _Request(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _Poke(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function _Execute(var DdeMsg:TDdeMsg):HDdeData; virtual;
  function CreateStringHandle(Str:PChar):Hsz;
  procedure FreeStringHandle(Stringhandle:Hsz);
  function IsData(var DdeMsg:TDdeMsg):Word;
  function IsSystem(var DdeMsg:TDdeMsg):Word;
  procedure Advise(Item:Word);	{Ruf von außen}
  procedure SetAlias(AnAlias:PChar);
{Rufe nach außen sind:
 - Verbindungsanzeige ein/aus (wParam=Bool)
 - Veränderung des Wertes (lParam=DataHandle)
 - Execute}
 end;

implementation

constructor TMyDDE.Init;
 var
  I: Integer;
 begin
  inherited Init(hInstance, CBF_Skip_Connect_Confirms or
   CBF_Skip_Registrations or CBF_Skip_Unregistrations);
  MainWnd:=SendMsgToWindow;	{Ziel-Fenster setzen}
  ServiceHsz:=CreateStringHandle(AppName);
  for I:=0 to DdeLastData do
   DataHsz[I]:=CreateStringHandle(DdeDataS[I]);
  for I:=0 to DdeLastSystem do
   SysHsz[I]:=CreateStringHandle(DdeSystemS[I]);
  AliasHsz:=0;
  Connections:=0;
  FillChar(Advising,sizeof(Advising),0);	{erst mal ColdLinks}
  if DdeNameService(Inst,ServiceHsz,0,DNS_Register)=0 then
   Error(3);
 end;

destructor TMyDDE.Done;
 var
  I:Integer;
 begin
  for I:=DdeLastData downto 0 do
   FreeStringHandle(DataHsz[i]);
  for I:=DdeLastSystem downto 0 do
   FreeStringHandle(SysHsz[i]);
  if AliasHsz<>0 then FreeStringHandle(AliasHsz);
  FreeStringHandle(ServiceHsz);
  inherited Done;
 end;

function TMyDDE._Connect;
 begin
 _Connect:=0;	{Keine Verbindung}
  if (DdeCmpStringHandles(DdeMsg.Hsz2,ServiceHsz)=0) then begin
   if (DdeCmpStringHandles(DdeMsg.Hsz1,DataHsz[0])=0)
   or (DdeCmpStringHandles(DdeMsg.Hsz1,AliasHsz)=0)
   or (DdeCmpStringHandles(DdeMsg.Hsz1,SysHsz[0])=0) then begin
    if Connections=0 then SendMessage(MainWnd,WM_Connect,1,0);
    Inc(Connections);
    _Connect:=1;		{Verbindung okay!}
   end;
  end;
 end;

function TMyDDE._Disconnect;
 begin
  Dec(Connections);
  if Connections=0 then SendMessage(MainWnd,WM_Connect,0,0);
				{Verbindungs-LED ausschalten}
 end;

function TMyDDE._Request;
 var
  S: TS31;
  W: Word;
  SP:PChar;
 begin
  _Request:=0;
  W:=IsData(DdeMsg);
  if W<>0 then begin	{String füllen lassen}
   SendMessage(MainWnd,WM_Request,W,LongInt(@S));
   _Request:=DdeCreateDataHandle(Inst,@S,lStrLen(S)+1,0,DataHsz[W],CF_Text,0);
  end else begin
   W:=IsSystem(DdeMsg);
   if W<>0 then begin
    GetMem(SP,1024);	{viel Platz für den String ohne Stackbelastung}
    wvsprintf(SP,DdeStrings[W],Alias);	{Vorhandenes Alias einsetzen}
    _Request:=DdeCreateDataHandle(Inst,SP,lStrLen(SP)+1,
     0,SysHsz[W],CF_Text,0);
    FreeMem(SP,1024);
   end;
  end;
 end;

function TMyDDE._AdvStart;
 var
  W: Word;
 begin
  _AdvStart:=0;
  W:=IsData(DdeMsg);
  if W<>0 then begin
   if Advising[W]<255 then	{Anzahl erhöhen, jedoch}
    Inc(Advising[W]);		{ohne Überlauf!}
   _AdvStart:=1;
  end;
 end;

function TMyDDE._AdvStop;
 var
  W: Word;
 begin
  _AdvStop:=0;
  W:=IsData(DdeMsg);
  if W<>0 then begin
   if Advising[W]>0 then	{Anzahl erniedrigen, jedoch}
    Dec(Advising[W]);		{ohne Unterlauf!}
   _AdvStop:=1;
  end;
 end;

function TMyDDE._Poke;
 var
  S:TS31;
  W:Word;
 begin
  _Poke:=DDE_FNotProcessed;	{Pessimistisch}
  W:=IsData(DdeMsg);
  if W<>0 then begin
   S[DdeGetData(DdeMsg.Data,@S,sizeof(S)-1,0)]:=#0;
   _Poke:=SendMessage(MainWnd,WM_Poke,W,LongInt(@S));
  end;
 end;

function TMyDDE._Execute;
 var
  S:TS31;
 begin
  _Execute:=DDE_FNotProcessed;
  if (DdeCmpStringHandles(DdeMsg.Hsz1,DataHsz[0])=0)
  or (DdeCmpStringHandles(DdeMsg.Hsz1,AliasHsz)=0) then begin
   DdeGetData(DdeMsg.Data,@S,sizeof(S),0);
   _Execute:=SendMessage(MainWnd,WM_Execute,lStrLen(S)+1,LongInt(@S));
  end;
 end;

function TMyDDE.CreateStringHandle;
 var Stringhandle: Hsz;
 begin
  Stringhandle:=DdeCreateStringHandle(Inst,Str,CP_WinAnsi);
  CreateStringHandle:=StringHandle;
  if StringHandle=0 then Error(2);
 end;

procedure TMyDDE.FreeStringHandle;
 begin
  if Stringhandle<>0 then
   DdeFreeStringHandle(Inst,StringHandle);
 end;

procedure TMyDDE.Advise(Item:Word);
 {Änderungen mitteilen, wenn gewünscht (Warm (Hot?)-Link)}
 begin
  if Advising[Item]<>0 then
   DdePostAdvise(Inst,DataHsz[0],DataHsz[Item]);
 end;

procedure TMyDDE.SetAlias(AnAlias:PChar);
 begin
  if AliasHsz<>0 then FreeStringHandle(AliasHsz);
  if AnAlias<>nil then begin
   AliasHsz:=CreateStringHandle(AnAlias);
   Alias:=AnAlias;
  end else begin
   AliasHsz:=0;
   Alias:='';		{Merker für Ausgabe niemals nil setzen!}
  end;
 end;

function TMyDDE.IsData(var DdeMsg:TDdeMsg):Word;
 var
  W: Word;
 begin
  IsData:=0;	{Kein Datum!}
  if DdeMsg.Fmt<>CF_Text then exit;
  if (DdeCmpStringHandles(DdeMsg.Hsz1,DataHsz[0])<>0)
  and (DdeCmpStringHandles(DdeMsg.Hsz1,AliasHsz)<>0) then exit;
  for W:=1 to DdeLastData do
   if DdeCmpStringHandles(DdeMsg.Hsz2,DataHsz[W])=0 then begin
    IsData:=W;
    exit;
   end;
 end;

function TMyDDE.IsSystem(var DdeMsg:TDdeMsg):Word;
 var
  W: Word;
 begin
  IsSystem:=0;	{Kein Datum!}
  if DdeMsg.Fmt<>CF_Text then exit;
  if DdeCmpStringHandles(DdeMsg.Hsz1,SysHsz[0])<>0 then exit;
  for W:=1 to DdeLastSystem do
   if DdeCmpStringHandles(DdeMsg.Hsz2,SysHsz[W])=0 then begin
    IsSystem:=W;
    exit;
   end;
 end;

end.
Detected encoding: OEM (CP437)1
Wrong umlauts? - Assume file is ANSI (CP1252) encoded