Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #16  
Старый 28.09.2023, 13:18
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Смех тут такое дело

а что там про фон было
Application.ProcessMessages; -> когда грузишь в базу (freehost). как можно заниматься другим чем нибудь
screens2.jpg
Ответить с цитированием
  #17  
Старый 29.09.2023, 12:47
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Стрелка не могу сообразить

Не могу сообразить Repaint и Application.ProcessMessages
все ровно когда загрузка в базу идет, другими кнопками не поиграешься
Код:
procedure TForm1.TodoTables;
var DB:TStringlist;
    i:integer;
begin
with simpledataset1 do
    begin
      DataSet.CommandType:=ctQuery;
      DataSet.CommandText:='SELECT table_name FROM INFORMATION_SCHEMA.TABLES';
   end;
   DB:=Tstringlist.Create;
   SimpleDataSet1.Connection:=sqlconnection1;
   if SimpleDataSet1.Active=false then SimpleDataSet1.Active:=true;
      SimpleDataSet1.DataSet.Active:=true;

   SimpleDataSet1.First;

   while not SimpleDataSet1.Eof do
   begin
     DB.Add(SimpleDataSet1.FieldByName('table_name').AsString);
     SimpleDataSet1.Next;
   end;

   for i := 0 to DB.Count-1 do listbox2.Items.Add(DB[i]);
   listbox2.ItemIndex:=0;

   DB.Free;
end;

//проверка таблицы на существование
procedure TForm1.Showtables;
begin
     SQLQuery1.SQLConnection:=SQLConnection1;
     SQLQuery1.SQL.Clear;
     SQLQuery1.SQL.Text:='SHOW TABLES LIKE "'+edit6.Text+'"'; //SQLQuery1.SQL.Text:='select * from test1';
     SQLQuery1.Open;
if not SQLQuery1.IsEmpty then
begin
  memo1.Lines.Add('поле с таким значением есть');
  if sqlconnection1.Connected=true then begin
    SQLTable1.TableName:=Edit6.Text;
    SQLTable1.Active:=true;
    ClientDataSet1.Active:=true;
    form1.Edit9.Text:=form1.Edit6.Text;
    PachImage;
  end;
end
    else
          begin
  memo1.Lines.Add('поле с таким значением нет');
  button2.Enabled:=true;
  form2.Label2.Caption:='Таблица с названием '+form1.edit6.text;
  form1.Edit9.Text:=form1.Edit6.Text;
  form2.ShowModal;
end;
  SQLQuery1.Close;
  image2.Picture.LoadFromFile('image\help\03.png');
 if level=2 then helptext1.Caption:='Отлично! Все работает' + #13#10+'нажмем на загрузку.';
end;

procedure TForm1.SQLConnection1AfterConnect(Sender: TObject);
begin
//StatusBar1.Panels.Items[0]:='Conecct OK';
StatusBar1.Panels[0].Text:='Connect OK';
end;

procedure TForm1.SQLConnection1AfterDisconnect(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='DisConnect OK';
end;

//создание таблицы
procedure TForm1.Createtables;
begin
    SQLQuery1.SQL.Clear;
    SQLQuery1.SQL.Add('CREATE TABLE if not exists '+edit6.text+' (id INT, name VARCHAR(255) NOT NULL, reviews VARCHAR(40) NOT NULL, size INT, attribute VARCHAR(255));');
    SQLQuery1.ExecSQL;
              memo1.Lines.Add('Таблица создана ...');
              listbox2.Clear; //очистка дерева MySql
              TodoTables; // загрузка в дерево
end;

procedure TForm1.cxGrid1DBTableView1CellClick(Sender: TcxCustomGridTableView;
  ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton;
  AShift: TShiftState; var AHandled: Boolean);
begin
 with cxGrid1DBTableView1.Controller do  //выдрать значение с ячейки
   if Assigned(FocusedRecord) and Assigned(FocusedItem) then
     edit10.Text := FocusedRecord.Values[FocusedItem.Index];
end;

//иконки в ячейках
procedure TForm1.cxGrid1DBTableView1CustomDrawCell(
  Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
  AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
var
    APainter: TcxPainterAccess;
    AEditViewInfo: TcxCustomTextEditViewInfo;
    AImageRect: TRect; StarsCount,i:integer;
begin
  if (AViewInfo.Item <> cxGrid1DBTableView1reviews) or
    not (AViewInfo.EditViewInfo is TcxCustomTextEditViewInfo) then
      Exit;
  APainter := TcxPainterAccess(TcxViewInfoAcess(AViewInfo).GetPainterClass.
    Create(ACanvas, AViewInfo));
   // AImageRect := AViewInfo.Bounds;   // закрашивает ячеку
  try
   { AEditViewInfo := TcxCustomTextEditViewInfo(AViewInfo.EditViewInfo);
    AEditViewInfo.TextRect.Left := AEditViewInfo.TextRect.Left + AViewInfo.ContentBounds.Height + 1;}
    //APainter.DrawContent;
    //APainter.DrawBorders;
    (ACanvas.FillRect(AViewInfo.ContentBounds)); //закрашивает ячейку

    AImageRect := AViewInfo.ContentBounds;
    AImageRect.Width := AImageRect.Height;

  {If (AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index] < 0) Then begin  ACanvas.DrawImage(cxImageList1, AImageRect.Left, AImageRect.Top, 0); end;  }

  StarsCount := AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index];
  For I := 0 To StarsCount-1 Do
  ACanvas.DrawImage(cxImageList1, AImageRect.Left+(I*16), AImageRect.Top, 0);

  finally
    APainter.Free;
  end;
  ADone := True;
