搞了大半天，做不出来

Question

描述一下问题，举个例
我用adoquery，向数据库中一次性添加2万条记录procedure Tform1.button1click,,
var 
i:integer;
begin
  while i<100000 do
begin
  adoquery1.append
  adoquery1.fieldbynanme('field').asinteger:=i;
  adoquery1.post;
end;
end;这是个简单的例子，其实我的问题和这类似，过程很复杂的。问题是：　当按下buttonclick事件的时候，也就是点button时这个过程会一直在这循环，一动不动，程序窗体也不动，一直到过程结速。有没有办法让这个过程，在运行时程序可以做其它的事，　也可以拖动窗体，点取消按钮可以终止执行上面的代码.采用多线程是否可解决这类问题，　能看懂我的意思吗？搞懂怎么做，我出300分

Answer 1

线程应该能解决这个问题，给你看个例子，这个例子中创建的几个线程一边按像素复制图像，一边还可以计算平方根unit main;{ Copyright (c) by Charlie Calvert  Example of using threads }interfaceuses
  Windows, Messages, SysUtils,
  Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls,
  Menus;const
  Margin = 20;
  
type
  PData = ^TData;
  TData = record
    XPos: Integer;
    YPos: Integer;
  end;  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Start1: TMenuItem;
    Edit1: TEdit;
    bSquare: TButton;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StartMenu(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure bSquareClick(Sender: TObject);
  private
    EarthMap: HBitmap;
    procedure DrawBitmap(PaintDC: HDC; Bitmap: HBitMap;
                         XVal, YVal: Integer);
  end;var
  Form1: TForm1;
  AWidth, AHeight: Integer;implementationuses
  CodeBox;
  
{$R *.DFM}
{$R earth.res}procedure TForm1.DrawBitmap(PaintDC: HDC; Bitmap: HBitMap;
                            XVal, YVal: Integer);
var
  MemDC: HDC;
  OldBitmap: HBitmap;
begin
  MemDC := CreateCompatibleDC(PaintDC);
  OldBitmap := SelectObject(MemDC, Bitmap);
  BitBlt(PaintDC, XVal, YVal, AWidth,
         AHeight, MemDC, 0, 0, SRCCOPY);
  SelectObject(MemDC, OldBitmap);
  DeleteObject(MemDC);
end;procedure TForm1.FormPaint(Sender: TObject);
begin
  if EarthMap <> 0 then
    DrawBitmap(GetDC(Handle), Earthmap, Margin, 0);
end;procedure TForm1.FormCreate(Sender: TObject);
var
  BStruct: Windows.TBitmap;
begin
  EarthMap := LoadBitmap(hInstance, 'Earth');
  GetObject(EarthMap, sizeof(Windows.TBitMap), @BStruct);
  AWidth := BStruct.bmWidth;
  AHeight := BStruct.bmHeight;
  PostMessage(Handle, wm_Size, 0, 0);
end;function ThreadFunc(Ptr: Pointer): LongInt; stdcall;
var
  i, j: Integer;
  P: TColorRef;
  DC: HDC;
  Data: PData;
begin
  Data := PData(Ptr);
  DC := GetDC(Form1.Handle);
  for j := 0 to AHeight do
    for i := Margin to AWidth + Margin do begin
      P := GetPixel(DC, i, j);
      SetPixel(DC, i + Data^.Xpos, Data^.YPos + j, P);
    end;
  ReleaseDC(Form1.Handle, DC);
  Dispose(Data);
end;procedure TForm1.StartMenu(Sender: TObject);
var
  hThread1, hThread2, hThread3: THandle;
  ThreadID: DWORD;
  Data: PData;
begin
  New(Data);
  Data^.xPos := AWidth;
  Data^.YPos := 0;
  hThread1 := CreateThread(nil, 0, @ThreadFunc,
                           Data, 0, ThreadID);  New(Data);
  Data^.xPos := 0;
  Data^.YPos := AHeight;
  hThread2 := CreateThread(nil, 0, @ThreadFunc,
                           Data, 0, ThreadID);  New(Data);
  Data^.xPos := AWidth;
  Data^.YPos := AHeight;
  hThread3 := CreateThread(nil, 0, @ThreadFunc,
                           Data, 0, ThreadID);  if ((hTHread1 = 0) or (hThread2 = 0) or (hThread3 = 0)) then
    MessageBox(Handle, 'No Thread!', nil, mb_Ok);
end;procedure TForm1.FormResize(Sender: TObject);
begin
  Edit1.Left := ClientWidth - (Edit1.Width + Margin);
  bSquare.Left := ClientWidth - (bSquare.Width + Margin);
end;procedure TForm1.bSquareClick(Sender: TObject);
var
  r: Double;
begin
  r := Str2Real(Edit1.Text);
  Edit1.Text := Format('%f', [Sqrt(r)]);
  Edit1.Refresh;
end;end.

Answer 2

使用ADO的异步执行能力设置ADOQuery1.ExecuteOptions:=[eoAsyncFetchNonBlocking];

Answer 3

在循环中加这一句：
application.processmessages;
:)

