Ребята: спасайте. Понимаю: что вопрос детский но не могу победить.
Выручайте...
В общем вот кусок кода:
procedure TMainClient.lbTareMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Single);
var
ValidateAnswer:TValidateAnswer;
begin
if (not UpdateMouseDownT) then exit;
UpdateMouseDownT := false;
if (not UpdateDoT) then
begin
if (Layout4.Height <> 0) then
lclCloseAnimationT;
Exit;
end;
lclUpAnimationT;
TThread.CreateAnonymousThread(procedure ()
begin
TThread.Synchronize (nil,
procedure ()
begin
lbTare.BeginUpdate;
Label7.Text := 'Обновляется';
end);
ValidateAnswer := ValidateID;
if ValidateAnswer = TValidateAnswer.aValid then
begin
ClientModule1.FDConnLocalSQLight.StartTransaction;
try
ClientModule1.GetTareBlanceToLocalBD;
ClientModule1.FDConnLocalSQLight.Commit;
except
on E: Exception do
begin
ClientModule1.FDConnLocalSQLight.Rollback;
TThread.Synchronize (nil,
procedure ()
begin
ShowToastMessage('Синхронизация прервана '+E.Message,TShowMessageType.aToastDlg);
end);
end;
end;
TThread.Synchronize(nil,
procedure ()
begin
UpdateTareBalanceItems;
lclCloseAnimationT;
Label7.Text := 'Обновлено';
lbTare.EndUpdate;
end);
end else
begin
TThread.Synchronize(nil,
procedure ()
begin
if (Layout4.Height <> 0) then
lclCloseAnimationT;
lbTare.EndUpdate;
case ValidateAnswer of
TValidateAnswer.aNotValid:
ShowToastMessage('Код Регистрации Отклонен', TShowMessagetype.aToastDlg);
TValidateAnswer.aNoConnection:
ShowToastMessage('Нет Соедиения с Сервером Поставщика', TShowMessagetype.aToastDlg);
end;
end);
end;
end).Start;
UpdateDoT := false;
end;
В се работает хорошо.
Но вот есть одна проблема...
Часть ЛистБокса не отрисовывается до окончания обновления данных.
Вопрос
juppy
Всем привет!
Ребята: спасайте. Понимаю: что вопрос детский но не могу победить.
Выручайте...
В общем вот кусок кода:
procedure TMainClient.lbTareMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); var ValidateAnswer:TValidateAnswer; begin if (not UpdateMouseDownT) then exit; UpdateMouseDownT := false; if (not UpdateDoT) then begin if (Layout4.Height <> 0) then lclCloseAnimationT; Exit; end; lclUpAnimationT; TThread.CreateAnonymousThread(procedure () begin TThread.Synchronize (nil, procedure () begin lbTare.BeginUpdate; Label7.Text := 'Обновляется'; end); ValidateAnswer := ValidateID; if ValidateAnswer = TValidateAnswer.aValid then begin ClientModule1.FDConnLocalSQLight.StartTransaction; try ClientModule1.GetTareBlanceToLocalBD; ClientModule1.FDConnLocalSQLight.Commit; except on E: Exception do begin ClientModule1.FDConnLocalSQLight.Rollback; TThread.Synchronize (nil, procedure () begin ShowToastMessage('Синхронизация прервана '+E.Message,TShowMessageType.aToastDlg); end); end; end; TThread.Synchronize(nil, procedure () begin UpdateTareBalanceItems; lclCloseAnimationT; Label7.Text := 'Обновлено'; lbTare.EndUpdate; end); end else begin TThread.Synchronize(nil, procedure () begin if (Layout4.Height <> 0) then lclCloseAnimationT; lbTare.EndUpdate; case ValidateAnswer of TValidateAnswer.aNotValid: ShowToastMessage('Код Регистрации Отклонен', TShowMessagetype.aToastDlg); TValidateAnswer.aNoConnection: ShowToastMessage('Нет Соедиения с Сервером Поставщика', TShowMessagetype.aToastDlg); end; end); end; end).Start; UpdateDoT := false; end;
В се работает хорошо.
Но вот есть одна проблема...
Часть ЛистБокса не отрисовывается до окончания обновления данных.
Вот как это выглядит в приложении:https://www.youtube.com/watch?v=NeZmUKwTfEk
Видно, что внизу остается белая часть до тех пор, пока все не выполнится.
Как ее победить - не знаю!
Помогите...
Изменено пользователем juppyСсылка на комментарий
1 ответ на этот вопрос
Рекомендуемые сообщения
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.