end;

procedure TForm1.FileDirectory;
var
  OpenDialog: TFileOpenDialog;
  SelectedFolder: string;
begin
OpenDialog := TFileOpenDialog.Create(Form1);
try
  OpenDialog.Options := OpenDialog.Options + [fdoPickFolders];
  if not OpenDialog.Execute then
    Abort;
    SelectedFolder := OpenDialog.FileName;
    Edit7.Text:= OpenDialog.FileName;
    FileSearch(OpenDialog.FileName,AddToDbCb);
    FileImg(OpenDialog.FileName,AddToMemoCb);
finally
  OpenDialog.Free;
end;
end;

//поиск картинок
procedure TForm1.FileSearch(const dirName:string; ACallBack : TInsertImageToDbCallBack);
var    searchResult: TSearchRec; x,x1:integer;  st,st1:string;
begin
x:=0;   x1:=1;  st:='111';
  if FindFirst(dirName+'\*', faAnyFile, searchResult)=0 then begin
    try
      repeat
        if (searchResult.Attr and faDirectory)=0 then begin
          if SameText(ExtractFileExt(searchResult.Name), '.jpg') then begin
          inc(x,1);
            ACallBack(IncludeTrailingBackSlash(dirName)+searchResult.Name,st,searchResult.Size,x,x1);
        end;
        end else if (searchResult.Name<>'.') and (searchResult.Name<>'..') then begin
        FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name,AddToDbCb);
         end;
      until FindNext(searchResult)<>0
    finally
      FindClose(searchResult);
    end;
  end;
end;

//добавление картинок в локальное дерево
procedure TForm1.FileImg(const dirName:string; ACallBack : TInsertImageToDbCallBack);
var
  searchResult: TSearchRec; x,x1:integer;  st:string;
begin
x:=0; x1:=1; st:='111';
  if FindFirst(dirName+'\*', faAnyFile, searchResult)=0 then begin
    try
      repeat
        if (searchResult.Attr and faDirectory)=0 then begin
          if SameText(ExtractFileExt(searchResult.Name), '.jpg') then begin
          inc(x,1);
            ACallBack(IncludeTrailingBackSlash(dirName)+searchResult.Name,st,searchResult.Size,x,x1);
        end;
        end else if (searchResult.Name<>'.') and (searchResult.Name<>'..') then begin
         FileImg(IncludeTrailingBackSlash(dirName)+searchResult.Name,AddToMemoCb);
         end;
      until FindNext(searchResult)<>0
    finally
      FindClose(searchResult);
    end;
  end;
end;

procedure TForm1.FileOpen; //открытие новых файлов в локальное дерево
var
  OpenDialog: TFileOpenDialog;
  SelectedFolder: string;
begin
OpenDialog := TFileOpenDialog.Create(Form1);
try
  OpenDialog.Options := OpenDialog.Options + [fdoPickFolders];
  if not OpenDialog.Execute then
    Abort;
    SelectedFolder := OpenDialog.FileName;
    Edit7.Text:= OpenDialog.FileName;
    FileSearch(OpenDialog.FileName,AddToDbCb);
    FileImg(OpenDialog.FileName,AddToMemoCb);
finally
  OpenDialog.Free;
end;
end;

