Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как научить VCL делать Refresh для запросов правильно

Автор: Nomadic

Если вы чехол с компьютера снимаете чаще, чем платье с вашей подруги, то вы уже давно научный сотрудник.

Старо как мир, и нет ничего военного:


 procedure RefreshQuery(Query: TQuery; F: boolean);
 var
   B: TBookMark;
 begin
   with Query do
     if Query.Active then
     begin
       B := GetBookMark;
       try
         Close;
         Unprepare;
         {Если не поставить этого, то если используется select
         SP, то иногда последующая операция вешает сервер.
         Кто скажет почему?!}
         Active := True;
         if F then
         begin
           try
             GotoBookMark(B)
           except
             on EDatabaseError do
               First;
           end
         end
         else
           First;
       finally
         FreeBookmark(B);
       end;
     end;
 end;
 

Уфф! Кажется, лyчше yже не сделать. :)

dbtables можно опционально пpопатчить (см. в конце), чтобы иметь такой вот pyлезный Detail query.

Update for dbtables.pas

New interface function DoRefreshQuery can Refresh TQuery component in master-detail scheme and alone.

TQuery.RefreshParams should be updated


 function GetFieldNamesStr(DataSet: TDataSet): string;
 var
   I: Integer;
 begin
   Result := '';
   with DataSet do
     for I := 0 to FieldCount - 1 do
     begin
       Result := Result + Fields[I].FieldName + ';';
     end;
 end;
 
 procedure DoRefreshQuery(Query: TQuery; KeyFields: string; BookMarkSearch:
   Boolean);
 var
   Fields: TList;
   KeyValues: Variant;
   KeyNames: string;
   Bmk: TBookmark;
   I: Integer;
   BookmarkFound: Boolean;
   CanLocate: Boolean;
 begin
   Fields := TList.Create;
   if KeyFields = '' then
     KeyFields := GetFieldNamesStr(Query);
   try
     Query.GetFieldList(Fields, KeyFields);
     for I := Fields.Count - 1 downto 0 do
       with TField(Fields[I]) do
         if Calculated or Lookup then
           Fields.Delete(I);
     CanLocate := Fields.Count > 0;
     if CanLocate then
     begin
       if Fields.Count = 1 then
         KeyValues := TField(Fields[0]).Value
       else
       begin
         KeyValues := VarArrayCreate([0, Fields.Count - 1], varVariant);
         KeyValues[0] := TField(Fields[0]).Value;
       end;
       KeyNames := TField(Fields[0]).FieldName;
       for I := 1 to Fields.Count - 1 do
       begin
         KeyNames := KeyNames + ';' + TField(Fields[I]).FieldName;
         KeyValues[I] := TField(Fields[I]).Value;
       end;
     end;
   finally
     Fields.Free;
   end;
   with Query do
   begin
     Bmk := nil;
     DisableControls;
     try
       BookmarkFound := False;
       if BookMarkSearch then
         Bmk := GetBookmark;
       Close;
       Open;
       if Assigned(Bmk) then
       try
         GotoBookMark(Bmk);
         BookmarkFound := True;
       except
       end;
       if not BookmarkFound and CanLocate then
         Locate(KeyNames, KeyValues, []);
     finally
       EnableControls;
       Screen.Cursor := crDefault;
       FreeBookmark(Bmk);
     end;
   end;
 end;
 
 procedure TQuery.RefreshParams;
 var
   DataSet: TDataSet;
 begin
   DisableControls;
   try
     if FDataLink.DataSource <> nil then
     begin
       DataSet := FDataLink.DataSource.DataSet;
       if DataSet <> nil then
         if DataSet.Active and (DataSet.State <> dsSetKey) then
           DoRefreshQuery(Self, GetFieldNamesStr(Self), False);
     end;
   finally
     EnableControls;
   end;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS