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;