嘿，我仔细看了你的代码，找到了导致程序崩溃的两个核心问题，同时给你准备了两种符合需求的修改方案，让程序能稳定重复生成随机抽取序列：

先说说你代码里的坑 #

1. 数组索引越界直接炸程序 #

在Button3Click的这段循环里：

for i := 0 to Memo2.Lines.Count do
  if Pos(s, Memo2.Lines[i]) > 0 then
    atribuit := true; {该主题已被抽取过}

Memo2.Lines.Count是当前已有的行数，而Delphi的字符串列表索引是从0到Count-1的，你循环到Count等于访问了一个不存在的位置，直接触发内存访问错误，程序当场崩溃。

2. 抽完所有主题后无限死循环 #

当Memo2里已经存了Memo1的所有主题时，while atribuit = true的循环会一直跑——因为永远找不到未被抽取的主题，程序要么假死要么因为其他连带问题崩溃。

两种修改方案任你选 #

根据你“重复生成随机抽取序列”的需求，我给你准备了两种实现方式：

方式一：允许重复抽取（最简单） #

如果不需要避免重复，已抽过的主题可以再次被选中，直接去掉检查逻辑就行，代码清爽又稳定：

procedure TForm1.Button3Click(Sender: TObject);
var
  s: string;
begin
  // 先检查有没有加载主题文件，避免空列表报错
  if Memo1.Lines.Count = 0 then
  begin
    ShowMessage('先加载主题文件呀！');
    Exit;
  end;

  // 随机选一行（Random(Count)会返回0到Count-1的数，正好对应列表索引）
  s := Memo1.Lines[Random(Memo1.Lines.Count)];
  Edit4.Text := Edit3.Text + ': ' + s;
  Memo2.Lines.Add(Edit4.Text);
end;

// 记得把Randomize移到Form创建时，只初始化一次就行，每次点按钮都初始化会搞乱随机序列
procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

方式二：抽完一轮自动重置（不重复抽一轮） #

如果需要每一轮都不重复抽取，抽完所有主题后可以重置已抽取列表，开启新的一轮：

procedure TForm1.Button3Click(Sender: TObject);
var
  s: string;
  i: integer;
  atribuit: boolean;
begin
  // 先检查主题文件是否加载
  if Memo1.Lines.Count = 0 then
  begin
    ShowMessage('先加载主题文件呀！');
    Exit;
  end;

  // 检查是否所有主题都抽完了，是的话询问是否重置
  if Memo2.Lines.Count >= Memo1.Lines.Count then
  begin
    if MessageDlg('所有主题都抽完啦，要不要开新的一轮？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      Memo2.Clear;
    end
    else
    begin
      Exit;
    end;
  end;

  atribuit := true;
  while atribuit = true do
  begin
    // 修正Random参数，用Count更直观
    s := Memo1.Lines[Random(Memo1.Lines.Count)];
    atribuit := false;
    // 修正循环边界，避免越界
    for i := 0 to Memo2.Lines.Count - 1 do
    begin
      // 这里改成精确对比，避免因为主题里有相似片段导致误判
      // 因为你存到Memo2的格式是"姓名: 序号. 主题"，所以提取后面的主题部分对比
      if s = Copy(Memo2.Lines[i], Pos(': ', Memo2.Lines[i]) + 2, Length(Memo2.Lines[i])) then
      begin
        atribuit := true;
        Break; // 找到已抽的，直接跳出循环，不用继续查了
      end;
    end;
  end;

  Edit4.Text := Edit3.Text + ': ' + s;
  Memo2.Lines.Add(Edit4.Text);
end;

// 同样，Randomize只初始化一次
procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

额外的小优化 #

在加载文件的Button1Click里加个文件存在检查，避免加载不存在的文件报错：

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  if not FileExists(Edit1.Text) then
  begin
    ShowMessage('主题文件找不到哦！');
    Exit;
  end;
  Memo1.Lines.LoadFromFile(Edit1.Text);

  // 已抽取文件不存在的话就清空Memo2，避免报错
  if FileExists(Edit2.Text) then
  begin
    Memo2.Lines.LoadFromFile(Edit2.Text);
  end
  else
  begin
    Memo2.Clear;
  end;

  // 给主题加序号
  for i := 0 to Memo1.Lines.Count-1 do
    Memo1.Lines[i] := IntToStr(i+1) + '. ' + Memo1.Lines[i];
end;

内容的提问来源于stack exchange，提问作者Stefan