procedure TForm1.AddToMemoCb(AFileName,Atrib:String; ASize,Aid,Arews:Integer);
begin
listbox1.Items.Add(Format('id: %d; File: %s; Size: %d; Reviews: %d; Attribute: %s',[Aid,AFileName,ASize,Arews,Atrib]));
end;

procedure TForm1.AddToDbCb(AFileName,Atrib:String; ASize,Aid,Arews: Integer);
begin
SqlConnection1.Open;
try

  SqlQuery1.SQL.Text := 'INSERT INTO '+Edit6.text+' (id, name, reviews, size, attribute) VALUES (:id, :name, :reviews, :size, :attribute)';
  {INSERT INTO Info (id,Cost,city)  VALUES (1,200, 'Pune'), (2, 150,'USA'), (3,345, 'France'); }
  SqlQuery1.ParamByName('id').AsInteger := Aid;
  SqlQuery1.ParamByName('name').AsString := AFileName;
  SqlQuery1.ParamByName('reviews').AsInteger := random(5);// Arews;
  SqlQuery1.ParamByName('size').AsInteger := ASize; //inttostr(imgsize);
  SqlQuery1.ParamByName('attribute').AsString := 'fff';
  SQLQuery1.ExecSQL;
  Memo1.Lines.Add('Запись_добавлена='+inttostr(Aid)+Afilename+inttostr(ASize));
finally
PachImage; //добавка в listbox5
SqlConnection1.Close;
end;
//Application.ProcessMessages;
end;

procedure TForm1.RecordBase;
var x,i:integer;
begin
SqlConnection1.Open;
try
for I := 0 to listbox2.Count-1 do begin
SqlQuery1.SQL.Text := 'INSERT INTO '+edit6.Text+' (id, name, reviews, size, attribute) VALUES (:id, :name, :reviews, :size, :attribute)';
SqlQuery1.ParamByName('id').AsInteger := i;
SqlQuery1.ParamByName('name').AsString := ListBox2.Items.Strings[i];
SqlQuery1.ParamByName('size').AsString := '4456874mb'; //inttostr(imgsize);
SqlQuery1.ExecSQL;
Memo1.Lines.Add('Запись_добавлена='+inttostr(i));
end;
finally
SqlConnection1.Close;
end;
{INSERT INTO Info (id,Cost,city)
VALUES (1,200, 'Pune'), (2, 150,'USA'), (3,345, 'France');}
//передача очень много данных
end;

procedure TForm1.PachImage;
var
  I: Integer;
  AColumn: TcxGridDBColumn;  RecNo: Integer;
begin
listbox5.Clear;
  //AColumn := cxGrid1DBTableView1.GetColumnByFieldName('name');
  if AColumn <> nil then  begin
   { for I := 0 to cxGrid1DBTableView1.Controller.SelectedRecordCount - 1 do
    if cxGrid1DBTableView1.Controller.SelectedRecords[i] is TcxGridDataRow then
    memo5.Lines.Add(cxGrid1DBTableView1.Controller.SelectedRecords[i].Values[AColumn.Index]); }
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do
  begin
    RecNo := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
    ListBox5.Items.Add(cxGrid1DBTableView1.DataController.Values[RecNo, 1]);
  end;
  end;
   ImageLoad;
end;
Ответить с цитированием
  #18  
Старый 30.09.2023, 00:38
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,057
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну, Repaint просто заставляет приложение/форму перерисоваться. Т.е. это тут аж вообще не причет.
Application.Process Messages позволяет в промежутке между командами выполнить обработку накопившихся оконных сообщений. Нелохо работает если отдельные команды выполняются быстро. Тогда впечатление, что интерфейс не "зависает".
В твоем случае отдельные команды достаточно длинные по времени выполнения (особенно, если картинки большие). Тут ProcessMessages не поможет. Я бы стмотрел в сторону "выпихивания" самой загрузки в отдельный поток. Но тут надо будет делать синхронизацию между потоком загрузки и основным потоком аккуратно.

Сорри, в таком большом куске кода лень разбираться, так что если есть конкретные вопросы, то задавай, постараюсь ответить.

Условно говоря, создаем внутри главной формы список. При выборе функции загрузки картинок, имена файлов закидываем в этот список. А фоновый поток, когда видит, что в списке есть картинки, начинает их подгружать. Обновление интерфейса можно сделать когда поток загрузил последнюю карнику, а еще лучше по кнопке, что бы синхронизацию не городить. Ну и помещение картинок в список и забирание их потоком синхронизировать через критические секции...
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
leon2009 (30.09.2023)
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 06:34.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter