test_mtcomvfp_简单的单线程实例.prg

需要WebView2.dll 1.06版，

通俗的来说就是在一个应用程序的主线程上调用执行指定的委托。主要目的是让工作的线程完成绝大部分的运算工作，将纯粹的界面更新放到UI线程中去完成，达到减轻UI线程负担的目的（避免UI无响应）,可问题VFP就一个Screen单线程所有的窗体并没有UI线程，它是单线程设计，窗体，控件代码执行，都在一个线程中，创建了线程后任何在线程中去更新Screen单线下任何“事物“的动作都会阻塞UI，感觉这情况非常麻烦。VFP在设计就是单线，所以VFP多线程也就是一个半成品。
*thread  可执行动作
*!*     thread.Start()                     开始
*!*     thread.Suspend()                 挂起、暂停
*!*     thread.Resume()                 恢复暂停的线程 
*!*     thread.Abort(1)                 停止(对外抛出ThreadAbortException异常)
*!*     thread.Join()                     主线程等待子线程计算完成；
*!*     thread.Join(2000)                 等待2000ms
*!*     thread.IsBackground = true      后台线程；进程关闭，线程也就消失了
*!*     thread.IsBackground = false    前台线程：进程关闭，线程执行完计算才消失
*!*     sleep                             相当于让线程睡眠，交出CPU，让CPU去执行其他的任务

*ThreadState 属性的取值如下：
#Defin Aborted                256        &&线程已停止；
#Defin AbortRequested        128     &&线程的Thread.Abort()方法已被调用，但是线程还未停止；
#Defin Background            4       &&线程在后台执行，与属性Thread.IsBackground有关；
#Defin Running                0       &&线程正在正常运行；
#Defin Stopped                16      &&线程已经被停止；
#Defin StopRequested        1        &&线程正在被要求停止；
#Defin Suspended            64      &&线程已经被挂起（此状态下，可以通过调用Resume()方法重新运行）；
#Defin SuspendRequested        2        &&线程正在要求被挂起，但是未来得及响应；
#Defin Unstarted            8       &&未调用Thread.Start()开始线程的运行；
#Defin WaitSleepJoin        32      &&线程因为调用了Wait(),Sleep()或Join()等方法处于封锁状态；

*Priority 优先级    
#Defin AboveNormal             3         &&可以将Thread安排在具有highest优先级线程之后，在Normal之前
#Defin BelowNormal             1         &&在Normal之后，Lowest之前
#Defin Highest                 4        &&在具有任何其他优先级的线程之前
#Defin Lowest                   0         &&在具有其他任何优先级的线程之后
#Defin Normal                  2         &&在AboveNormal之后，BelowNormal之前。默认值。

*ApartmentState
#Defin STA                  0         &&像私人汽车，使用完就释放  STA模型用于非线程安全的COM对象这意味着它们不处理自己的同步;
                                    这是一个常用的UI组件。因此，如果另一个线程需要与对象交互(例如按下表单中的按钮)，则消息被编组到STA线程上
#Defin MTA                  1         &&像公交,要的内存更多
#Defin Unknown              2       

Public responder  

lcPath="c:\zmq\"

Set Default To "&lcPath."

Clear 

_vfp.AutoYield = .F.

    
    
*--创建线程函数
Text To m.lcthrFunction Textmerge noShow

Function test1
         Lparameters chwnd
        Local lcPath ;
            , lnHwnd
            
        m.lnHwnd = Int( Val( m.chwnd ) )
        
        Do While (.T.)
            Sleep( 500 ) 
             wParam  = Ttoc( Datetime() )
            PostMessage( m.lnHwnd , 0x401, @wParam , Len( wParam ) )
        Enddo 
        
Endfunc 
Endtext 

strtofile( lcthrFunction , 'showtime.prg' )
Compile  "showtime.prg"

*--绑定这个消息对象
*--似乎_Screen.Hwnd 不能绑定
Public oFrmMsgScreen
oFrmMsgScreen = Createobject("FrmMsgScreen")
With oFrmMsgScreen
    .Show
