Многопоточность showmodal и WaitForSingleObject

[bulldog5293]

Эт я просто на вашем форуме код нашёл, вот он

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, unit2;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    PB: TProgressBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    CT: array [1..2000] of TMyThread;
    Prior: TThreadPriority;
    procedure ThreadComplete(var Message: TMessage); message WM_THREAD_COMPLETE;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
   IDX: Integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
IDX:=Idx+1;
CT[idx] := TMyThread.Create(Prior, idx);
 CT[idx].Start;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CT[idx].Terminate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IDX:=0;
end;
procedure TForm1.ThreadComplete(var Message: TMessage);
begin
  if Assigned(CT[Message.WParam]) then
  begin
    CT[Message.WParam].WaitFor;
    FreeAndNil(CT[Message.WParam]);
  end;
memo1.Lines.Add('Поток завершен');
end;
end.

и поток

unit Unit2;
interface
uses
    Windows, Messages, Forms, Classes, SysUtils;
const
    WM_THREAD_COMPLETE = WM_APP + 123;
type
 TMyThread = class(TThread)
  private
    Err: string;
    A,SS: Integer;
    procedure Complete;
    procedure Error;
    procedure TStop;
    procedure MyThreadTerminate(Sender: TObject);
   protected
     procedure Execute; override;
     procedure Progress;
    public
     constructor Create(Prior: TThreadPriority; ID: Integer);        
     destructor Destroy; override;
     procedure MyError(E : Exception);
    end;
implementation
uses Unit1;           //Юнит основного приложения
{ TMyThread }
procedure TMyThread.MyThreadTerminate(Sender: TObject);
begin
 // тут типа завершается
end;
destructor TMyThread.Destroy;
begin
  inherited Destroy;
end;
constructor TMyThread.Create(Prior: TThreadPriority; ID: Integer);
begin
  inherited Create(True);
  Priority := Prior;
  SS:=ID;
  OnTerminate := MyThreadTerminate;
  FreeOnTerminate := False;
end;
procedure TMyThread.Error;
Begin
 Form1.memo1.Lines.Add('Ошибка');
End;
Procedure TMyThread.MyError(E:Exception);
begin
 err:=SysErrorMessage(GetLastError);
 Synchronize(Error);
end;
procedure TMyThread.Complete;
begin
 Form1.memo1.Lines.Add('Завершил выполнение задания');
 Form1.PB.Position:=100;
end;
procedure TMyThread.TStop;
begin
 Form1.memo1.Lines.Add('Поток тормознули');
end;
procedure TMyThread.Progress;
begin
 Form1.PB.Position:=A;
end;
procedure TMyThread.Execute;
begin
A:=0;
 try
   try
    while A<100 do
     begin
      if self.Terminated then
       begin
        Synchronize(TStop);
         break;
       end;
       Synchronize(Progress);
        a:=a+1;
        sleep(10);
        if a=100 then Synchronize(Complete);
     end;
        except
    MyError(Exception(ExceptObject));
        end
  finally
     PostMessage(Form1.Handle, WM_THREAD_COMPLETE, SS, 0);
     Application.ProcessMessages;
  end;
 end;
end.

только вот если один поток вызывает PostMessage(Form1.Handle, WM_THREAD_COMPLETE, SS, 0); и через несколько секунд вызовит другой конфликта разве не будет?

[bulldog5293]

Пробывал так

 begin
      count:=0;
        FH.get('http://' + FUrl+'/',ss);
        end;
/ begin
      FH.get('http://' + FUrl+'/login.php?r=',S);
        end;
        begin
        If Pos('src="image.php?"', S.datastring) > 0 then
          try
      new := TStringList.Create;
      png := TPNGObject.Create;
      img.Position:=0;
        png.LoadFromStream(img);
          Form2.Image1.Picture.Assign(png);
PostMessage(Form2.Handle, WM_THREAD_COMPLETE, 0, 0);
Synchronize(ShowModalForm);
          code:=Form2.edit1.text;
          if code <> '' then
             finally
       png.Free;
      img:=nil;
         inf.Free;
          end;
         end;

