找多线程实例(50分)

各位DFW，哪里有多线程实例下载？（由易到难）。

你在计算机里搜索
包含
synchronize
（entercriticalsection）
然后选*.pas
就可以找到了所有例子，然后看就行了

你的qq和mail

利用线程一
Windows 95是Microsoft公司的第一个真正的多任务操作系统。在每一时刻可以有多个进程同时工作，而每一个进程又包含有多个线程。但只有一个处理器的计算机不可能真正地“同时”执行多个线程，而是操作系统把时间分成若干个时间片，然后把一个个时间片分配给每一个线程。
一个执行了的程序就是一个进程，一个进程则至少有一个主线程。一位高级程序员，绝不会让自己的程序里面只有一个主线程存在（除非只有很少的几十行代码），而是尽量让自己的程序在同一时刻里干更多的事，在比较大一点的应用中尤其如此，象数据库τ贸绦颍?谕臣频氖焙蛭一瓜胱銎渌?履兀∫虼耍?绾斡行У乩?孟叱淘蚴敲恳桓龀绦蛟倍加α私獾摹１疚木痛思虻サ靥敢幌略贒elphi中如何利用线程。
（1）创建一个线程。
（2）创建一个能作为线程入口的函数。
Windows API调用CreateThread函数来创建一个线程。函数如下：
HANDLE CreateThread(
LPSECURITY_ATTRIBUTES:lpThreadAttributes;
//线程安全属性地址
DWORD:dwStackSize;
//初始化线程堆栈尺寸
LPTHREAD_START_ROUTINE:lpStartAddress;
//线程函数所指向的地址
LPVOID:lpParameter;
//给线程函数传递的参数
DWORD:dwCreationFlags;
//有关线程的标志
LPDWORD:lpThreadId;
//系统分配给线程的ID
);
第一个参数是安全属性，一般设为nil，使用缺省的安全属性。当我们想此线程有另外的子进程时，可改变它的属性。
第二个参数是线程堆栈尺寸，一般设为0，表示与此应用的堆栈尺寸相同，即主线程与创建的线程一样长度的堆栈。并且其长度会根据需要自动变长。
第三个参数，也是最重要的一个，是一个指向函数名的指针，但传递时很简单，只需在线程函数名前加上@就可以了。
第四个参数是你需要向线程函数传递的参数，一般是一个指向结构的指针。不需传递参数时，则这个参数设为nil。
第五个参数，传入与线程有关的一些标志，如果是CREATE_SUSPENDED,则创建一个挂起的线程，即这个线程本身已创建，它的堆栈也已创建。但这个线程不会被分配给CPU时间，只有当ResumeThread函数被调用后才能执行；当然，也可以调用SuspendThread函数再次挂起线程。要是标志为0，那么一旦建立线程，线程函数就被立即调用。一般传为0即可。
最后一个参数是系统分配给这个线程的唯一的ID标志。
下面这个程序MyThreadPro.pas介绍了线程如何建立及使用：
//Your first test Thread Program.
unit MyThreadPro;
interface
uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,StdCtrls;
type
TForm1 = class(TForm)
UsedThread: TButton;
NoUsedThread: TButton;
procedure UsedThreadClick(Sender: TObject);
procedure NoUsedThreadClick(Sender: TObject);
var
Form1: TForm1;
implementation
{$R *.DFM}
//这是线程函数，它可以放在下面程序的任何地方
function MyThreadFunc(Pointer):Longint;stdcall;
var
i:integer;
DC:HDC;
S:string;
begin
DC:=GetDC(Form1.Handle);
for i:=0 to 100000do
begin
S:=Inttostr(i);
Textout(DC,10,10,Pchar(S),length(S));
end;
ReleaseDC(Form1.Handle,DC);
end;

procedure TForm1.UsedThreadClick(Sender: TObject);
var
hThread:Thandle;//定义一个句柄
ThreadIDWord;
begin
//创建线程，同时线程函数被调用
hthread:=CreateThread(nil,0,
@MyThreadfunc,nil,0,ThreadID);
if hThread=0 then
messagebox(
Handle,'Didn’t Create a Thread',nil,MB_OK);
end;

