VPF::поток запущен, а форма висит - Форум программистов

Чучмек

Дата 1.7.2012, 15:11 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41

И еще. Знаешь, не знаешь ...
Прежде чем вызвать в потоке CreateOleObject необходимо вызвать coinitialize.

Код


procedure Txxx.execute;
 begin
 coinitialize(nil);
 ...
 Excel := CreateOleObject('Excel.Application');
 ...
 excel.quit;
 ...
 couninitialize;
 end;

--------------------

умную мысль держи при себе, а дурной - поделись с другими

Чучмек

Дата 1.7.2012, 20:18 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41

Еще...
В твоем случае можно вообще обойтись без Synchronize.
В TPotok объяви переменную hProgressBar:Cardinal (в место ProgressBar), в которую, при инициализации потока, сохраняй StatusProgressBar.Handle
В потоке можешь смело использовать

Код


SetWindowPos(hProgressBar, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);

вместо

Код


StatusProgressBar.visible:=true;

Код


SetWindowPos(hProgressBar, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW);

вместо

Код


StatusProgressBar.visible:=false;

Код


PostMessage(hProgressBar, PBM_SETRANGE32, Mix, Max);

вместо

Код


StatusProgressBar.Min:=Min;
StatusProgressBar.Max:=Max;

Код


PostMessage(hProgressBar, PBM_SETPOS, position,0);

вместо

Код


StatusProgressBar.Position:=position;

Константы из CommCtrl

Код


const
 PBM_SETPOS              = WM_USER+2;
 PBM_SETRANGE32          = WM_USER+6;

Это сообщение отредактировал(а) Чучмек - 1.7.2012, 20:32

--------------------

умную мысль держи при себе, а дурной - поделись с другими

chikistbuch

Дата 1.7.2012, 20:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.3.2008

Репутация: нет
Всего: 1

Охренеть. Чучмек, спасибо конечно, но ....
Оставлю этот вопрос на потом. Еще раз спасибо!!!

Это сообщение отредактировал(а) chikistbuch - 1.7.2012, 20:36

chikistbuch

Дата 1.7.2012, 21:21 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.3.2008

Репутация: нет
Всего: 1

Всё таки решил попробовать, пишет ошибку:

Код


[DCC Error] Unit1.pas(251): E2003 Undeclared identifier: 'coinitialize'

Код


procedure TPotok.Execute;
var
  WorkBook, Sheet: Variant;
  i, j, kolKolonok, kolStrok:integer;
  sql, sql_1: string;
  maxID: array [1..2] of string;
  sqlArray: OLEVariant;
  bool:boolean;
begin
  coinitialize(nil);
  try
    Excel := CreateOleObject('Excel.Application');//создаем что-то типа excel
  except
    MessageBox(Application.ActiveFormHandle, 'MS Excel не найден!'+#13#10+'Для работы программы необходимо установить MS Excel.', 'Внимание!', MB_ICONWARNING or MB_OK);
    exit;
  end;

  Excel.Application.Enab

Чучмек

Дата 1.7.2012, 21:46 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41

Пропиши в uses activex

Это сообщение отредактировал(а) Чучмек - 1.7.2012, 21:47

--------------------

умную мысль держи при себе, а дурной - поделись с другими

Чучмек

Дата 1.7.2012, 22:08 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41

Опять же...

Цитата(chikistbuch @ 1.7.2012, 21:21

)

MessageBox(Application.ActiveFormHandle,

В execute не должно быть ничего типа Application.xxx... и Form1.xxx... - такое только через Synchronize.
Переменную Excel объяви в Execute. В execute Excel и закроешь.

--------------------

умную мысль держи при себе, а дурной - поделись с другими

chikistbuch

Дата 1.7.2012, 22:27 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 57
Регистрация: 15.3.2008

Репутация: нет
Всего: 1

Цитата(Чучмек @ 1.7.2012, 22:08)

Опять же...

Цитата(chikistbuch @ 1.7.2012, 21:21

)

MessageBox(Application.ActiveFormHandle,

))) а оно все равно работает ))))))