Endwith 

*--创建线程
Local oThreadedAdapter
oThreadedAdapter       = Createobjectex("Netsuite.MultiThreadedAdapter","","")
othread1              = oThreadedAdapter.ThreadedAdapter( MTA )    
othread1.IsBackground = .T.                      &&后台线程        
othread1.Priority     = Normal                &&优先级                                          
othread1.name          = 'test1'             &&可以给这个线程命名一个名称
With oThreadedAdapter 
    .ProgId   = [mtcomvfp.MultiThread]         &&这个是用来关联VFP写的COM DLL
     Text To m.lcCmd Textmerge Noshow Pretext 1+2+4
          set Procedure To showtime.prg Additive  
          Return test1("<<Transform(oFrmMsgScreen.HWnd)>>" )
     Endtext    
    .Cmd = m.lcCmd    &&载入线程
Endwith 

*--绑定一个线程消息完成对象
Local loCOMAdapterEvents
m.loCOMAdapterEvents= CREATEOBJECT("COMAdapterEvents")
If !EVENTHANDLER( oThreadedAdapter, m.loCOMAdapterEvents) Then 
    Messagebox('绑定一个线程对象完成失败！',16, '绑定一个线程对象')
    Return .F.
Endif 
othread1.Start() &&运行线程1

*--绑定一个线程消息执行对象
Define Class FrmMsgScreen  as Form

    othread     = Null
    Add Object edt as editbox  WITH left=0, top=0,width=this.Width,height=this.Height 
    edt.Anchor  = 15
    
    Procedure init
        BINDEVENT(this.hWnd, 0x401 , this, "onMessage") 
    Endproc 
    
    Procedure OnMessage(hWnd,msg,wParam,lParam)
        this.edt.Value =  SYS(2600,wParam,lParam)
    Endproc

Enddefine 

*--绑定线程的方法(线程完成)
*--定制自定义类是带有属性、事件和方法，但没有可视表示的类。;
   适用于定义其他类型类的一些一般规则也适用于定义定制类。;
   使用 Session 对象以提供有效的内存管理和确保多线程应用程序中多个对象实例的行为安全。
Define Class COMAdapterEvents AS session OLEPUBLIC
       Implements MultiThreadedAdapterEvents IN "Netsuite.MultiThreadedAdapter"      
       Procedure MultiThreadedAdapterEvents_ThreadCompleted( oThreadedAdapter As Object ;             &&线程适配器
                                                              , othread           As Object ;             &&线程对象
                                                              , oThreadVFP          As Object ;             &&线程中的VFP对象,(注意：若执行函数方法异常是没有线程对象返回）
                                                              , cReturnParameter As string ;             &&返回参数
                                                              , cRetuErrMsg       As String ) AS VOID   &&线程异常 成功='Y',否则异常信息
         
            Local lcShow            ;
                , lcShowRequestData ;
                , lntimeStart 

            m.lcShowRequestData  = "" 
            Text To m.lcShow Textmerge Noshow Pretext 1 + 2 
                 -----------------------------------------------------------------------
                 我是线程:<<Transform( m.othread.ManagedThreadId )>> ,模式: <<Icase( m.othread.ApartmentState = 0 , 'STA', m.othread.ApartmentState = 1 , 'MTA' , "Unknown" )>> ,执行(<<othread.name>>),完成....
                 返回参数:<<m.cReturnParameter>>
                 异常信息:<<m.cRetuErrMsg>>
            Endtext 
            ?m.lcShow + Chr(13) + m.lcShowRequestData 
            If VarType( m.othreadVFP ) == 'O' And !Isnull( m.othreadVFP ) Then 
               *访问该线程VFP对象:m.othreadVFP 
            Endif 
       ENDPROC    

Enddefine

*!*    *--错误编号
*!*    Declare INTEGER zmq_strerror In "libzmq.dll" INTEGER @errnum_
*!*    errnum_=0
*!*    nstrerror=zmq_strerror(@errnum_)
*!*    ?nstrerror
*!*    ?"错误编号:" + Transform( errnum_ )