Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.07.2017, 12:28   #1
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию Проблема с работой в потоке при обращении к элементу другой программы (АвтоКАДа)

Здравствуйте!
Пытаюсь сделать в Дельфи (D7) программу, которая в потоке будет менять цвет объекта из АвтоКАДа (мигать).
Проблема возникла вот какая: почему-то функция смены цвета работает в Create потока, а в Execute любое обращение к АвтоКАДу вызывает проблемы (всё зависает разными способами).
Перепробовал несколько разных вариантов, остановился на этой реализации:
Код:
type
  TACTF = record
    excolot: Integer;  // цвет объекта
    Ent: IAcadEntity;  // объекта в АвтоКАДе (интерфейс)
    Handl: string;  // Хендл (идентификатор) объекта в АвтоКАДе
  end;
  TOneMoreThread=class(TThread)
  private
    AcadApp: IAcadApplication;  // Интерфейс самого АвтоКАДа
  protected
    procedure execute; override;
  public
    ArrObj: array of TACTF;
    constructor Create(HandStr:TStringList);
    destructor Destroy; override;
  end;
  ...
  TForm1
    ...  
  private
    OneMoreThread:TOneMoreThread;
    HandStrs: TStringList;   // Список хендлов объектов, забираемых из StringGrid

    ...
  
 Procedure SetEntColor(HandNom: integer; Col: integer);
var
  Ent: IAcadEntity;
begin
  Ent:=(Form1.AcadApp.ActiveDocument.HandleToObject(Form1.HandStrs[HandNom]) as IAcadEntity);
  Ent.color:=Col;
  Ent.Update;
end;

procedure TOneMoreThread.execute;
var
  i, Nom:Integer;
begin
  inherited;
  Nom:=0;
//  While not terminated do
//  begin
    inc(Nom);
    Form1.Caption:=IntToStr(Nom)+' st'+ArrObj[0].Handl;
    SetEntColor(0,acRed);  //  даже такая реализация не работает: глюков не происходил, но до Form1.Caption:=IntToStr(Nom)+' ch' так и не доходит
    For i:=0 to Length(ArrObj)-1 do
    begin
//      ArrObj[i].Ent.color:=acRed;  
//      ArrObj[i].Ent.Highlight(True);
    end;
    Form1.Caption:=IntToStr(Nom)+' ch';
    Sleep(1000);
    Form1.Caption:=IntToStr(Nom)+' sch';
//    SetEntColor(ArrObj[0].Ent,ArrObj[i].excolot);
    For i:=0 to Length(ArrObj)-1 do
    begin
//      ArrObj[i].Ent.color:=ArrObj[i].excolot;
//      ArrObj[i].Ent.Highlight(False);
    end;
    Form1.Caption:=IntToStr(Nom)+' en'+ArrObj[1].Handl;
    Sleep(2000);
//  end;
end;

constructor TOneMoreThread.Create(HandStr:TStringList);
var
  i: integer;
begin
  inherited Create(True); (*Поток создаем в состоянии «Приостановлен»*)
  AcadApp:= GetAcadApplication(true);
  SetLength(ArrObj,HandStr.Count);
  If HandStr.Count>0 then
  begin
    for i:=0 to Length(ArrObj)-1 do
    begin
      ArrObj[i].Ent:=(AcadApp.ActiveDocument.HandleToObject(HandStr[i]) as IAcadEntity);
//      SetEntColor(ArrObj[i].Ent,acRed);   // <------------  В этом месте изменение цвета работает!
//      ArrObj[i].Ent.Update;

      ArrObj[i].excolot:=ArrObj[i].Ent.color;
      ArrObj[i].Handl:=ArrObj[i].Ent.Handle;
    end;
  end;
  FreeOnTerminate := True; (* Поток освободит ресурсы при окончании работы*)
  Self.Priority := tpNormal;
  resume;
end;

destructor TOneMoreThread.Destroy;
begin
  AcadApp:= nil;
  SetLength(ArrObj,0);
  inherited Destroy;
end;


procedure TForm1.Button15Click(Sender: TObject);
var
  NCol,i:Integer;
begin
  NCol:=StringGrid1.Selection.Left;
  If NCol=1 then NCol:=2; If NCol=3 then NCol:=4; If NCol=5 then NCol:=6;
  HandStrs:=TStringList.Create;
  For i:=StringGrid1.Selection.Top to StringGrid1.Selection.Bottom do
    if StringGrid1.Cells[NCol,i]<>'' then
      HandStrs.Add(StringGrid1.Cells[NCol,i]);
  OneMoreThread:=TOneMoreThread.Create(HandStrs);
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
  OneMoreThread.Terminate;
  HandStrs.Free;
end;
Ship_1 вне форума Ответить с цитированием
Старый 06.07.2017, 13:38   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

1. Execute и Create работают с РАЗНЫМИ объектами Acad-a.
Create устанавливает свое
Код:
  AcadApp:= GetAcadApplication(true);