procedure TForm1.NoUsedThreadClick(Sender: TObject);
begin
MyThreadfunc(nil);
//没有创建线程时，直接调用线程函数
end;

end.

上面这个程序介绍了我们在使用线程及未使用线程二种情况下，运行该程序的反应。当点UsedThread按钮时，则建立一个线程，这时我们可以在程序进行计算的同时，改变窗体的尺寸及移动它。当按下NoUsedThread按钮时，不建立线程，我们会发现在程序没有计算完之前根本不能做其它任何事情！此程序在基于Windows95的Delphi3中运行通过。

to jsxjd:
当我按照你的方法创建两个线程，运行时老是出错（单个线程没问题），究竟是那里
冲突了？THANKS。
to 老人家：
我的MAIL：XHKEN@163.com

unit ThSort;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TThreadSortForm = class(TForm)
StartBtn: TButton;
BubbleSortBox: TPaintBox;
SelectionSortBox: TPaintBox;
QuickSortBox: TPaintBox;
Label1: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Label2: TLabel;
Label3: TLabel;
procedure BubbleSortBoxPaint(Sender: TObject);
procedure SelectionSortBoxPaint(Sender: TObject);
procedure QuickSortBoxPaint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StartBtnClick(Sender: TObject);
private
ThreadsRunning: Integer;
procedure RandomizeArrays;
procedure ThreadDone(Sender: TObject);
public
procedure PaintArray(Box: TPaintBox;
const A: array of Integer);
end;

var
ThreadSortForm: TThreadSortForm;
implementation
uses SortThds;
{$R *.dfm}
type
PSortArray = ^TSortArray;
TSortArray = array[0..114] of Integer;
var
ArraysRandom: Boolean;
BubbleSortArray, SelectionSortArray, QuickSortArray: TSortArray;
{ TThreadSortForm }
procedure TThreadSortForm.PaintArray(Box: TPaintBox;
const A: array of Integer);
var
I: Integer;
begin
with Boxdo
begin
Canvas.Pen.Color := clRed;
for I := Low(A) to High(A)do
PaintLine(Canvas, I, A);
end;
end;

procedure TThreadSortForm.BubbleSortBoxPaint(Sender: TObject);
begin
PaintArray(BubbleSortBox, BubbleSortArray);
end;

procedure TThreadSortForm.SelectionSortBoxPaint(Sender: TObject);
begin
PaintArray(SelectionSortBox, SelectionSortArray);
end;

procedure TThreadSortForm.QuickSortBoxPaint(Sender: TObject);
begin
PaintArray(QuickSortBox, QuickSortArray);
end;

procedure TThreadSortForm.FormCreate(Sender: TObject);
begin
RandomizeArrays;
end;

procedure TThreadSortForm.StartBtnClick(Sender: TObject);
begin
RandomizeArrays;
ThreadsRunning := 3;
with TBubbleSort.Create(BubbleSortBox, BubbleSortArray)do
OnTerminate := ThreadDone;
with TSelectionSort.Create(SelectionSortBox, SelectionSortArray)do
OnTerminate := ThreadDone;
with TQuickSort.Create(QuickSortBox, QuickSortArray)do
OnTerminate := ThreadDone;
StartBtn.Enabled := False;
end;

procedure TThreadSortForm.RandomizeArrays;
var
I: Integer;
begin
if not ArraysRandom then
begin
Randomize;
for I := Low(BubbleSortArray) to High(BubbleSortArray)do
BubbleSortArray := Random(170);
SelectionSortArray := BubbleSortArray;
QuickSortArray := BubbleSortArray;
ArraysRandom := True;
Repaint;
end;
end;

procedure TThreadSortForm.ThreadDone(Sender: TObject);
begin
Dec(ThreadsRunning);
if ThreadsRunning = 0 then
begin
StartBtn.Enabled := True;
ArraysRandom := False;
end;
end;

