公司同事排队上厕所, 如果厕所有空位, 优先考虑领导使用, 然后才是普通员工按排队顺序使用
转自：http://blog.csdn.net/simonhehe/article/details/8471320
unit utThreadPool;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm_CatchWC = class(TForm)
lvWC: TListView;
lvEmploye: TListView;
btnAddWC: TButton;
btnAddEmploye: TButton;
btnAddM: TButton;
btnStart: TButton;
procedure FormCreate(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnAddWCClick(Sender: TObject);
procedure btnAddEmployeClick(Sender: TObject);
procedure btnAddMClick(Sender: TObject);
private
{ Private declarations }
hMutex : THandle; //互斥句柄
WCArr : array of dword; //厕所
myMsg : dword; //自定义消息
FActived : boolean; //是否开抢
WC, Employe : integer; //当前厕所与员工的匹配情况
//添加员工
procedure AddEmploye(const ARoleName: string);
public
{ Public declarations }
end;
var
Form_CatchWC: TForm_CatchWC;
implementation
{$R *.dfm}
//使用WC 每人限用50秒
function UseWC(index : integer): integer; stdcall;
var
i, vWC, vEmploye : integer;
msg : TMsg;
begin
while GetMessage(msg, 0, 0, 0) do
begin
if msg.message = Form_CatchWC.myMsg then
begin
vEmploye := Form_CatchWC.Employe;
vWC := Form_CatchWC.WC;
for i := 1 to 50 do
begin
sleep(200);
WaitForSingleObject(Form_CatchWC.hMutex,INFINITE);
Form_CatchWC.lvEmploye.Items.Item[vEmploye].SubItems[2] := inttostr(i);
ReleaseMutex(Form_CatchWC.hMutex);
end;
Form_CatchWC.lvWC.Items[vWC].SubItems[0] := '空闲';
end;
end;
end;
//分配WC 优先经理M
function AssignWC(index : integer): integer; stdcall;
var
i, j : integer;
JobFound : boolean;
begin
while true do
begin
sleep(500);
if Form_CatchWC.FActived then
begin
JobFound := False;
for i := 0 to Form_CatchWC.lvWC.Items.Count - 1 do
begin
if Form_CatchWC.lvWC.Items[i].SubItems[0] = '空闲' then
begin
//经理优先
for j := 0 to Form_CatchWC.lvEmploye.Items.Count - 1 do
begin
if (Form_CatchWC.lvEmploye.Items[j].SubItems[0] = 'M') and (Form_CatchWC.lvEmploye.Items[j].SubItems[1] = '等待') then
begin
//可以如厕时, WC牌号和员工牌号
Form_CatchWC.WC := i;
Form_CatchWC.Employe := j;
//调整员工, WC状态
Form_CatchWC.lvWC.Items.Item[i].SubItems[0] := '使用';
Form_CatchWC.lvEmploye.Items.Item[j].SubItems[1] := '入厕';
//给线程发送消息, 告知如厕
PostThreadMessage(Form_CatchWC.WCArr[i], Form_CatchWC.myMsg, 0, 0);
//当前厕所已占用, 只能找其他厕所了
JobFound := True;
break;
end;
end;
if JobFound then Break;
//经理先蹲, 然后员工
for j := 0 to Form_CatchWC.lvEmploye.Items.Count - 1 do
begin
if (Form_CatchWC.lvEmploye.Items[j].SubItems[0] = 'E') and (Form_CatchWC.lvEmploye.Items[j].SubItems[1] = '等待') then
begin
Form_CatchWC.WC := i;
Form_CatchWC.Employe := j;
Form_CatchWC.lvWC.Items.Item[i].SubItems[0] := '使用';
Form_CatchWC.lvEmploye.Items.Item[j].SubItems[1] := '入厕';
PostThreadMessage(Form_CatchWC.WCArr[i], Form_CatchWC.myMsg, 0, 0);
JobFound := True;
break;
end;
end;
end;
if JobFound then break;
end;
end;
end;
end;
procedure TForm_CatchWC.AddEmploye(const ARoleName : string);
var
item : TListItem;
i : integer;
uThread : THandle;
begin
//增加员工等待线程
SetLength(WCArr, Length(WCArr) + 1);
CreateThread(nil, 0, @UseWC, nil, 0, uThread);
WCArr[Length(WCArr) - 1] := uThread;
with lvEmploye.Items.Add do
begin
Caption := '员工' + inttostr(Length(WCArr) - 1);
SubItems.Add(ARoleName);
SubItems.Add('等待');
SubItems.Add('0');
end;
end;
procedure TForm_CatchWC.btnAddEmployeClick(Sender: TObject);
begin
AddEmploye('E');
end;
procedure TForm_CatchWC.btnAddMClick(Sender: TObject);
begin
AddEmploye('M');
end;
procedure TForm_CatchWC.btnAddWCClick(Sender: TObject);
begin
with lvWC.Items.Add do
begin
Caption := '厕所' + inttostr(lvWC.Items.Count + 1);
SubItems.Add('空闲');
end;
end;
procedure TForm_CatchWC.btnStartClick(Sender: TObject);
begin
FActived := True;
end;
procedure TForm_CatchWC.FormCreate(Sender: TObject);
var
uThread : dword;
i : integer;
item : TListItem;
begin
hMutex := CreateMutex(0, false,'hMutex');
myMsg := WM_USER + 1;
lvWC.Clear;
with lvWC.Items.Add do
begin
Caption := '厕所' + inttostr(lvWC.Items.Count);
SubItems.Add('空闲');
end;
lvEmploye.Clear;
AddEmploye('E');
AddEmploye('E');
AddEmploye('M');
//创建分配厕所的线程
windows.CreateThread(nil,0,@AssignWC,nil,0,uThread);
FActived := False;
end;
end.
窗口布局代码
object Form_CatchWC: TForm_CatchWC
Left = 0
Top = 0
Caption = #25250#21397#25152
ClientHeight = 247
ClientWidth = 705
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object lvWC: TListView
Left = 8
Top = 8
Width = 233
Height = 225
Columns = <
item
Caption = #21397#25152#32534#21495
end
item
Caption = #20351#29992#29366#24577
end>
Items.ItemData = {
05200000000100000000000000FFFFFFFFFFFFFFFF00000000FFFFFFFF000000
0003955340623100}
TabOrder = 0
ViewStyle = vsReport
end
object lvEmploye: TListView
Left = 247
Top = 8
Width = 306
Height = 225
Columns = <
item
Caption = #21592#24037#32534#21495
end
item
Caption = #32844#20301
end
item
Caption = #24403#21069#29366#24577
end
item
Caption = #35745#26102
end>
Items.ItemData = {
05200000000100000000000000FFFFFFFFFFFFFFFF00000000FFFFFFFF000000
00035854E55D3100}
TabOrder = 1
ViewStyle = vsReport
end
object btnAddWC: TButton
Left = 622
Top = 112
Width = 75
Height = 25
Caption = #22686#21152#21397#25152
TabOrder = 2
OnClick = btnAddWCClick
end
object btnAddEmploye: TButton
Left = 622
Top = 16
Width = 75
Height = 25
Caption = #21592#24037#25490#38431
TabOrder = 3
OnClick = btnAddEmployeClick
end
object btnAddM: TButton
Left = 622
Top = 64
Width = 75
Height = 25
Caption = #32463#29702#25490#38431
TabOrder = 4
OnClick = btnAddMClick
end
object btnStart: TButton
Left = 622
Top = 160
Width = 75
Height = 25
Caption = #24320#22987#25250#21397#25152
TabOrder = 5
OnClick = btnStartClick
end
end
开心洋葱 , 版权所有丨如未注明 , 均为原创丨未经授权请勿修改 , 转载请注明一个Delphi多线程实现的厕所排队程序！
