1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

procedure ListBoxToClipboard(ListBox: TListBox;
  BufferSize: Integer;
  CopyAll: Boolean);
var
  Buffer: PChar;
  Size: Integer;
  Ptr: PChar;
  I: Integer;
  Line: string[255];
  Count: Integer;
begin
  if not Assigned(ListBox) then
    Exit;

  GetMem(Buffer, BufferSize);
  Ptr   := Buffer;
  Count := 0;
  for I := 0 to ListBox.Items.Count - 1 do
  begin
    Line := ListBox.Items.strings[I];
    if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then
      Continue;
    { Check buffer overflow }
    Count := Count + Length(Line) + 3;
    if Count = BufferSize then
      Break;
    { Append to buffer }
    Move(Line[1], Ptr^, Length(Line));
    Ptr    := Ptr + Length(Line);
    Ptr[0] := #13;
    Ptr[1] := #10;
    Ptr    := Ptr + 2;
  end;
  Ptr[0] := #0;
  ClipBoard.SetTextBuf(Buffer);
  FreeMem(Buffer, BufferSize);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure LBSelectedToZwablage(LB: TListBox);
var S : String;
    z : Integer;
begin
  with LB do
    begin
    for z := 0 to Items.Count-1 do
      begin
      if Selected[z] then
        S := S+Items[z]+#13#10;
      end;
    ClipBoard.AsText := S;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LBSelectedToZwablage(ListBox1);
end;					

1:
2:

if S <> '' then//neu
  ClipBoard.AsText := S;