а Execute зачем-то работает через форму
Цитата:
SetEntColor(0,acRed); // даже такая реализация не работает: глюков не происходил, но до Form1.Caption:=IntToStr(Nom)+' ch' так и не доходит
Цитата:
Ent:=(Form1.AcadApp.ActiveDocument.HandleToObj ect(Form1.HandStrs[HandNom]) as IAcadEntity);
А давно и много раз повторено работа c VCL в потоках должна быть в обертке Synchonize!!!
форма это VCL объект.

и ничего не известно про
Цитата:
Form1.AcadApp
в приведенном коде НЕТ его задания.
А это совсем ДРУГАЯ переменная(и объект) нежели поле потока
Цитата:
TOneMoreThread=class(TThread)
private
AcadApp: IAcadApplication; // Интерфейс самого АвтоКАДа
которым ты пользуешься в Create.
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 06.07.2017, 14:06   #3
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

Цитата:
Сообщение от evg_m Посмотреть сообщение
1. Execute и Create работают с РАЗНЫМИ объектами Acad-a.
Create устанавливает свое
Код:
  AcadApp:= GetAcadApplication(true);
а Execute зачем-то работает через форму
Цитата:
Сообщение от evg_m Посмотреть сообщение
А давно и много раз повторено работа c VCL в потоках должна быть в обертке Synchonize!!!
А с интерфейсами? Обращение к форме было последней попыткой хоть как-то заставить работать Execute. До этого пытался всё обращение к AcadApp делать внутри потока. Но даже перенеся в Execute
Код:
AcadApp:= GetAcadApplication(true);
получил только глюк: ещё до первого изменения заголовка формы произошло что-то, напоминающее разворачивание прозрачной формы на весь экран, и всё на экране стало недоступным (как будто форма развернула прозрачное стекло на весь экран).

AcadApp формы работает без перебоев, определяется так же, как и в потоке, но при нажатии отдельной кнопки.
Ship_1 вне форума Ответить с цитированием
Старый 11.07.2017, 12:02   #4
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

Что-то никто как-то ничего... Ну я пока покопался немного и всё-таки добился мигания. Сейчас у меня это выглядит так:
Код:
type
  TACTF = record
    excolot: Integer;
    Ent: IAcadEntity;
    Handl: string;
  end;
  TOneMoreThread=class(TThread)
  private
    AcadApp: IAcadApplication;
    procedure Colorized;
    Procedure SetEntColor(HandNom: integer; Col: integer);
  protected
    procedure execute; override;
  public
    ArrObj: array of TACTF;
    constructor Create(HandStr:TStringList);
    destructor Destroy; override;
  end;
...
...
Procedure TOneMoreThread.SetEntColor(HandNom: integer; Col: integer);
var
  Ent: IAcadEntity;
begin
  Ent:=(AcadApp.ActiveDocument.HandleToObject(ArrObj[HandNom].Handl) as IAcadEntity);
  Ent.color:=Col;
  Ent.Update;
end;

procedure TOneMoreThread.Colorized;
var
  i, Nom:Integer;
begin
  Nom:=0;
  While not terminated do
  begin
    inc(Nom);
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,acRed);
    end;
    Sleep(50);
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,ArrObj[i].excolot);
    end;
    Sleep(1000);
  end;
end;

procedure TOneMoreThread.execute;
begin
  inherited;
  synchronize(Colorized);
end;

constructor TOneMoreThread.Create(HandStr:TStringList);
var
  i: integer;
begin
  inherited Create(True); (*Поток создаём в состоянии "Приостановлен"*)
  AcadApp:= GetAcadApplication(true);
  SetLength(ArrObj,HandStr.Count);
  If HandStr.Count>0 then
  begin
    for i:=0 to Length(ArrObj)-1 do
    begin
      ArrObj[i].Ent:=(AcadApp.ActiveDocument.HandleToObject(HandStr[i]) as IAcadEntity);
      ArrObj[i].excolot:=ArrObj[i].Ent.color;
      ArrObj[i].Handl:=ArrObj[i].Ent.Handle;
    end;
  end;
  FreeOnTerminate := True; (* Поток освободит ресурсы при окончании работы *)
  Self.Priority := tpNormal;
  resume;
end;

destructor TOneMoreThread.Destroy;
begin
  AcadApp:= nil;
  SetLength(ArrObj,0);
  inherited Destroy;
end;


procedure TForm1.Button15Click(Sender: TObject);
var
  NCol,i:Integer;
begin
  NCol:=StringGrid1.Selection.Left;
  If NCol=1 then NCol:=2; If NCol=3 then NCol:=4; If NCol=5 then NCol:=6;
  HandStrs:=TStringList.Create;
  For i:=StringGrid1.Selection.Top to StringGrid1.Selection.Bottom do
    if StringGrid1.Cells[NCol,i]<>'' then
      HandStrs.Add(StringGrid1.Cells[NCol,i]);
  OneMoreThread:=TOneMoreThread.Create(HandStrs);
