unit1.pas

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls,unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    ProgressBar1: TProgressBar;

    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TerminatedProc(Sender:TObject);//线程终止时执行的过程

  private
    { Private declarations }

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  BitMap:TBitMap;
  CopyThread:TCopyThread;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  p:TPoint;
begin
  p.X:=BitMap.Width;
  P.Y:=0;
  CopyThread:=TCopyThread.Create(p);
  CopyThread.OnTerminate:=TerminatedProc;//指定线程终止时执行的过程
  ProgressBar1.Max:=BitMap.Width*BitMap.Height;
  ProgressBar1.Position:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if Assigned(CopyThread) then
   begin
     CopyThread.Terminate;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BitMap:= TBitmap.Create;
  BitMap.LoadFromFile('e:\zh\car.bmp');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BitMap.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Self.Canvas.Draw(0,0,BitMap);
end;

procedure TForm1.TerminatedProc;
begin
  MessageBox(Handle,'线程已终止','提示信息',MB_OK);
end;

end.

 

unit2.pas

unit Unit2;

interface

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

type
  TCopyThread = Class(TThread)
  private
    FPoint:TPoint;
    procedure UpdateProgressBar; //用于同步主线程的进度条
   protected
    procedure Execute;Override;
  public
    Constructor Create(p:TPoint);
  End;

implementation
uses unit1;

constructor TCopyThread.Create(p: TPoint);
begin
  FPoint:=p;
  inherited Create(False);
end;
 
procedure TCopyThread.Execute;
var
  i,j:Integer;
  dot:TColorRef;
  DC:HDC;
begin
  FreeOnTerminate:=True; //线程执行完后自动释放对象资源
  DC:=GetDC(Form1.Handle);
  for i := 0 to BitMap.Width - 1 do
    for j := 0 to BitMap.Height - 1 do
      if not Terminated then    //如果线程没有终止（放上这句为了随时可以终止线程）
        begin
          //为了执行时间久一点，所以逐个像素拷贝
          dot:=GetPixel(DC,i,j);
          SetPixel(DC,i+FPoint.X,j+FPoint.Y,dot);
          Synchronize(UpdateProgressBar); //与主线程VCL同步
        end;
end;
procedure TCopyThread.UpdateProgressBar;
begin
  Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+1;
end;

end.