Implement multi-thread toilet troubleshooting

I saw a post. It's fun. I learned how to implement it.

The scenario is as follows:

Colleagues in the company queue for the toilet. If there is space available in the toilet, the leadership should be given priority, and then ordinary employees should use the toilet in the order of queuing.

Bytes ---------------------------------------------------------------------------------------------------------------------------

Unit File

Unit utthreadpool; interfaceuses windows, messages, sysutils, variants, classes, graphics, controls, forms, dialogs, stdctrls, comctrls; type layout = Class (tform) lvwc: tlistview; lvemploye: tlistview; outputs: tbutton; btnstart: tbutton; Procedure formcreate (Sender: tobject); Procedure btnstartclick (Sender: tobject); Procedure alert (Sender: tobject); procedure merge (Sender: tobject); Procedure btnaddmclick (Sender: tobject); Private {private Declarations} hmutex: thandle; // mutex handle wcarr: array of DWORD; // toilet mymsg: DWORD; // custom message factived: Boolean; // whether to enable WC, employe: integer; // matching of the current restroom and employees // Add employee procedure addemploye (const arolename: string); Public {public declarations} end; var form_catchwc: tform_catchwc; implementation {$ R *. DFM} // use WC 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 (infinite ); form_catchwc.lvemploye.items.item [vemploye]. subitems [2]: = inttostr (I); releasemutex (form_catchwc.hmutex); end; form_catchwc.lvwc.items [VWC]. subitems [0]: = 'id'; end; // assign WC priority manager mfunction assignwc (Index: integer): integer; stdcall; var I, j: integer; jobfound: Boolean; begin while true do slein 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] = 'id' then begin // manager Priority 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] = 'waiting') then begin // when the restroom is available, the WC number and employee number form_catchwc.wc: = I; form_catchwc.employe: = J; // adjust the employee, WC status form_catchwc.lvwc.items.item [I]. subitems [0]: = 'use'; form_catchwc.lvemploye.items.item [J]. subitems [1]: = 'restroom '; // send a message to the thread to inform the toilet of postthreadmessage (form_catchwc.wcarr [I], form_catchwc.mymsg, 0, 0); // The current restroom is in use, only other toilets can be found. jobfound: = true; break; end; If jobfound then break; // The manager squats first, and then the employee 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] = 'waiting') then begin form_catchwc.wc: = I; form_catchwc.employe: = J; form_catchwc.lvwc.items.item [I]. subitems [0]: = 'use'; form_catchwc.lvemploye.items.item [J]. subitems [1]: = ''; postthreadmessage (form_catchwc.wcarr [I], form_catchwc.mymsg, 0, 0); jobfound: = true; break; end; if jobfound then break; end; Procedure tform_catchwc.addemploye (const arolename: string); var item: tlistitem; I: integer; uthread: thandle; begin // Add the worker waiting thread setlength (wcarr, length (wcarr) + 1); createthread (nil, 0, @ usewc, nil, 0, uthread ); wcarr [length (wcarr)-1]: = uthread; with lvemploye. items. add do begin caption: = 'employees' + inttostr (length (wcarr)-1); subitems. add (arolename); subitems. add ('waiting'); subitems. add ('0'); end; Procedure extract (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: = 'restroom '+ inttostr (lvwc. items. count + 1); subitems. add ('id'); end; Procedure tform_catchwc.btnstartclick (Sender: tobject); begin factived: = true; end; Procedure destroy (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: = 'restroom '+ inttostr (lvwc. items. count); subitems. add ('id'); end; lvemploye. clear; addemploye ('E'); addemploye ('M'); // create a thread for allocating toilets for Windows. createthread (nil, 0, @ assignwc, nil, 0, uthread); factived: = false; end.

Form file

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  endend