如何解决多线程程序中每个线程运行速度不同的问题

多线程图形特效预览,相同的线程,如何保证运行时有相同的速度? 代码如下:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;
type
  TPreViewer = class(TThread)
    private
      FImg: TImage;
      FBmp: TBitMap;
    public
      constructor Create(img: TImage; bmp: Tbitmap);
      procedure ShowImag;
      procedure Execute; override;
  end;
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    Image2: TImage;
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  flag: Boolean;
  HA,HB: TPreViewer;implementation
{$R *.dfm}
{ TPreViewer }
constructor TPreViewer.Create(img: TImage; bmp: Tbitmap);
begin
  FImg := img;
  FBmp := bmp;
  inherited Create(True);
end;procedure TPreViewer.Execute;
begin
  inherited;
  while true do
  begin
    if not Flag then
    begin
      Terminate;
      Exit;
    end;
  Synchronize(ShowImag);
    //ShowImag;
  end;
  
end;procedure TPreViewer.ShowImag;
var
  i: integer;
  b: TBitMap;
begin
  if Terminated then Exit;
  b := TbitMap.Create;
  b.Width := Fbmp.Width;
  b.Height := Fbmp.Height;
  Fimg.Canvas.Lock;
  for i := 0 to B.Height - 1 do
  begin
    B.Canvas.CopyRect(Rect(0,b.Height-i,b.Width,b.Height),Fbmp.Canvas,Rect(0,0, Fbmp.Width,i));
    Fimg.Canvas.Draw(0,0,b);
    //sleep(10);    Application.ProcessMessages;
  end;
  Fimg.Canvas.Unlock;
  b.Free;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  pic,pic2 : TBitmap;
begin
  self.DoubleBuffered := true;
  flag := True;
  pic := Tbitmap.Create;
  pic2 := TBitmap.Create;
  
  pic.LoadFromFile('D:\bmp\cus3.bmp');
  pic2.LoadFromFile('D:\bmp\cus3.bmp');
  HA := TPreViewer.Create(image1,pic);
  //Ha.Priority := tpHighest;  //这个也不管用  Ha.FreeOnTerminate := True;  HB := TPreviewer.Create(image2,pic2);
  //HB.Priority := tpHighest;
  HB.FreeOnTerminate := True;end;procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Ha.Resume;
  //sleep(10);
  HB.Resume;
end;procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  flag := False;
end;
end.
运行时一个image显示快些,另一个则很慢,过一段时间的快的变得很慢,而慢的又变得很快,用什么方法可以让他们保持相同的速度?谢谢!