procedure SaveToClipBoard(Text: String);
var
  Cs: PChar;
  hData: THandle;
begin
  if OpenClipBoard(Form1.Handle) then
    begin
      EmptyClipBoard;
      hData := GlobalAlloc(GMem_Moveable or GMem_DDEShare, Length(Text));
      Cs := GlobalLock(hData);
      StrPCopy(Cs, Text);
      GlobalUnLock(hData);
      SetClipBoardData(cf_Text, hData);
      CloseClipBoard;
    end;
end;