end.
/////////////////////////////
unit SortThds;
interface
uses
Classes, Graphics, ExtCtrls;
type
{ TSortThread }
PSortArray = ^TSortArray;
TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;
TSortThread = class(TThread)
private
FBox: TPaintBox;
FSortArray: PSortArray;
FSize: Integer;
FA, FB, FI, FJ: Integer;
proceduredo
VisualSwap;
protected
procedure Execute;
override;
procedure VisualSwap(A, B, I, J: Integer);
procedure Sort(var A: array of Integer);
virtual;
abstract;
public
constructor Create(Box: TPaintBox;
var SortArray: array of Integer);
end;

{ TBubbleSort }
TBubbleSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer);
override;
end;

{ TSelectionSort }
TSelectionSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer);
override;
end;

{ TQuickSort }
TQuickSort = class(TSortThread)
protected
procedure Sort(var A: array of Integer);
override;
end;

procedure PaintLine(Canvas: TCanvas;
I, Len: Integer);
implementation
procedure PaintLine(Canvas: TCanvas;
I, Len: Integer);
begin
Canvas.PolyLine([Point(0, I * 2 + 1), Point(Len, I * 2 + 1)]);
end;

{ TSortThread }
constructor TSortThread.Create(Box: TPaintBox;
var SortArray: array of Integer);
begin
FBox := Box;
FSortArray := @SortArray;
FSize := High(SortArray) - Low(SortArray) + 1;
FreeOnTerminate := True;
inherited Create(False);
end;

{ Sincedo
VisualSwap uses a VCL component (i.e., the TPaintBox) it should never
be called directly by this thread. do
VisualSwap should be called by passing
it to the Synchronize method which causesdo
VisualSwap to be executed by the
main VCL thread, avoiding multi-thread conflicts. See VisualSwap for an
example of calling Synchronize. }
procedure TSortThread.DoVisualSwap;
begin
with FBoxdo
begin
Canvas.Pen.Color := clBtnFace;
PaintLine(Canvas, FI, FA);
PaintLine(Canvas, FJ, FB);
Canvas.Pen.Color := clRed;
PaintLine(Canvas, FI, FB);
PaintLine(Canvas, FJ, FA);
end;
end;

{ VisusalSwap is a wrapper ondo
VisualSwap making it easier to use. The
parameters are copied to instance variables so they are accessable
by the main VCL thread when it executesdo
VisualSwap }
procedure TSortThread.VisualSwap(A, B, I, J: Integer);
begin
FA := A;
FB := B;
FI := I;
FJ := J;
Synchronize(DoVisualSwap);
end;

{ The Execute method is called when the thread starts }
procedure TSortThread.Execute;
begin
Sort(Slice(FSortArray^, FSize));
end;

{ TBubbleSort }
procedure TBubbleSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := High(A)do
wnto Low(A)do
for J := Low(A) to High(A) - 1do
if A[J] > A[J + 1] then
begin
VisualSwap(A[J], A[J + 1], J, J + 1);
T := A[J];
A[J] := A[J + 1];
A[J + 1] := T;
if Terminated then
Exit;
end;
end;

{ TSelectionSort }
procedure TSelectionSort.Sort(var A: array of Integer);
var
I, J, T: Integer;
begin
for I := Low(A) to High(A) - 1do
for J := High(A)do
wnto I + 1do
if A > A[J] then
begin
VisualSwap(A, A[J], I, J);
T := A;
A := A[J];
A[J] := T;
if Terminated then
Exit;
end;
end;

{ TQuickSort }
procedure TQuickSort.Sort(var A: array of Integer);
procedure QuickSort(var A: array of Integer;
iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := A[(Lo + Hi) div 2];
repeat
while A[Lo] < Middo
Inc(Lo);
while A[Hi] > Middo
Dec(Hi);
if Lo <= Hi then
begin
VisualSwap(A[Lo], A[Hi], Lo, Hi);
T := A[Lo];
A[Lo] := A[Hi];
A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then
QuickSort(A, iLo, Hi);
if Lo < iHi then
QuickSort(A, Lo, iHi);
if Terminated then
Exit;
end;

begin
QuickSort(A, Low(A), High(A));
end;

end.

jsxjd的那个程序只要用到一个线程就行了,所以没有设置同步,
你创建了两个线程,当然会出错啦,
你创建两个的话,要用synchronize来同步!

多人接受答案了。

学习