Delphi thread Message Processing

Source: Internet
Author: User
When writing a program at ordinary times, there is always a problem of message communication between the form (tform) and the thread (tthread. The annoyance is that the form cannot send messages to the thread (tthread) (the thread does not have a window handle ). After several days of hard work, I came up with two solutions and discussed them with you. First. We know that the MFC class library in VC ++ encapsulates the Message Processing (beginmessage, endmessage), and the message processing in MFC creates a message ing table and calls the Function) or the procedure address is saved to the ing table (Message Processing is essentially a method or process call), plus a message distribution mechanism, to receive and send messages <see VC ++ technical insider>. Therefore, we only need to create a message ing table for the thread and establish a message distribution mechanism. In this way, messages sent from the form to the thread can be processed. The following code implements the message ing table and message distribution class (for details, see <../message processing design (thread) 1/messagehandle. Pas>) unit messagehandle; XML: namespace prefix = o ns = "urn: Schemas-Microsoft-com: Office: office"/> interfaceuses messages, classes, sysutils, dialogs; const pmsg_base = $ be00; // customize the message base address; pmsg_num = 200; // message table size; {** custom message processing class *; function = create a custom message table, custom messages between processing threads and between the main form (macro) *} // Message Processing handle tmessagehandle = procedure (VAR message: tmessage) of object; tpdispatcher = Class (tobject) private // message table (the Message ID is an array subscript); messagehandles: array of tmess Agehandle; // obtain the array ID function getindexfrommsgid (const amessageid: Cardinal): integer; Public constructor create; destructor destroy; // send the message procedure sendmessage (VAR message: tmessage); overload; // Add the custom message to the corresponding message table; Procedure addhandle (const amessageid: Cardinal; amessagehandle: tmessagehandle); end; // implementation {role} constructor role. create; var I: integer; begin setlength (Messagehandles, pmsg_num); // corresponding table of 200 messages // initialize the Message Queue; for I: = 0 to PRED (pmsg_num) Do messagehandles [I]: = nil; end; destructor tpdispatcher. destroy; begin {release message table} freeandnil (messagehandles); end; Procedure tpdispatcher. addhandle (const amessageid: Cardinal; amessagehandle: tmessagehandle); var TID: integer; begin TID: = getindexfrommsgid (amessageid); Assert (TID> 0) or (TID <PRED (pmsg_num); Assert (Assigned (amessagehandle); messagehandles [TID]: = amessagehandle; end; function tpdispatcher. getindexfrommsgid (const amessageid: Cardinal): integer; begin result: = amessageid-pmsg_base; end; Procedure tpdispatcher. sendmessage (VAR message: tmessage); var TID: integer; tmsghandle: tmessagehandle; begin TID: = getindexfrommsgid (message. MSG); Assert (TID> 0) or (TID <PRED (pmsg_num); tmsghandle: = m Essagehandles [TID]; if assigned (tmsghandle) Then tmsghandle (Message); end; now we only need to register a custom message and then use the message distribution class (tpdispatcher ), process thread messages. The Code is as follows <see ../message processing design (thread) 1/test/unit1.pas>: Unit unit1const {custom long thread message} my_message2 = pmsg_base + 02;  Type tform1 = Class (tform) handle: tbutton; sendthead: tbutton; sendform: tbutton; sendother: tbutton; Procedure sendtheadclick (Sender: tobject); // send message procedure formcreate (Sender: tobject); Procedure formdestroy (Sender: tobject); Private fdispatcher: tpdispatcher; message ing table class fhandle: tphandler; fthread: tpthread; custom Thread class public {public deations clar} end; vaR form1: tform1; implementation {$ R *. DFM} procedure tform1.sendtheadclick (Sender: tobject); var amessage: tmessage; begin amessage. MSG: = my_message2; amessage. wparam: = 1; fdispatcher. sendmessage (amessage); end; Procedure tform1.formcreate (Sender: tobject); begin {create a message ing table class} fdispatcher: = tpdispatcher. create; fhandle: = tphandler. create;  {Creation thread} Fthread: = tpthread. Create (false );  {Add a message to the ing table} fdispatcher. addhandle (my_message2, fthread. domessage); end;  Procedure tform1.formdestroy (Sender: tobject); var I: integer; begin freeandnil (fdispatcher); freeandnil (fhandle); for I: = 0 to 3 do freeandnil (fthread [I]); end; second. A window can process messages because it has a window handle. To enable the thread to process messages as well, we can add a window name handle for the corresponding window class to the thread. (The source code is in <.. /message processing design (thread) 2/pthread. in pas>) unit pthread; interfaceuses classes, sysutils, windows, messages, dialogs; const my_message1 = $ bd00 + 01; type {** Message Processing Thread class *; function = add thread message processing capability, *} tpmsgthread = Class (tthread) Private // window handle fwndhandle: hwnd; // window data information fwndclass: wndclass; // pointer to the window callback function fobjectinstance: pointer; // initialize the window data procedure initwnd; // create a hidden window procedure createwnd; // register the hidden window procedure registwnd; Procedure destroywnd; // window Callback Function Procedure pwndproc (VAR message: tmessage); Virtual; protected procedure execute; override; Procedure doterminate; override; Public constructor create (createsuterminded: Boolean); Virtual; property wndhandle: hwnd read fwndhandle write fwndhandle; end; implementationconst wnd_name = 'py20'; {tpmsgthread} constructor tpmsgthread. create (createsu0000ded: Boolean); begin inherited create (createsu0000ded); fwndhandle: = INTEGER (NiL); initwnd; registwnd; createwnd; end; Procedure tpmsgthread. createwnd; begin if (wndhandle = INTEGER (NiL) Then wndhandle: = createwindow (fwndclass. lpszclassname, fwndclass. lpszclassname, ws_popup or ws_caption or partition or ws_minimizebox, getsystemmetrics (sm_cxscreen) Div 2, getsystemmetrics (sm_cyscreen) Div 2, 0, 0, 0, 0, fwndclass. hinstance, nil); // callback function of the replacement window setwindowlong (wndhandle, gwl_wndproc, longint (fobjectinstance); end; Procedure tpmsgthread. destroywnd; begin unregisterclass (fwndclass. lpszclassname, fwndclass. hinstance); destroywindow (wndhandle); end; Procedure tpmsgthread. doterminate; begin inherited; destroywnd; end; Procedure tpmsgthread. execute; beginend; Procedure tpmsgthread. initwnd; begin fwndclass. lpszclassname: = pchar (wnd_name); fwndclass. hinstance: = handle; fwndclass. lpfnwndproc: = @ defwindowproc; end; Procedure tpmsgthread. pwndproc (VAR message: tmessage); beginend; Procedure tpmsgthread. registwnd; begin fobjectinstance: = classes. makeobjectinstance (pwndproc); If (fwndclass. hinstance <> INTEGER (NiL) Then registerclass (fwndclass); end;

 

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.