![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | 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)
| ||