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

Видеокурс программиста и крэкера 5D 2O17
(актуальность: август 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

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

БОЛЬШОЙ FAQ ПО DELPHI



Как заставить DBGrid сортировать данные по щелчку на заголовке столбца

Автор: Nomadic

Песня о зависшем Windows: Кликну, а в ответ - тишина.

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с опpеделенным макpосом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.


 unit vgRXutil;
 
 interface
 
 uses
   SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;
 
 { TrxDBLookup }
 procedure RefreshRXLookup(Lookup: TrxLookupControl);
 procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
 
 function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
 
 { TRxQuery }
 
 { Applicatable to SQL's without SELECT * syntax }
 
 { Inserts FieldName into first position in '%Order' macro and refreshes query }
 procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
 
 { Sets '%Order' macro, if defined, and refreshes query }
 procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
 
 { Converts list of order fields if defined and refreshes query }
 procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
 
 implementation
 uses
   vgUtils, vgDBUtl, vgBDEUtl;
 
 { TrxDBLookup refresh }
 
 type
   TRXLookupControlHack = class(TrxLookupControl)
     property DataSource;
     property LookupSource;
     property Value;
     property EmptyValue;
   end;
 
 procedure RefreshRXLookup(Lookup: TrxLookupControl);
 var
   SaveField: string;
 begin
   with TRXLookupControlHack(Lookup) do
   begin
     SaveField := DataField;
     DataField := '';
     DataField := SaveField;
   end;
 end;
 
 procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
 var
   SaveField: string;
 begin
   with TRXLookupControlHack(Lookup) do
   begin
     SaveField := LookupDisplay;
     LookupDisplay := '';
     LookupDisplay := SaveField;
   end;
 end;
 
 function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
 begin
   with TRXLookupControlHack(Lookup) do
   try
     if Value <> EmptyValue then
       Result := StrToInt(Value)
     else
       Result := 0;
   except
     Result := 0;
   end;
 end;
 
 procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
 var
   Param: TParam;
   OldActive: Boolean;
   OldOrder: string;
   Bmk: TPKBookMark;
 begin
   Param := FindParam(Query.Macros, 'Order');
   if not Assigned(Param) then
     Exit;
 
   OldOrder := Param.AsString;
 
   if OldOrder <> NewOrder then
   begin
     OldActive := Query.Active;
     if OldActive then
       Bmk := GetPKBookmark(Query, '');
     try
       Query.Close;
       Param.AsString := NewOrder;
       try
         Query.Prepare;
       except
         Param.AsString := OldOrder;
       end;
       Query.Active := OldActive;
       if OldActive then
         SetToPKBookMark(Query, Bmk);
     finally
       if OldActive then
         FreePKBookmark(Bmk);
     end;
   end;
 end;
 
 procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
 var
   NewOrderFields: TStrings;
 
   procedure AddOrderField(S: string);
   begin
     if NewOrderFields.IndexOf(S) < 0 then
       NewOrderFields.Add(S);
   end;
 
 var
   I, J: Integer;
   Field: TField;
   FieldDef: TFieldDef;
   S: string;
 begin
   NewOrderFields := TStringList.Create;
   with Query do
   try
     for I := 0 to OrderFields.Count - 1 do
     begin
       S := OrderFields[I];
       Field := FindField(S);
       if Assigned(Field) and (Field.FieldNo > 0) then
         AddOrderField(IntToStr(Field.FieldNo))
       else
       try
         J := StrToInt(S);
         if J < FieldDefs.Count then
           AddOrderField(IntToStr(J));
       except
       end;
     end;
     OrderFields.Assign(NewOrderFields);
   finally
     NewOrderFields.Free;
   end;
 end;
 
 procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
 var
   Param: TParam;
   Tmp, OldOrder, NewOrder: string;
   I: Integer;
   C: Char;
   TmpField: TField;
   OrderFields: TStrings;
 begin
   Param := FindParam(Query.Macros, 'Order');
   if not Assigned(Param) or Field.Calculated or Field.Lookup then
     Exit;
   OldOrder := Param.AsString;
   I := 0;
   Tmp := '';
   OrderFields := TStringList.Create;
   try
     OrderFields.Ad(Field.FieldName);
     while I < Length(OldOrder) do
     begin
       Inc(I);
       C := OldOrder[I];
       if C in FieldNameChars then
         Tmp := Tmp + C;
 
       if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '')
         then
       begin
         TmpField := Field.DataSet.FindField(Tmp);
         if OrderFields.IndexOf(Tmp) < 0 then
           OrderFields.Add(Tmp);
         Tmp := '';
       end;
     end;
 
     UpdateOrderFields(Query, OrderFields);
     NewOrder := OrderFields[0];
     for I := 1 to OrderFields.Count - 1 do
       NewOrder := NewOrder + ', ' + OrderFields[1];
   finally
     OrderFields.Free;
   end;
   InsertOrderBy(Query, NewOrder);
 end;
 
 end.
 




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



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



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


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