end;


procedure TForm1.Button16Click(Sender: TObject);
begin
  OneMoreThread.Terminate;
  HandStrs.Free;
end;
Но проблема вот в чём: форма зависает и больше ничего сделать не даёт (в т.ч. закончить поток через Button16Click). Не пойму почему: вроде, все связи с формой убрал из потока...
Ship_1 вне форума Ответить с цитированием
Старый 11.07.2017, 12:24   #5
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

Цитата:
Код:
 synchronize(Colorized);
все что вы пытаетесь делать в потоке, на самом вы делаете в ОСНОВНОМ потоке.
synchronize это приостановка потока И ПЕРЕХОД в основной.
вот и получается
Цитата:
форма зависает и больше ничего сделать не даёт
её ресурсы забрал себе поток.

Я же делаю Sleep.
Sleep поскольку он внутри colorized и значит внутри synchronize ТОЖЕ относится к основному потоку.

как минимум надо
Код:
while not terminated do begin
   synchronize(... ); // что-то делаем 
   sleep(...); // остановка потока ВНЕ synchronize
end;
или же ПЕРЕНЕСТИ synchronize внутрь colorized и по крайней мере Sleep высвободить из-под synchronize.
программа — запись алгоритма на языке понятном транслятору

Последний раз редактировалось evg_m; 11.07.2017 в 12:27.
evg_m вне форума Ответить с цитированием
Старый 11.07.2017, 12:50   #6
Ship_1
Форумчанин
 
Регистрация: 10.02.2014
Сообщений: 526
По умолчанию

Получилось вот так:
Код:
Procedure TOneMoreThread.SetColorBlock;
var
  i:Integer;
begin
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,acRed);
    end;
end;

Procedure TOneMoreThread.ClearColorBlock;
var
  i:Integer;
begin
    For i:=0 to Length(ArrObj)-1 do
    begin
      SetEntColor(i,ArrObj[i].excolot);
    end;
end;

procedure TOneMoreThread.Colorized;
var
  Nom:Integer;
begin
  Nom:=0;
  While not terminated do
  begin
    inc(Nom);
    synchronize(SetColorBlock);
    Sleep(50);
    synchronize(ClearColorBlock);
    Sleep(1000);
  end;
end;

procedure TOneMoreThread.execute;
begin
  inherited;
  Colorized;
end;
Получается, что нельзя для синхронизации делать процедуры с параметрами? Попытался сделать SetColorBlock(color: integer), компилятор мне сказал что-то про то, что это не оверлоад.
И ещё вот такой вопрос: если synchronize использует основной поток, то чьими переменными он пользуется? У меня AcadApp есть и в основном потоке, и в этом. SetEntColor чей AcadApp использует? В предыдущем варианте, когда всё было внутри synchronize, программа не зависала, но и смены цвета не происходило.
Ship_1 вне форума Ответить с цитированием
Старый 11.07.2017, 13:52   #7
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

Цитата:
если synchronize использует основной поток, то чьими переменными он пользуется?
всеми которые доступны с т.з. компилятора. (переменная это понятия компилятора, не программы).

правило разрешения имен. Какая "переменная" c таким именем будет использована.
1. локальные имена (в т.ч. параметры процедур).
Код:
procedure One;
var
  x: integer;
begin
2.внутренние поля объекта(для процедур-методов)
Код:
TmyClass 
  x: string;
  ...
end;

procedure TMyclass.OneX;
begin
3. имена объявленные в ТОМ же unit
Код:
var
  x: TDateTime;

procedure Two; 
begin
4. имена объявленные в ДРУГИХ unit подключенных с использованием uses в порядке их перечисления.
в некоторых случаях при наличии одинаковых имен это приводит к проблемам.


все нарушения(коррекции) порядка использования лечатся использованием составных имен
1. добавлением имени модуля
Код:
unit5.x :=strtount( unit6.x );
2. добавлением имени объекта
Код:
var
  obj1: TmyClass;

procedure XX;
var
  x: integer;
begin
  x:=strtoint(obj1.x);
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Потоки. Как избежать конфликта при обращении к одному элементу? Ship_1 Общие вопросы Delphi 2 26.04.2017 13:12
WinInet в потоке - проблема при компиляции Ship_1 Общие вопросы Delphi 10 21.04.2017 16:47
Проблема при обращении эксель к ворду. RGZZ Microsoft Office Excel 0 16.06.2010 17:17
Thread. проблемы с работой потока. Моментально исчезают созданные в потоке формы. Casper-SC Общие вопросы .NET 3 24.04.2010 12:28
Связанные таблицы - проблема при обращении к полю БД nataly_ukr БД в Delphi 7 13.11.2007 10:47