[Delphi (Object Pascal)] 一个Delphi多线程实现的厕所排队程序 →→→→→进入此内容的聊天室

来自 , 2020-11-27, 写在 Delphi (Object Pascal), 查看 149 次.
URL http://www.code666.cn/view/ad1f8bb9
  1. unit utThreadPool;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TForm_CatchWC = class(TForm)
  11.     lvWC: TListView;
  12.     lvEmploye: TListView;
  13.     btnAddWC: TButton;
  14.     btnAddEmploye: TButton;
  15.     btnAddM: TButton;
  16.     btnStart: TButton;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure btnStartClick(Sender: TObject);
  19.     procedure btnAddWCClick(Sender: TObject);
  20.     procedure btnAddEmployeClick(Sender: TObject);
  21.     procedure btnAddMClick(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.     hMutex : THandle;  //互斥句柄
  25.     WCArr : array of dword;  //厕所
  26.     myMsg : dword;      //自定义消息
  27.     FActived : boolean;   //是否开抢
  28.     WC, Employe : integer;  //当前厕所与员工的匹配情况
  29.     //添加员工
  30.     procedure AddEmploye(const ARoleName: string);
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   Form_CatchWC: TForm_CatchWC;
  37.  
  38. implementation
  39.  
  40. {$R *.dfm}
  41. //使用WC  每人限用50秒
  42. function UseWC(index : integer): integer; stdcall;
  43. var
  44.   i, vWC, vEmploye : integer;
  45.   msg : TMsg;
  46. begin
  47.   while GetMessage(msg, 0, 0, 0) do
  48.   begin
  49.     if msg.message = Form_CatchWC.myMsg then
  50.     begin
  51.       vEmploye := Form_CatchWC.Employe;
  52.       vWC := Form_CatchWC.WC;
  53.  
  54.       for i := 1 to 50 do
  55.       begin
  56.         sleep(200);
  57.         WaitForSingleObject(Form_CatchWC.hMutex,INFINITE);
  58.         Form_CatchWC.lvEmploye.Items.Item[vEmploye].SubItems[2] := inttostr(i);
  59.         ReleaseMutex(Form_CatchWC.hMutex);
  60.       end;
  61.       Form_CatchWC.lvWC.Items[vWC].SubItems[0] := '空闲';
  62.     end;
  63.   end;
  64. end;
  65. //分配WC  优先经理M
  66. function AssignWC(index : integer): integer; stdcall;
  67. var
  68.   i, j : integer;
  69.   JobFound : boolean;
  70. begin
  71.   while true do
  72.   begin
  73.     sleep(500);
  74.     if Form_CatchWC.FActived then
  75.     begin
  76.       JobFound := False;
  77.       for i := 0 to Form_CatchWC.lvWC.Items.Count - 1 do
  78.       begin
  79.         if Form_CatchWC.lvWC.Items[i].SubItems[0] = '空闲' then
  80.         begin
  81.         //经理优先
  82.           for j := 0 to Form_CatchWC.lvEmploye.Items.Count - 1 do
  83.           begin
  84.             if (Form_CatchWC.lvEmploye.Items[j].SubItems[0] = 'M') and (Form_CatchWC.lvEmploye.Items[j].SubItems[1] = '等待') then
  85.             begin
  86.               //可以如厕时, WC牌号和员工牌号
  87.               Form_CatchWC.WC := i;
  88.               Form_CatchWC.Employe := j;
  89.               //调整员工, WC状态
  90.               Form_CatchWC.lvWC.Items.Item[i].SubItems[0] := '使用';
  91.               Form_CatchWC.lvEmploye.Items.Item[j].SubItems[1] := '入厕';
  92.               //给线程发送消息, 告知如厕
  93.               PostThreadMessage(Form_CatchWC.WCArr[i], Form_CatchWC.myMsg, 0, 0);
  94.               //当前厕所已占用, 只能找其他厕所了
  95.               JobFound := True;
  96.               break;
  97.             end;
  98.           end;
  99.  
  100.           if JobFound then Break;
  101.           //经理先蹲, 然后员工
  102.           for j := 0 to Form_CatchWC.lvEmploye.Items.Count - 1 do
  103.           begin
  104.             if (Form_CatchWC.lvEmploye.Items[j].SubItems[0] = 'E') and (Form_CatchWC.lvEmploye.Items[j].SubItems[1] = '等待') then
  105.             begin
  106.               Form_CatchWC.WC := i;
  107.               Form_CatchWC.Employe := j;
  108.  
  109.               Form_CatchWC.lvWC.Items.Item[i].SubItems[0] := '使用';
  110.               Form_CatchWC.lvEmploye.Items.Item[j].SubItems[1] := '入厕';
  111.               PostThreadMessage(Form_CatchWC.WCArr[i], Form_CatchWC.myMsg, 0, 0);
  112.               JobFound := True;
  113.               break;
  114.             end;
  115.           end;
  116.         end;
  117.         if JobFound then break;
  118.       end;
  119.     end;
  120.   end;
  121. end;
  122.  
  123. procedure TForm_CatchWC.AddEmploye(const ARoleName : string);
  124. var
  125.   item : TListItem;
  126.   i : integer;
  127.   uThread : THandle;
  128. begin
  129.   //增加员工等待线程
  130.   SetLength(WCArr, Length(WCArr) + 1);
  131.  
  132.   CreateThread(nil, 0, @UseWC, nil, 0, uThread);
  133.   WCArr[Length(WCArr) - 1] := uThread;
  134.   with lvEmploye.Items.Add do
  135.   begin
  136.     Caption := '员工' + inttostr(Length(WCArr) - 1);
  137.     SubItems.Add(ARoleName);
  138.     SubItems.Add('等待');
  139.     SubItems.Add('0');
  140.   end;
  141. end;
  142.  
  143. procedure TForm_CatchWC.btnAddEmployeClick(Sender: TObject);
  144. begin
  145.   AddEmploye('E');
  146. end;
  147.  
  148. procedure TForm_CatchWC.btnAddMClick(Sender: TObject);
  149. begin
  150.   AddEmploye('M');
  151. end;
  152.  
  153. procedure TForm_CatchWC.btnAddWCClick(Sender: TObject);
  154. begin
  155.   with lvWC.Items.Add do
  156.   begin
  157.     Caption := '厕所' + inttostr(lvWC.Items.Count + 1);
  158.     SubItems.Add('空闲');
  159.   end;
  160. end;
  161.  
  162. procedure TForm_CatchWC.btnStartClick(Sender: TObject);
  163. begin
  164.   FActived := True;
  165. end;
  166.  
  167. procedure TForm_CatchWC.FormCreate(Sender: TObject);
  168. var
  169.   uThread : dword;
  170.   i : integer;
  171.   item : TListItem;
  172. begin
  173.   hMutex := CreateMutex(0, false,'hMutex');
  174.   myMsg := WM_USER + 1;
  175.  
  176.   lvWC.Clear;
  177.   with lvWC.Items.Add do
  178.   begin
  179.     Caption := '厕所' + inttostr(lvWC.Items.Count);
  180.     SubItems.Add('空闲');
  181.   end;
  182.  
  183.   lvEmploye.Clear;
  184.   AddEmploye('E');
  185.   AddEmploye('E');
  186.   AddEmploye('M');
  187.   //创建分配厕所的线程
  188.   windows.CreateThread(nil,0,@AssignWC,nil,0,uThread);
  189.   FActived := False;
  190. end;
  191.  
  192. end.
  193.  
  194.  
  195. //delphi/6207

回复 "一个Delphi多线程实现的厕所排队程序"

这儿你可以回复上面这条便签

captcha