Answer 4

procedure Tform1.button1click,,
var 
i:integer;
begin
  while i<100000 do
  begin
    adoquery1.append
    adoquery1.fieldbynanme('field').asinteger:=i;
    adoquery1.post;
    application.processmessages;
  end;
end;

Answer 5

这个程序又没有对i值进行相应的处理,比如I+1,让循环怎么处理,进行判断呢?上面的朋友的Application.processMessages,能解决这个问题吗?

Answer 6

type
  TTestThread = class(TThread)
  private
    FADOConn: TADOConnection;         // 如果可能，用于进行事务处理，比较复杂
    FSourceDS: TADOQuery;
    FDestDS: TADOQuery;
    procedure SetDestDS(const Value: TADOQuery);
    procedure SetSourceDS(const Value: TADOQuery);
    procedure SetADOConn(const Value: TADOConnection);
  protected
    procedure Execute; override;
  published
    property SourceDS: TADOQuery read FSourceDS write SetSourceDS default nil;
    property DestDS: TADOQuery read FDestDS write SetDestDS default nil;
    property ADOConn: TADOConnection read FADOConn write SetADOConn default nil;
  end;
{ TTestThread }procedure TTestThread.Execute;
var
  I: Integer;
begin
  inherited;
  
  FreeOnTerminate := True;                   // 记录添加执行完毕后，线程自动销毁
  SourceDS.First;
  while not SourceDS.Eof do
  begin
    DestDS.Append;
    DestDS.FieldByName('XXXX').AsString := SourceDS.FieldByName('XXXX').AsString;
    DestDS.Post;    SourceDS.Next;
  end;
  DestDS.UpdateBatch();
end;procedure TTestThread.SetADOConn(const Value: TADOConnection);
begin
  if not Assigned(Value) then
    raise EADOError.Create('Invalidate parameter for ADOConn')
  else
    FADOConn := Value;
end;procedure TTestThread.SetDestDS(const Value: TADOQuery);
begin
  if not Assigned(Value) then
    raise EADOError.Create('Invalid parameter for DestDS!')
  else
    FDestDS := Value;
end;procedure TTestThread.SetSourceDS(const Value: TADOQuery);
begin
  if not Assigned(Value) then
    raise EADOError.Create('Invalid parameter for SourceDS!');
  FSourceDS := Value;
end;//-------------------------------------------------------------------------------var
  AppRecThrd: TAppendRecThread;procedure TForm1.btnStartAppendClick(Sender: TObject);
begin
  AppRecThrd := TAppendRecThread.Create(True);        // 线程创建时设置为暂停状态
  AppRecThrd.SourceDS := adqrySource;
  AppRecThrd.DestDS := adqryDest;
  AppRecThrd.Execute;                                  // 唤醒线程，让她执行。
end;// 慎用线程！

Answer 7

procedure TForm1.btnSuspendThread(Sender: TObject);
var
  dwExitCode: DWORD;
begin
  if Assigned(AppRecThrd) then
  begin
    GetExitCodeThread(AppRecThrd.Handle, dwExitCode);
    if dwExitCode = STILL_ACTIVE then
    begin
      AppRecThrd.Suspend;
      if MessageBox(Handle, '您确定终止程序运行吗？', '停止', 
           MB_YESNO or MB_ICONWARNING) = IDYES then
         AppRecThrd.Terminate
      else
         AppRecThrd.Resume;
    end;
  end;
end;