procedure BUX.ShowModalForm;
begin
Form2.ShowModal;
end;


unit Unit2;

interface

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

type
  TFOR2 = class(TForm)
    Image1: TImage;
    Edit1: TEdit;
    Button2: TButton;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadComplete(var Message: TMessage); //message WM_THREAD_COMPLETE;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FOR2: TFOR2;

implementation

{$R *.dfm}

procedure TFOR2ThreadComplete(var Message: TMessage);
begin
showmodal;
end;

procedure TFOR2.Button1Click(Sender: TObject);
begin
  ModalResult := mrOk;
end;

end.

но эффекта модальной формы нет и если поставить 2 раза один сайт то загружается сразу 2 картинки, одна поверх другой. Что не так?

[bulldog5293]

Проблему понял, но как решить нет. Если с одного потока грузится изображение в Image, то второму потоку на это пофиг и грузит своё. В итоге получается картинка поверх картинки. Можно ли это как то приостановить?

[GunSmoker]

Боже, начните хотя бы с этого, куда вы в потоки-то лезете?

[bulldog5293]

Легче таскать по ссылкам, чем предложить альтернативу showmessage, дабы не нажимать её постоянно что бы выполнился тот код который для других потоков не должен быть доступен

[veniside]

Так вам предложили альтернативу -- MessageBox(), её можно вызывать когда угодно из какого угодно потока. Другой вопрос, на сколько вам такая альтернатива нужна, т.к. до сих пор не понятно, что и с чем у вас должно быть синхронизировано.

Если с одного потока грузится изображение в Image, то второму потоку на это пофиг и грузит своё. В итоге получается картинка поверх картинки. Можно ли это как то приостановить?

можно, через TCriticalSection, например.

[bulldog5293]

2 и более потоков могут одновременно использовать как showmodal так и TMemoryStream, если не ставить showmessage то появляется showmodal на ней картинка из TMemoryStream, а следом другая, после чего showmodal само собой не открывается. Из-за этого я и спросил есть ли альтернатива showmessage дабы не выводить её постоянно что бы притармазнуть параллельный поток и дождаться клика по модальной форме. А критическая секция тут не ваиант, т.к. потоки выполняются параллельно и у обоих это критсекция

[veniside]

Если у вас одна критическая секция выполняется в обоих потоках одновременно (это единственное, что я понял из ваших слов), то это не критическая секция, а критическая дырка.

[bulldog5293]

    
    CS.Enter;
       img:=TMemoryStream.Create;
          CS.Leave;
new := TStringList.Create;
      png := TPNGObject.Create;
      img.Position:=0;
        png.LoadFromStream(img);
          Form2.Image1.Picture.Assign(png);
Synchronize(ShowModalForm);
          code:=Form2.edit1.text;
          if code <> '' then
             finally
       png.Free;
      img:=nil;
         inf.Free;
          end;
         end;

так не хочит и тем более если 2 потока работают параллельно разве не получится что у них общаяя крит секция

[veniside]

Если у вас CS объявлена локально в каждом потоке, то нет, не получится.

Да даже если и глобально, приведенный выше код защищает только момент создания img, т.е. 2 потока не смогут одновременно создать img (опять же, х.з. локальный он или глобальный), но спокойно смогут одновременно выполнить Form2.Image1.Picture.Assign(png);

Т.е. должно быть как-то так:

CS.Enter;
try
  // тут весь код
finally
  CS.Leave;
end;

Ещё одна проблема в том, что Form2.Image1.Picture.Assign(png) скорей всего нельзя вызывать вне Synchronize(). Равно как и code:=Form2.edit1.text;

Правило очень простое: всё, что можно отнести к VCL (кнопки, картинки, лейблы, поля ввода, вобще всё визуальное и большинство невизуального) должно всегда исключительно работать только в главном потоке. Именно для этого и ввели костыль под названием Synchronize().