• Delphi中主线程与子线程调用同一方法同步问题


    开发环境是Delphi7

    此处用的是临界;信号量,互斥就不做测试了!

    仅仅是测试,哈哈

    =================Unit

    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls;

    type
    TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;
    TMythread=class(TThread)
    protected
    procedure Execute;override;

    end;
    var
    Form1: TForm1;
    Critical:TRTLCriticalSection ;
    A:Integer;
    MyThread:TMythread;
    implementation

    {$R *.dfm}
    var
    WaitLockBool: boolean; //主线程的该操作是否处于等待状态
    function PubF(Ini:Integer ;var AA:integer):string;
    var
    vstr:string;
    i:Integer;
    begin

    EnterCriticalSection(Critical);//进入临界段
    Form1.Memo2.Lines.Add('开启');
    for i:=0 to 2 do
    begin
    Sleep(1000);
    Application.ProcessMessages ;
    inc(AA);

    Form1.Memo2.Lines.Add('Str_'+inttostr(AA)+' '+inttostr(i)+' '+ IntToStr(ini));
    end;
    Form1.Memo2.Lines.Add('关闭');
    Result :='Str_'+inttostr(AA)+' '+inttostr(i)+' '+ IntToStr(ini);
    LeaveCriticalSection(Critical);//退出临界段
    end;
    procedure PMainWaitLock; //主线程等待临界区执行完成
    var
    i,vCount: integer;
    begin
    WaitLockBool := true;
    vCount:=12000; //如果看不出效果,请把这个参数改小,改成vCount:=1200 或者120
    for i:=1 to vCount do //超时时长,可根据实际情况进行设置
    begin
    if Critical.LockCount<>-1 then
    begin
    Application.ProcessMessages;
    sleep(1); //休眠1毫秒
    end
    else
    break;
    end;
    if (i<vCount) then
    WaitLockBool := false;
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    begin
    InitializeCriticalSection(Critical);
    end;

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    DeleteCriticalSection(Critical);
    if MyThread<>nil then
    if not MyThread.Terminated then
    begin
    MyThread.Terminate;
    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    MyThread:=TMythread.Create(False);
    end;

    { TMythread }

    procedure TMythread.Execute;
    var
    i,AA:Integer;

    begin
    AA:=0;
    for I := 1 to 2 do
    begin
    Sleep(1000);
    PubF(i,AA);
    end;

    end;

    procedure TForm1.Button2Click(Sender: TObject);
    var
    AA:Integer;
    begin
    AA:=1000;
    PMainWaitLock;
    if not WaitLockBool then
    PubF(10,AA)
    else
    ShowMessage('被占用,请重试!')
    end;

    end.

    ==============Form

    object Form1: TForm1
    Left = 669
    Top = 413
    Width = 326
    Height = 508
    Caption = 'Form1'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    OnClose = FormClose
    OnCreate = FormCreate
    PixelsPerInch = 96
    TextHeight = 13
    object Button1: TButton
    Left = 48
    Top = 384
    Width = 75
    Height = 25
    Caption = 'B1_线程'
    TabOrder = 0
    OnClick = Button1Click
    end
    object Button2: TButton
    Left = 192
    Top = 384
    Width = 75
    Height = 25
    Caption = 'B2主'
    TabOrder = 1
    OnClick = Button2Click
    end
    object Memo2: TMemo
    Left = 24
    Top = 16
    Width = 273
    Height = 241
    ImeName = '中文(简体) - 搜狗拼音输入法'
    ScrollBars = ssBoth
    TabOrder = 2
    end
    end

  • 相关阅读:
    Volar vue终极开发神器!
    Object.assign基础与实际应用场景
    如何将Promise.then中的值直接return出来
    zap linux环境下的使用
    量化
    博客园中实现代码高亮
    react环境搭建
    博客园中实现代码高亮
    Python之标准库【shutil】
    Python之标准库【shutil】
  • 原文地址:https://www.cnblogs.com/dmqhjp/p/14302040.html
Copyright © 2020-2023  润新知