求助：这段多线程代码为什么不稳定？

[hpygzhx520]

先描述一下情况：

程序用一按钮启动定时器（触发间隔5秒），定时器内循环创建8个线程，传递多个参数。线程函数就是在内存里面创建一个位图，然后写字。程序运行几分钟，或十几分钟后就会崩溃，无法定位出错点。

线程内的代码都是局部变量，也没有操作窗口上面的控件，我就不明白为什么不稳定？

初学delphi不久，折腾了一个星期无果，来此求助。不胜感激。

全部代码就这么点：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    Image1: TImage;
    Button2: TButton;
    Image2: TImage;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PParData = ^TParData;

  TParData = record
     cardNum:Integer;
     stationName:string;
     trunkNo:string;
     relatedFormID:string;
     materialName:string;
     taskState:string;
     materialNum:Integer;
     sl1:integer;
  end;
var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=True;//启动定时器
end;


function LEDThread(AParData: PParData):Boolean; stdcall;
var
  txtRect: Trect;
  fontObj: Longint;
  hBrush: Longint;
  memDC: Longint;
  hDisplayDC: Longint;
  newBitmap: Longint;
  oldpBitmap: Longint;
  myFont: Longint;
  oneItem:string;
begin
  hDisplayDC := GetDC(0);
  memDC := CreateCompatibleDC(hDisplayDC);
  newBitmap := CreateCompatibleBitmap(hDisplayDC, 320, 96);
  oldpBitmap := SelectObject(memDC, newBitmap);
  SetBkMode(memDC, TRANSPARENT);
  hBrush := CreateSolidBrush(0);
  FillRect(memDC, txtRect, hBrush);
  DeleteObject(hBrush);
  SetTextColor(memDC, 255);
  myFont := CreateFont(14, 7, 0, 0, 0, 0, 0, 0, GB2312_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, FF_ROMAN, '宋体');
  fontObj := SelectObject(memDC, myFont);
  DeleteObject(fontObj);

  with txtRect do // 出口
  begin
    Left := 130;
    Top := 16 * 0;
    Right := 320;
    Bottom := 16 * 1;
  end;
  oneItem:=AParData.stationName;
  //尝试用TextOut和DrawText两个函数，效果都差不多
  TextOut(memDC,txtRect.Left, txtRect.Top ,PChar(oneItem),Length(oneItem));
  //DrawText(memDC, PChar(AParData.stationName), -1, txtRect,DT_SINGLELINE Or DT_CENTER Or DT_VCENTER);
  //如果函数代码到此结束，观察，测试，程序是稳定的。一旦DrawText或TextOut在函数内使用大于一次，就会很不稳定
  with txtRect do
  begin
    Left := 8;
    Top := 16 * 1;
    Right := 320;
    Bottom := 16 * 2;
  end;
  oneItem:='车牌号: ' + AParData.trunkNo;
  TextOut(memDC,txtRect.Left, txtRect.Top ,PChar(oneItem),Length(oneItem));
  //DrawText(memDC, PChar('车牌号: ' + AParData.trunkNo), -1, txtRect,DT_SINGLELINE Or DT_LEFT Or DT_VCENTER);

  with txtRect do
  begin
    Left := 8;
    Top := 16 * 2;
    Right := 320;
    Bottom := 16 * 3;
  end;
  oneItem:='品牌:   ' +AParData.materialName;
  TextOut(memDC,txtRect.Left, txtRect.Top ,PChar(oneItem),Length(oneItem));
  //DrawText(memDC, PChar('品牌:   ' + AParData.materialName), -1, txtRect,DT_SINGLELINE Or DT_LEFT Or DT_VCENTER);

  with txtRect do
  begin
    Left := 8;
    Top := 16 * 3;
    Right := 320;
    Bottom := 16 * 4;
  end;
  oneItem:='计划出库:  ' + inttostr(AParData.materialNum)+ ' 件，' + ' 已出库:' + inttostr(AParData.sl1) + ' 件';
  TextOut(memDC,txtRect.Left, txtRect.Top ,PChar(oneItem),Length(oneItem));
  //DrawText(memDC, PChar('计划出库:  ' + inttostr(AParData.materialNum)+ ' 件，' + ' 已出库:' + inttostr(oneParData.sl1) + ' 件'), -1, txtRect,DT_SINGLELINE Or DT_LEFT Or DT_VCENTER);

  with txtRect do
  begin
    Left := 8;
    Top := 16 * 4;
    Right := 320;
    Bottom := 16 * 5;
  end;
  oneItem:='单据:  ' + AParData.relatedFormID;
  TextOut(memDC,txtRect.Left, txtRect.Top ,PChar(oneItem),Length(oneItem));
  //DrawText(memDC, PChar('单据:  ' + AParData.relatedFormID), -1, txtRect,DT_SINGLELINE Or DT_LEFT Or DT_VCENTER);
  DeleteDC(memDC);
  ReleaseDC(0, hDisplayDC);
  DeleteObject(newBitmap);
  DeleteObject(oldpBitmap);
  Sleep(1000); //暂停，方便从任务管理器观察线程
  Result:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:Integer;
    hThread: THandle;
    ThreadID: DWord;
    vParData: PParData;
begin
  Timer1.Enabled:=false;
  for i := 0 to 7 do //创建8个线程
  begin
      ThreadID:=0;
      New(vParData);
      vParData.cardNum:=1;
      vParData.stationName:='a';
      vParData.trunkNo:='b';
      vParData.relatedFormID:='c';
      vParData.materialName:='d';
      vParData.taskState:='e';
      vParData.materialNum:=2;
      vParData.sl1:=3;
      hThread := CreateThread(nil, 0, @LEDThread, vParData, 0, ThreadID);
  end;
  Timer1.Enabled:=True;
end;

end.

[xhz8000]

在定时器里面的第一行加上： IsMultiThread := TRUE;

[xhz8000]

procedure TForm1.Button1Click(Sender: TObject); begin IsMultiThread := TRUE; //这里加也行 Timer1.Enabled:=True;//启动定时器 end;

[sololie]

内存泄露，泄到不能泄就歇菜了

[xhz8000]

确实你分配的New(vParData); 内存也不见在那里释放？？

[sololie]

CreateThread创建线程后，必须把delphi的系统全局变量IsMultiThread设为TRUE，线程结束后它系统会自动把IsMultiThread设回FALSE。但是，最好的方法就是用抛弃CreateThread，而用BeginThread来创建线程，BeginThread内存会把IsMultiThread:=True。 你的代码做下面修改 function LEDThread(AParData: PParData): Boolean; // stdcall; 去掉 begin ..... DeleteObject(oldpBitmap); Dispose(AParData); // 这里释放内存 Sleep(100); //这个sleep不能太大，或者去掉这个sleep Result := True; end; 改好后，你再继续测试个把小时看看

[sololie]

创建线程用BeginThread,参数返回值跟CreateThread一样 hThread := BeginThread(nil, 0, @LEDThread, vParData, 0, ThreadID);

[cankoo]

sololie 好热心哦

[hpygzhx520]

感谢各位，明天测试！非常感谢。