procedure TForm1.ManualRadioClick(Sender: TObject); begin if Automatic then begin RequestBtn.Enabled := ManualRadio.Checked; DDEClientConv1.ConnectMode := ddeManual; Automatic := False; end; end;
人工模式转换为自动模式:
procedure TForm1.AutoRadioClick(Sender: TObject); begin if not Automatic then begin RequestBtn.Enabled := ManualRadio.Checked; If (DDEService = '') or (DDETopic = '') then begin MessageDlg(' Can not Set Link.',mtWarning,[mbOK],0); Exit; end; DDEClientConv1.SetLink (DDEService, DDETopic); DDEClientItem1.DdeConv := DDEClientConv1; DDEClientItem1.DDEItem := DDEItem; DDEClientConv1.ConnectMode := ddeAutomatic; Automatic := True; end; end;
procedure TForm1.PasteBtnClick(Sender: TObject); begin if GetPasteLinkInfo (DDEService, DDETopic, DDEItem) then begin DDEClientConv1.SetLink (DDEService, DDETopic); if Automatic then begin DDEClientItem1.DdeConv := DDEClientConv1; DDEClientItem1.DDEItem := DDEItem; end; end; end;
procedure TForm1.RequestBtnClick(Sender: TObject); var TheData: PChar; begin If DDEItem = '' then begin MessageDlg('Can not Request Data',mtWarning,[mbOK],0); Exit; end; TheData := StrAlloc(79);
DDEClientConv1.OpenLink;
TheData := DDEClientConv1.RequestData(DDEItem);
DDEClientConv1.CloseLink;
if TheData <> nil then Memo1.Text := StrPas(TheData); StrDisPose(TheData); end;
procedure TForm1.PokeBtnClick(Sender: TObject); begin If DDEItem = '' then begin MessageDlg('Can not Poke Data.',mtWarning,[mbOK],0); Exit; end; if Automatic then DDEClientConv1.PokeDataLines(DDEItem,Memo1.Lines) else begin DDEClientConv1.OpenLink; DDEClientConv1.PokeDataLines(DDEItem,Memo1.Lines); DDEClientConv1.CloseLink; end; end;
function TForm1.SendMacro(Name: String;Command: String): Boolean; var Macro: String; Cmd: array[0..255] of Char; begin Result := True; if Name <> '' then begin Macro := Format('['+Command+'(%s)]', [Name]) + #13#10; StrPCopy (Cmd, Macro); DDEClient.OpenLink; if not DDEClient.ExecuteMacro(Cmd, False) then Result := False; DDEClient.CloseLink; end; end;
procedure TForm1.CreateButtonClick(Sender: TObject); var Name: String; begin Name := InputBox('Input Box','Input Group Name',''); if Name = '' then MessageDlg('Group name can not be blank.', mtError, [mbOK], 0) else if SendMacro(Name,'CreateGroup') = False then MessageDlg('Unable to create group.', mtInformation, [mbOK], 0); end;
添加程序项:
procedure TForm1.AddButtonClick(Sender: TObject); var Name: String; begin Name := InputBox('Input Box','Input application full_Path name',''); if Name = '' then MessageDlg('Application name can not be blank.', mtError, [mbOK], 0) else if SendMacro(Name,'AddItem') = False then MessageDlg('Unable to Add Item.', mtInformation, [mbOK], 0); end;
删除程序组:
procedure TForm1.DeleteButtonClick(Sender: TObject); var Name: String; begin Name := InputBox('Input Box','Input Group Name to be Deleted',''); if Name = '' then MessageDlg('Group name can not be blank.', mtError, [mbOK], 0) else if SendMacro(Name,'DeleteGroup') = False then MessageDlg('Unable to create group.', mtInformation, [mbOK], 0); end;
procedure TDdeSrvrForm.doMacro(Sender: TObject;Msg: TStrings); var Cmd: String; i: Integer; begin Cmd := ''; if Msg.Count = 0 then Exit; for I := 0 to Msg.Count-1 do begin Cmd := Msg.Strings[i]; if UpperCase(Cmd) = 'COPYDDE' then DDETestItem.CopyToClipboard else if UpperCase(Cmd) = 'CLEAR' then Memo1.text: = '' else if UpperCase(Cmd) = 'WS_NORMAL' then WindowState := wsNormal else if UpperCase(Cmd) = 'WS_MINIMIZED' then WindowState := wsMinimized else if UpperCase(Cmd) = 'WS_MAXIMIZED' then WindowState := wsMaximized else MessageDlg('Invalid Command',mtWarning,[mbOK],0); end; end;