多线程

Question

靠，在Delphi的Demo下不是有一个吗？？？？？？？？

Answer 1

//这是一个未完的程序,飞机开火是单独的一个线程完成的
unit Fly;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,shellapi, StdCtrls,mmsystem, Menus;
  procedure ThreadFire;stdcall;
type
  TFlyer=Record      //飞行器类
    Speed:integer;//速度
    Life:integer;//飞行器数量
    Value:integer;//飞行器生命力
    Score:Integer;//得分
    Left:integer;//左右位置
    Top:integer;//上下位置
    Face:integer;//飞行器图像句柄
    State:integer;//飞行器状态  0:未开始;1:正常;2:子弹发射中;
    ConFig:integer;//武器装备
    KeyStack:string;//当前未释放的键
end;type
  TForm1 = class(TForm)
    Image1: TImage;
    TimerSky: TTimer;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    A1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    H1: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    procedure TimerSkyTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N5Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    bmp,tmpBmp:Tbitmap;
    Flys:TFlyer;
    ThreadID: DWORD;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure ThreadFire;stdcall;
var Iwhite,itmp:Integer;begin
  with form1 do
  begin
    Iwhite:=CreatePen(PS_SOLID,0,RGB(255,255,255));
    selectOBject(Canvas.handle,Iwhite);    MoveToEx(Canvas.handle,flys.Left+6,flys.Top,nil);    for  itmp:=form1.flys.Top downto 0 do
    begin
//      bitblt(btmp.Canvas.handle,0,0,form1.Width,form1.Height,bmp.canvas.Handle ,0,0,SRCCOPY);
      LineTo(Canvas.handle,flys.Left+6,itmp);
 //     bitblt(form1.Canvas.handle,0,0,form1.Width,form1.Height,btmp.canvas.Handle ,0,0,SRCCOPY);
    end;
    DeleteObject(Iwhite);
  end;
end;procedure TForm1.TimerSkyTimer(Sender: TObject);
begin
  if pos('32',flys.KeyStack)>0 then CreateThread(nil,0,@ThreadFire,nil,0,ThreadID);      //空格
  bitblt(tmpBmp.Canvas.handle,0,0,clientWidth,clientHeight,bmp.Canvas.handle,0,0,SRCCOPY);
  DrawIcon(tmpbmp.canvas.handle,flys.Left ,flys.Top,flys.Face );
  bitblt(Canvas.handle,0,0,clientWidth,clientHeight,tmpbmp.Canvas.handle,0,0,SRCCOPY);
  bitblt(tmpBmp.Canvas.Handle,0,0,bmp.Width,2,bmp.Canvas.handle,0,bmp.Height-2,SRCCOPY);
  bitblt(bmp.Canvas.Handle,0,2,bmp.Width,bmp.Height,bmp.Canvas.handle,0,0,SRCCOPY);
  bitblt(bmp.Canvas.Handle,0,0,bmp.Width,2,TmpBmp.Canvas.handle,0,0,SRCCOPY);
end;procedure TForm1.FormCreate(Sender: TObject);
var i,j :integer;
    dct:Trect;
begin
  playsound('bk.wav',0,SND_ASYNC+SND_Loop+SND_SYNC);
  cursor:=-3;
  bmp:=Tbitmap.Create ;
  tmpBmp:=Tbitmap.Create ;
  bmp.Width :=(screen.width div image1.Width+1) *image1.Width  ;
  bmp.Height:=(screen.Height div image1.Height+1) *image1.Height ;
  TmpBmp.Width :=bmp.Width;
  TmpBmp.Height :=bmp.Height;
  bmp.Canvas.Brush.Bitmap := IMAGE1.Picture.Bitmap;
  For i := 0 To (screen.Width div IMAGE1.Width+1) do
  For j := 0 To (screen.Height div IMAGE1.Height+1) do
  dct:=rect(i*2,0,(i+1)*2,bmp.Height);
  bmp.Canvas.fillRect(Rect(0,0,i * IMAGE1.Width, j * IMAGE1.Height));
  flys.Left:=(clientWidth-application.Icon.Width) div 2 ;
  Flys.Top :=clientHeight - application.Icon.Height ;
  flys.Face:=application.Icon.Handle;
  flys.Speed:=15;
  flys.State:=0;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
  tmpbmp.Free;
end;procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);begin
//caption:=inttostr(key);
  if pos(inttostr(key),flys.KeyStack)=0 then flys.KeyStack:=flys.KeyStack+inttostr(key)+',';
  if pos('37',flys.KeyStack)>0 then if flys.Left>5 then  flys.Left :=flys.Left-flys.Speed;//左
  if pos('38',flys.KeyStack)>0 then if flys.Top >0 then flys.Top := flys.Top-flys.Speed;//上
  if pos('39',flys.KeyStack)>0 then if flys.Left <clientwidth-32 then flys.Left :=flys.Left+flys.Speed; //右
  if pos('40',flys.KeyStack)>0 then if flys.Top <clientheight-32 then flys.Top :=flys.Top +flys.Speed;  //下
end;
procedure TForm1.N5Click(Sender: TObject);
begin
  case TMenuItem(sender).tag of
  1:
  begin
    flys.State:=1; 
    timersky.Enabled :=true;
    playsound('start.wav',0,SND_SYNC);
    playsound('bk1.wav',0,SND_ASYNC+SND_Loop);
    n3.Enabled :=true;
  end;
  2:
  begin
    timersky.Enabled :=not timersky.Enabled;
    if timersky.Enabled=true then n3.Caption:='暂停' else n3.Caption:='继续';
  end;
  3:
  begin
    PlaySound(nil,0,SND_PURGE);
    PostQuitMessage (0);
  end;
  4:messagebox(handle,'光标键   飞行控制' + #13 + '空格键   常规武器','操作说明',mb_ok);
  5:shellabout(handle,Pchar(caption),'RedBird Times',flys.Face);
  6:ShellExecute(0, nil, 'mailto:[email protected]', nil, nil, SW_NORMAL);
  7:ShellExecute(0, nil, 'http://rbsky.myetang.com', nil, nil, SW_NORMAL);
  end;
end;procedure TForm1.FormResize(Sender: TObject);
begin
  if flys.State <>0 then
  begin
    if flys.Left >clientwidth-32 then flys.Left :=clientwidth-32;
    if flys.Top >clientheight-32 then flys.Top :=clientheight-32;
  end;
end;procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var itmp:integer;
begin
  itmp:=pos(inttostr(key),flys.KeyStack);
  if itmp>0 then flys.KeyStack:=copy(flys.KeyStack,1,itmp-1)+copy(flys.KeyStack,itmp+length(flys.keystack),255);
end;end.

Answer 2

<DelphiDir>\Demos\Threads\thrddemo.dpr__________________________________________________________________________
http://i58.boy.net.cn/ (抱歉，未建好)
邮件列表，大家互助, mailto:[email protected]
http://cn.groups.yahoo.com/group/delphi_sky/
或： http://agui.delphibbs.com/