|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
|||
|
|||
тут такое дело
а что там про фон было
Application.ProcessMessages; -> когда грузишь в базу (freehost). как можно заниматься другим чем нибудь screens2.jpg |
#17
|
|||
|
|||
не могу сообразить
Не могу сообразить 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
|
|||
|
|||
Ну, Repaint просто заставляет приложение/форму перерисоваться. Т.е. это тут аж вообще не причет.
Application.Process Messages позволяет в промежутке между командами выполнить обработку накопившихся оконных сообщений. Нелохо работает если отдельные команды выполняются быстро. Тогда впечатление, что интерфейс не "зависает". В твоем случае отдельные команды достаточно длинные по времени выполнения (особенно, если картинки большие). Тут ProcessMessages не поможет. Я бы стмотрел в сторону "выпихивания" самой загрузки в отдельный поток. Но тут надо будет делать синхронизацию между потоком загрузки и основным потоком аккуратно. Сорри, в таком большом куске кода лень разбираться, так что если есть конкретные вопросы, то задавай, постараюсь ответить. Условно говоря, создаем внутри главной формы список. При выборе функции загрузки картинок, имена файлов закидываем в этот список. А фоновый поток, когда видит, что в списке есть картинки, начинает их подгружать. Обновление интерфейса можно сделать когда поток загрузил последнюю карнику, а еще лучше по кнопке, что бы синхронизацию не городить. Ну и помещение картинок в список и забирание их потоком синхронизировать через критические секции... |
Этот пользователь сказал Спасибо lmikle за это полезное сообщение: | ||
leon2009 (30.09.2023)
|