Добавлено @ 22:32
Намудрил, сам не знаю что, но работает ))))))) (все в одном unit'е):

Код


type
   TPotok = class(TThread)
    private
      hProgressBar:Cardinal;
      list: TStrings;
      filename: string;
      Excel: OleVariant;
      ProgressBar: TProgressBar;
      UniQuery: TUniQuery;
      procedure loaddata;
     { Private declarations }
    protected
      procedure Execute; override;
end;

var
  potok: TPotok;

Код


procedure TPotok.Execute;
var
  WorkBook, Sheet: Variant;
  i, j, kolKolonok, kolStrok:integer;
  sql, sql_1: string;
  maxID: array [1..2] of string;
  sqlArray: OLEVariant;
  bool:boolean;
begin
  coinitialize(nil);
  try
    Excel := CreateOleObject('Excel.Application');//создаем что-то типа excel
  except
    MessageBox(0, 'MS Excel не найден!'+#13#10+'Для работы программы необходимо установить MS Excel.', 'Внимание!', MB_ICONWARNING or MB_OK);
    exit;
  end;

  Excel.Application.EnableEvents := false;// Отключаем реакцию Excel на события, чтобы ускорить вывод информации
  Excel.DisplayAlerts:=False;//отключаем сообщения excel'я

  WorkBook := Excel.WorkBooks.Open(filename);//открываем файл
  PostMessage(0, WM_CloseExcel, 0, 0);//закрываем excel после выполнения данной процедуры

  try
    Sheet := Workbook.Sheets.Item[1] //выбираем лист
  except
    MessageBox(Application.ActiveFormHandle, 'Ошибка!'+#13#10+'Файл MS Excel пуст или поврежден.', 'Внимание!', MB_ICONWARNING or MB_OK);
    exit;
  end;

  kolStrok:=Sheet.UsedRange.Rows.Count;
  kolKolonok:=Sheet.UsedRange.Columns.Count;
  sqlArray:=Sheet.UsedRange.Value; //прочитали все значения в массив

  for i := 1 to kolKolonok do begin //проверяем правильность названия колонок
    j:=0;
    bool:=false;//индикатор совпадения имени

    while (j<list.Count-1) AND (NOT bool) do begin
      if AnsiUpperCase(sqlArray[1,i])=AnsiUpperCase(list.Strings[j]) then begin //если название колонки совпадает с названием колонки в БД
        sqlArray[1,i]:=form1.getAS(sqlArray[1,i], 2);//записали название колонки familia
        bool:=true;
      end;
      j:=j+1;
    end;

    if not bool then begin //если совпадений в названии колонки не найдено
      MessageBox(Application.ActiveFormHandle, pChar('Ошибка! Неверное название '+inttostr(i)+' колонки: "'+string(sqlArray[1,i])+'".'), 'Внимание!', MB_ICONWARNING or MB_OK);
      exit;//прерываем выполнение кода
    end;
  end;

  if  MessageBox(0, 'Загрузить данные из указанного файла?', 'Внимание!', MB_ICONWARNING or MB_YESNO) = IDNO then exit;//прерываем выполнение кода

  ProgressBar.Position:=0;
  ProgressBar.Visible:=true;
  ProgressBar.Max:=kolStrok+round(0.2*kolStrok);


  UniQuery.SQL.Text:='SELECT MAX(`id`) FROM spisok';//узнали макс id
  UniQuery.Execute;
  maxID[1]:=UniQuery.Fields.Fields[0].AsString;

    sql:='PREPARE excelInsert FROM "INSERT INTO `spisok` ('; //подготавливаем sql запрос на ввод данных

  for i:=1 to kolKolonok do begin
    sql:=sql+'`'+sqlArray[1,i]+'`, ';
    sql_1:=sql_1+'@'+sqlArray[1,i]+', ';//для EXECUTE
  end;
  delete(sql, length(sql)-1, 2);
  delete(sql_1, length(sql_1)-1, 2);//для EXECUTE
  sql:=sql+') VALUES (';

  for i:=1 to kolKolonok do begin
    sql:=sql+'?, ';
  end;
  delete(sql, length(sql)-1, 2);
  sql:=sql+')";';           //подготовили запрос на вставку

  for i := 2 to kolStrok do begin //так как первая строка содержит названия колонок
    if i mod 10 = 0 then ProgressBar.Position:=i;
    for j := 1 to kolKolonok do begin
      if string(sqlArray[i,j])='' then sql:=sql+'SET @'+string(sqlArray[1,j])+' = NULL;'//проверяем не пуста ли строка
        else sql:=sql+'SET @'+string(sqlArray[1,j])+' = "'+string(sqlArray[i,j])+'";';//формируем значения
    end;
  sql:=sql+'EXECUTE excelInsert USING '+sql_1+';';;
  end;

  UniQuery.SQL.Text:=sql;
  UniQuery.Execute; //вставили все значения


  UniQuery.SQL.Text:='SELECT MAX(`id`) FROM spisok';//узнали макс id
  UniQuery.Execute;
  maxID[2]:=inttostr(form1.UniQuery2.Fields.Fields[0].AsInteger+1);

  if maxID[1]='' then sql_1:='WHERE id < '+maxID[2] //формируем условие запроса
    else sql_1:='WHERE id BETWEEN '+maxID[1]+' AND '+maxID[2];
  sql:='UPDATE spisok SET data_redaktirovania = "'+FormatDateTime('yyyy:mm:dd',Now())+'" '+sql_1;//выставляем дату редактирования записи
  UniQuery.SQL.Text:=sql;
  UniQuery.Execute;

  ProgressBar.Position:=ProgressBar.Max;

  kolStrok:=kolStrok-1; //так как 1 строка - название колонок
  sql_1:=inttostr(kolStrok)[length(inttostr(kolStrok))];//формируем сообщение
  sql:='Загрузка данных выполнена успешно!'+#13#10+'Загружен';

  if (sql_1='1') and (kolStrok<>11) then sql:=sql+'а'
    else sql:=sql+'о';

  sql:=sql+' '+inttostr(kolStrok);
  if (kolStrok>10) and (kolStrok<21) or (sql_1='0') or (sql_1='5') or (sql_1='6') or (sql_1='7') or (sql_1='8') or (sql_1='9') then sql:=sql+' записей.'
    else if sql_1='1' then sql:=sql+' запись.'
      else sql:=sql+' записи.';

  MessageBox(0, PWideChar(sql), 'Внимание!', MB_ICONWARNING or MB_OK);

  ProgressBar.Visible:=false;

  Excel.Quit;  //якобы мы нажимаем на крестик в excel
  Excel:=unassigned;  //походу это нужно писать в паре с Quit (перевод - неназначенный)

  Synchronize(loaddata); // Вызов метода с синхронизацией
  couninitialize;
end;

procedure TPotok.loaddata();
begin
  getDB();
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
begin
  form1.OpenDialog1.Filter:='Файлы Excel|*.xls; *.xlsx';
  if form1.OpenDialog1.Execute() then begin
    potok := TPotok.Create(true);// true - после создания класса поток автоматически запущен не будет
    potok.FreeOnTerminate := true;//после завершения кода потока он сразу завершится
    potok.ProgressBar:=StatusProgressBar;
    potok.UniQuery:=form1.UniQuery2;
    potok.hProgressBar:=StatusProgressBar.Handle;
    potok.filename := form1.Opendialog1.FileName;
    potok.list:=form4.CheckListBox1.Items;
    potok.Priority := tpNormal;//Устанавливаем приоритет
    potok.Resume;//Запускаем поток
  end;
end;

Это сообщение отредактировал(а) chikistbuch - 1.7.2012, 22:36

Чучмек

Дата 1.7.2012, 23:05 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41

22: